chiark / gitweb /
src/final.lisp, src/frontend.lisp: Compile methods before dumping.
[sod] / src / method-proto.lisp
index a3e9b65e1fa0a5b8d09c0cb8dddce88b5a634bc8..7fd08b8f48a13426c1fd04d4306671a31e140de2 100644 (file)
@@ -85,14 +85,16 @@ (defclass method-entry ()
    (chain-head :initarg :chain-head :type sod-class
               :reader method-entry-chain-head)
    (chain-tail :initarg :chain-tail :type sod-class
-              :reader method-entry-chain-tail))
+              :reader method-entry-chain-tail)
+   (role :initarg :role :type (or :keyword null) :reader method-entry-role))
   (:documentation
    "An entry point into an effective method.
 
-   Specifically, this is the entry point to the effective method METHOD
-   invoked via the vtable for the chain headed by CHAIN-HEAD.  The CHAIN-TAIL
-   is the most specific class on this chain; this is useful because we can
-   reuse the types of method entries from superclasses on non-primary chains.
+   Specifically, this is the entry point to the effective METHOD invoked via
+   the vtable for the chain headed by CHAIN-HEAD, and serving the given ROLE.
+   The CHAIN-TAIL is the most specific class on this chain; this is useful
+   because we can reuse the types of method entries from superclasses on
+   non-primary chains.
 
    Each effective method may have several different method entries, because
    an effective method can be called via vtables attached to different
@@ -101,16 +103,24 @@ (defclass method-entry ()
    job of the method entry to adjust the instance pointers correctly for the
    rest of the effective method.
 
+   A vtable can contain more than one entry for the same message.  Such
+   entries are distinguished by their roles.  A message always has an entry
+   with the `nil role; in addition, a varargs message also has a `:valist'
+   role, which accepts a `va_list' argument in place of the variable argument
+   listNo other roles are currently defined, though they may be introduced by
+   extensions.
+
    The boundaries between a method entry and the effective method
    is (intentionally) somewhat fuzzy.  In extreme cases, the effective method
    may not exist at all as a distinct entity in the output because its
    content is duplicated in all of the method entry functions.  This is left
    up to the effective method protocol."))
 
-(export 'make-method-entry)
-(defgeneric make-method-entry (effective-method chain-head chain-tail)
+(export 'make-method-entries)
+(defgeneric make-method-entries (effective-method chain-head chain-tail)
   (:documentation
-   "Return a METHOD-ENTRY for an EFFECTIVE-METHOD called via CHAIN-HEAD.
+   "Return a list of `method-entry' objects for an EFFECTIVE-METHOD called
+   via CHAIN-HEAD.
 
    There is no default method for this function.  (Maybe when the
    effective-method/method-entry output protocol has settled down I'll know
@@ -180,6 +190,19 @@ (defgeneric method-entry-function-type (entry)
   (:documentation
    "Return the C function type for a method entry."))
 
+(export 'method-entry-slot-name)
+(defgeneric method-entry-slot-name (entry)
+  (:documentation
+   "Return the `vtmsgs' slot name for a method entry.
+
+   The default method indirects through `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)
+  (:method ((entry method-entry) (role (eql :valist)) name)
+    (format nil "~A__v" name)))
+
 (export 'effective-method-basic-argument-names)
 (defgeneric effective-method-basic-argument-names (method)
   (:documentation
@@ -252,13 +275,12 @@ (defun invoke-method (codegen target arguments-tail direct-method)
    CLASS where CLASS is the class on which the method was defined.
 
    If the message accepts a variable-length argument list then a copy of the
-   prevailing master argument pointer is provided in place of the
-   `:ellipsis'."
+   prevailing argument pointer is provided in place of the `:ellipsis'."
 
   (let* ((message (sod-method-message direct-method))
         (class (sod-method-class direct-method))
         (function (sod-method-function-name direct-method))
-        (arguments (cons (format nil "&sod__obj.~A.~A"
+        (arguments (cons (format nil "&sod__obj->~A.~A"
                                  (sod-class-nickname
                                   (sod-class-chain-head class))
                                  (sod-class-nickname class))
@@ -267,14 +289,14 @@ (defun invoke-method (codegen target arguments-tail direct-method)
        (convert-stmts codegen target
                       (c-type-subtype (sod-method-type direct-method))
                       (lambda (var)
-                        (ensure-var codegen *sod-ap* (c-type va-list))
+                        (ensure-var codegen *sod-tmp-ap* (c-type va-list))
                         (emit-inst codegen
-                                   (make-va-copy-inst *sod-ap*
-                                                      *sod-master-ap*))
+                                   (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-ap*))))
+                                   (make-va-end-inst *sod-tmp-ap*))))
        (deliver-expr codegen target (make-call-inst function arguments)))))
 
 (export 'ensure-ilayout-var)
@@ -311,12 +333,12 @@ (defun make-trampoline (codegen super body)
   (let* ((message (codegen-message codegen))
         (message-type (sod-message-type message))
         (return-type (c-type-subtype message-type))
-        (arguments (mapcar (lambda (arg)
-                             (if (eq (argument-name arg) *sod-ap*)
-                                 (make-argument *sod-master-ap*
-                                                (c-type va-list))
-                                 arg))
-                           (sod-message-no-varargs-tail message))))
+        (raw-args (sod-message-argument-tail message))
+        (arguments (if (varargs-message-p message)
+                       (cons (make-argument *sod-ap*
+                                            (c-type va-list))
+                             (butlast raw-args))
+                       raw-args)))
     (codegen-push codegen)
     (ensure-ilayout-var codegen super)
     (funcall body (codegen-target codegen))
@@ -334,13 +356,13 @@ (defgeneric effective-method-function-name (method)
    "Returns the function name of an effective method."))
 
 (export 'method-entry-function-name)
-(defgeneric method-entry-function-name (method chain-head)
+(defgeneric method-entry-function-name (method chain-head role)
   (:documentation
    "Returns the function name of a method entry.
 
-   The method entry is given as an effective method/chain-head pair, rather
-   than as a method entry object because we want the function name before
-   we've made the entry object."))
+   The method entry is given as an effective method/chain-head/role triple,
+   rather than as a method entry object because we want the function name
+   before we've made the entry object."))
 
 (export 'compute-method-entry-functions)
 (defgeneric compute-method-entry-functions (method)
@@ -378,7 +400,7 @@ (defun invoke-delegation-chain (codegen target basic-tail chain kernel)
 
   (let* ((message (codegen-message codegen))
         (argument-tail (if (varargs-message-p message)
-                           (cons *sod-master-ap* basic-tail)
+                           (cons *sod-tmp-ap* basic-tail)
                            basic-tail)))
     (labels ((next-trampoline (method chain)
               (if (or kernel chain)