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

admissible-registers word

diff --git a/basis/compiler/cfg/cfg-docs.factor b/basis/compiler/cfg/cfg-docs.factor
index 9413464ee2b730bdb80c6713569c8a79876eb108..67e3a81254efc650dde46729498c9e83d3cbde08 100644 (file)
--- a/basis/compiler/cfg/cfg-docs.factor
+++ b/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
-words ;
+compiler.cfg.stack-frame compiler.tree help.markup help.syntax namespaces
+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 } ;

diff --git a/basis/compiler/cfg/linear-scan/linear-scan-docs.factor b/basis/compiler/cfg/linear-scan/linear-scan-docs.factor
new file mode 100644 (file)
index 0000000..5cb837a
--- /dev/null
+++ b/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." } ;

diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
index c24b52b310608dbe79aabbbcb8c0342ce504c176..ad97fd48c2cb2596c9dee6f3076803f0fcbfe65f 100644 (file)
--- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor
+++ b/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

diff --git a/basis/compiler/cfg/linear-scan/linear-scan.factor b/basis/compiler/cfg/linear-scan/linear-scan.factor
index d3ee2f6fbb4ee00fc2b742885fdc2fba9ed1fee0..684c232564e167fcf56d5e70f307cbf294e19058 100644 (file)
--- a/basis/compiler/cfg/linear-scan/linear-scan.factor
+++ b/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
-    frame-pointer?>> [
-        [ int-regs ] dip [ clone ] map
-        [ [ [ frame-reg ] dip remove ] change-at ] keep
+    machine-registers swap frame-pointer?>> [
+        [ [ frame-reg = not ] filter ] assoc-map
     ] when ;
 
 : linear-scan ( cfg -- cfg' )