compiler.cfg.*: more docs, tests and a small refactoring of the

admissible-registers word

basis/compiler/cfg/cfg-docs.factor

@@ -1,6 +1,6 @@
 USING: compiler.cfg compiler.cfg.instructions compiler.cfg.rpo
-compiler.cfg.stack-frame help.markup help.syntax namespaces sequences vectors
+compiler.cfg.stack-frame compiler.tree help.markup help.syntax namespaces
-words ;
+sequences vectors words ;
 IN: compiler.cfg
 
 HELP: basic-block
@@ -26,6 +26,7 @@ HELP: cfg
     { { $slot "word" } { "The " { $link word } " the cfg is produced from." } }
     { { $slot "post-order" } { "The blocks of the cfg in a post order traversal " { $link sequence } "." } }
     { { $slot "stack-frame" } { { $link stack-frame } " of the cfg." } }
+    { { $slot "frame-pointer?" } { "Whether the cfg needs a frame pointer. Only cfgs generated for " { $link #alien-callback } " nodes does need it." } }
   }
 }
 { $see-also post-order } ;

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

@@ -0,0 +1,6 @@
+USING: assocs compiler.cfg help.markup help.syntax ;
+IN: compiler.cfg.linear-scan
+
+HELP: admissible-registers
+{ $values { "cfg" cfg } { "regs" assoc } }
+{ $description "Lists all registers usable by the cfg by register class. In general, that's all registers except the frame pointer register that might be used by the cfg for other purposes." } ;

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

@@ -779,3 +779,12 @@ H{
     }
     register-status
 ] unit-test
+
+{ t } [
+    T{ cfg { frame-pointer? f } } admissible-registers machine-registers =
+] unit-test
+
+{ f } [
+    T{ cfg { frame-pointer? t } } admissible-registers
+    int-regs of frame-reg swap member?
+] unit-test

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

@@ -39,10 +39,8 @@ IN: compiler.cfg.linear-scan
     cfg check-numbering ;
 
 : admissible-registers ( cfg -- regs )
-    [ machine-registers ] dip
+    machine-registers swap frame-pointer?>> [
-    frame-pointer?>> [
+        [ [ frame-reg = not ] filter ] assoc-map
-        [ int-regs ] dip [ clone ] map
-        [ [ [ frame-reg ] dip remove ] change-at ] keep
     ] when ;
 
 : linear-scan ( cfg -- cfg' )