This protocol is used by `simple-message' subclasses."))
+(export 'method-keyword-argument-lists)
+(defgeneric method-keyword-argument-lists (method direct-methods)
+ (:documentation
+ "Returns a list of keyword argument lists to be merged.
+
+ This should return a list suitable for passing to `merge-keyword-lists',
+ i.e., each element should be a pair consisting of a list of `argument'
+ objects and a string describing the source of the argument list."))
+
(export 'compute-sod-effective-method)
(defgeneric compute-sod-effective-method (message class)
(:documentation
No `me' argument is prepended; any `:ellipsis' is left as it is."))
-(export 'sod-message-no-varargs-tail)
-(defgeneric sod-message-no-varargs-tail (message)
- (: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'."))
-
(export 'sod-method-function-type)
(defgeneric sod-method-function-type (method)
(:documentation
not included, and neither are more exotic arguments added as part of the
method delegation protocol."))
+(export 'effective-method-live-p)
+(defgeneric effective-method-live-p (method)
+ (:documentation
+ "Returns true if the effective METHOD is live.
+
+ An effective method is `live' if it should actually have proper method entry
+ functions associated with it and stored in the class vtable. The other
+ possibility is that the method is `dead', in which case the function
+ pointers in the vtable are left null."))
+
;;;--------------------------------------------------------------------------
;;; Code generation.
(cons (make-argument *sod-key-pointer*
(c-type (* (void :const))))
raw-args))))
- (*keyword-struct-disposition* t))
+ (*keyword-struct-disposition* (if (effective-method-keywords method)
+ :pointer :null)))
(codegen-push codegen)
(ensure-ilayout-var codegen super)
- (when (and (keyword-message-p message)
- (not (eq *keyword-struct-disposition* :null)))
- (let ((tag (effective-method-keyword-struct-tag method)))
- (ensure-var codegen *sod-keywords* (c-type (* (struct tag :const)))
- *sod-key-pointer*)))
+ (when (keyword-message-p message)
+ (if (eq *keyword-struct-disposition* :null)
+ (deliver-call codegen :void "SOD__IGNORE" *sod-key-pointer*)
+ (let ((tag (effective-method-keyword-struct-tag method)))
+ (ensure-var codegen *sod-keywords*
+ (c-type (* (struct tag :const)))
+ *sod-key-pointer*))))
(funcall body (codegen-target codegen))
(codegen-pop-function codegen (temporary-function)
(c-type (fun (lisp return-type)
nil."
(let* ((message (codegen-message codegen))
- (argument-tail (cond ((varargs-message-p message)
- (cons *sod-tmp-ap* basic-tail))
- ((keyword-message-p message)
- (cons (keyword-struct-pointer) basic-tail))
- (t basic-tail))))
+ (argument-tail (if (varargs-message-p message)
+ (cons *sod-tmp-ap* basic-tail)
+ basic-tail)))
(labels ((next-trampoline (method chain)
(if (or kernel chain)
(make-trampoline codegen (sod-method-class method)
(if (null chain)
(funcall kernel target)
(let ((trampoline (next-trampoline (car chain)
- (cdr chain))))
+ (cdr chain)))
+ (tail (if (keyword-message-p message)
+ (cons (keyword-struct-pointer)
+ argument-tail)
+ argument-tail)))
(invoke-method codegen target
- (cons trampoline argument-tail)
+ (cons trampoline tail)
(car chain))))))
(invoke chain target))))