X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/b426ab51d0598242a4c2b57d563341db66d71f7b..180bfa7ca8efeb1297a0bc3f0ff55b02b4e40f9b:/src/method-impl.lisp?ds=sidebyside

diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index 46f268b..c5785a2 100644
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -380,7 +380,8 @@ (defmethod method-entry-function-type ((entry method-entry))
 	 (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 @@ (defmethod make-method-entries ((method basic-effective-method)
 				  :chain-head chain-head
 				  :chain-tail chain-tail)
 		   entries)))
+      (when (varargs-message-p message) (make :valist))
       (make nil)
       entries)))
 
@@ -438,8 +440,9 @@ (defmethod compute-method-entry-functions ((method basic-effective-method))
 				     (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 @@ (defmethod compute-method-entry-functions ((method basic-effective-method))
 	       (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 @@ (defmethod compute-method-entry-functions ((method basic-effective-method))
 			 (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 @@ (defmethod compute-method-entry-functions ((method basic-effective-method))
 						       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))))