r11615: 2007-04-12 Kevin Rosenberg (kevin@rosenberg.net)

        * Version 1.5.18
        * src/functions.lisp: Patch from Ian Eslick for Lispworks 5

diff --git a/ChangeLog b/ChangeLog
index 9969e763423ccef4ae75df317d192ebcf68be2b8..64355c63c3a5c497b40d3f40dfdcf69493c2e932 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,7 +1,11 @@
+2007-04-12 Kevin Rosenberg (kevin@rosenberg.net)
+       * Version 1.5.18
+       * src/functions.lisp: Patch from Ian Eslick for Lispworks 5
+
 2006-10-10 Kevin Rosenberg (kevin@rosenberg.net)
        * Version 1.5.17
        * src/functions.lisp: Patch from Edi Weitz for Lispworks 5/Linux
-       
+
 2006-09-02 Kevin Rosenberg (kevin@rosenberg.net)
        * Version 1.5.16
        * src/libraries.lisp: Add cygwin support

diff --git a/debian/changelog b/debian/changelog
index 060c0db756ff592f43e13d7a185213904e91b8df..ebb99cf761faabb099b1d6cbe83185402db855e6 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-uffi (1.5.18-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kevin@b9.com>  Thu, 12 Apr 2007 23:48:46 -0600
+
 cl-uffi (1.5.17-1) unstable; urgency=low
 
   * New upstream

diff --git a/src/functions.lisp b/src/functions.lisp
index fb74d6aaf1d7a5c8c08eb54583fe3ee355d0c557..aab3b63d934dddb50ba29c1f798327a6dc9d54ff 100644 (file)
--- a/src/functions.lisp
+++ b/src/functions.lisp
@@ -104,7 +104,7 @@
            (push (list (first arg)
                        (list :reference-return (second arg))) processed)
            (push (subseq arg 0 2) processed))
-       finally (return processed)))
+       finally (return (nreverse processed))))
 
 (defun preprocess-names (names)
   (let ((fname (gensym)))
@@ -146,21 +146,36 @@
        #+(or cmu scl sbcl)
        `(%def-function ,names ,args 
          ,@(if returning (list :returning returning) (values)))
-       #+lispworks
-       `(%def-function ,names ,(convert-lispworks-args args) 
+       #+(and lispworks lispworks5)
+       (multiple-value-bind (name-pair fname lisp-name)
+           (preprocess-names names)
+         `(progn
+              (%def-function ,name-pair ,(convert-lispworks-args args)
+                             ,@(if module (list :module module) (values))
+                             ,@(if returning (list :returning returning) (values)))
+              (defun ,lisp-name ,lisp-args
+                (,fname ,@(mapcar 
+                           #'(lambda (arg)
+                               (cond ((member (first arg) lisp-args)
+                                      (first arg))
+                                     ((member (first arg) out :key #'first)
+                                      t)))
+                         args)))))
+       #+(and lispworks (not lispworks5))
+       `(%def-function ,names ,(convert-lispworks-args args)
          ,@(if module (list :module module) (values))
          ,@(if returning (list :returning returning) (values)))
        #-(or cmu scl sbcl lispworks)
        (multiple-value-bind (name-pair fname lisp-name)
            (preprocess-names names)
-         `(prog1
+         `(progn
            (%def-function ,name-pair ,processed 
             :module ,module :returning ,returning)
            ;(declaim (inline ,fname))
            (defun ,lisp-name ,lisp-args
              (with-foreign-objects ,out
                (values (,fname ,@(mapcar #'first args))
-                       ,@(mapcar #'(lambda (arg)
+                       ,@(mapcar #'(lambda (arg)
                                      (list 'deref-pointer
                                            (first arg)
                                            (second arg))) out))))))
@@ -176,7 +191,6 @@
         (function-args (process-function-args args))
         (foreign-name (if (atom names) names (car names)))
         (lisp-name (if (atom names) (make-lisp-name names) (cadr names))))
-
     ;; todo: calling-convention :stdcall for cormanlisp
     #+allegro
     `(ff:def-foreign-call (,lisp-name ,foreign-name)