Lots more has happened.

[sod] / methods.lisp

diff --git a/methods.lisp b/methods.lisp
index 0fbb3f0..67033da 100644 (file)
--- a/methods.lisp
+++ b/methods.lisp
@@ -42,7 +42,7 @@
    However, an :ELLIPSIS is replaced by an argument of type `va_list', named
    `sod__ap'."))
 
-(defgeneric direct-method-function-type (method)
+(defgeneric sod-method-function-type (method)
   (:documentation
    "Return the C function type for the direct method.
 
@@ -53,7 +53,7 @@
    prepends an appropriate `me' argument to the user-provided argument list.
    Fancy method classes may need to override this behaviour."))
 
-(defgeneric direct-method-next-method-type (method)
+(defgeneric sod-method-next-method-type (method)
   (:documentation
    "Return the C function type for the next-method trampoline.
 
@@ -64,10 +64,14 @@
    the right job.  Very fancy subclasses might need to do something
    different."))
 
-(defgeneric direct-method-function-name (method)
+(defgeneric sod-method-function-name (method)
   (:documentation
    "Return the C function name for the direct method."))
 
+(defgeneric method-entry-function-type (entry)
+  (:documentation
+   "Return the C function type for a method entry."))
+
 ;;;--------------------------------------------------------------------------
 ;;; Message classes.
 
@@ -162,7 +166,7 @@
                       ("me" (* (class (sod-method-class method))))
                       . (c-function-arguments type))))))
 
-(defmethod direct-method-function-name ((method basic-direct-method))
+(defmethod sod-method-function-name ((method basic-direct-method))
   (with-slots (class role message) method
     (format nil "~A__~@[~(~A~)_~]method_~A__~A" class role
            (sod-class-nickname (sod-message-class message))
@@ -377,7 +381,7 @@
 
   (let* ((message (sod-method-message direct-method))
         (class (sod-method-class direct-method))
-        (function (direct-method-function-name direct-method))
+        (function (sod-method-function-name direct-method))
         (arguments (cons (format nil "(~A *)&sod__obj.~A" class
                                  (sod-class-nickname
                                   (sod-class-chain-head class)))
@@ -444,7 +448,7 @@
     (codegen-pop-function codegen (temporary-function)
                          (c-type (fun (lisp return-type)
                                       ("me" (* (class super)))
-                                      . arguments))))))
+                                      . arguments)))))
 
 (defun invoke-delegation-chain (codegen target basic-tail chain kernel)
   "Invoke a chain of delegating methods.
@@ -705,8 +709,19 @@
   (setf (slot-value method 'functions)
        (compute-method-entry-functions method)))
 
-(defmethod make-method-entry
-    ((method basic-effective-method) (chain-head sod-class))
-  (make-instance 'method-entry :method method :chain-head chain-head))
+(defmethod method-entry-function-type ((entry method-entry))
+  (let* ((method (method-entry-effective-method entry))
+        (message (effective-method-message method))
+        (type (sod-message-type message)))
+    (c-type (fun (lisp (c-type-subtype type))
+                ("me" (* (class (method-entry-chain-tail entry))))
+                . (sod-message-argument-tail message)))))
+
+(defmethod make-method-entry ((method basic-effective-method)
+                             (chain-head sod-class) (chain-tail sod-class))
+  (make-instance 'method-entry
+                :method method
+                :chain-head chain-head
+                :chain-tail chain-tail))
 
 ;;;----- That's all, folks --------------------------------------------------