r1610: *** empty log message ***

diff --git a/benchmarks/allocation.cl b/benchmarks/allocation.cl
new file mode 100644 (file)
index 0000000..de014f7
--- /dev/null
+++ b/benchmarks/allocation.cl
@@ -0,0 +1,48 @@
+(in-package :cl-user)
+
+
+(defun stk ()
+  #+allegro
+  (ff:with-stack-fobject (ptr :int) 
+    (setf (ff:fslot-value ptr) 0))
+  #+lispworks
+  (fli:with-dynamic-foreign-objects ((ptr :int))
+    (setf (fli:dereference ptr) 0))
+  #+cmu
+  (alien:with-alien ((ptr alien:signed))
+    (setf ptr 0))
+  )
+
+(defun stat ()
+  #+allegro
+  (let ((ptr (ff:allocate-fobject :int :c)))
+    (declare (dynamic-extent ptr))
+    (setf (ff:fslot-value-typed :int :c ptr) 0)
+    (ff:free-fobject ptr))
+  #+lispworks
+  (let ((ptr (fli:allocate-foreign-object :type :int)))
+    (declare (dynamic-extent ptr))
+    (setf (fli:dereference ptr) 0)
+    (fli:free-foreign-object ptr))
+  #+cmu
+  (let ((ptr (alien:make-alien (alien:signed 32))))
+    (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
+            (dynamic-extent ptr))
+    (setf (alien:deref ptr) 0)
+    (alien:free-alien ptr))
+  )
+
+
+
+(defun stk-vs-stat ()
+  (format t "~&Stack allocation")
+  (time (dotimes (i 1000) 
+         (dotimes (j 1000)
+           (stk))))
+  (format t "~&Static allocation, open-coded slot access")
+  (time (dotimes (i 1000) 
+         (dotimes (j 1000)
+           (stat)))))
+
+                           
+