compiler.cfg.linear-scan.assignment: refactoring of assign-registers-in-block + tests

basis/compiler/cfg/linear-scan/assignment/assignment-docs.factor

@@ -19,25 +19,29 @@ HELP: assign-gc-roots
 
 HELP: assign-registers-in-block
 { $values { "bb" basic-block } }
-{ $description "Assigns registers and also inserts " { $link ##reload } " and " { $link ##spill } " instructions." } ;
+{ $description "Assigns registers to vregs and also inserts " { $link ##reload } " and " { $link ##spill } " instructions." } ;
 
 HELP: assign-registers
 { $values { "cfg" cfg } { "live-intervals" sequence } }
 { $description "Uses the live intervals in the sequence to assign physical registers to all instructions in the cfg. The live intervals must first have had their physical registers assigned by " { $link allocate-registers } "." } ;
 
-HELP: assign-registers-in-insn
+HELP: assign-all-registers
 { $values { "insn" insn } }
-{ $description "Assigns physical registers and spill slots for the virtual registers used by the instruction." } ;
+{ $description "Assigns physical registers for the virtual registers used and defined by the instruction." } ;
 
 HELP: compute-live-in
 { $values { "bb" basic-block } }
 { $description "Computes the live in registers for a basic block." }
 { $see-also machine-live-ins } ;
 
+HELP: expire-old-intervals
+{ $values { "n" integer } { "pending-heap" min-heap } }
+{ $description "Expires all intervals older than the cutoff point." } ;
+
 HELP: insert-reload
 { $values { "live-interval" live-interval-state } }
 { $description "Inserts a " { $link ##reload } " instruction for a live interval." }
-{ $see-also insert-spill } ;
+{ $see-also handle-reload insert-spill } ;
 
 HELP: machine-edge-live-ins
 { $var-description "Mapping from basic blocks to predecessors to values which are live on a particular incoming edge." } ;

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

@@ -22,6 +22,33 @@ IN: compiler.cfg.linear-scan.assignment.tests
     (setup-vreg-spills)
     [ representations set ] [ leader-map set ] [ spill-slots set ] tri* ;
 
+! activate-new-intervals
+{
+    {
+        T{ ##reload
+           { dst RBX }
+           { rep tagged-rep }
+           { src T{ spill-slot } }
+        }
+    }
+} [
+    ! Setup
+    H{ } clone pending-interval-assoc set
+    <min-heap> pending-interval-heap set
+    30 {
+        T{ live-interval-state
+           { vreg 789 }
+           { reg RBX }
+           { reload-from T{ spill-slot } }
+           { reload-rep tagged-rep }
+           { ranges V{ { 30 30  } } }
+           { uses
+             V{ T{ vreg-use { n 26 } { use-rep tagged-rep } } }
+           }
+        }
+    } live-intervals>min-heap [ activate-new-intervals ] { } make
+] unit-test
+
 ! assign-gc-roots
 {
     T{ gc-map { gc-roots { T{ spill-slot { n 7 } } } } }
@@ -123,6 +150,14 @@ IN: compiler.cfg.linear-scan.assignment.tests
     46 vreg>reg
 ] [ bad-vreg? ] must-fail-with
 
+! vregs>regs
+{ H{ { 44 RBX } { 33 RAX } } } [
+    { { 33 int-rep 33 f } { 44 int-rep 44 f } } setup-vreg-spills
+    H{ { 33 RAX } { 44 RBX } } pending-interval-assoc set
+    { 33 44 } vregs>regs
+] unit-test
+
+
 { { 3 56 } } [
     { { 3 7 } { -1 56 } { -1 3 } } >min-heap [ -1 = ] heap-pop-while
     natural-sort

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

@@ -1,13 +1,17 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs combinators compiler.cfg
+USING: accessors assocs combinators compiler.cfg
-compiler.cfg.linearization compiler.cfg.liveness compiler.cfg.registers
 compiler.cfg.instructions compiler.cfg.linear-scan.allocation.state
-compiler.cfg.linear-scan.live-intervals compiler.cfg.renaming.functor
+compiler.cfg.linear-scan.live-intervals compiler.cfg.linearization
-compiler.cfg.ssa.destruction.leaders cpu.architecture
+compiler.cfg.liveness compiler.cfg.registers
-fry heaps kernel make math namespaces sequences sets ;
+compiler.cfg.renaming.functor compiler.cfg.ssa.destruction.leaders fry
+heaps kernel make math namespaces sequences ;
 IN: compiler.cfg.linear-scan.assignment
 
+: heap-pop-while ( heap quot: ( key -- ? ) -- values )
+    '[ dup heap-empty? [ f f ] [ dup heap-peek @ ] if ]
+    [ over heap-pop* ] produce 2nip ; inline
+
 ! This contains both active and inactive intervals; any interval
 ! such that start <= insn# <= end is in this set.
 SYMBOL: pending-interval-heap
@@ -61,10 +65,6 @@ SYMBOL: machine-live-outs
 : compute-live-out ( bb -- )
     [ live-out keys vregs>regs ] keep machine-live-outs get set-at ;
 
-: heap-pop-while ( heap quot: ( key -- ? ) -- values )
-    '[ dup heap-empty? [ f f ] [ dup heap-peek @ ] if ]
-    [ over heap-pop* ] produce 2nip ; inline
-
 : insert-spill ( live-interval -- )
     [ reg>> ] [ spill-rep>> ] [ spill-to>> ] tri ##spill, ;
 
@@ -104,11 +104,6 @@ RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
 : assign-derived-roots ( gc-map -- )
     [ [ [ vreg>spill-slot ] bi@ ] assoc-map ] change-derived-roots drop ;
 
-: assign-registers-in-insn ( insn -- )
-    dup assign-all-registers dup gc-map-insn? [
-        gc-map>> [ assign-gc-roots ] [ assign-derived-roots ] bi
-    ] [ drop ] if ;
-
 : begin-block ( bb -- )
     {
         [ basic-block namespaces:set ]
@@ -117,23 +112,26 @@ RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
         [ compute-live-in ]
     } cleave ;
 
+: handle-gc-map-insn ( insn -- )
+    dup , gc-map>> [ assign-gc-roots ] [ assign-derived-roots ] bi ;
+
 : assign-registers-in-block ( bb -- )
     dup begin-block
     [
         [
             [
-                {
+                [ insn#>> prepare-insn ]
-                    [ insn#>> prepare-insn ]
+                [ assign-all-registers ]
-                    [ assign-registers-in-insn ]
+                [ dup gc-map-insn? [ handle-gc-map-insn ] [ , ] if ] tri
-                    [ , ]
-                } cleave
             ] each
         ] V{ } make
     ] change-instructions compute-live-out ;
 
+: live-intervals>min-heap ( live-intervals -- min-heap )
+    [ [ live-interval-start ] map ] keep zip >min-heap ;
+
 : init-assignment ( live-intervals -- )
-    [ [ live-interval-start ] map ] keep zip
+    live-intervals>min-heap unhandled-intervals namespaces:set
-    >min-heap unhandled-intervals namespaces:set
     <min-heap> pending-interval-heap namespaces:set
     H{ } clone pending-interval-assoc namespaces:set
     H{ } clone machine-live-ins namespaces:set