benchmarks/allocation.cl

   1 (in-package :cl-user)
   2
   3
   4 (defun stk ()
   5   #+allegro
   6   (ff:with-stack-fobject (ptr :int)
   7     (setf (ff:fslot-value ptr) 0))
   8   #+lispworks
   9   (fli:with-dynamic-foreign-objects ((ptr :int))
  10     (setf (fli:dereference ptr) 0))
  11   #+cmu
  12   (alien:with-alien ((ptr alien:signed))
  13     (setf ptr 0))
  14   )
  15
  16 (defun stat ()
  17   #+allegro
  18   (let ((ptr (ff:allocate-fobject :int :c)))
  19     (declare (dynamic-extent ptr))
  20     (setf (ff:fslot-value-typed :int :c ptr) 0)
  21     (ff:free-fobject ptr))
  22   #+lispworks
  23   (let ((ptr (fli:allocate-foreign-object :type :int)))
  24     (declare (dynamic-extent ptr))
  25     (setf (fli:dereference ptr) 0)
  26     (fli:free-foreign-object ptr))
  27   #+cmu
  28   (let ((ptr (alien:make-alien (alien:signed 32))))
  29     (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
  30              (dynamic-extent ptr))
  31     (setf (alien:deref ptr) 0)
  32     (alien:free-alien ptr))
  33   )
  34
  35
  36
  37 (defun stk-vs-stat ()
  38   (format t "~&Stack allocation")
  39   (time (dotimes (i 1000)
  40           (dotimes (j 1000)
  41             (stk))))
  42   (format t "~&Static allocation, open-coded slot access")
  43   (time (dotimes (i 1000)
  44           (dotimes (j 1000)
  45             (stat)))))
  46
  47
  48