compiler.cfg.linear-scan.*: more tests and docs for allocation and state

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

@@ -1,12 +1,17 @@
 USING: assocs compiler.cfg compiler.cfg.instructions
 compiler.cfg.linear-scan.allocation compiler.cfg.linear-scan.allocation.state
-compiler.cfg.linear-scan.live-intervals help.markup help.syntax kernel sequences ;
+compiler.cfg.linear-scan.live-intervals hashtables help.markup help.syntax
+kernel sequences ;
 IN: compiler.cfg.linear-scan.allocation
 
 HELP: (allocate-registers)
 { $values { "unhandled-min-heap" "stuff" } }
 { $description "Register allocation works by emptying the unhandled intervals and sync points." } ;
 
+HELP: active-positions
+{ $values { "new" live-interval-state } { "assoc" assoc } }
+{ $description "Looks at the " { $link active-intervals } " and sets to 0 those registers in 'assoc' that can't be used for allocation." } ;
+
 HELP: allocate-registers
 { $values
   { "intervals/sync-points" sequence }
@@ -15,6 +20,15 @@ HELP: allocate-registers
 }
 { $description "Performs register allocation of a " { $link sequence } " of live intervals. Each live interval is assigned a physical register and also a spill slot if it needs to be spilled." } ;
 
+HELP: assign-register
+{ $values { "new" live-interval-state } { "registers" assoc } }
+{ $description "Assigns a processor register to the live interval." } ;
+
+HELP: free-positions
+{ $values { "registers" assoc } { "reg-class" } { "avail-registers" assoc } }
+{ $description "Creates an alist mapping registers to their desirability for allocation. 'avail-registers' is an alist and not a " { $link hashtable } " because the register allocation order is significant." }
+{ $see-also register-status } ;
+
 HELP: handle-sync-point
 { $values
   { "sync-point" sync-point }

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

@@ -44,6 +44,26 @@ cpu x86.64? [
         interval-[30,60] add-active
         interval-[30,46] machine-registers register-status
     ] unit-test
+
+    ! free-positions
+    {
+        {
+            { RAX 1/0. }
+            { RCX 1/0. }
+            { RDX 1/0. }
+            { RBX 1/0. }
+            { RBP 1/0. }
+            { RSI 1/0. }
+            { RDI 1/0. }
+            { R8 1/0. }
+            { R9 1/0. }
+            { R10 1/0. }
+            { R11 1/0. }
+            { R12 1/0. }
+        }
+    } [
+        machine-registers int-regs free-positions
+    ] unit-test
 ] when
 
 ! handle-sync-point

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

@@ -8,8 +8,7 @@ heaps kernel locals math namespaces sequences ;
 IN: compiler.cfg.linear-scan.allocation
 
 : active-positions ( new assoc -- )
-    [ active-intervals-for ] dip
+    swap active-intervals-for [ reg>> 0 2array ] map assoc-union! drop ;
-    '[ [ 0 ] dip reg>> _ add-use-position ] each ;
 
 : inactive-positions ( new assoc -- )
     [ [ inactive-intervals-for ] keep ] dip

basis/compiler/cfg/linear-scan/allocation/state/state-docs.factor

@@ -33,14 +33,6 @@ HELP: deactivate-intervals
 { $values { "n" integer } }
 { $description "Any active intervals which have ended are moved to handled. Any active intervals which cover the current position are moved to inactive." } ;
 
-HELP: free-positions
-{ $values
-  { "registers" assoc }
-  { "reg-class" reg-class }
-  { "assoc" assoc }
-}
-{ $description "Returns an assoc with the registers that can be used by the live interval. A utility used by " { $link register-status } " word." } ;
-
 HELP: handled-intervals
 { $var-description { $link vector } " of handled live intervals. This variable I think is only used during the " { $link allocate-registers } " step." } ;
 

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

@@ -1,5 +1,6 @@
 USING: accessors arrays assocs combinators.extras compiler.cfg
-compiler.cfg.instructions compiler.cfg.linear-scan.allocation.state
+compiler.cfg.instructions compiler.cfg.linear-scan.allocation
+compiler.cfg.linear-scan.allocation.state
 compiler.cfg.linear-scan.live-intervals compiler.cfg.utilities cpu.architecture
 cpu.x86.assembler.operands heaps kernel layouts namespaces sequences system
 tools.test ;
@@ -37,7 +38,7 @@ IN: compiler.cfg.linear-scan.allocation.state.tests
 ! add-use-position
 cpu x86.64? [
     {
-        H{
+        {
             { XMM0 1/0. }
             { XMM1 25 }
             { XMM2 1/0. }
@@ -48,12 +49,12 @@ cpu x86.64? [
             { XMM7 1/0. }
             { XMM8 1/0. }
             { XMM9 1/0. }
-            { XMM11 1/0. }
             { XMM10 1/0. }
-            { XMM13 1/0. }
+            { XMM11 1/0. }
             { XMM12 1/0. }
-            { XMM15 1/0. }
+            { XMM13 1/0. }
             { XMM14 1/0. }
+            { XMM15 1/0. }
         }
     } [
         25 XMM1 machine-registers float-regs free-positions
@@ -61,6 +62,11 @@ cpu x86.64? [
     ] unit-test
 ] when
 
+! add-use-position
+{ { { "prutt" 12 } } } [
+    30 "prutt" { { "prutt" 12 } } [ add-use-position ] keep
+] unit-test
+
 ! assign-spill-slot
 cpu x86.32?
 H{
@@ -98,34 +104,27 @@ H{
     check-handled
 ] unit-test
 
-! free-positions
-cpu x86.64? [
-    {
-        H{
-            { RCX 1/0. }
-            { RBX 1/0. }
-            { RAX 1/0. }
-            { R12 1/0. }
-            { RDI 1/0. }
-            { R10 1/0. }
-            { RSI 1/0. }
-            { R11 1/0. }
-            { R8 1/0. }
-            { R9 1/0. }
-            { RDX 1/0. }
-            { RBP 1/0. }
-        }
-    } [
-        machine-registers int-regs free-positions
-    ] unit-test
-] when
-
 ! align-spill-area
 { t } [
     3 f f { } 0 insns>block <cfg> [ align-spill-area ] keep
     spill-area-align>> cell =
 ] unit-test
 
+! inactive-intervals-for
+{
+    V{ T{ live-interval-state { reg-class int-regs } { vreg 123 } } }
+} [
+    f machine-registers init-allocator
+    T{ live-interval-state { reg-class int-regs } { vreg 123 } }
+    [ add-inactive ] keep inactive-intervals-for
+] unit-test
+
+! interval/sync-point-key
+{ { 33 1/0.0 1/0.0 } } [
+    T{ sync-point { n 33 } } interval/sync-point-key
+] unit-test
+
+! next-spill-slot
 {
     T{ spill-slot f 0 }
     T{ spill-slot f 8 }
@@ -137,10 +136,7 @@ cpu x86.64? [
     cfg get
 ] unit-test
 
-{ { 33 1/0.0 1/0.0 } } [
+! >unhandled-min-heap
-    T{ sync-point { n 33 } } interval/sync-point-key
-] unit-test
-
 {
     {
         { { 5 1/0. 1/0. } T{ sync-point { n 5 } } }