Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv4460

Modified Files: compiler.lisp Log Message: Smarten up make-compiled-two-forms-into-registers slightly, this speeds up the compiler.

--- /project/movitz/cvsroot/movitz/compiler.lisp 2008/03/06 21:14:22 1.194 +++ /project/movitz/cvsroot/movitz/compiler.lisp 2008/03/15 00:21:38 1.195 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.194 2008/03/06 21:14:22 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.195 2008/03/15 00:21:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -5769,6 +5769,15 @@ (operands instruction) (values binding destination))))

+(defun program-is-load-constant (prg) + (and (not (cdr prg)) + (let ((i (car prg))) + (when (and (listp i) + (eq :load-constant (car i))) + (values (third i) + (second i)))))) + + (defun make-compiled-two-forms-into-registers (form0 reg0 form1 reg1 funobj env) "Returns first: code that does form0 into reg0, form1 into reg1. second: whether code is functional-p, @@ -5791,44 +5800,48 @@ :env env :result-mode reg1) (values (cond - ((and (typep final0 'binding) - (not (code-uses-binding-p code1 final0 :load nil :store t))) - (append (compiler-call #'compile-form-unprotected - :form form0 - :result-mode :ignore - :funobj funobj - :env env) - code1 - `((:load-lexical ,final0 ,reg0 :protect-registers (,reg1))))) - ((program-is-load-lexical-of-binding code1) - (destructuring-bind (src dst &key protect-registers shared-reference-p) - (cdar code1) - (assert (eq reg1 dst)) - (append code0 - `((:load-lexical ,src ,reg1 - :protect-registers ,(union protect-registers - (list reg0)) - :shared-reference-p ,shared-reference-p))))) - ;; XXX if we knew that code1 didn't mess up reg0, we could do more.. - (t #+ignore (when (and (not (tree-search code1 reg0)) - (not (tree-search code1 :call))) - (warn "got b: ~S ~S for ~S: ~{~&~A~}" form0 form1 reg0 code1)) - (let ((binding (make-instance 'temporary-name :name (gensym "tmp-"))) - (xenv (make-local-movitz-environment env funobj))) - (movitz-env-add-binding xenv binding) - (append (compiler-call #'compile-form - :form form0 - :funobj funobj - :env env - :result-mode reg0) - `((:init-lexvar ,binding :init-with-register ,reg0 - :init-with-type ,(type-specifier-primary type0))) - (compiler-call #'compile-form - :form form1 - :funobj funobj - :env xenv - :result-mode reg1) - `((:load-lexical ,binding ,reg0)))))) + ((and (typep final0 'binding) + (not (code-uses-binding-p code1 final0 :load nil :store t))) + (append (compiler-call #'compile-form-unprotected + :form form0 + :result-mode :ignore + :funobj funobj + :env env) + code1 + `((:load-lexical ,final0 ,reg0 :protect-registers (,reg1))))) + ((program-is-load-lexical-of-binding code1) + (destructuring-bind (src dst &key protect-registers shared-reference-p) + (cdar code1) + (assert (eq reg1 dst)) + (append code0 + `((:load-lexical ,src ,reg1 + :protect-registers ,(union protect-registers + (list reg0)) + :shared-reference-p ,shared-reference-p))))) + ((eq reg1 (program-is-load-constant code1)) + (append code0 + code1)) + ;; XXX if we knew that code1 didn't mess up reg0, we could do more.. + (t +;; (when (and (not (tree-search code1 reg0)) +;; (not (tree-search code1 :call))) +;; (warn "got b: ~S ~S for ~S: ~{~&~A~}" form0 form1 reg0 code1)) + (let ((binding (make-instance 'temporary-name :name (gensym "tmp-"))) + (xenv (make-local-movitz-environment env funobj))) + (movitz-env-add-binding xenv binding) + (append (compiler-call #'compile-form + :form form0 + :funobj funobj + :env env + :result-mode reg0) + `((:init-lexvar ,binding :init-with-register ,reg0 + :init-with-type ,(type-specifier-primary type0))) + (compiler-call #'compile-form + :form form1 + :funobj funobj + :env xenv + :result-mode reg1) + `((:load-lexical ,binding ,reg0)))))) (and functional0 functional1) t (compiler-values-list (all0))