X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/3dca7758421664a838c54b273bd9221f02072045..678b6c0f7fe1d62abdf249b173a8a922c4e5c1d3:/src/method-proto.lisp

diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index b4b788d..e0d8742 100644
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -47,8 +47,8 @@
    order.  (Either that or you have to add an overriding method to
    `compute-sod-effective-method'."))
 
-(export 'message-effective-method-class)
-(defgeneric message-effective-method-class (message)
+(export 'sod-message-effective-method-class)
+(defgeneric sod-message-effective-method-class (message)
   (:documentation
    "Return the effective method class for the given MESSAGE.
 
@@ -67,8 +67,8 @@
    "Return the effective method when a CLASS instance receives MESSAGE.
 
    The default method constructs an instance of the message's chosen
-   `message-effective-method-class', passing the MESSAGE, the CLASS and the
-   list of applicable methods as initargs to `make-instance'."))
+   `sod-message-effective-method-class', passing the MESSAGE, the CLASS and
+   the list of applicable methods as initargs to `make-instance'."))
 
 (export 'compute-effective-methods)
 (defgeneric compute-effective-methods (class)
@@ -86,7 +86,7 @@
 	       :reader method-entry-chain-head)
    (chain-tail :initarg :chain-tail :type sod-class
 	       :reader method-entry-chain-tail)
-   (role :initarg :role :type (or :keyword null) :reader method-entry-role))
+   (role :initarg :role :type (or keyword null) :reader method-entry-role))
   (:documentation
    "An entry point into an effective method.
 
@@ -292,15 +292,13 @@
 	(convert-stmts codegen target
 		       (c-type-subtype (sod-method-type direct-method))
 		       (lambda (var)
-			 (ensure-var codegen *sod-tmp-ap* (c-type va-list))
-			 (emit-inst codegen
-				    (make-va-copy-inst *sod-tmp-ap*
-						       *sod-ap*))
-			 (deliver-expr codegen var
-				       (make-call-inst function arguments))
-			 (emit-inst codegen
-				    (make-va-end-inst *sod-tmp-ap*))))
-	(deliver-expr codegen target (make-call-inst function arguments)))))
+			 (ensure-var codegen *sod-tmp-ap* c-type-va-list)
+			 (deliver-call codegen :void "va_copy"
+				       *sod-tmp-ap* *sod-ap*)
+			 (apply #'deliver-call codegen var
+				function arguments)
+			 (deliver-call codegen :void "va_end" *sod-tmp-ap*)))
+	(apply #'deliver-call codegen target function arguments))))
 
 (export 'ensure-ilayout-var)
 (defun ensure-ilayout-var (codegen super)
@@ -335,11 +333,12 @@
 
   (let* ((message (codegen-message codegen))
 	 (message-type (sod-message-type message))
+	 (message-class (sod-message-class message))
+	 (method (codegen-method codegen))
 	 (return-type (c-type-subtype message-type))
 	 (raw-args (sod-message-argument-tail message))
 	 (arguments (if (varargs-message-p message)
-			(cons (make-argument *sod-ap*
-					     (c-type va-list))
+			(cons (make-argument *sod-ap* c-type-va-list)
 			      (butlast raw-args))
 			raw-args)))
     (codegen-push codegen)
@@ -348,7 +347,12 @@
     (codegen-pop-function codegen (temporary-function)
 			  (c-type (fun (lisp return-type)
 				       ("me" (* (class super)))
-				       . arguments)))))
+				       . arguments))
+			  "Delegation-chain trampoline ~:_~
+			   for `~A.~A' ~:_on `~A'."
+			  (sod-class-nickname message-class)
+			  (sod-message-name message)
+			  (effective-method-class method))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Method entry protocol.
@@ -410,7 +414,7 @@
 		   (make-trampoline codegen (sod-method-class method)
 				    (lambda (target)
 				      (invoke chain target)))
-		   0))
+		   *null-pointer*))
 	     (invoke (chain target)
 	       (if (null chain)
 		   (funcall kernel target)