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
+compiler.cfg.instructions compiler.errors compiler.tree help.markup
-literals make multiline sequences stack-checker.alien strings ;
+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 } }
+{ $values { "symbol" string } { "library/f" { $maybe library } } }
-{ $description "Checks that a symbol with the given name exists in the given library. Throws an error if not." } ;
+{ $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
+USING: accessors alien alien.c-types assocs compiler.cfg
-compiler.cfg.builder.alien compiler.cfg.builder.alien.params
+compiler.cfg.builder compiler.cfg.builder.alien
-compiler.cfg.builder.blocks compiler.cfg.instructions
+compiler.cfg.builder.alien.params compiler.cfg.builder.blocks
-compiler.cfg.registers compiler.test compiler.tree.builder
+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)
+HELP: cleanup-tree*
-{ $values { "#call" #call } { "nodes" sequence } }
+{ $values { "node" node } { "node/nodes" "a node or a sequence of nodes" } }
-{ $description "Replace a #call having a known result with a #drop of its inputs followed by #push nodes for the outputs." } ;
+{ $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
+USING: accessors alien alien.c-types alien.data arrays assocs
-math.private math generic words quotations alien alien.c-types
+combinators combinators.short-circuit compiler.tree
-alien.data strings sbufs sequences.private slots.private
+compiler.tree.builder compiler.tree.checker compiler.tree.cleanup
-combinators definitions system layouts vectors
+compiler.tree.combinators compiler.tree.debugger
-math.partial-dispatch math.order math.functions accessors
+compiler.tree.normalization compiler.tree.propagation
-hashtables classes assocs io.encodings.utf8 io.encodings.ascii
+compiler.tree.propagation.info generalizations grouping hashtables
-io.encodings fry slots sorting.private combinators.short-circuit
+io.encodings io.encodings.ascii io.encodings.utf8 kernel
-grouping prettyprint generalizations
+kernel.private layouts math math.functions math.intervals math.order
-compiler.tree
+math.partial-dispatch math.private prettyprint quotations sequences
-compiler.tree.combinators
+sequences.private slots slots.private sorting.private tools.test
-compiler.tree.cleanup
+vectors ;
-compiler.tree.builder
-compiler.tree.recursive
-compiler.tree.normalization
-compiler.tree.propagation
-compiler.tree.propagation.info
-compiler.tree.checker
-compiler.tree.debugger ;
 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 } }