Changeset 770

Timestamp:

Apr 13, 2004, 12:15:43 PM (21 years ago)

Author:

Gary Byers

Message:

(Partial) fixes to struct-returning method definitions.

File:

• trunk/ccl/examples/objc-runtime.lisp (modified) (5 diffs)

trunk/ccl/examples/objc-runtime.lisp

@@ -1386 +1386 @@
          (selector nil)
          (argspecs nil)
-         (resulttype nil))
+         (resulttype nil)
+         (struct-return nil))
     (flet ((bad-selector (why) (error "Can't parse method selector ~s : ~a"
                                    selector-arg why)))
@@ -1450 +1451 @@
           (progn
             (push name argspecs)
+            (setq struct-return t)
             (push :address argspecs)
             (setq resulttype :void))
@@ -1463 +1465 @@
                                      `(:id :<sel> ,@(nreverse argtypes))
                                      resulttype))
-                (push (car argspecs) argtypes))))))
+                (push (car argspecs) argtypes))
+              struct-return))))
 
 (defun objc-method-definition-form (class-p selector-arg class-arg body env)
@@ -1471 +1474 @@
                         argspecs
                         body
-                        typestring)
+                        typestring
+                        struct-return)
       (parse-objc-method selector-arg class-arg body)
       (multiple-value-bind (body decls) (parse-body body env)
@@ -1483 +1487 @@
                (self (intern "SELF"))
                (_cmd (intern "_CMD"))
-               (super (gensym "SUPER")) 
-               (params `(:id ,self :<sel> ,_cmd ,@argspecs)))
+               (super (gensym "SUPER"))
+               (params `(:id ,self :<sel> ,_cmd)))
+          (when struct-return
+            (setq params `(,(car argspecs) ,(cadr argspecs) ,@params))
+            (setq argspecs (cddr argspecs)))
+          (setq params (nconc params argspecs))
           `(progn
             (defcallback ,impname