fix bug where traversal order was lost

diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor
index 5b3e1af930efc9bf95cccc83079a7cdb384da2e4..4ce9c59e7e0ef4ec12fe23b3dbbc414c43c591ee 100644 (file)
--- a/basis/compiler/cfg/instructions/instructions.factor
+++ b/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

diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
index df9f29e999e66cfbae36f65c041e1a7a506d8d40..feb9ac2504fe7987ec8bcb7d57ff51c161320642 100644 (file)
--- a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor
+++ b/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 spill-temp } }
-        T{ _copy { dst 0 } { src 1 } { class int-regs } }
-        T{ _reload { dst 1 } { class int-regs } { n spill-temp } }
-        T{ _spill { src 0 } { class float-regs } { n spill-temp } }
-        T{ _copy { dst 0 } { src 1 } { class float-regs } }
-        T{ _reload { dst 1 } { class float-regs } { n spill-temp } }
+        T{ _spill { src 1 } { class int-regs } { n spill-temp } }
+        T{ _copy { dst 1 } { src 0 } { class int-regs } }
+        T{ _reload { dst 0 } { class int-regs } { n spill-temp } }
+        T{ _spill { src 1 } { class float-regs } { n spill-temp } }
+        T{ _copy { dst 1 } { src 0 } { class float-regs } }
+        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 spill-temp } }
-        T{ _copy { dst 0 } { src 2 } { class int-regs } }
+        T{ _spill { src 2 } { class int-regs } { n spill-temp } }
         T{ _copy { dst 2 } { src 1 } { class int-regs } }
-        T{ _reload { dst 1 } { class int-regs } { n spill-temp } }
+        T{ _copy { dst 1 } { src 0 } { class int-regs } }
+        T{ _reload { dst 0 } { class int-regs } { n spill-temp } }
     }
 ] [
     {
@@ -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 spill-temp } }
+        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{ _reload { dst 0 } { class int-regs } { n spill-temp } }
+        T{ _copy { dst 0 } { src 3 } { class int-regs } }
+        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 spill-temp } }
+        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{ _reload { dst 0 } { class int-regs } { n spill-temp } }
+        T{ _copy { dst 0 } { src 3 } { class int-regs } }
+        T{ _reload { dst 3 } { class int-regs } { n spill-temp } }
     }
 ] [
     {

diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
index b996520546e3cec495f72963c6733f82960c029d..bd7528291d16f0e06f4b7acb5e00a02ff3f788e4 100644 (file)
--- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor
+++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor
@@ -126,22 +126,36 @@ 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 [
+        [ 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
     ] [