Changeset 5717

Timestamp:

Jan 18, 2007, 2:58:12 AM (18 years ago)

Author:

Gary Byers

Message:

ff-call-expand-function in ftd.
Don't try to type-expand :registers <exp> form in EXTERNAL-CALL.

File:

• trunk/ccl/lib/foreign-types.lisp (modified) (4 diffs)

trunk/ccl/lib/foreign-types.lisp

@@ -54 +54 @@
   (external-function-definitions (make-hash-table :test #'eq))
   (dirlist (make-dll-header))
-  (attributes ()))
+  (attributes ())
+  (ff-call-expand-function ()))
 
 
@@ -68 +69 @@
                       :signed-char #+darwinppc-target t #-darwinppc-target nil
                       :struct-by-value #+darwinppc-target t #-darwinppc-target nil
-                      :prepend-underscores #+darwinppc-target t #-darwinppc-target nil)))
+                      :struct-return-in-registers #+(or (and darwinppc-target 64-bit-target)) t #-(or (and darwinppc-target 64-bit-target)) nil
+                      :struct-return-explicit  #+(or (and darwinppc-target 64-bit-target)) t #-(or (and darwinppc-target 64-bit-target)) nil
+                      :struct-by-value-by-field  #+(or (and darwinppc-target 64-bit-target)) t #-(or (and darwinppc-target 64-bit-target)) nil
+                    
+                      :prepend-underscores #+darwinppc-target t #-darwinppc-target nil)
+                    :ff-call-expand-function
+                    #+(and darwinppc-target 32-bit-target) 'ppc32::darwin-expand-ff-call
+                    #+(and darwinppc-target 64-bit-target) 'ppc64::darwin-expand-ff-call
+                    #+(and linuxppc-target 32-bit-target) 'ppc32::linux-expand-ff-call
+                    #+(and linuxppc-target 64-bit-target) 'ppc64::linux-expand-ff-call
+                    #+linuxx8664-target 'x8664::linux-expand-ff-call
+                    #+darwinx8664-target 'x8664:::darwin-expand-ff-call
+                    #+freebsdx8664-target 'x8664:::freebsd-expand-ff-call 
+  
+                    ))
                     
 (defvar *target-ftd* *host-ftd*)
@@ -1324 +1339 @@
         (let* ((spec (car a))
                (val (cadr a)))
-          (representation (foreign-type-to-representation-type spec))
+          (if (eq spec :registers)
+            (representation spec)
+            (representation (foreign-type-to-representation-type spec)))
         (representation val)))
     `(%ff-call ,entry ,@(representation)))))
@@ -1447 +1464 @@
                ((<= bits 16) (if signed :signed-halfword :unsigned-halfword))
                ((<= bits 32) (if signed :signed-fullword :unsigned-fullword))
+               ((<= bits 64) (if signed :signed-doubleword :unsigned-doubleword))
                (t `(:record ,bits)))))
       (foreign-float-type