Index: /branches/ia32/lib/ffi-darwinx8632.lisp
===================================================================
--- /branches/ia32/lib/ffi-darwinx8632.lisp	(revision 7817)
+++ /branches/ia32/lib/ffi-darwinx8632.lisp	(revision 7818)
@@ -1,7 +1,7 @@
 (in-package "CCL")
 
-;;; On Darwin/IA-32, when a function returns a structure or union
-;;; larger than 8 bytes, the caller passes a pointer to
-;;; appropriate storage as the first argument to the function.
+;;; When a function returns a structure or union larger than 8 bytes,
+;;; the caller passes a pointer to appropriate storage as the first
+;;; argument to the function.
 (defun x86-darwin32::record-type-returns-structure-as-first-arg (rtype)
   (when (and rtype
@@ -13,4 +13,5 @@
 		    (parse-foreign-type rtype))))
       (> (ensure-foreign-type-bits ftype) 64))))
+
 
 ;;; All arguments are passed on the stack, except for MMX and XMM
@@ -67,5 +68,5 @@
 	  (argforms (foreign-type-to-representation-type result-type))
 	  (let* ((call (funcall result-coerce result-type-spec `(,@callform ,@(argforms)))))
-	    (format t "~&call = ~s" call)
+	    ;;(format t "~&call = ~s" call)
 	    call)))))
 
@@ -80,9 +81,44 @@
 ;;; The byte offset of the foreign return address, relative to STACK-PTR
 
-(defun x86-darwin32::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-return-name)
+(defun x86-darwin32::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name)
+  (declare (ignore fp-args-ptr))
+  (collect ((lets)
+	    (rlets)
+	    (inits)
+	    (dynamic-extent-names))
+    (let* ((rtype (parse-foreign-type result-spec)))
+      (when (typep rtype 'foreign-record-type)
+	(if (x86-darwin32::record-type-returns-structure-as-first-arg rtype)
+	  (setq argvars (cons struct-result-name argvars)
+		argspecs (cons :address argspecs)
+		rtype *void-foreign-type*)
+	  (rlets (list struct-result-name (foreign-record-type-name rtype)))))
+      (do* ((argvars argvars (cdr argvars))
+	    (argspecs argspecs (cdr argspecs))
+	    (delta 4 4)
+	    (offset 0 (+ offset delta)))
+	   ((null argvars)
+	    (values (rlets) (lets) (dynamic-extent-names) (inits) rtype nil 4)))))
+	
   (format t "~&in generate-callback-bindings")
   )
 
 (defun x86-darwin32::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg)
+  (declare (ignore fp-args-ptr))
   (format t "~&in generate-callback-return-value")
-  )
+  (unless (eq return-type *void-foreign-type*)
+    (if (typep return-type 'foreign-record-type)
+      ;; Would have been mapped to :VOID unless record-type was <= 64 bits
+      (format t "~&need to return structure ~s by value" return-type)
+      (let* ((return-type-keyword (foreign-type-to-representation-type return-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 0) ,result)))))
+