From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Thu, 21 Mar 2002 14:21:48 +0000 (+0000)
Subject: r1610: *** empty log message ***
X-Git-Tag: v1.6.1~557
X-Git-Url: http://git.kpe.io/?a=commitdiff_plain;h=5709e7e3117996052ca59d6b997f8e73c74d8bb0;p=uffi.git

r1610: *** empty log message ***
---

diff --git a/benchmarks/allocation.cl b/benchmarks/allocation.cl
new file mode 100644
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)))))
+
+			    
+