X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/66836e149e29c12c8bf4884ff91de7d9a9c879cb..0c4559280eea9f0268866198be50b6f0395b4251:/src/method-impl.lisp

diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index f3673d8..86fd4cd 100644
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -98,6 +98,9 @@
       (call-next-method)
       (primary-method-class message)))
 
+(defmethod primary-method-class ((message simple-message))
+  'basic-direct-method)
+
 ;;;--------------------------------------------------------------------------
 ;;; Direct method classes.
 
@@ -189,12 +192,17 @@
 			 (slot-name (eql 'next-method-type)))
   (declare (ignore class))
   (let* ((message (sod-method-message method))
-	 (type (sod-message-type message)))
+	 (return-type (c-type-subtype (sod-message-type message)))
+	 (msgargs (sod-message-argument-tail message))
+	 (arguments (if (varargs-message-p message)
+			(cons (make-argument *sod-master-ap*
+					     (c-type va-list))
+			      (butlast msgargs))
+			msgargs)))
     (setf (slot-value method 'next-method-type)
-	  (c-type (fun (lisp (c-type-subtype type))
+	  (c-type (fun (lisp return-type)
 		       ("me" (* (class (sod-method-class method))))
-		       .
-		       (c-function-arguments type))))))
+		       . arguments)))))
 
 (defmethod slot-unbound (class
 			 (method delegating-direct-method)
@@ -320,19 +328,18 @@
       method
     (let* ((message-type (sod-message-type message))
 	   (return-type (c-type-subtype message-type))
-	   (voidp (eq return-type (c-type void)))
 	   (basic-tail (effective-method-basic-argument-names method)))
       (flet ((method-kernel (target)
 	       (dolist (before before-methods)
 		 (invoke-method codegen :void basic-tail before))
-	       (if (or voidp (null after-methods))
+	       (if (null after-methods)
 		   (funcall body target)
 		   (convert-stmts codegen target return-type
 				  (lambda (target)
 				    (funcall body target)
 				    (dolist (after (reverse after-methods))
 				      (invoke-method codegen :void
-						     after basic-tail)))))))
+						     basic-tail after)))))))
 	(invoke-delegation-chain codegen target basic-tail
 				 around-methods #'method-kernel)))))
 
@@ -446,7 +453,8 @@
 	   (varargs-prologue ()
 	     (ensure-var codegen *sod-master-ap* (c-type va-list))
 	     (emit-inst codegen
-			(make-va-start-inst *sod-master-ap* parm-n)))
+			(make-va-start-inst *sod-master-ap*
+					    (argument-name parm-n))))
 	   (varargs-epilogue ()
 	     (emit-inst codegen (make-va-end-inst *sod-master-ap*)))
 	   (finish-entry (tail)
@@ -459,7 +467,7 @@
 
       ;; Generate the method body.  We'll work out what to do with it later.
       (codegen-push codegen)
-      (let* ((result (if (eq return-type (c-type void)) nil
+      (let* ((result (if (eq return-type c-type-void) nil
 			 (temporary-var codegen return-type)))
 	     (emf-target (or result :void)))
 	(compute-effective-method-body method codegen emf-target)
@@ -519,12 +527,11 @@
 
 (defmethod compute-effective-method-body
     ((method simple-effective-method) codegen target)
-  (with-slots (message basic-argument-names primary-methods) method
-    (basic-effective-method-body codegen target method
-				 (lambda (target)
-				   (simple-method-body method
-						       codegen
-						       target)))))
+  (basic-effective-method-body codegen target method
+			       (lambda (target)
+				 (simple-method-body method
+						     codegen
+						     target))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Standard method combination.
@@ -533,7 +540,7 @@
 (defclass standard-message (simple-message)
   ()
   (:documentation
-   "Message class for standard method combination.
+   "Message class for standard method combinations.
 
    Standard method combination is a simple method combination where the
    primary methods are invoked as a delegation chain, from most- to