[Openmcl-cvs-notifications] r10790 - /trunk/source/lib/ffi-linuxx8632.lisp

[gb at clozure.com]

Author: gb
Date: Wed Sep 17 18:06:40 2008
New Revision: 10790

Log:
Return callback results differently (requires changes in .SPcallback
subprim.)

Assume that .SPcallback has reserved a few words on entry; store
results there, and set a flag in a word that's zeroed by .SPcallback
to indicate whether the result is a float that needs to be loaded
into the x87.

(Need to do similar things on Darwinx8632).


Modified:
    trunk/source/lib/ffi-linuxx8632.lisp

Modified: trunk/source/lib/ffi-linuxx8632.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/ffi-linuxx8632.lisp (original)
+++ trunk/source/lib/ffi-linuxx8632.lisp Wed Sep 17 18:06:40 2008
@@ -155,14 +155,23 @@
       ;; Would have been mapped to :VOID unless record-type was <=3D 64 bi=
ts
       (format t "~&need to return structure ~s by value" return-type)
       (let* ((return-type-keyword (foreign-type-to-representation-type ret=
urn-type)))
-	`(setf (,
-		(case return-type-keyword
-		  (:address '%get-ptr)
-		  (:signed-doubleword '%%get-signed-longlong)
-		  (:unsigned-doubleword '%%get-unsigned-longlong)
-		  (:double-float '%get-double-float)
-		  (:single-float '%get-single-float)
-		  (:unsigned-fullword '%get-unsigned-long)
-		  (t '%get-signed-long)
-		  ) ,stack-ptr 8) ,result)))))
+        (ccl::collect ((forms))
+          (forms 'progn)
+          (case return-type-keyword
+            (:single-float
+             (forms `(setf (%get-unsigned-byte ,stack-ptr -16) 1)))
+            (:double-float
+             (forms `(setf (%get-unsigned-byte ,stack-ptr -16) 2))))
+          (forms
+           `(setf (,
+                   (case return-type-keyword
+                     (:address '%get-ptr)
+                     (:signed-doubleword '%%get-signed-longlong)
+                     (:unsigned-doubleword '%%get-unsigned-longlong)
+                     (:double-float '%get-double-float)
+                     (:single-float '%get-single-float)
+                     (:unsigned-fullword '%get-unsigned-long)
+                     (t '%get-signed-long)
+                     ) ,stack-ptr -8) ,result))
+          (forms))))))
 =