Changeset 11589


Ignore:
Timestamp:
Jan 6, 2009, 9:24:19 AM (11 years ago)
Author:
gb
Message:

Try to get variadic method calls working on DarwinPPC64. The IDE comes up
on PPC64 and seeme to work. (It actually used to work in early Leopard
prereleases ...)

Still need to be able to catch NSExceptions in lisp (need magic annotations
in .SPffcall and friends), and need to test the stuff that maps lisp
exceptions to NSExceptions.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/objc-bridge/objc-runtime.lisp

    r11426 r11589  
    15741574#+(and apple-objc ppc64-target)
    15751575(defun %process-varargs-list (gpr-pointer fpr-pointer ngprs nfprs arglist)
    1576   (dolist (arg-temp arglist)
     1576  (dolist (arg-temp arglist (min nfprs 13))
    15771577    (typecase arg-temp
    15781578      ((signed-byte 64)
     
    19111911                             ,return-type-spec))))))))
    19121912
    1913 #+(and apple-objc ppc64-target)
     1913#+(and apple-objc-2.0 ppc64-target)
    19141914(defun %compile-varargs-send-function-for-signature (sig)
    19151915  (let* ((return-type-spec (car sig))
     
    19191919         (selector (gensym))
    19201920         (rest-arg (gensym))
    1921          (arg-temp (gensym))
    1922          (marg-ptr (gensym))
    1923          (regparams (gensym))
     1921         (fp-arg-ptr (gensym))
     1922         (c-frame (gensym))
     1923         (gen-arg-ptr (gensym))
    19241924         (selptr (gensym))
    19251925         (gpr-total (gensym))
     
    19271927         (n-static-fprs 0))
    19281928    (collect ((static-arg-forms))
    1929       (static-arg-forms `(setf (paref ,regparams (:* address) 0) ,receiver))
    1930       (static-arg-forms `(setf (paref ,regparams (:* address) 1) ,selptr))
     1929      (static-arg-forms `(setf (paref ,gen-arg-ptr (:* address) 0) ,receiver))
     1930      (static-arg-forms `(setf (paref ,gen-arg-ptr (:* address) 1) ,selptr))
    19311931      (do* ((args args (cdr args))
    19321932            (arg-type-specs arg-type-specs (cdr arg-type-specs)))
     
    19351935               (spec (car arg-type-specs))
    19361936               (static-arg-type (parse-foreign-type spec))
    1937                (gpr-base regparams)
    1938                (fpr-base marg-ptr)
     1937               (gpr-base gen-arg-ptr)
     1938               (fpr-base fp-arg-ptr)
    19391939               (gpr-offset (* n-static-gprs 8)))
    19401940          (etypecase static-arg-type
     
    19521952            (foreign-single-float-type
    19531953             (static-arg-forms
    1954               `(setf (%get-single-float ,gpr-base ,(+ 4 (* 8 n-static-gprs))) ,arg))
     1954              `(setf (%get-single-float ,gpr-base ,(+ 4 gpr-offset)) ,arg))
    19551955             (when (< n-static-fprs 13)
    19561956               (static-arg-forms
     
    19731973             (incf n-static-gprs)))))
    19741974     
    1975       (progn
     1975      (compile
    19761976        nil
    19771977        `(lambda (,receiver ,selector ,@args &rest ,rest-arg)
    19781978          (declare (dynamic-extent ,rest-arg))
    19791979          (let* ((,selptr (%get-selector ,selector))
    1980                  (,gpr-total ,n-static-gprs))
    1981             (dolist (,arg-temp ,rest-arg)
    1982               (declare (ignore ,arg-temp))
    1983               (incf ,gpr-total 1))
    1984             (if (> ,gpr-total 8)
    1985               (setq ,gpr-total (- ,gpr-total 8))
    1986               (setq ,gpr-total 0))           
    1987             (%stack-block ((,marg-ptr (+ ,(%foreign-type-or-record-size
    1988                                            :<MARG> :bytes)
    1989                                          (* 8 ,gpr-total))))
    1990              
    1991               (with-macptrs ((,regparams (pref ,marg-ptr :<MARG>.reg<P>arams)))
    1992                 (progn ,@(static-arg-forms))
    1993                 (%process-varargs-list ,regparams ,marg-ptr ,n-static-gprs ,n-static-fprs  ,rest-arg)
    1994                 (external-call "_objc_msgSendv"
    1995                                :address ,receiver
    1996                                :address ,selptr
    1997                                :size_t (+ 64 (* 8 ,gpr-total))
    1998                                :address ,marg-ptr
    1999                                ,return-type-spec)))))))))
     1980                 (,gpr-total (+ ,n-static-gprs (length ,rest-arg))))
     1981            (%stack-block ((,fp-arg-ptr (* 8 13)))
     1982              (with-variable-c-frame ,gpr-total ,c-frame
     1983                (with-macptrs ((,gen-arg-ptr))
     1984                  (%setf-macptr-to-object ,gen-arg-ptr (+ ,c-frame (ash ppc64::c-frame.param0 (- ppc64::word-shift))))
     1985                  (progn ,@(static-arg-forms))
     1986                  (%load-fp-arg-regs (%process-varargs-list ,gen-arg-ptr ,fp-arg-ptr ,n-static-gprs ,n-static-fprs  ,rest-arg) ,fp-arg-ptr)
     1987                 
     1988                  (%do-ff-call nil (%reference-external-entry-point (load-time-value (external "_objc_msgSend"))))
     1989                  ;; Using VALUES here is a hack: the multiple-value
     1990                  ;; returning machinery clobbers imm0.
     1991                  (values (%%ff-result ,(foreign-type-to-representation-type return-type-spec))))))))))))
    20001992
    20011993
Note: See TracChangeset for help on using the changeset viewer.