From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Fri, 13 Apr 2007 05:49:01 +0000 (+0000)
Subject: r11615: 2007-04-12 Kevin Rosenberg (kevin@rosenberg.net)
X-Git-Tag: v1.6.1~10
X-Git-Url: http://git.kpe.io/?p=uffi.git;a=commitdiff_plain;h=4c8542b7e7184990d44f8db9a38736eabfa01da7

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 9969e76..64355c6 100644
--- 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 060c0db..ebb99cf 100644
--- 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 fb74d6a..aab3b63 100644
--- 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)