X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=benchmarks%2Fallocation.lisp;h=29636da5b0da9022a9b0673dbb5c7dc0bf4f7dea;hb=HEAD;hp=516902a6ae0cd4260eab04b048f01e64c2f868ae;hpb=a95b9a217335917d96b8c0cced4f49c3e4846115;p=uffi.git

diff --git a/benchmarks/allocation.lisp b/benchmarks/allocation.lisp
index 516902a..29636da 100644
--- a/benchmarks/allocation.lisp
+++ b/benchmarks/allocation.lisp
@@ -7,13 +7,8 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: allocation.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
+;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
@@ -22,7 +17,7 @@
 
 (defun stk-int ()
   #+allegro
-  (ff:with-stack-fobject (ptr :int) 
+  (ff:with-stack-fobject (ptr :int)
     (setf (ff:fslot-value ptr) 0))
   #+lispworks
   (fli:with-dynamic-foreign-objects ((ptr :int))
@@ -31,6 +26,10 @@
   (alien:with-alien ((ptr alien:signed))
     (let ((p (alien:addr ptr)))
       (setf (alien:deref p) 0)))
+  #+sbcl
+  (sb-alien:with-alien ((ptr sb-alien:signed))
+    (let ((p (sb-alien:addr ptr)))
+      (setf (sb-alien:deref p) 0)))
   )
 
 (defun stk-vector ()
@@ -43,6 +42,9 @@
   #+cmu
   (alien:with-alien ((ptr (alien:array alien:signed 10)))
     (setf (alien:deref ptr 5) 0))
+  #+sbcl
+  (sb-alien:with-alien ((ptr (sb-alien:array sb-alien:signed 10)))
+    (setf (sb-alien:deref ptr 5) 0))
   )
 
 (defun stat-int ()
@@ -59,9 +61,15 @@
   #+cmu
   (let ((ptr (alien:make-alien (alien:signed 32))))
     (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
-	     (dynamic-extent ptr))
+             (dynamic-extent ptr))
     (setf (alien:deref ptr) 0)
     (alien:free-alien ptr))
+  #+sbcl
+  (let ((ptr (sb-alien:make-alien (sb-alien:signed 32))))
+    (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
+     (dynamic-extent ptr))
+    (setf (sb-alien:deref ptr) 0)
+    (sb-alien:free-alien ptr))
   )
 
 (defun stat-vector ()
@@ -78,33 +86,39 @@
   #+cmu
   (let ((ptr (alien:make-alien (alien:array (alien:signed 32) 10))))
     (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
-	     (dynamic-extent ptr))
+             (dynamic-extent ptr))
     (setf (alien:deref ptr 5) 0)
     (alien:free-alien ptr))
+  #+sbcl
+  (let ((ptr (sb-alien:make-alien (sb-alien:array (sb-alien:signed 32) 10))))
+    (declare ;;(type (sb-alien (* (sb-alien:unsigned 32))) ptr)
+             (dynamic-extent ptr))
+    (setf (sb-alien:deref ptr 5) 0)
+    (sb-alien:free-alien ptr))
   )
 
 
 (defun stk-vs-stat ()
   (format t "~&Stack allocation, Integer")
-  (time (dotimes (i 1000) 
-	  (dotimes (j 1000)
-	    (stk-int))))
+  (time (dotimes (i 1000)
+          (dotimes (j 1000)
+            (stk-int))))
   (format t "~&Static allocation, Integer")
-  (time (dotimes (i 1000) 
-	  (dotimes (j 1000)
-	    (stat-int))))
+  (time (dotimes (i 1000)
+          (dotimes (j 1000)
+            (stat-int))))
   (format t "~&Stack allocation, Vector")
-  (time (dotimes (i 1000) 
-	  (dotimes (j 1000)
-	    (stk-int))))
+  (time (dotimes (i 1000)
+          (dotimes (j 1000)
+            (stk-int))))
   (format t "~&Static allocation, Vector")
-  (time (dotimes (i 1000) 
-	  (dotimes (j 1000)
-	    (stat-int))))
+  (time (dotimes (i 1000)
+          (dotimes (j 1000)
+            (stat-int))))
 )
 
 
 (stk-vs-stat)
 
-			    
+