From 476ebf5b25f17c00603fe1048fb327f3980bca0a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Tue, 14 Oct 2014 13:41:14 +0200
Subject: [PATCH] compiler.cfg.*: more docs, tests and a small refactoring of
 the admissible-registers word

---
 basis/compiler/cfg/cfg-docs.factor                      | 5 +++--
 basis/compiler/cfg/linear-scan/linear-scan-docs.factor  | 6 ++++++
 basis/compiler/cfg/linear-scan/linear-scan-tests.factor | 9 +++++++++
 basis/compiler/cfg/linear-scan/linear-scan.factor       | 6 ++----
 4 files changed, 20 insertions(+), 6 deletions(-)
 create mode 100644 basis/compiler/cfg/linear-scan/linear-scan-docs.factor

diff --git a/basis/compiler/cfg/cfg-docs.factor b/basis/compiler/cfg/cfg-docs.factor
index 9413464ee2..67e3a81254 100644
--- 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
index 0000000000..5cb837a72a
--- /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 c24b52b310..ad97fd48c2 100644
--- 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 d3ee2f6fbb..684c232564 100644
--- 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' )