chiark / gitweb /
src/: Introduce `deliver-call' to abbreviate function calls.
[sod] / src / method-proto.lisp
index 8b3822a778ea5c6cb5716b82b78bfc8fadc7c8cf..c8b47ad90d67d674b56f04217c4fc29de3ac5d19 100644 (file)
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -32,7 +32,7 @@ (export '(effective-method effective-method-message effective-method-class))
 (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.
 
@@ -47,8 +47,8 @@ (defclass effective-method ()
    order.  (Either that or you have to add an overriding method to
    `compute-sod-effective-method'."))
 
-(export 'message-effective-method-class)
-(defgeneric message-effective-method-class (message)
+(export 'sod-message-effective-method-class)
+(defgeneric sod-message-effective-method-class (message)
   (:documentation
    "Return the effective method class for the given MESSAGE.
 
@@ -67,8 +67,8 @@ (defgeneric compute-sod-effective-method (message class)
    "Return the effective method when a CLASS instance receives MESSAGE.
 
    The default method constructs an instance of the message's chosen
-   `message-effective-method-class', passing the MESSAGE, the CLASS and the
-   list of applicable methods as initargs to `make-instance'."))
+   `sod-message-effective-method-class', passing the MESSAGE, the CLASS and
+   the list of applicable methods as initargs to `make-instance'."))
 
 (export 'compute-effective-methods)
 (defgeneric compute-effective-methods (class)
@@ -80,19 +80,21 @@ (defgeneric compute-effective-methods (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
@@ -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
@@ -200,8 +223,8 @@ (export '(method-codegen codegen-message codegen-class
          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.
@@ -234,10 +257,13 @@ (defgeneric simple-method-body (method codegen target)
 
 ;;; 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.
 
@@ -266,15 +292,15 @@ (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-tmp-ap* (c-type va-list))
+                        (ensure-var codegen *sod-tmp-ap* c-type-va-list)
                         (emit-inst codegen
                                    (make-va-copy-inst *sod-tmp-ap*
                                                       *sod-ap*))
-                        (deliver-expr codegen var
-                                      (make-call-inst function arguments))
+                        (apply #'deliver-call codegen var
+                               function arguments)
                         (emit-inst codegen
                                    (make-va-end-inst *sod-tmp-ap*))))
-       (deliver-expr codegen target (make-call-inst function arguments)))))
+       (apply #'deliver-call codegen target function arguments))))
 
 (export 'ensure-ilayout-var)
 (defun ensure-ilayout-var (codegen super)
@@ -312,7 +338,7 @@ (defun make-trampoline (codegen super body)
         (return-type (c-type-subtype message-type))
         (raw-args (sod-message-argument-tail message))
         (arguments (if (varargs-message-p message)
-                       (cons (make-argument *sod-ap* (c-type va-list))
+                       (cons (make-argument *sod-ap* c-type-va-list)
                              (butlast raw-args))
                        raw-args)))
     (codegen-push codegen)
@@ -332,13 +358,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)