test/chimaera.sod: Use the macros for sending messages.

[sod] / src / method-impl.lisp

diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index 46f268b..c5785a2 100644 (file)
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -380,7 +380,8 @@
         (message (effective-method-message method))
         (type (sod-message-type message))
         (tail (ecase (method-entry-role entry)
-                ((nil) (sod-message-argument-tail message)))))
+                ((nil) (sod-message-argument-tail message))
+                (:valist (sod-message-no-varargs-tail message)))))
     (c-type (fun (lisp (c-type-subtype type))
                 ("me" (* (class (method-entry-chain-tail entry))))
                 . tail))))
@@ -396,6 +397,7 @@
                                  :chain-head chain-head
                                  :chain-tail chain-tail)
                   entries)))
+      (when (varargs-message-p message) (make :valist))
       (make nil)
       entries)))
 
@@ -438,8 +440,9 @@
                                     (mapcar #'car
                                             (sod-class-chains class))))
         (n-entries (length chain-tails))
-        (entry-args (sod-message-argument-tail message))
-        (parm-n (let ((tail (last entry-args 2)))
+        (raw-entry-args (sod-message-argument-tail message))
+        (entry-args (sod-message-no-varargs-tail message))
+        (parm-n (let ((tail (last raw-entry-args 2)))
                   (and tail (eq (cadr tail) :ellipsis) (car tail))))
         (entry-target (codegen-target codegen))
 
@@ -457,20 +460,36 @@
               (ensure-var codegen "sod__obj" ilayout-type
                           (make-convert-to-ilayout-inst class
                                                         head "me"))))
-          (varargs-prologue ()
-            (ensure-var codegen *sod-ap* (c-type va-list))
-            (emit-inst codegen
-                       (make-va-start-inst *sod-ap*
-                                           (argument-name parm-n))))
-          (varargs-epilogue ()
-            (emit-inst codegen (make-va-end-inst *sod-ap*)))
           (finish-entry (tail)
             (let* ((head (sod-class-chain-head tail))
-                   (name (method-entry-function-name method head nil))
+                   (role (if parm-n :valist nil))
+                   (name (method-entry-function-name method head role))
                    (type (c-type (fun (lisp return-type)
                                       ("me" (* (class tail)))
                                       . entry-args))))
-              (codegen-pop-function codegen name type))))
+              (codegen-pop-function codegen name type)
+
+              ;; If this is a varargs method then we've made the
+              ;; `:valist' role.  Also make the `nil' role.
+              (when parm-n
+                (let ((call (make-call-inst name
+                                            (cons "me"
+                                                  (mapcar #'argument-name
+                                                          entry-args))))
+                      (main (method-entry-function-name method head nil))
+                      (main-type (c-type (fun (lisp return-type)
+                                              ("me" (* (class tail)))
+                                              . raw-entry-args))))
+                  (codegen-push codegen)
+                  (ensure-var codegen *sod-ap* (c-type va-list))
+                  (emit-inst codegen
+                             (make-va-start-inst *sod-ap*
+                                                 (argument-name parm-n)))
+                  (convert-stmts codegen entry-target return-type
+                                 (lambda (target)
+                                   (deliver-expr codegen target call)))
+                  (emit-inst codegen (make-va-end-inst *sod-ap*))
+                  (codegen-pop-function codegen main main-type))))))
 
       ;; Generate the method body.  We'll work out what to do with it later.
       (codegen-push codegen)
@@ -493,9 +512,7 @@
                         (ensure-var codegen (inst-name var)
                                     (inst-type var) (inst-init var))
                         (emit-decl codegen var)))
-                  (when parm-n (varargs-prologue))
                   (emit-insts codegen insts)
-                  (when parm-n (varargs-epilogue))
                   (deliver-expr codegen entry-target result)
                   (finish-entry tail)))
 
@@ -513,15 +530,7 @@
                                                       emf-arg-tail)))))
                   (dolist (tail chain-tails)
                     (setup-entry tail)
-                    (cond (parm-n
-                           (varargs-prologue)
-                           (convert-stmts codegen entry-target return-type
-                                          (lambda (target)
-                                            (deliver-expr codegen
-                                                          target call)
-                                            (varargs-epilogue))))
-                          (t
-                           (deliver-expr codegen entry-target call)))
+                    (deliver-expr codegen entry-target call)
                     (finish-entry tail)))))))
 
       (codegen-functions codegen))))