From bf8aadd76bceba05d2a325181a71763a5625c89b Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Sun, 30 Aug 2015 10:58:38 +0100 Subject: [PATCH] src/method-{proto,impl}.lisp: Add `:valist' method-entry role. For each varargs message, add a new entry whose name has a `__v' suffix, and which takes a `va_list' argument in place of the variable-length argument list of the `nil' entry. The `nil' entry now just sets up the `va_list' pointer and invokes the corresponding `:valist' entry function. This actually makes constructing the method-entry functions somewhat cleaner, since the handling of variable argument lists is now concentrated in the construction of a separate entry function. --- src/method-impl.lisp | 55 ++++++++++++++++++++++++++++++--------------------- src/method-proto.lisp | 10 +++++++--- 2 files changed, 39 insertions(+), 26 deletions(-) diff --git a/src/method-impl.lisp b/src/method-impl.lisp index 46f268b..c5785a2 100644 --- a/src/method-impl.lisp +++ b/src/method-impl.lisp @@ -380,7 +380,8 @@ (message (effective-method-message method)) (type (sod-message-type message)) (tail (ecase (method-entry-role entry) - ((nil) (sod-message-argument-tail message))))) + ((nil) (sod-message-argument-tail message)) + (:valist (sod-message-no-varargs-tail message))))) (c-type (fun (lisp (c-type-subtype type)) ("me" (* (class (method-entry-chain-tail entry)))) . tail)))) @@ -396,6 +397,7 @@ :chain-head chain-head :chain-tail chain-tail) entries))) + (when (varargs-message-p message) (make :valist)) (make nil) entries))) @@ -438,8 +440,9 @@ (mapcar #'car (sod-class-chains class)))) (n-entries (length chain-tails)) - (entry-args (sod-message-argument-tail message)) - (parm-n (let ((tail (last entry-args 2))) + (raw-entry-args (sod-message-argument-tail message)) + (entry-args (sod-message-no-varargs-tail message)) + (parm-n (let ((tail (last raw-entry-args 2))) (and tail (eq (cadr tail) :ellipsis) (car tail)))) (entry-target (codegen-target codegen)) @@ -457,20 +460,36 @@ (ensure-var codegen "sod__obj" ilayout-type (make-convert-to-ilayout-inst class head "me")))) - (varargs-prologue () - (ensure-var codegen *sod-ap* (c-type va-list)) - (emit-inst codegen - (make-va-start-inst *sod-ap* - (argument-name parm-n)))) - (varargs-epilogue () - (emit-inst codegen (make-va-end-inst *sod-ap*))) (finish-entry (tail) (let* ((head (sod-class-chain-head tail)) - (name (method-entry-function-name method head nil)) + (role (if parm-n :valist nil)) + (name (method-entry-function-name method head role)) (type (c-type (fun (lisp return-type) ("me" (* (class tail))) . entry-args)))) - (codegen-pop-function codegen name type)))) + (codegen-pop-function codegen name type) + + ;; If this is a varargs method then we've made the + ;; `:valist' role. Also make the `nil' role. + (when parm-n + (let ((call (make-call-inst name + (cons "me" + (mapcar #'argument-name + entry-args)))) + (main (method-entry-function-name method head nil)) + (main-type (c-type (fun (lisp return-type) + ("me" (* (class tail))) + . raw-entry-args)))) + (codegen-push codegen) + (ensure-var codegen *sod-ap* (c-type va-list)) + (emit-inst codegen + (make-va-start-inst *sod-ap* + (argument-name parm-n))) + (convert-stmts codegen entry-target return-type + (lambda (target) + (deliver-expr codegen target call))) + (emit-inst codegen (make-va-end-inst *sod-ap*)) + (codegen-pop-function codegen main main-type)))))) ;; Generate the method body. We'll work out what to do with it later. (codegen-push codegen) @@ -493,9 +512,7 @@ (ensure-var codegen (inst-name var) (inst-type var) (inst-init var)) (emit-decl codegen var))) - (when parm-n (varargs-prologue)) (emit-insts codegen insts) - (when parm-n (varargs-epilogue)) (deliver-expr codegen entry-target result) (finish-entry tail))) @@ -513,15 +530,7 @@ emf-arg-tail))))) (dolist (tail chain-tails) (setup-entry tail) - (cond (parm-n - (varargs-prologue) - (convert-stmts codegen entry-target return-type - (lambda (target) - (deliver-expr codegen - target call) - (varargs-epilogue)))) - (t - (deliver-expr codegen entry-target call))) + (deliver-expr codegen entry-target call) (finish-entry tail))))))) (codegen-functions codegen)))) diff --git a/src/method-proto.lisp b/src/method-proto.lisp index 78429ef..7fd08b8 100644 --- a/src/method-proto.lisp +++ b/src/method-proto.lisp @@ -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) -- 2.11.0