X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/51af043f73c683c0609d4285a1bfee7d07e08b7a..e895be217c3be6769708da17c9ae87cb22db040e:/src/method-proto.lisp

diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index 5687802..e72044e 100644
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -49,6 +49,13 @@
    will be a list of applicable methods sorted in most-to-least specific
    order."))
 
+(export 'sod-message-receiver-type)
+(defgeneric sod-message-receiver-type (message class)
+  (:documentation
+   "Return the type of the `me' argument in a MESSAGE received by CLASS.
+
+   Typically this will just be `CLASS *' or `const CLASS *'."))
+
 (export 'sod-message-applicable-methods)
 (defgeneric sod-message-applicable-methods (message class)
   (:documentation
@@ -135,7 +142,8 @@
    The list needn't be in any particular order."))
 
 (export '(method-entry method-entry-effective-method
-	  method-entry-chain-head method-entry-chain-tail))
+	  method-entry-chain-head method-entry-chain-tail
+	  method-entry-role))
 (defclass method-entry ()
   ((%method :initarg :method :type effective-method
 	    :reader method-entry-effective-method)
@@ -263,6 +271,7 @@
 
    The default method indirects through `method-entry-slot-name-by-role'."))
 
+(export 'method-entry-slot-name-by-role)
 (defgeneric method-entry-slot-name-by-role (entry role name)
   (:documentation "Easier implementation for `method-entry-slot-name'.")
   (:method ((entry method-entry) (role (eql nil)) name) name)
@@ -286,9 +295,9 @@
   (: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
+   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."))
 
 ;;;--------------------------------------------------------------------------
@@ -336,13 +345,10 @@
 
 ;;; Additional instructions.
 
-;; HACK: use gensyms for the `class' and `expr' slots to avoid leaking the
-;; slot names, because `expr' is exported by our package, and `class' is
-;; actually from the `common-lisp' package.
 (definst convert-to-ilayout (stream :export t)
-    (#1=#:class chain-head #2=#:expr)
+    (%class chain-head %expr)
   (format stream "SOD_ILAYOUT(~@<~A, ~_~A, ~_~A~:>)"
-	  #1# (sod-class-nickname chain-head) #2#))
+	  class (sod-class-nickname chain-head) expr))
 
 ;;; Utilities.
 
@@ -479,11 +485,13 @@
 			  ((keyword-message-p message)
 			   (cons (make-argument *sod-key-pointer*
 						(c-type (* (void :const))))
-				 raw-args))))
+				 raw-args))
+			  (t raw-args)))
 	 (*keyword-struct-disposition* (if (effective-method-keywords method)
 					   :pointer :null)))
     (codegen-push codegen)
     (ensure-ilayout-var codegen super)
+    (deliver-call codegen :void "SOD__IGNORE" "sod__obj")
     (when (keyword-message-p message)
       (if (eq *keyword-struct-disposition* :null)
 	  (deliver-call codegen :void "SOD__IGNORE" *sod-key-pointer*)