Changeset 6609

Timestamp:

May 25, 2007, 5:08:01 AM (18 years ago)

Author:

Gary Byers

Message:

No #_objc_msgSendv in ObjC 2.0, since that would make too much sense.
Fix the #+x8664-darwin-target case.

File:

• branches/ide-1.0/ccl/examples/objc-runtime.lisp (modified) (6 diffs)

branches/ide-1.0/ccl/examples/objc-runtime.lisp

@@ -1460 +1460 @@
 #+apple-objc
 (eval-when (:compile-toplevel :execute)
-  #+x8664-target
-  (%def-foreign-type :<MARG> (foreign-pointer-type-to (parse-foreign-type :x86_64_marg_list)))
-  #+ppc-target
+  #+(and ppc-target (not apple-objc-2.0))
   (def-foreign-type :<MARG>
       (:struct nil
@@ -1472 +1470 @@
 
   
-#+(and apple-objc x8664-target)
+#+(and apple-objc-2.0 x8664-target)
 (defun %compile-varargs-send-function-for-signature (sig)
-  (let* ((return-type-spec (car sig))
+  (let* ((return-type-spec (foreign-type-to-representation-type (car sig)))
+         (op (case return-type-spec
+               (:address '%get-ptr)
+               (:unsigned-byte '%get-unsigned-byte)
+               (:signed-byte '%get-signed-byte)
+               (:unsigned-halfword '%get-unsigned-word)
+               (:signed-halfword '%get-signed-word)
+               (:unsigned-fullword '%get-unsigned-long)
+               (:signed-fullword '%get-signed-long)
+               (:unsigned-doubleword '%get-natural)
+               (:signed-doubleword '%get-signed-natural)
+               (:single-float '%get-single-float)
+               (:double-float '%get-double-float)))
+         (result-offset
+          (case op
+            ((:single-float :double-float) 0)
+            (t -8)))
          (arg-type-specs (butlast (cdr sig)))
          (args (objc-gen-message-arglist (length arg-type-specs)))
@@ -1481 +1495 @@
          (rest-arg (gensym))
          (arg-temp (gensym))
-         (marg-ptr (gensym))
          (regparams (gensym))
          (stackparams (gensym))
+         (fpparams (gensym))
+         (cframe (gensym))
          (selptr (gensym))
          (gpr-total (gensym))
@@ -1501 +1516 @@
                (static-arg-type (parse-foreign-type spec))
                (gpr-base (if (< n-static-gprs 6) regparams stackparams))
-               (fpr-base (if (< n-static-fprs 8) marg-ptr stackparams))
+               (fpr-base (if (< n-static-fprs 8) fpparams stackparams))
                (gpr-offset (if (< n-static-gprs 6) n-static-gprs n-static-stack-args))
                (fpr-offset (if (< n-static-fprs 8)
-                             (* 16 n-static-fprs)
+                             (* 8 n-static-fprs)
                              (* 8 n-static-stack-args))))
           (etypecase static-arg-type
@@ -1521 +1536 @@
                (incf n-static-stack-args)))
             (foreign-single-float-type
-             (if (eq fpr-base stackparams)
-               (setq fpr-offset (* 2 fpr-offset)))
              (static-arg-forms
               `(setf (%get-single-float ,fpr-base ,fpr-offset) ,arg))
@@ -1557 +1570 @@
                  (incf ,gpr-total)
                  (incf ,stack-total))))
-           (%stack-block ((,marg-ptr (+ ,(%foreign-type-or-record-size
-                                          :<MARG> :bytes)
-                                        (* 8 ,stack-total))))
-             
-             (setf (pref ,marg-ptr :<MARG>.rax) ,fpr-total)
-             (with-macptrs ((,regparams (pref ,marg-ptr :<MARG>.reg<P>arams)) 
-                            (,stackparams (pref ,marg-ptr :<MARG>.stack<P>arams)))
-               (progn ,@(static-arg-forms))
-               (%process-varargs-list ,regparams ,marg-ptr ,stackparams ,n-static-gprs ,n-static-fprs ,n-static-stack-args ,rest-arg)
-               (external-call "_objc_msgSendv"
-                              :address ,receiver
-                              :address ,selptr
-                              :size_t (+ 48 (* 8 ,stack-total))
-                              :address ,marg-ptr
-                              ,return-type-spec)))))))))
+           (%stack-block ((,fpparams (* 8 8)))
+             (with-macptrs (,regparams ,stackparams)
+               (with-variable-c-frame
+                   (+ 8 ,stack-total) ,cframe
+                   (%setf-macptr-to-object ,regparams (+ ,cframe 2))
+                   (%setf-macptr-to-object ,stackparams (+ ,cframe 8))
+                   (progn ,@(static-arg-forms))
+                   (%process-varargs-list ,regparams ,fpparams ,stackparams ,n-static-gprs ,n-static-fprs ,n-static-stack-args ,rest-arg)
+                   (%do-ff-call ,fpr-total ,cframe ,fpparams (%reference-external-entry-point (load-time-value (external "_objc_msgSend"))))
+                   ,@(if op
+                         `((,op ,regparams ,result-offset))
+                         `(())))))))))))
+
 
 #+(and apple-objc ppc32-target)