X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/aa14a4cddcb96b681d5c19a2ec8bad382f43b264..4b8e5c0347115ff30841f1d1e71afe59ecb6c82c:/src/method-proto.lisp diff --git a/src/method-proto.lisp b/src/method-proto.lisp index 8909fc9..b4b788d 100644 --- a/src/method-proto.lisp +++ b/src/method-proto.lisp @@ -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. @@ -80,19 +80,21 @@ (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 @@ 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 @@ -131,9 +141,9 @@ (: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) @@ -180,6 +190,19 @@ (: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 @@ 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 @@ ;;; 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. @@ -252,13 +278,12 @@ 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 +292,14 @@ (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 +336,12 @@ (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 +359,13 @@ "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 +403,7 @@ (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)