1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
;;;; -*- 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
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg
;;;;
;;;; *************************************************************************
(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)))
#+sbcl
(sb-alien:with-alien ((ptr sb-alien:signed))
(let ((p (sb-alien:addr ptr)))
(setf (sb-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))
#+sbcl
(sb-alien:with-alien ((ptr (sb-alien:array sb-alien:signed 10)))
(setf (sb-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))
#+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 ()
#+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))
#+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))))
(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)
|
