Changeset 16623

Timestamp:

Oct 15, 2015, 5:47:44 PM (6 years ago)

Author:

gb

Message:

vreg.lisp: in MATCH-VREG, just use PUSH (not PUSHNEW) to
add a vinsn to an lreg's refs/defs sets.
vinsn.lisp: fix indentation in CREATE-FLOW graph. Bail out
early on very large functions, which are likely to have very
large flow graphs.

Location:

trunk/source/compiler

Files:

• vinsn.lisp (modified) (4 diffs)
• vreg.lisp (modified) (1 diff)

trunk/source/compiler/vinsn.lisp

@@ -880 +880 @@
   (show-vinsns vinsns 2)
   (let* ((nodes ()))
+    
     (flet ((label->fgn (label) (dll-node-pred label)))
       (loop
@@ -927 +928 @@
 
           (unless (typep first 'callnode)
-          (dolist (ref (fgn-inedges first))
-            (nsubstitute second first (fgn-outedges ref))
-            (when (typep ref 'jumpnode)
-              (when (eq first (jumpnode-outedge ref))
-                (setf (jumpnode-outedge ref) second))
-              (when (typep ref 'condnode)
-                (when (eq first (condnode-branchedge ref))
-                  (setf (condnode-branchedge ref) second)))))
-
-          (if (setf (fgn-extended-pred second) (fgn-extended-pred first))
-            (setf (fgn-extended-succ (fgn-extended-pred first)) second))
-          (setf (fgn-inedges second) (fgn-inedges first))
-          (multiple-value-bind (label1 jump) (detach-dll-nodes first)
-            (let* ((label2 (dll-header-succ second)))
-              (insert-dll-node-before label1 label2 jump)
-              (when (null (delete jump (vinsn-label-refs label2)))
-                (remove-dll-node label2))
-              (remove-dll-node jump)
-              (setf (fgn-id second) (fgn-id first))))
+            (dolist (ref (fgn-inedges first))
+              (nsubstitute second first (fgn-outedges ref))
+              (when (typep ref 'jumpnode)
+                (when (eq first (jumpnode-outedge ref))
+                  (setf (jumpnode-outedge ref) second))
+                (when (typep ref 'condnode)
+                  (when (eq first (condnode-branchedge ref))
+                    (setf (condnode-branchedge ref) second)))))
+
+            (if (setf (fgn-extended-pred second) (fgn-extended-pred first))
+              (setf (fgn-extended-succ (fgn-extended-pred first)) second))
+            (setf (fgn-inedges second) (fgn-inedges first))
+            (multiple-value-bind (label1 jump) (detach-dll-nodes first)
+              (let* ((label2 (dll-header-succ second)))
+                (insert-dll-node-before label1 label2 jump)
+                (when (null (delete jump (vinsn-label-refs label2)))
+                  (remove-dll-node label2))
+                (remove-dll-node jump)
+                (setf (fgn-id second) (fgn-id first))))
           
-          (setf (car nodes1) nil))))
-
-        
+            (setf (car nodes1) nil))))
+
+
 
       
@@ -1894 +1895 @@
 
 
+
 (defun optimize-vinsns (header)
+
+  
   ;; Delete unreferenced labels that the compiler might have emitted.
-
   ;; Subsequent operations may cause other labels to become
   ;; unreferenced.
@@ -1909 +1912 @@
     (eliminate-dead-code header) 
     (cond (*backend-use-linear-scan*
+           (let* ((size (dll-header-length header)))
+             (when (> size 10000)
+               (linear-scan-bailout "function size exceeds compiler limitation"))
+             )
            (normalize-vinsns header)
            (let* ((fg (create-flow-graph header))

trunk/source/compiler/vreg.lisp

@@ -214 +214 @@
               (unless (or (vinsn-attribute-p vinsn :spill) (vinsn-attribute-p vinsn :reload))
                 (if result-p
-                  (pushnew vinsn (lreg-defs vreg))
-                  (pushnew vinsn (lreg-refs vreg))))
+                  (push vinsn (lreg-defs vreg))
+                  (push vinsn (lreg-refs vreg))))
               (error "Bad vreg: ~s" vreg)))
           (when vreg-value