compiler.cfg.*,compiler.tree.*: more docs and tests

basis/compiler/cfg/builder/alien/alien-docs.factor

@@ -1,6 +1,7 @@
 USING: alien alien.libraries compiler.cfg compiler.cfg.builder
-compiler.cfg.instructions compiler.tree help.markup help.syntax
-literals make multiline sequences stack-checker.alien strings ;
+compiler.cfg.instructions compiler.errors compiler.tree help.markup
+help.syntax literals make multiline sequences stack-checker.alien
+strings ;
 IN: compiler.cfg.builder.alien
 
 <<
@@ -21,7 +22,7 @@ HELP: caller-linkage
 { $values
   { "params" alien-node-params }
   { "symbol" string }
-  { "dll" dll }
+  { "dll/f" { $maybe dll } }
 }
 { $description "This word gets the name and library to use when linking to a function in a dynamically loaded dll. It is assumed that the library exports the undecorated name, regardless of calling convention." } ;
 
@@ -31,8 +32,8 @@ HELP: caller-return
 { $examples { $unchecked-example $[ ex-caller-return ] } } ;
 
 HELP: check-dlsym
-{ $values { "symbol" string } { "library" library } }
-{ $description "Checks that a symbol with the given name exists in the given library. Throws an error if not." } ;
+{ $values { "symbol" string } { "library/f" { $maybe library } } }
+{ $description "Checks that a symbol with the given name exists in the given library. Adds an error to the " { $link linkage-errors } " hash if not." } ;
 
 HELP: emit-callback-body
 { $values

basis/compiler/cfg/builder/alien/alien-tests.factor

@@ -1,7 +1,8 @@
-USING: accessors alien alien.c-types compiler.cfg compiler.cfg.builder
-compiler.cfg.builder.alien compiler.cfg.builder.alien.params
-compiler.cfg.builder.blocks compiler.cfg.instructions
-compiler.cfg.registers compiler.test compiler.tree.builder
+USING: accessors alien alien.c-types assocs compiler.cfg
+compiler.cfg.builder compiler.cfg.builder.alien
+compiler.cfg.builder.alien.params compiler.cfg.builder.blocks
+compiler.cfg.instructions compiler.cfg.registers compiler.cfg.stacks
+compiler.errors compiler.test compiler.tree.builder
 compiler.tree.optimizer cpu.architecture cpu.x86.assembler
 cpu.x86.assembler.operands kernel literals make namespaces sequences
 stack-checker.alien system tools.test words ;
@@ -41,6 +42,22 @@ IN: compiler.cfg.builder.alien.tests
     [ emit-callback-body drop ] V{ } make
 ] cfg-unit-test
 
