Merge branch 'master' of git://factorcode.org/git/factor

basis/compiler/cfg/branch-splitting/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/compiler/cfg/branch-splitting/branch-splitting.factor

@@ -0,0 +1,29 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators.short-circuit compiler.cfg.def-use
+compiler.cfg.rpo kernel math sequences ;
+IN: compiler.cfg.branch-splitting
+
+: split-branch ( branch -- )
+    [
+        [ instructions>> ] [ predecessors>> ] bi [
+            instructions>> [ pop* ] [ push-all ] bi
+        ] with each
+    ] [
+        [ successors>> ] [ predecessors>> ] bi [
+            [ drop clone ] change-successors drop
+        ] with each
+    ] bi ;
+
+: split-branches? ( bb -- ? )
+    {
+        [ predecessors>> length 1 >= ]
+        [ successors>> length 1 <= ]
+        [ instructions>> [ defs-vregs ] any? not ]
+        [ instructions>> [ temp-vregs ] any? not ]
+    } 1&& ;
+
+: split-branches ( cfg -- cfg' )
+    dup [
+        dup split-branches? [ split-branch ] [ drop ] if
+    ] each-basic-block f >>post-order ;

basis/compiler/cfg/instructions/instructions.factor

@@ -248,4 +248,4 @@ INSN: _reload dst class n ;
 INSN: _copy dst src class ;
 INSN: _spill-counts counts ;
 
-SYMBOL: temp-spill
+SYMBOL: spill-temp

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

@@ -68,12 +68,12 @@ T{ live-interval
 [
     {
         T{ _copy { dst 5 } { src 4 } { class int-regs } }
-        T{ _spill { src 0 } { class int-regs } { n 6 } }
+        T{ _spill { src 1 } { class int-regs } { n spill-temp } }
-        T{ _copy { dst 0 } { src 1 } { class int-regs } }
+        T{ _copy { dst 1 } { src 0 } { class int-regs } }
-        T{ _reload { dst 1 } { class int-regs } { n 6 } }
+        T{ _reload { dst 0 } { class int-regs } { n spill-temp } }
-        T{ _spill { src 0 } { class float-regs } { n 7 } }
+        T{ _spill { src 1 } { class float-regs } { n spill-temp } }
-        T{ _copy { dst 0 } { src 1 } { class float-regs } }
+        T{ _copy { dst 1 } { src 0 } { class float-regs } }
-        T{ _reload { dst 1 } { class float-regs } { n 7 } }
+        T{ _reload { dst 0 } { class float-regs } { n spill-temp } }
     }
 ] [
     {
@@ -87,10 +87,10 @@ T{ live-interval
 
 [
     {
-        T{ _spill { src 0 } { class int-regs } { n 3 } }
+        T{ _spill { src 2 } { class int-regs } { n spill-temp } }
-        T{ _copy { dst 0 } { src 2 } { class int-regs } }
         T{ _copy { dst 2 } { src 1 } { class int-regs } }
-        T{ _reload { dst 1 } { class int-regs } { n 3 } }
+        T{ _copy { dst 1 } { src 0 } { class int-regs } }
+        T{ _reload { dst 0 } { class int-regs } { n spill-temp } }
     }
 ] [
     {
@@ -102,10 +102,10 @@ T{ live-interval
 
 [
     {
-        T{ _spill { src 0 } { class int-regs } { n 3 } }
+        T{ _spill { src 0 } { class int-regs } { n spill-temp } }
         T{ _copy { dst 0 } { src 2 } { class int-regs } }
         T{ _copy { dst 2 } { src 1 } { class int-regs } }
-        T{ _reload { dst 1 } { class int-regs } { n 3 } }
+        T{ _reload { dst 1 } { class int-regs } { n spill-temp } }
     }
 ] [
     {
@@ -136,7 +136,7 @@ T{ live-interval
 ] unit-test
 
 [
-    { T{ _spill { src 4 } { class int-regs } { n 4 } } }
+    { T{ _spill { src 4 } { class int-regs } { n spill-temp } } }
 ] [
     {
        T{ register->memory { from 4 } { to 4 } { reg-class int-regs } }
@@ -162,10 +162,10 @@ T{ live-interval
     {
         T{ _copy { dst 1 } { src 0 } { class int-regs } }
         T{ _copy { dst 2 } { src 0 } { class int-regs } }
-        T{ _spill { src 3 } { class int-regs } { n 5 } }
+        T{ _spill { src 4 } { class int-regs } { n spill-temp } }
         T{ _copy { dst 4 } { src 0 } { class int-regs } }
-        T{ _copy { dst 3 } { src 4 } { class int-regs } }
+        T{ _copy { dst 0 } { src 3 } { class int-regs } }
-        T{ _reload { dst 0 } { class int-regs } { n 5 } }
+        T{ _reload { dst 3 } { class int-regs } { n spill-temp } }
     }
 ] [
     {
@@ -182,10 +182,10 @@ T{ live-interval
         T{ _copy { dst 2 } { src 0 } { class int-regs } }
         T{ _copy { dst 9 } { src 1 } { class int-regs } }
         T{ _copy { dst 1 } { src 0 } { class int-regs } }
-        T{ _spill { src 3 } { class int-regs } { n 10 } }
+        T{ _spill { src 4 } { class int-regs } { n spill-temp } }
         T{ _copy { dst 4 } { src 0 } { class int-regs } }
-        T{ _copy { dst 3 } { src 4 } { class int-regs } }
+        T{ _copy { dst 0 } { src 3 } { class int-regs } }
-        T{ _reload { dst 0 } { class int-regs } { n 10 } }
+        T{ _reload { dst 3 } { class int-regs } { n spill-temp } }
     }
 ] [
     {

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

@@ -68,10 +68,10 @@ M: memory->memory >insn
     [ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ;
 
 M: register->memory >insn
-    [ from>> ] [ reg-class>> ] [ to>> ] tri _spill ;
+    [ from>> ] [ reg-class>> ] bi spill-temp _spill ;
 
 M: memory->register >insn
-    [ to>> ] [ reg-class>> ] [ from>> ] tri _reload ;
+    [ to>> ] [ reg-class>> ] bi spill-temp _reload ;
 
 M: register->register >insn
     [ to>> ] [ from>> ] [ reg-class>> ] tri _copy ;
@@ -82,10 +82,10 @@ M: memory->memory >collision-table
     [ from>> ] [ to>> ] bi = [ "Not allowed" throw ] unless ;
 
 M: register->memory >collision-table
-    [ from>> ] [ reg-class>> ] [ to>> ] tri _spill ;
+    [ from>> ] [ reg-class>> ] bi spill-temp _spill ;
 
 M: memory->register >collision-table
-    [ to>> ] [ reg-class>> ] [ from>> ] tri _reload ;
+    [ to>> ] [ reg-class>> ] bi spill-temp _reload ;
 
 M: register->register >collision-table
     [ to>> ] [ from>> ] [ reg-class>> ] tri _copy ;
@@ -119,10 +119,6 @@ M: register->register to-loc drop register ;
 : independent-assignment? ( operations -- pair )
     to-reg froms get key? not ;
 
-: init-temp-spill ( operations -- )
-    [ [ to>> ] [ from>> ] bi max ] [ max ] map-reduce
-    1 + temp-spill set ;
-
 : set-tos/froms ( operations -- )
     [ [ [ from-reg ] keep ] H{ } map>assoc froms set ]
     [ [ [ to-reg ] keep ] H{ } map>assoc tos set ]
@@ -130,26 +126,40 @@ M: register->register to-loc drop register ;
 
 :: (trace-chain) ( obj hashtable -- )
     obj to-reg froms get at* [
+        dup ,
         obj over hashtable clone [ maybe-set-at ] keep swap
-        [ (trace-chain) ] [ , drop ] if
+        [ (trace-chain) ] [ 2drop ] if
     ] [
-        drop hashtable ,
+        drop
     ] if ;
 
 : trace-chain ( obj -- seq )
     [
+        dup ,
         dup dup associate (trace-chain)
-    ] { } make [ keys ] map concat reverse ;
+    ] { } make prune reverse ;
+
 
 : trace-chains ( seq -- seq' )
     [ trace-chain ] map concat ;
 
-: break-cycle-n ( operations -- operations' )
+ERROR: resolve-error ;
+
+: split-cycle ( operations -- chain spilled-operation )
     unclip [
-        [ from>> temp-spill get ]
+        [ set-tos/froms ]
+        [
+            [ start? ] find nip
+            [ resolve-error ] unless* trace-chain
+        ] bi
+    ] dip ;
+
+: break-cycle-n ( operations -- operations' )
+    split-cycle [
+        [ from>> spill-temp ]
         [ reg-class>> ] bi \ register->memory boa
     ] [
-        [ to>> temp-spill [ get ] [ inc ] bi swap ]
+        [ to>> spill-temp swap ]
         [ reg-class>> ] bi \ memory->register boa
     ] bi [ 1array ] bi@ surround ;
 
@@ -182,9 +192,7 @@ M: register->register to-loc drop register ;
 
 : mapping-instructions ( mappings -- insns )
     [
-        [ init-temp-spill ]
+        [ set-tos/froms ] [ parallel-mappings ] bi
-        [ set-tos/froms ]
-        [ parallel-mappings ] tri
         [ [ >insn ] each ] { } make
     ] with-scope ;