compiler.cfg.linear-scan.allocation.*: lots more docs and some word simplifications

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

@@ -1,6 +1,41 @@
-USING: compiler.cfg compiler.cfg.linear-scan.allocation help.markup
+USING: assocs compiler.cfg compiler.cfg.instructions
-help.syntax sequences ;
+compiler.cfg.linear-scan.allocation compiler.cfg.linear-scan.allocation.state
+compiler.cfg.linear-scan.live-intervals help.markup help.syntax 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: allocate-registers
+{ $values
+  { "live-intervals" sequence }
+  { "sync-point" sequence }
+  { "registers" assoc }
+  { "live-intervals'" sequence }
+}
+{ $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: handle-sync-point
+{ $values
+  { "sync-point" sync-point }
+  { "active-intervals" assoc }
+}
+{ $description "Removes from 'active-intervals' all intervals that were spilled at the sync point. Most of the time, all intervals are spilled. But it depends on if the sync point was constructed from a " { $link clobber-insn } " or " { $link hairy-clobber-insn } "." } ;
+
+HELP: spill-at-sync-point
+{ $values
+  { "sync-point" sync-point }
+  { "live-interval" live-interval-state }
+  { "?" "a boolean" }
+}
+{ $description "Maybe spills the live-interval at the given sync point. If the interval was spilled, then " { $link f } " is put on the stack to indicate that the interval isn't live anymore, " { $link t } " otherwise." }
+{ $see-also spill-at-sync-point? } ;
+
+HELP: spill-at-sync-point?
+{ $values
+  { "sync-point" sync-point }
+  { "live-interval" live-interval-state }
+  { "?" "a boolean" }
+}
+{ $description "If the live interval has a definition at a keep-dst? sync-point, don't spill." } ;

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

@@ -18,24 +18,22 @@ IN: compiler.cfg.linear-scan.allocation
         _ add-use-position
     ] each ;
 
-: register-status ( new -- free-pos )
+: register-status ( new registers -- free-pos )
-    dup free-positions
+    over reg-class>> free-positions
     [ inactive-positions ] [ active-positions ] [ nip ] 2tri
     >alist alist-max ;
 
 : no-free-registers? ( result -- ? )
     second 0 = ; inline
 
