Changeset 187

Timestamp:

Jan 3, 2004, 11:49:04 AM (21 years ago)

Author:

Gary Byers

Message:

(Mostly) work with gnu-objc; may have broken apple-objc ...

File:

• trunk/ccl/examples/bridge.lisp (modified) (7 diffs)

trunk/ccl/examples/bridge.lisp

@@ -351 +351 @@
    #'(lambda (m c)
        (declare (ignore c))
-       (ignore-errors
+       (#+gnu-objc progn #+apple-objc ignore-errors
          ;; Some libraries seem to have methods with bogus-looking
          ;; type signatures
@@ -368 +368 @@
   (cons
    (objc-foreign-arg-type (method-typestring m))
-   (%stack-block ((type 4) (offset 4))
-     (loop for i from 2 below (method-get-number-of-arguments m)
-           do (#_method_getArgumentInfo m i type offset)
-           collect 
-           (objc-foreign-arg-type (%get-cstring (%get-ptr type)))))))
+   (loop for i from 2 below (method-get-number-of-arguments m)
+         collect 
+         (objc-foreign-arg-type (objc-get-method-argument-info m i)))))
 
 
@@ -475 +473 @@
 
 (defun convert-to-argspecs (argtypes result-ftype args evalargs)
-  (flet ((foo (tftype) 
-           (if (and (consp tftype) (eq (first tftype) :record))
-             (/ (second tftype) 32)
-             tftype)))
+  (flet ((foo (ftype &optional for-result)
+                   (let* ((translated
+                   (if for-result
+                     (translate-foreign-result-type ftype)
+                     (translate-foreign-arg-type ftype))))
+             (if (and (consp translated) (eq (first translated) :record))
+               #+apple-objc
+               (/ (second translated) 32)
+               #+gnu-objc `(:* ,ftype)
+               translated))))
     (nconc
      (loop
@@ -484 +488 @@
        for ftype in argtypes
        do (ensure-foreign-type-bits (parse-foreign-type ftype))
-       append (list (foo (translate-foreign-arg-type ftype))
+       append (list (foo ftype) 
                     (if evalargs
-                      (coerce-to-foreign-type a ftype)
-                      `(coerce-to-foreign-type ,a ,ftype))))
-     (list (foo (translate-foreign-result-type result-ftype))))))
+                      (coerce-to-foreign-type a
+                                              #+apple-objc ftype
+                                              #+gnu-objc (foo ftype))
+                      `(coerce-to-foreign-type ,a #+apple-objc ,ftype #+gnu-objc ,(foo ftype)))))
+     (list (foo result-ftype t)))))
  
 
@@ -576 +582 @@
 
 (defun check-method-arg-count (m args)
-  (unless (= (length args) (- (#_method_getNumberOfArguments m) 2))
+  (unless (= (length args) (- (method-get-number-of-arguments m) 2))
     (error "Incorrect number of arguments (~S) to ObjC message ~S" 
            (length args) 
-           (%get-cstring (#_sel_getName (pref m :objc_method.method_name))))))
+           (%get-cstring (lisp-string-from-sel (pref m :objc_method.method_name))))))
 
 
@@ -715 +721 @@
                 ;; Regular stret send
                 `(progn
-                   (external-call
-                    "_objc_msgSend_stret"
-                    :address ,s :id ,o :<SEL> ,sel
+                   (objc-message-send-stret ,s ,o ,(cadr sel)
                     ,@(append (butlast argspecs) (list :void)))
                    ,s)
                 ;; Super stret send
                 `(progn
-                   (external-call
-                    "_objc_msgSendSuper_stret"
-                    :address ,s :address ,super :<SEL> ,sel
+                   (objc-message-send-super-stret ,s ,super ,(cadr sel)
                     ,@(append (butlast argspecs) (list :void)))
                    ,s)))
@@ -734 +736 @@
                          (not (returns-boolean-exception-p msg)))
                   `(coerce-from-bool
-                    (external-call "_objc_msgSend" :id ,o :<SEL> ,sel ,@argspecs))
-                  `(external-call "_objc_msgSend" :id ,o :<SEL> ,sel ,@argspecs))
+                    (objc-message-send ,o ,(cadr sel) ,@argspecs))
+                  `(objc-message-send ,o ,(cadr sel) ,@argspecs))
                 ;; Super send
                 (if (and (eq rspec :signed-byte)
                          (not (returns-boolean-exception-p msg)))
                   `(coerce-from-bool
-                    (external-call "_objc_msgSendSuper" 
-                                   :address ,super :<SEL> ,sel ,@argspecs))
-                  `(external-call "_objc_msgSendSuper" 
-                                  :address ,super :<SEL> ,sel ,@argspecs)))
+                    (objc-message-send-super ,super ,(cadr sel) ,@argspecs))
+                  `(objc-message-send-super ,super ,(cadr sel) ,@argspecs)))
               ;; STRET not required but provided
               (error "The message ~S must be sent using SEND" msg)))))))