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
10 ;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
12 ;;;; *************************************************************************
14 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
20 (ff:with-stack-fobject (ptr :int)
21 (setf (ff:fslot-value ptr) 0))
23 (fli:with-dynamic-foreign-objects ((ptr :int))
24 (setf (fli:dereference ptr) 0))
26 (alien:with-alien ((ptr alien:signed))
27 (let ((p (alien:addr ptr)))
28 (setf (alien:deref p) 0)))
30 (sb-alien:with-alien ((ptr sb-alien:signed))
31 (let ((p (sb-alien:addr ptr)))
32 (setf (sb-alien:deref p) 0)))
37 (ff:with-stack-fobject (ptr '(:array :int 10) )
38 (setf (ff:fslot-value ptr 5) 0))
40 (fli:with-dynamic-foreign-objects ((ptr (:c-array :int 10)))
41 (setf (fli:dereference ptr 5) 0))
43 (alien:with-alien ((ptr (alien:array alien:signed 10)))
44 (setf (alien:deref ptr 5) 0))
46 (sb-alien:with-alien ((ptr (sb-alien:array sb-alien:signed 10)))
47 (setf (sb-alien:deref ptr 5) 0))
52 (let ((ptr (ff:allocate-fobject :int :c)))
53 (declare (dynamic-extent ptr))
54 (setf (ff:fslot-value-typed :int :c ptr) 0)
55 (ff:free-fobject ptr))
57 (let ((ptr (fli:allocate-foreign-object :type :int)))
58 (declare (dynamic-extent ptr))
59 (setf (fli:dereference ptr) 0)
60 (fli:free-foreign-object ptr))
62 (let ((ptr (alien:make-alien (alien:signed 32))))
63 (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
65 (setf (alien:deref ptr) 0)
66 (alien:free-alien ptr))
68 (let ((ptr (sb-alien:make-alien (sb-alien:signed 32))))
69 (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
71 (setf (sb-alien:deref ptr) 0)
72 (sb-alien:free-alien ptr))
77 (let ((ptr (ff:allocate-fobject '(:array :int 10) :c)))
78 (declare (dynamic-extent ptr))
79 (setf (ff:fslot-value-typed '(:array :int 10) :c ptr 5) 0)
80 (ff:free-fobject ptr))
82 (let ((ptr (fli:allocate-foreign-object :type '(:c-array :int 10))))
83 (declare (dynamic-extent ptr))
84 (setf (fli:dereference ptr 5) 0)
85 (fli:free-foreign-object ptr))
87 (let ((ptr (alien:make-alien (alien:array (alien:signed 32) 10))))
88 (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
90 (setf (alien:deref ptr 5) 0)
91 (alien:free-alien ptr))
93 (let ((ptr (sb-alien:make-alien (sb-alien:array (sb-alien:signed 32) 10))))
94 (declare ;;(type (sb-alien (* (sb-alien:unsigned 32))) ptr)
96 (setf (sb-alien:deref ptr 5) 0)
97 (sb-alien:free-alien ptr))
101 (defun stk-vs-stat ()
102 (format t "~&Stack allocation, Integer")
103 (time (dotimes (i 1000)
106 (format t "~&Static allocation, Integer")
107 (time (dotimes (i 1000)
110 (format t "~&Stack allocation, Vector")
111 (time (dotimes (i 1000)
114 (format t "~&Static allocation, Vector")
115 (time (dotimes (i 1000)