-: assign-register ( new -- )
+: assign-register ( new registers -- )
-    dup register-status {
+    dupd register-status {
         { [ dup no-free-registers? ] [ drop assign-blocked-register ] }
         { [ 2dup register-available? ] [ register-available ] }
         [ drop assign-blocked-register ]
     } cond ;
 
 : spill-at-sync-point? ( sync-point live-interval -- ? )
-    ! If the live interval has a definition at a keep-dst?
-    ! sync-point, don't spill.
     {
         [ drop keep-dst?>> not ]
         [ [ n>> ] dip find-use dup [ def-rep>> ] when not ]
@@ -49,25 +47,22 @@ GENERIC: handle ( obj -- )
 
 M: live-interval-state handle
     [ start>> [ deactivate-intervals ] [ activate-intervals ] bi ]
-    [ assign-register ] bi ;
+    [ registers get assign-register ] bi ;
 
-: handle-sync-point ( sync-point -- )
+: handle-sync-point ( sync-point active-intervals -- )
-    active-intervals get values
+    values [ [ spill-at-sync-point ] with filter! drop ] with each ;
-    [ [ spill-at-sync-point ] with filter! drop ] with each ;
 
 M: sync-point handle ( sync-point -- )
     [ n>> [ deactivate-intervals ] [ activate-intervals ] bi ]
-    [ handle-sync-point ] bi ;
+    [ active-intervals get handle-sync-point ] bi ;
 
 : (allocate-registers) ( unhandled-min-heap -- )
     [ drop handle ] slurp-heap ;
 
-: finish-allocation ( -- )
+: gather-intervals ( -- live-intervals )
-    active-intervals inactive-intervals
+    handled-intervals get
-    [ get values [ handled-intervals get push-all ] each ] bi@ ;
+    active-intervals inactive-intervals [ get values concat ] bi@ 3append ;
 
-: allocate-registers ( live-intervals sync-point machine-registers -- live-intervals )
+: allocate-registers ( live-intervals sync-point registers -- live-intervals' )
-    init-allocator
+    init-allocator unhandled-min-heap get (allocate-registers)
-    unhandled-min-heap get (allocate-registers)
+    gather-intervals ;
-    finish-allocation
-    handled-intervals get ;

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

@@ -1,10 +1,20 @@
 USING: compiler.cfg.linear-scan.live-intervals help.markup help.syntax ;
 IN: compiler.cfg.linear-scan.allocation.spilling
 
+HELP: spill-before
+{ $values
+  { "before" live-interval-state }
+  { "before/f" { $link live-interval-state } " or " { $link f } }
+}
+{ $description "If the interval does not have any usages before the spill location, then it is the second child of an interval that was split. We reload the value and let the resolve pass insert a spill later." } ;
+
 HELP: spill-intersecting-active
 { $values { "new" live-interval-state } { "reg" "register" } }
 { $description "If there is an active interval using 'reg' (there should be at most one) are split and spilled and removed from the inactive set." } ;
 
 HELP: spill-partially-available
-{ $values { "new" live-interval-state } { "pair" "register availability status" } }
+{ $values
+  { "new" live-interval-state }
+  { "pair" "register availability status" }
+}
 { $description "A register would be available for part of the new interval's lifetime if all active and inactive intervals using that register were split and spilled." } ;

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

@@ -38,9 +38,6 @@ ERROR: bad-live-ranges interval ;
     ] [ 2drop ] if ;
 
 : spill-before ( before -- before/f )
-    ! If the interval does not have any usages before the spill location,
-    ! then it is the second child of an interval that was split. We reload
-    ! the value and let the resolve pass insert a spill later.
     dup uses>> empty? [ drop f ] [
         {
             [ ]
@@ -141,7 +138,7 @@ ERROR: bad-live-ranges interval ;
     ! and spilled.
     [ first spill-intersecting ] [ register-available ] 2bi ;
 
-: spill-partially-available ( live-interval pair -- )
+: spill-partially-available ( new pair -- )
     [ second 1 - split-for-spill [ add-unhandled ] when* ] keep
     '[ _ spill-available ] when* ;
 

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

@@ -14,25 +14,39 @@ HELP: active-intervals
 
 HELP: add-active
 { $values { "live-interval" live-interval-state } }
-{ $description "Adds a live interval to the " { $link active-intervals } " assoc." } ;
+{ $description "Adds a live interval to the " { $link active-intervals } " assoc." }
+{ $see-also active-intervals } ;
 
 HELP: align-spill-area
-{ $values { "align" integer } }
+{ $values { "align" integer } { "cfg" cfg } }
 { $description "This word is used to ensure that the alignment of the spill area in the " { $link cfg } " is equal to the largest " { $link spill-slot } "." } ;
 
+HELP: assign-spill-slot
+{ $values
+  { "coalesced-vreg" "vreg" }
+  { "rep" representation }
+  { "spill-slot" spill-slot }
+}
+{ $description "Assigns a spill slot for the vreg." } ;
+
 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 { "new" live-interval-state } { "assoc" assoc } }
+{ $values
-{ $description "A utility used by " { $link register-status } " and " { $link spill-status } " words." } ;
+  { "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." } ;
+{ $var-description { $link vector } " of handled live intervals. This variable I think is only used during the " { $link allocate-registers } " step." } ;
 
 HELP: inactive-intervals
-{ $var-description { $link vector } " of inactive live intervals." } ;
+{ $var-description { $link assoc } " of inactive live intervals. Keys are register class symbols and the values vectors of " { $link live-interval-state } "." }
+{ $see-also active-intervals } ;
 
 HELP: init-allocator
 { $values
@@ -51,11 +65,15 @@ HELP: progress
 { $var-description "Start index of current live interval. We ensure that all live intervals added to the unhandled set have a start index strictly greater than this one. This ensures that we can catch infinite loop situations. We also ensure that all live intervals added to the handled set have an end index strictly smaller than this one. This helps catch bugs." }
 { $see-also check-handled check-unhandled } ;
 
+HELP: register-available?
+{ $values { "new" live-interval-state } { "result" "a pair" } { "?" "a boolean" } }
+{ $description "Whether the register in 'result' can be used for the given live interval." } ;
+
 HELP: registers
 { $var-description "Mapping from register classes to sequences of machine registers." } ;
 
 HELP: spill-slots
-{ $var-description "Mapping from vregs to spill slots." } ;
+{ $var-description "Mapping from pairs of vregs and represenation sizes to spill slots." } ;
 
 HELP: unhandled-min-heap
 { $var-description { $link min-heap } " of all live intervals and sync points which still needs processing. It is used by " { $link (allocate-registers) } ". The key of the heap is a pair of values, " { $slot "start" } " and " { $slot "end" } " for the "  { $link live-interval-state } " tuple and " { $slot "n" } " and 1/0.0 for the " { $link sync-point } " tuple. That way smaller live intervals are always processed before larger ones and all live intervals before sync points." } ;

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

@@ -144,11 +144,11 @@ SYMBOL: spill-slots
     H{ } clone spill-slots set
     -1 progress set ;
 
-: free-positions ( new -- assoc )
+: free-positions ( registers reg-class -- assoc )
-    reg-class>> registers get at
+    of [ 1/0. ] H{ } <linked-assoc> map>assoc ;
-    [ 1/0. ] H{ } <linked-assoc> map>assoc ;
 
-: add-use-position ( n reg assoc -- ) [ [ min ] when* ] change-at ;
+: add-use-position ( n reg assoc -- )
+    [ [ min ] when* ] change-at ;
 
 : register-available? ( new result -- ? )
     [ end>> ] [ second ] bi* < ; inline