X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/4e561d89167ab39483f850df3ebc1f8c82dc9e7d..0c4559280eea9f0268866198be50b6f0395b4251:/src/method-impl.lisp diff --git a/src/method-impl.lisp b/src/method-impl.lisp index 8de19da..86fd4cd 100644 --- a/src/method-impl.lisp +++ b/src/method-impl.lisp @@ -192,12 +192,17 @@ (slot-name (eql 'next-method-type))) (declare (ignore class)) (let* ((message (sod-method-message method)) - (type (sod-message-type message))) + (return-type (c-type-subtype (sod-message-type message))) + (msgargs (sod-message-argument-tail message)) + (arguments (if (varargs-message-p message) + (cons (make-argument *sod-master-ap* + (c-type va-list)) + (butlast msgargs)) + msgargs))) (setf (slot-value method 'next-method-type) - (c-type (fun (lisp (c-type-subtype type)) + (c-type (fun (lisp return-type) ("me" (* (class (sod-method-class method)))) - . - (c-function-arguments type)))))) + . arguments))))) (defmethod slot-unbound (class (method delegating-direct-method) @@ -323,19 +328,18 @@ method (let* ((message-type (sod-message-type message)) (return-type (c-type-subtype message-type)) - (voidp (eq return-type (c-type void))) (basic-tail (effective-method-basic-argument-names method))) (flet ((method-kernel (target) (dolist (before before-methods) (invoke-method codegen :void basic-tail before)) - (if (or voidp (null after-methods)) + (if (null after-methods) (funcall body target) (convert-stmts codegen target return-type (lambda (target) (funcall body target) (dolist (after (reverse after-methods)) (invoke-method codegen :void - after basic-tail))))))) + basic-tail after))))))) (invoke-delegation-chain codegen target basic-tail around-methods #'method-kernel))))) @@ -449,7 +453,8 @@ (varargs-prologue () (ensure-var codegen *sod-master-ap* (c-type va-list)) (emit-inst codegen - (make-va-start-inst *sod-master-ap* parm-n))) + (make-va-start-inst *sod-master-ap* + (argument-name parm-n)))) (varargs-epilogue () (emit-inst codegen (make-va-end-inst *sod-master-ap*))) (finish-entry (tail)