Major effort to plug slot-name leaks.
[sod] / src / method-proto.lisp
index 8909fc9..b4b788d 100644 (file)
@@ -32,7 +32,7 @@
 (defclass effective-method ()
   ((message :initarg :message :type sod-message
            :reader effective-method-message)
-   (class :initarg :class :type sod-class :reader effective-method-class))
+   (%class :initarg :class :type sod-class :reader effective-method-class))
   (:documentation
    "The behaviour invoked by sending a message to an instance of a class.
 
 (export '(method-entry method-entry-effective-method
          method-entry-chain-head method-entry-chain-tail))
 (defclass method-entry ()
-  ((method :initarg :method :type effective-method
-          :reader method-entry-effective-method)
+  ((%method :initarg :method :type effective-method
+           :reader method-entry-effective-method)
    (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
    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
   (:documentation
    "Return the argument tail for the message with `:ellipsis' substituted.
 
-   As with SOD-MESSAGE-ARGUMENT-TAIL, no `me' argument is prepended.
-   However, an :ELLIPSIS is replaced by an argument of type `va_list', named
-   `sod__ap'."))
+   As with `sod-message-argument-tail', no `me' argument is prepended.
+   However, an `:ellipsis' is replaced by an argument of type `va_list',
+   named `sod__ap'."))
 
 (export 'sod-method-function-type)
 (defgeneric sod-method-function-type (method)
   (: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
          codegen-method codegen-target))
 (defclass method-codegen (codegen)
   ((message :initarg :message :type sod-message :reader codegen-message)
-   (class :initarg :class :type sod-class :reader codegen-class)
-   (method :initarg :method :type effective-method :reader codegen-method)
+   (%class :initarg :class :type sod-class :reader codegen-class)
+   (%method :initarg :method :type effective-method :reader codegen-method)
    (target :initarg :target :reader codegen-target))
   (:documentation
    "Augments CODEGEN with additional state regarding an effective method.
 
 ;;; Additional instructions.
 
-(export 'convert-to-ilayout)
-(definst convert-to-ilayout (stream) (class chain-head expr)
+;; 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)
   (format stream "SOD_ILAYOUT(~@<~A, ~_~A, ~_~A~:>)"
-         class (sod-class-nickname chain-head) expr))
+         #1# (sod-class-nickname chain-head) #2#))
 
 ;;; Utilities.
 
    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))
        (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)
   (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))
    "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)
 
   (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)