compiler.cfg.linear-scan: Debugging resolve pass

basis/compiler/cfg/linear-scan/debugger/debugger.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel sequences sets arrays math strings fry
-prettyprint compiler.cfg.linear-scan.live-intervals
+namespaces prettyprint compiler.cfg.linear-scan.live-intervals
-compiler.cfg.linear-scan.allocation ;
+compiler.cfg.linear-scan.allocation compiler.cfg ;
 IN: compiler.cfg.linear-scan.debugger
 
 : check-assigned ( live-intervals -- )
@@ -34,3 +34,6 @@ IN: compiler.cfg.linear-scan.debugger
 
 : live-intervals. ( seq -- )
     [ interval-picture ] map simple-table. ;
+
+: test-bb ( insns n -- )
+    [ <basic-block> swap >>number swap >>instructions ] keep set ;

basis/compiler/cfg/linear-scan/linear-scan-tests.factor

@@ -1417,9 +1417,6 @@ USING: math.private ;
     intersect-inactive
 ] unit-test
 
-: test-bb ( insns n -- )
-    [ <basic-block> swap >>number swap >>instructions ] keep set ;
-
 ! Bug in live spill slots calculation
 
 V{ T{ ##prologue } T{ ##branch } } 0 test-bb
@@ -1489,7 +1486,9 @@ SYMBOL: linear-scan-result
         flatten-cfg 1array mr.
     ] unit-test ;
 
-{ 1 2 } test-linear-scan-on-cfg
+! This test has a critical edge -- do we care about these?
+
+! { 1 2 } test-linear-scan-on-cfg
 
 ! Bug in inactive interval handling
 ! [ rot dup [ -rot ] when ]

basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor

@@ -1,6 +1,65 @@
+USING: accessors arrays compiler.cfg compiler.cfg.instructions
+compiler.cfg.linear-scan.debugger
+compiler.cfg.linear-scan.live-intervals
+compiler.cfg.linear-scan.numbering
+compiler.cfg.linear-scan.resolve compiler.cfg.predecessors
+compiler.cfg.registers compiler.cfg.rpo cpu.architecture kernel
+namespaces tools.test vectors ;
 IN: compiler.cfg.linear-scan.resolve.tests
-USING: compiler.cfg.linear-scan.resolve tools.test arrays kernel ;
 
 [ { 1 2 3 4 5 6 } ] [
     { 3 4 } V{ 1 2 } clone [ { 5 6 } 3append-here ] keep >array
 ] unit-test
+
+V{
+    T{ ##peek f V int-regs 0 D 0 }
+    T{ ##branch }
+} 0 test-bb
+
+V{
+    T{ ##replace f V int-regs 0 D 1 }
+    T{ ##return }
+} 1 test-bb
+
+1 get 1vector 0 get (>>successors)
+
+cfg new 0 get >>entry
+compute-predecessors
+dup reverse-post-order number-instructions
+drop
+
+CONSTANT: test-live-interval-1
+T{ live-interval
+   { start 0 }
+   { end 6 }
+   { uses V{ 0 6 } }
+   { ranges V{ T{ live-range f 0 2 } T{ live-range f 4 6 } } }
+   { spill-to 0 }
+   { vreg V int-regs 0 }
+}
+
+[ f ] [
+    0 get test-live-interval-1 spill-to
+] unit-test
+
+[ 0 ] [
+    1 get test-live-interval-1 spill-to
+] unit-test
+
+CONSTANT: test-live-interval-2
+T{ live-interval
+   { start 0 }
+   { end 6 }
+   { uses V{ 0 6 } }
+   { ranges V{ T{ live-range f 0 2 } T{ live-range f 4 6 } } }
+   { reload-from 0 }
+   { vreg V int-regs 0 }
+}
+
+[ 0 ] [
+    0 get test-live-interval-2 reload-from
+] unit-test
+
+[ f ] [
+    1 get test-live-interval-2 reload-from
+] unit-test

basis/compiler/cfg/linear-scan/resolve/resolve.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs kernel math namespaces sequences
 classes.tuple classes.parser parser fry words make arrays
-combinators compiler.cfg.linear-scan.live-intervals
+locals combinators compiler.cfg.linear-scan.live-intervals
 compiler.cfg.liveness compiler.cfg.instructions ;
 IN: compiler.cfg.linear-scan.resolve
 
@@ -24,23 +24,36 @@ SYNTAX: OPERATION:
 
 >>
 
+: reload-from ( bb live-interval -- n/f )
+    2dup [ block-from ] [ start>> ] bi* =
+    [ nip reload-from>> ] [ 2drop f ] if ;
+
+: spill-to ( bb live-interval -- n/f )
+    2dup [ block-to ] [ end>> ] bi* =
+    [ nip spill-to>> ] [ 2drop f ] if ;
+
 OPERATION: memory->memory spill-to>> reload-from>>
 OPERATION: register->memory reg>> reload-from>>
 OPERATION: memory->register spill-to>> reg>>
 OPERATION: register->register reg>> reg>>
 
-: add-mapping ( from to -- )
+:: add-mapping ( bb1 bb2 li1 li2 -- )
-    dup reload-from>> [
+    bb2 li2 reload-from [
-        over spill-to>> [ memory->memory ] [ register->memory ] if
+        bb1 li1 spill-to
+        [ li1 li2 memory->memory ]
+        [ li1 li2 register->memory ] if
     ] [
-        over spill-to>> [ memory->register ] [ register->register ] if
+        bb1 li1 spill-to
+        [ li1 li2 memory->register ]
+        [ li1 li2 register->register ] if
     ] if ;
 
 : resolve-value-data-flow ( bb to vreg -- )
+    [ 2dup ] dip
     live-intervals get at
     [ [ block-to ] dip child-interval-at ]
     [ [ block-from ] dip child-interval-at ]
-    bi-curry bi* 2dup eq? [ 2drop ] [ add-mapping ] if ;
+    bi-curry bi* 2dup eq? [ 2drop 2drop ] [ add-mapping ] if ;
 
 : compute-mappings ( bb to -- mappings )
     [
@@ -50,9 +63,6 @@ OPERATION: register->register reg>> reg>>
 
 GENERIC: >insn ( operation -- )
 
-: >operation< ( operation -- from to reg-class )
-    [ from>> ] [ to>> ] [ reg-class>> ] tri ; inline
-
 M: memory->memory >insn
     [ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ;
 
@@ -80,7 +90,7 @@ M: register->register >insn
     [ predecessors>> length 1 >= ] bi* and ; inline
 
 : insert-position/join ( from to -- before after )
-    drop instructions>> { } ;
+    drop instructions>> dup pop 1array ;
 
 : insert-position ( bb to -- before after )
     {