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 ;;;; $Id: allocation.lisp,v 1.1 2002/09/30 10:02:36 kevin Exp $
12 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
14 ;;;; UFFI users are granted the rights to distribute and use this software
15 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
16 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
17 ;;;; *************************************************************************
19 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
25 (ff:with-stack-fobject (ptr :int)
26 (setf (ff:fslot-value ptr) 0))
28 (fli:with-dynamic-foreign-objects ((ptr :int))
29 (setf (fli:dereference ptr) 0))
31 (alien:with-alien ((ptr alien:signed))
32 (let ((p (alien:addr ptr)))
33 (setf (alien:deref p) 0)))
38 (ff:with-stack-fobject (ptr '(:array :int 10) )
39 (setf (ff:fslot-value ptr 5) 0))
41 (fli:with-dynamic-foreign-objects ((ptr (:c-array :int 10)))
42 (setf (fli:dereference ptr 5) 0))
44 (alien:with-alien ((ptr (alien:array alien:signed 10)))
45 (setf (alien:deref ptr 5) 0))
50 (let ((ptr (ff:allocate-fobject :int :c)))
51 (declare (dynamic-extent ptr))
52 (setf (ff:fslot-value-typed :int :c ptr) 0)
53 (ff:free-fobject ptr))
55 (let ((ptr (fli:allocate-foreign-object :type :int)))
56 (declare (dynamic-extent ptr))
57 (setf (fli:dereference ptr) 0)
58 (fli:free-foreign-object ptr))
60 (let ((ptr (alien:make-alien (alien:signed 32))))
61 (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
63 (setf (alien:deref ptr) 0)
64 (alien:free-alien ptr))
69 (let ((ptr (ff:allocate-fobject '(:array :int 10) :c)))
70 (declare (dynamic-extent ptr))
71 (setf (ff:fslot-value-typed '(:array :int 10) :c ptr 5) 0)
72 (ff:free-fobject ptr))
74 (let ((ptr (fli:allocate-foreign-object :type '(:c-array :int 10))))
75 (declare (dynamic-extent ptr))
76 (setf (fli:dereference ptr 5) 0)
77 (fli:free-foreign-object ptr))
79 (let ((ptr (alien:make-alien (alien:array (alien:signed 32) 10))))
80 (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
82 (setf (alien:deref ptr 5) 0)
83 (alien:free-alien ptr))
88 (format t "~&Stack allocation, Integer")
89 (time (dotimes (i 1000)
92 (format t "~&Static allocation, Integer")
93 (time (dotimes (i 1000)
96 (format t "~&Stack allocation, Vector")
97 (time (dotimes (i 1000)
100 (format t "~&Static allocation, Vector")
101 (time (dotimes (i 1000)