[cffi-devel] Inline pointer related functions on Allegro

[John Fremlin]

Luís Oliveira <luismbo at gmail.com> writes:
> On Thu, Aug 20, 2009 at 3:34 AM, John Fremlin<jf at msi.co.jp> wrote:
>> The no-long-long feature is incredibly broken on 64-bit Linux, as it
>> assumes that a long is 32-bits when it is actually 64-bits. This causes
>> very hard crashes (Allegro's strange SIGEMT).
>
> Yeah, the problem of course is that there is no free 64-bit version of
> Allegro so we can't support as well as we'd like. You should complain
> to them. :-)

Well, I would rather recommend that everyone use SBCL as it is more
correct, has a modern compiler, supports threads, and bugs are actually
fixed(!) in a few days, rather than for the next release (or not at all).

Here's one more patch to inline some common CFFI operations which makes
things faster. I'm not sure if you want to apply this patch as it is
obviously a little cunning and if you want speed you should probably be
using SBCL anyway.

As you can see, programming with Allegro tends to involve lots of SPR
(support request) numbers. :-(

(This views are my personal ones and do not reflect those of MSI.)

--- old-cffi/src/cffi-allegro.lisp	2009-09-10 16:48:13.000000000 +0900
+++ new-cffi/src/cffi-allegro.lisp	2009-09-10 16:48:13.000000000 +0900
@@ -87,15 +89,41 @@
   "Return true if PTR1 and PTR2 point to the same address."
   (eql ptr1 ptr2))
 
-(defun null-pointer ()
+(defmacro defun-speedy (name lambda-list documentation &body body) 
+  ;; this is a very cheesy inliner for a few simple cases
+  (check-type documentation string)
+  (assert body)
+  `(progn
+     (declaim (inline ,name)) ;; this is just nonsense as Allegro 8.1 cannot inline user functions :-(
+     (defun ,name ,lambda-list
+       ,documentation
+       (declare (optimize speed))
+       , at body)
+     (define-compiler-macro ,name ,lambda-list
+       `(progn 
+
+;; AARRRGH -- yet another Allegro compiler bug if this useless progn
+;; is omitted (spr36171)
+
+;; [The Allegro compiler has some insane ideas about how to do (setf
+;; let) resulting in the wrong output from get-setf-expansion (in
+;; compiled mode).]
+
+         (let (,,@(loop 
+                        for n in lambda-list 
+                        collect ``(,',n ,,n)))
+           (declare (optimize speed))
+           ,@',body)))))
+
+(defun-speedy null-pointer ()
   "Return a null pointer."
   0)
 
-(defun null-pointer-p (ptr)
+(defun-speedy null-pointer-p (ptr)
   "Return true if PTR is a null pointer."
   (zerop ptr))
 
-(defun inc-pointer (ptr offset)
+(defun-speedy inc-pointer (ptr offset)
   "Return a pointer pointing OFFSET bytes past PTR."
   (+ ptr offset))
 
@@ -136,7 +164,7 @@
     (return-from with-foreign-pointer
       `(let ((,size-var ,size))
          (declare (ignorable ,size-var))
-         (ff:with-static-fobject (,var '(:array :char ,size)
+         (ff:with-static-fobject (,var '(:array :char ,(eval size))
                                        :allocation :foreign-static-gc)
            ;; (excl::stack-allocated-p var) => T
            (let ((,var (ff:fslot-address ,var)))

[...]