X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/1622ed8e30b05ba9025520cde3e68d186c8c7e50..e046c3f65a8f7241889fb9b6005aac21e2aad1a8:/src/method-proto.lisp?ds=sidebyside

diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index f5d8be7..6f8dc02 100644
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -63,6 +63,15 @@
 
    This protocol is used by `simple-message' subclasses."))
 
+(export 'method-keyword-argument-lists)
+(defgeneric method-keyword-argument-lists (method direct-methods)
+  (:documentation
+   "Returns a list of keyword argument lists to be merged.
+
+   This should return a list suitable for passing to `merge-keyword-lists',
+   i.e., each element should be a pair consisting of a list of `argument'
+   objects and a string describing the source of the argument list."))
+
 (export 'compute-sod-effective-method)
 (defgeneric compute-sod-effective-method (message class)
   (:documentation
@@ -216,6 +225,16 @@
    not included, and neither are more exotic arguments added as part of the
    method delegation protocol."))
 
+(export 'effective-method-live-p)
+(defgeneric effective-method-live-p (method)
+  (:documentation
+   "Returns true if the effective METHOD is live.
+
+   An effective method is `live' if it should actually have proper method entry
+   functions associated with it and stored in the class vtable.  The other
+   possibility is that the method is `dead', in which case the function
+   pointers in the vtable are left null."))
+
 ;;;--------------------------------------------------------------------------
 ;;; Code generation.
 
@@ -409,14 +428,17 @@
 			   (cons (make-argument *sod-key-pointer*
 						(c-type (* (void :const))))
 				 raw-args))))
-	 (*keyword-struct-disposition* t))
+	 (*keyword-struct-disposition* (if (effective-method-keywords method)
+					   :pointer :null)))
     (codegen-push codegen)
     (ensure-ilayout-var codegen super)
-    (when (and (keyword-message-p message)
-	       (not (eq *keyword-struct-disposition* :null)))
-      (let ((tag (effective-method-keyword-struct-tag method)))
-	(ensure-var codegen *sod-keywords* (c-type (* (struct tag :const)))
-		    *sod-key-pointer*)))
+    (when (keyword-message-p message)
+      (if (eq *keyword-struct-disposition* :null)
+	  (deliver-call codegen :void "SOD__IGNORE" *sod-key-pointer*)
+	  (let ((tag (effective-method-keyword-struct-tag method)))
+	    (ensure-var codegen *sod-keywords*
+			(c-type (* (struct tag :const)))
+			*sod-key-pointer*))))
     (funcall body (codegen-target codegen))
     (codegen-pop-function codegen (temporary-function)
 			  (c-type (fun (lisp return-type)
@@ -480,11 +502,9 @@
    nil."
 
   (let* ((message (codegen-message codegen))
-	 (argument-tail (cond ((varargs-message-p message)
-			       (cons *sod-tmp-ap* basic-tail))
-			      ((keyword-message-p message)
-			       (cons (keyword-struct-pointer) basic-tail))
-			      (t basic-tail))))
+	 (argument-tail (if (varargs-message-p message)
+			    (cons *sod-tmp-ap* basic-tail)
+			    basic-tail)))
     (labels ((next-trampoline (method chain)
 	       (if (or kernel chain)
 		   (make-trampoline codegen (sod-method-class method)
@@ -495,9 +515,13 @@
 	       (if (null chain)
 		   (funcall kernel target)
 		   (let ((trampoline (next-trampoline (car chain)
-						      (cdr chain))))
+						      (cdr chain)))
+			 (tail (if (keyword-message-p message)
+				   (cons (keyword-struct-pointer)
+					 argument-tail)
+				   argument-tail)))
 		     (invoke-method codegen target
-				    (cons trampoline argument-tail)
+				    (cons trampoline tail)
 				    (car chain))))))
       (invoke chain target))))