1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: allocation.cl
6 ;;;; Purpose: Benchmark allocation and slot-access speed
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Mar 2002
12 ;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
14 ;;;; *************************************************************************
16 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
22 (ff:with-stack-fobject (ptr :int)
23 (setf (ff:fslot-value ptr) 0))
25 (fli:with-dynamic-foreign-objects ((ptr :int))
26 (setf (fli:dereference ptr) 0))
28 (alien:with-alien ((ptr alien:signed))
29 (let ((p (alien:addr ptr)))
30 (setf (alien:deref p) 0)))
32 (sb-alien:with-alien ((ptr sb-alien:signed))
33 (let ((p (sb-alien:addr ptr)))
34 (setf (sb-alien:deref p) 0)))
39 (ff:with-stack-fobject (ptr '(:array :int 10) )
40 (setf (ff:fslot-value ptr 5) 0))
42 (fli:with-dynamic-foreign-objects ((ptr (:c-array :int 10)))
43 (setf (fli:dereference ptr 5) 0))
45 (alien:with-alien ((ptr (alien:array alien:signed 10)))
46 (setf (alien:deref ptr 5) 0))
48 (sb-alien:with-alien ((ptr (sb-alien:array sb-alien:signed 10)))
49 (setf (sb-alien:deref ptr 5) 0))
54 (let ((ptr (ff:allocate-fobject :int :c)))
55 (declare (dynamic-extent ptr))
56 (setf (ff:fslot-value-typed :int :c ptr) 0)
57 (ff:free-fobject ptr))
59 (let ((ptr (fli:allocate-foreign-object :type :int)))
60 (declare (dynamic-extent ptr))
61 (setf (fli:dereference ptr) 0)
62 (fli:free-foreign-object ptr))
64 (let ((ptr (alien:make-alien (alien:signed 32))))
65 (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
67 (setf (alien:deref ptr) 0)
68 (alien:free-alien ptr))
70 (let ((ptr (sb-alien:make-alien (sb-alien:signed 32))))
71 (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
73 (setf (sb-alien:deref ptr) 0)
74 (sb-alien:free-alien ptr))
79 (let ((ptr (ff:allocate-fobject '(:array :int 10) :c)))
80 (declare (dynamic-extent ptr))
81 (setf (ff:fslot-value-typed '(:array :int 10) :c ptr 5) 0)
82 (ff:free-fobject ptr))
84 (let ((ptr (fli:allocate-foreign-object :type '(:c-array :int 10))))
85 (declare (dynamic-extent ptr))
86 (setf (fli:dereference ptr 5) 0)
87 (fli:free-foreign-object ptr))
89 (let ((ptr (alien:make-alien (alien:array (alien:signed 32) 10))))
90 (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
92 (setf (alien:deref ptr 5) 0)
93 (alien:free-alien ptr))
95 (let ((ptr (sb-alien:make-alien (sb-alien:array (sb-alien:signed 32) 10))))
96 (declare ;;(type (sb-alien (* (sb-alien:unsigned 32))) ptr)
98 (setf (sb-alien:deref ptr 5) 0)
99 (sb-alien:free-alien ptr))
103 (defun stk-vs-stat ()
104 (format t "~&Stack allocation, Integer")
105 (time (dotimes (i 1000)
108 (format t "~&Static allocation, Integer")
109 (time (dotimes (i 1000)
112 (format t "~&Stack allocation, Vector")
113 (time (dotimes (i 1000)
116 (format t "~&Static allocation, Vector")
117 (time (dotimes (i 1000)