X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/3109662aca9c06495ac22c5c58b46e1c036aca5c..9ec578d9fe450b7e7f9030dc9d930185593aa991:/src/method-impl.lisp diff --git a/src/method-impl.lisp b/src/method-impl.lisp index b74994f..09dbb2b 100644 --- a/src/method-impl.lisp +++ b/src/method-impl.lisp @@ -46,6 +46,7 @@ (defmethod slot-unbound (class (message basic-message) (slot-name (eql 'argument-tail))) + (declare (ignore class)) (let ((seq 0)) (setf (slot-value message 'argument-tail) (mapcar (lambda (arg) @@ -59,6 +60,7 @@ (defmethod slot-unbound (class (message basic-message) (slot-name (eql 'no-varargs-tail))) + (declare (ignore class)) (setf (slot-value message 'no-varargs-tail) (mapcar (lambda (arg) (if (eq arg :ellipsis) @@ -125,6 +127,7 @@ (defmethod slot-unbound (class (method basic-direct-method) (slot-name (eql 'function-type))) + (declare (ignore class)) (let ((type (sod-method-type method))) (setf (slot-value method 'function-type) (c-type (fun (lisp (c-type-subtype type)) @@ -184,16 +187,19 @@ (defmethod slot-unbound (class (method delegating-direct-method) (slot-name (eql 'next-method-type))) + (declare (ignore class)) (let* ((message (sod-method-message method)) (type (sod-message-type message))) (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) (slot-name (eql 'function-type))) + (declare (ignore class)) (let* ((message (sod-method-message method)) (type (sod-method-type method)) (method-args (c-function-arguments type))) @@ -238,6 +244,7 @@ (defmethod slot-unbound (class (method basic-effective-method) (slot-name (eql 'basic-argument-names))) + (declare (ignore class)) (let ((message (effective-method-message method))) (setf (slot-value method 'basic-argument-names) (subst *sod-master-ap* *sod-ap* @@ -255,6 +262,7 @@ (defmethod slot-unbound (class (method basic-effective-method) (slot-name (eql 'functions))) + (declare (ignore class)) (setf (slot-value method 'functions) (compute-method-entry-functions method))) @@ -285,6 +293,7 @@ (defmethod shared-initialize :after ((codegen method-codegen) slot-names &key) + (declare (ignore slot-names)) (with-slots (message target) codegen (setf target (if (eq (c-type-subtype (sod-message-type message)) (c-type void)) @@ -413,9 +422,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) @@ -453,48 +459,53 @@ ;; 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) + (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))))) + (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))))