X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/b426ab51d0598242a4c2b57d563341db66d71f7b..357885be46389c70dc9e7c7859f47af68aeb58ae:/src/method-proto.lisp diff --git a/src/method-proto.lisp b/src/method-proto.lisp index 78429ef..c8b47ad 100644 --- a/src/method-proto.lisp +++ b/src/method-proto.lisp @@ -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 @@ (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 @@ 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 @@ "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,8 +80,8 @@ (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 @@ -105,8 +105,10 @@ 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. No other roles are currently defined, though they may - be introduced by extensions. + 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 @@ -197,7 +199,9 @@ (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 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) @@ -219,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. @@ -253,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. @@ -285,15 +292,15 @@ (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) @@ -331,8 +338,7 @@ (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)