[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] CVS: sbcl/src/compiler ir1opt.lisp, 1.129,
From:       Nikodemus Siivola <demoss () users ! sourceforge ! net>
Date:       2008-02-18 19:25:25
Message-ID: E1JRBcD-0002OM-Td () sc8-pr-cvs8 ! sourceforge ! net
[Download RAW message or body]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv9179/src/compiler

Modified Files:
	ir1opt.lisp node.lisp 
Log Message:
1.0.14.36: faster PROPAGATE-FROM-SETS

 20-25% improvement for the test-case in bug 188.

 * New slot in LAMBDA-VAR: LAST-INITIAL-TYPE, which holds the last
   initial-type for that variable seen by PROPAGATE-FROM-SETS.

 * Be lazy, and don't PROPAGATE-TO-REFS unless something of
   interest has happened, to wit:

    -- One of the CSET nodes has a new, more specific type.

    -- INITIAL-TYPE has become more specific.

   This also allows us elide TYPE-UNION computation in the
   uninteresting cases.

 * Requires having NODE-REOPTIMIZE set when IR1-OPTIMIZE-SET
   is called.


Index: ir1opt.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1opt.lisp,v
retrieving revision 1.129
retrieving revision 1.130
diff -u -d -r1.129 -r1.130
--- ir1opt.lisp	18 Feb 2008 19:14:11 -0000	1.129
+++ ir1opt.lisp	18 Feb 2008 19:25:23 -0000	1.130
@@ -306,6 +306,9 @@
            (when value
              (derive-node-type node (lvar-derived-type value)))))
         (cset
+         ;; PROPAGATE-FROM-SETS can do a better job if NODE-REOPTIMIZE
+         ;; is accurate till the node actually has been reoptimized.
+         (setf (node-reoptimize node) t)
          (ir1-optimize-set node))
         (cast
          (ir1-optimize-cast node)))))
@@ -1342,17 +1345,22 @@
 ;;; the union of the INITIAL-TYPE and the types of all the set
 ;;; values and to a PROPAGATE-TO-REFS with this type.
 (defun propagate-from-sets (var initial-type)
-  (collect ((res initial-type type-union))
-    (dolist (set (basic-var-sets var))
+  (let ((changes (not (csubtypep (lambda-var-last-initial-type var) initial-type)))
+        (types nil))
+    (dolist (set (lambda-var-sets var))
       (let ((type (lvar-type (set-value set))))
-        (res type)
+        (push type types)
         (when (node-reoptimize set)
-          (derive-node-type set (make-single-value-type type))
+          (let ((old-type (node-derived-type set)))
+            (unless (values-subtypep old-type type)
+              (derive-node-type set (make-single-value-type type))
+              (setf changes t)))
           (setf (node-reoptimize set) nil))))
-    (let ((res (res)))
-      (awhen (maybe-infer-iteration-var-type var initial-type)
-        (setq res it))
-      (propagate-to-refs var res)))
+    (when changes
+      (setf (lambda-var-last-initial-type var) initial-type)
+      (let ((res-type (or (maybe-infer-iteration-var-type var initial-type)
+                          (apply #'type-union initial-type types))))
+        (propagate-to-refs var res-type))))
   (values))
 
 ;;; If a LET variable, find the initial value's type and do
@@ -1368,9 +1376,9 @@
                  (initial-type (lvar-type initial-value)))
             (setf (lvar-reoptimize initial-value) nil)
             (propagate-from-sets var initial-type))))))
-
   (derive-node-type node (make-single-value-type
                           (lvar-type (set-value node))))
+  (setf (node-reoptimize node) nil)
   (values))
 
 ;;; Return true if the value of REF will always be the same (and is

Index: node.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/node.lisp,v
retrieving revision 1.71
retrieving revision 1.72
diff -u -d -r1.71 -r1.72
--- node.lisp	15 Jan 2008 11:59:32 -0000	1.71
+++ node.lisp	18 Feb 2008 19:25:23 -0000	1.72
@@ -1114,6 +1114,8 @@
   ;; determine that this is a set closure variable, and is thus not a
   ;; good subject for flow analysis.
   (constraints nil :type (or sset null))
+  ;; Initial type of a LET variable as last seen by PROPAGATE-FROM-SETS.
+  (last-initial-type *universal-type* :type ctype)
   ;; The FOP handle of the lexical variable represented by LAMBDA-VAR
   ;; in the fopcompiler.
   (fop-value nil))


-------------------------------------------------------------------------
This SF.net email is sponsored by: Microsoft
Defy all challenges. Microsoft(R) Visual Studio 2008.
http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]