X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/1d8cc67a3f4ded443f5efc673a616883cbae9c50..e75eb63d81df077c02c6c74439fb14a34d4fb93e:/src/method-impl.lisp diff --git a/src/method-impl.lisp b/src/method-impl.lisp index b657b8b..49c6676 100644 --- a/src/method-impl.lisp +++ b/src/method-impl.lisp @@ -98,6 +98,9 @@ (call-next-method) (primary-method-class message))) +(defmethod primary-method-class ((message simple-message)) + 'basic-direct-method) + ;;;-------------------------------------------------------------------------- ;;; Direct method classes. @@ -193,7 +196,8 @@ (setf (slot-value method 'next-method-type) (c-type (fun (lisp (c-type-subtype type)) ("me" (* (class (sod-method-class method)))) - . (c-function-arguments type)))))) + . + (c-function-arguments type)))))) (defmethod slot-unbound (class (method delegating-direct-method) @@ -319,19 +323,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))))) @@ -421,9 +424,6 @@ (emf-type (c-type (fun (lisp return-type) ("sod__obj" (lisp ilayout-type)) . (sod-message-no-varargs-tail message)))) - (result (if (eq return-type (c-type void)) nil - (temporary-var codegen return-type))) - (emf-target (or result :void)) ;; Method entry details. (chain-tails (remove-if-not (lambda (super) @@ -461,48 +461,55 @@ ;; Generate the method body. We'll work out what to do with it later. (codegen-push codegen) - (compute-effective-method-body method codegen emf-target) - (multiple-value-bind (vars insts) (codegen-pop codegen) - (cond ((or (= n-entries 1) - (<= (* n-entries (reduce #'+ insts :key #'inst-metric)) - *method-entry-inline-threshold*)) - - ;; The effective method body is simple -- or there's only one - ;; of them. We'll inline the method body into the entry - ;; functions. - (dolist (tail chain-tails) - (setup-entry tail) - (dolist (var vars) - (ensure-var codegen (inst-name var) - (inst-type var) (inst-init var))) - (when parm-n (varargs-prologue)) - (emit-insts codegen insts) - (when parm-n (varargs-epilogue)) - (deliver-expr codegen entry-target result) - (finish-entry tail))) - - (t - - ;; The effective method body is complicated and we'd need more - ;; than one copy. We'll generate an effective method function - ;; and call it a lot. - (codegen-build-function codegen emf-name emf-type vars - (nconc insts (and result (list (make-return-inst result))))) - - (let ((call (make-call-inst emf-name - (cons "sod__obj" (mapcar #'argument-name - emf-arg-tail))))) + (let* ((result (if (eq return-type c-type-void) nil + (temporary-var codegen return-type))) + (emf-target (or result :void))) + (compute-effective-method-body method codegen emf-target) + (multiple-value-bind (vars insts) (codegen-pop codegen) + (cond ((or (= n-entries 1) + (<= (* n-entries (reduce #'+ insts :key #'inst-metric)) + *method-entry-inline-threshold*)) + + ;; The effective method body is simple -- or there's only + ;; one of them. We'll inline the method body into the entry + ;; functions. (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))) - (finish-entry tail)))))) + (dolist (var vars) + (if (typep var 'var-inst) + (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))) + + (t + + ;; The effective method body is complicated and we'd need + ;; more than one copy. We'll generate an effective method + ;; function and call it a lot. + (codegen-build-function codegen emf-name emf-type vars + (nconc insts (and result + (list (make-return-inst result))))) + + (let ((call (make-call-inst emf-name + (cons "sod__obj" (mapcar #'argument-name + 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))) + (finish-entry tail))))))) (codegen-functions codegen)))) @@ -514,12 +521,11 @@ (defmethod compute-effective-method-body ((method simple-effective-method) codegen target) - (with-slots (message basic-argument-names primary-methods) method - (basic-effective-method-body codegen target method - (lambda (target) - (simple-method-body method - codegen - target))))) + (basic-effective-method-body codegen target method + (lambda (target) + (simple-method-body method + codegen + target)))) ;;;-------------------------------------------------------------------------- ;;; Standard method combination. @@ -528,7 +534,7 @@ (defclass standard-message (simple-message) () (:documentation - "Message class for standard method combination. + "Message class for standard method combinations. Standard method combination is a simple method combination where the primary methods are invoked as a delegation chain, from most- to