Massive focused action

basis/compiler/cfg/debugger/debugger.factor

@@ -4,7 +4,8 @@ USING: kernel words sequences quotations namespaces io
 classes.tuple accessors prettyprint prettyprint.config
 compiler.tree.builder compiler.tree.optimizer
 compiler.cfg.builder compiler.cfg.linearization
-compiler.cfg.stack-frame compiler.cfg.linear-scan ;
+compiler.cfg.stack-frame compiler.cfg.linear-scan
+compiler.cfg.optimizer ;
 IN: compiler.cfg.debugger
 
 GENERIC: test-cfg ( quot -- cfgs )
@@ -19,6 +20,7 @@ SYMBOL: allocate-registers?
 
 : test-mr ( quot -- mrs )
     test-cfg [
+        optimize-cfg
         build-mr
         allocate-registers? get
         [ linear-scan build-stack-frame ] when

basis/compiler/cfg/linearization/linearization.factor

@@ -53,7 +53,10 @@ M: ##compare-float-branch linearize-insn
     binary-conditional _compare-float-branch emit-branch ;
 
 : linearize-basic-block ( bb -- )
-    [ number>> _label ] [ linearize-insns ] bi ;
+    [ number>> _label ]
+    [ gc>> [ _gc ] when ]
+    [ linearize-insns ]
+    tri ;
 
 : linearize-basic-blocks ( rpo -- insns )
     [ [ linearize-basic-block ] each ] { } make ;

basis/compiler/cfg/registers/registers.factor

@@ -5,12 +5,12 @@ parser prettyprint.backend prettyprint.sections ;
 IN: compiler.cfg.registers
 
 ! Virtual registers, used by CFG and machine IRs
-TUPLE: vreg reg-class n ;
+TUPLE: vreg { reg-class read-only } { n read-only } ;
 SYMBOL: vreg-counter
 : next-vreg ( reg-class -- vreg ) \ vreg-counter counter vreg boa ;
 
 ! Stack locations
-TUPLE: loc n ;
+TUPLE: loc { n read-only } ;
 
 TUPLE: ds-loc < loc ;
 C: <ds-loc> ds-loc

basis/compiler/cfg/rpo/rpo.factor

@@ -1,20 +1,32 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors namespaces make math sequences
-compiler.cfg.instructions ;
+USING: kernel accessors namespaces make math sequences sets
+assocs fry compiler.cfg.instructions ;
 IN: compiler.cfg.rpo
 
-: post-order-traversal ( basic-block -- )
-    dup visited>> [ drop ] [
-        t >>visited
+SYMBOL: visited
+
+: post-order-traversal ( bb -- )
+    dup id>> visited get key? [ drop ] [
+        dup id>> visited get conjoin
         [ successors>> [ post-order-traversal ] each ] [ , ] bi
     ] if ;
 
-: post-order ( procedure -- blocks )
+: post-order ( bb -- blocks )
     [ post-order-traversal ] { } make ;
 
 : number-blocks ( blocks -- )
     [ >>number drop ] each-index ;
 
-: reverse-post-order ( procedure -- blocks )
-    post-order <reversed> dup number-blocks ; inline
+: reverse-post-order ( bb -- blocks )
+    H{ } clone visited [
+        post-order <reversed> dup number-blocks
+    ] with-variable ; inline
+
+: each-basic-block ( cfg quot -- )
+    [ entry>> reverse-post-order ] dip each ; inline
+
+: change-basic-blocks ( cfg quot -- cfg' )
+    [ '[ _ change-instructions drop ] each-basic-block ]
+    [ drop ]
+    2bi ; inline

basis/compiler/cfg/utilities/utilities.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math layouts namespaces cpu.architecture
-namespaces compiler.cfg compiler.cfg.instructions ;
+USING: accessors kernel math layouts make sequences
+cpu.architecture namespaces compiler.cfg
+compiler.cfg.instructions ;
 IN: compiler.cfg.utilities
 
 : value-info-small-tagged? ( value-info -- ? )

basis/compiler/compiler.factor

@@ -6,8 +6,9 @@ threads graphs generic combinators deques search-deques
 stack-checker stack-checker.state stack-checker.inlining
 compiler.errors compiler.units compiler.tree.builder
 compiler.tree.optimizer compiler.cfg.builder
-compiler.cfg.linearization compiler.cfg.linear-scan
-compiler.cfg.stack-frame compiler.codegen ;
+compiler.cfg.optimizer compiler.cfg.linearization
+compiler.cfg.linear-scan compiler.cfg.stack-frame
+compiler.codegen ;
 IN: compiler
 
 SYMBOL: compile-queue
@@ -73,6 +74,7 @@ t compile-dependencies? set-global
 
 : backend ( nodes word -- )
     build-cfg [
+        optimize-cfg
         build-mr
         linear-scan
         build-stack-frame