+! caller-linkage
+{ "malloc" f } [
+    f f cdecl f f "malloc" alien-invoke-params boa
+    caller-linkage
+] unit-test
+
+SYMBOL: foo
+
+{ t "fdkjlsdflfd" } [
+    begin-stack-analysis \ foo f begin-cfg drop
+    f f cdecl f f "fdkjlsdflfd" alien-invoke-params boa
+    caller-linkage 2drop
+    linkage-errors get foo of error>>
+    [ no-such-symbol? ] [ name>> ] bi
+] unit-test
+
 ! caller-parameters
 cpu x86.64? [
     ${
@@ -72,6 +89,11 @@ cpu x86.64? [
     caller-stack-cleanup
 ] unit-test
 
+! check-dlsym
+{ } [
+    "malloc" f check-dlsym
+] unit-test
+
 ! prepare-caller-return
 ${
     cpu x86.32? { { 1 int-rep EAX } } { { 1 int-rep RAX } } ?

basis/compiler/cfg/builder/alien/alien.factor

@@ -57,7 +57,7 @@ IN: compiler.cfg.builder.alien
 : caller-stack-cleanup ( params stack-size -- cleanup )
     swap [ return>> ] [ abi>> ] bi stack-cleanup ;
 
-: check-dlsym ( symbol library -- )
+: check-dlsym ( symbol library/f -- )
     {
         { [ dup library-dll dll-valid? not ] [
             [ library-dll dll-path ] [ dlerror>> ] bi
@@ -69,7 +69,7 @@ IN: compiler.cfg.builder.alien
         [ 2drop ]
     } cond ;
 
-: caller-linkage ( params -- symbol dll )
+: caller-linkage ( params -- symbol dll/f )
     [ function>> ] [ library>> lookup-library ] bi
     2dup check-dlsym library-dll ;
 

basis/compiler/tree/cleanup/cleanup-docs.factor

@@ -1,6 +1,11 @@
-USING: compiler.tree help.markup help.syntax kernel sequences ;
+USING: classes compiler.tree help.markup help.syntax kernel sequences
+;
 IN: compiler.tree.cleanup
 
+HELP: (cleanup-folding)
+{ $values { "#call" #call } { "nodes" sequence } }
+{ $description "Replace a #call having a known result with a #drop of its inputs followed by #push nodes for the outputs." } ;
+
 HELP: >copy
 { $values { "node" node } { "#copy" #copy } }
 { $description "Creates a #copy node from the inputs and outputs of a node." } ;
@@ -11,11 +16,12 @@ HELP: cleanup-folding?
 
 HELP: cleanup-tree
 { $values { "nodes" sequence } { "nodes'" sequence } }
-{ $description "Main entry point for the cleanup-tree optimization phase. We don't recurse into children here, instead the methods do it since the logic is a bit more involved." } ;
+{ $description "Main entry point for the cleanup-tree optimization phase. We don't recurse into children here, instead the methods do it since the logic is a bit more involved." }
+{ $see-also cleanup-tree* } ;
 
-HELP: (cleanup-folding)
-{ $values { "#call" #call } { "nodes" sequence } }
-{ $description "Replace a #call having a known result with a #drop of its inputs followed by #push nodes for the outputs." } ;
+HELP: cleanup-tree*
+{ $values { "node" node } { "node/nodes" "a node or a sequence of nodes" } }
+{ $description "Runs the cleanup pass for an SSA node." } ;
 
 HELP: flatten-recursive
 { $values { "#recursive" #recursive } { "nodes" sequence } }
@@ -25,11 +31,17 @@ HELP: fold-only-branch
 { $values { "#branch" #branch } { "node/nodes" "a " { $link node } " or a sequence of nodes" } }
 { $description "If only one branch is live we don't need to branch at all; just drop the condition value." } ;
 
+HELP: record-predicate-folding
+{ $values { "#call" #call } }
+{ $description "Adds a suitable dependency for a call to a word that is a " { $link predicate } " word that has been folded." } ;
+
 ARTICLE: "compiler.tree.cleanup" "Cleanup Phase"
 "A phase run after propagation to finish the job, so to speak. Codifies speculative inlining decisions, deletes branches marked as never taken, replaces folded calls with constants and flattens local recursive blocks that do not call themselves."
 $nl
 "Main entry point:"
 { $subsections cleanup-tree }
-"Each node type implements its own method on the " { $link cleanup-tree* } " generic." ;
+"Each node type implements its own method on the " { $link cleanup-tree* } " generic."
+$nl
+"Previous pass: " { $vocab-link "compiler.tree.propagation" } ", next pass: " { $vocab-link "compiler.tree.escape-analysis" } "." ;
 
 ABOUT: "compiler.tree.cleanup"

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -1,21 +1,14 @@
-USING: tools.test kernel.private kernel arrays sequences
-math.private math generic words quotations alien alien.c-types
-alien.data strings sbufs sequences.private slots.private
-combinators definitions system layouts vectors
-math.partial-dispatch math.order math.functions accessors
-hashtables classes assocs io.encodings.utf8 io.encodings.ascii
-io.encodings fry slots sorting.private combinators.short-circuit
-grouping prettyprint generalizations
-compiler.tree
-compiler.tree.combinators
-compiler.tree.cleanup
-compiler.tree.builder
-compiler.tree.recursive
-compiler.tree.normalization
-compiler.tree.propagation
-compiler.tree.propagation.info
-compiler.tree.checker
-compiler.tree.debugger ;
+USING: accessors alien alien.c-types alien.data arrays assocs
+combinators combinators.short-circuit compiler.tree
+compiler.tree.builder compiler.tree.checker compiler.tree.cleanup
+compiler.tree.combinators compiler.tree.debugger
+compiler.tree.normalization compiler.tree.propagation
+compiler.tree.propagation.info generalizations grouping hashtables
+io.encodings io.encodings.ascii io.encodings.utf8 kernel
+kernel.private layouts math math.functions math.intervals math.order
+math.partial-dispatch math.private prettyprint quotations sequences
+sequences.private slots slots.private sorting.private tools.test
+vectors ;
 FROM: math => float ;
 QUALIFIED-WITH: alien.c-types c
 IN: compiler.tree.cleanup.tests
@@ -542,6 +535,51 @@ cell-bits 32 = [
     \ >c-ptr inlined?
 ] unit-test
 
+MIXIN: foo-mix
+
+! cleanup-folding?
+: call-node-foldable2 ( -- node )
+    T{ #call
+       { word foo-mix? }
+       { in-d V{ 8815401 } }
+       { out-d { 8815405 } }
+       { info
+         H{
+             {
+                 8815401
+                 T{ value-info-state
+                    { class
+                      intersection{
+                          not{
+                              POSTPONE: f
+                          }
+                          not{ foo-mix }
+                      }
+                    }
+                    { interval
+                      full-interval
+                    }
+                  }
+             }
+             {
+                 8815405
+                 T{ value-info-state
+                    { class POSTPONE: f }
+                    { interval
+                      empty-interval
+                    }
+                    { literal? t }
+                  }
+             }
+         }
+       }
+    } ;
+
+{ t } [
+    call-node-foldable2 cleanup-folding?
+] unit-test
+
+
 ! cleanup-folding
 : call-node-foldable ( -- node )
     T{ #call

basis/compiler/tree/propagation/info/info-docs.factor

@@ -17,7 +17,7 @@ HELP: literal-class
 
 HELP: node-input-infos
 { $values { "node" node } { "seq" sequence } }
-{ $description "Lists the value infos for the input variables of an SSA tree node." } ;
+{ $description "Lists the value infos for the input variables of an SSA tree node. For " { $link #call } " nodes, the inputs represents the values on the stack when the word is called." } ;
 
 HELP: node-output-infos
 { $values { "node" node } { "seq" sequence } }