X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=benchmarks%2Fallocation.cl;fp=benchmarks%2Fallocation.cl;h=0000000000000000000000000000000000000000;hb=a95b9a217335917d96b8c0cced4f49c3e4846115;hp=caebce2650944466879bcd0ead363f6ea62d7558;hpb=bcd9fb3deb580f2976e7505a7433795ed6ad1bb3;p=uffi.git

diff --git a/benchmarks/allocation.cl b/benchmarks/allocation.cl
deleted file mode 100644
index caebce2..0000000
--- a/benchmarks/allocation.cl
+++ /dev/null
@@ -1,110 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          allocation.cl
-;;;; Purpose:       Benchmark allocation and slot-access speed
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Mar 2002
-;;;;
-;;;; $Id: allocation.cl,v 1.3 2002/03/21 19:47:20 kevin Exp $
-;;;;
-;;;; 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)))
-(in-package :cl-user)
-
-
-(defun stk-int ()
-  #+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))
-    (let ((p (alien:addr ptr)))
-      (setf (alien:deref p) 0)))
-  )
-
-(defun stk-vector ()
-  #+allegro
-  (ff:with-stack-fobject (ptr '(:array :int 10) )
-    (setf (ff:fslot-value ptr 5) 0))
-  #+lispworks
-  (fli:with-dynamic-foreign-objects ((ptr (:c-array :int 10)))
-    (setf (fli:dereference ptr 5) 0))
-  #+cmu
-  (alien:with-alien ((ptr (alien:array alien:signed 10)))
-    (setf (alien:deref ptr 5) 0))
-  )
-
-(defun stat-int ()
-  #+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 stat-vector ()
-  #+allegro
-  (let ((ptr (ff:allocate-fobject '(:array :int 10) :c)))
-    (declare (dynamic-extent ptr))
-    (setf (ff:fslot-value-typed '(:array :int 10) :c ptr 5) 0)
-    (ff:free-fobject ptr))
-  #+lispworks
-  (let ((ptr (fli:allocate-foreign-object :type '(:c-array :int 10))))
-    (declare (dynamic-extent ptr))
-    (setf (fli:dereference ptr 5) 0)
-    (fli:free-foreign-object ptr))
-  #+cmu
-  (let ((ptr (alien:make-alien (alien:array (alien:signed 32) 10))))
-    (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
-	     (dynamic-extent ptr))
-    (setf (alien:deref ptr 5) 0)
-    (alien:free-alien ptr))
-  )
-
-
-(defun stk-vs-stat ()
-  (format t "~&Stack allocation, Integer")
-  (time (dotimes (i 1000) 
-	  (dotimes (j 1000)
-	    (stk-int))))
-  (format t "~&Static allocation, Integer")
-  (time (dotimes (i 1000) 
-	  (dotimes (j 1000)
-	    (stat-int))))
-  (format t "~&Stack allocation, Vector")
-  (time (dotimes (i 1000) 
-	  (dotimes (j 1000)
-	    (stk-int))))
-  (format t "~&Static allocation, Vector")
-  (time (dotimes (i 1000) 
-	  (dotimes (j 1000)
-	    (stat-int))))
-)
-
-
-(stk-vs-stat)
-
-			    
-