diff --git a/basis/compiler/cfg/builder/blocks/blocks-docs.factor b/basis/compiler/cfg/builder/blocks/blocks-docs.factor index b96f7969af..4d28e57a75 100644 --- a/basis/compiler/cfg/builder/blocks/blocks-docs.factor +++ b/basis/compiler/cfg/builder/blocks/blocks-docs.factor @@ -58,10 +58,6 @@ HELP: set-basic-block { $values { "basic-block" basic-block } } { $description "Sets the given blocks as the current one by storing it in the basic-block dynamic variable. If it has any " { $slot "instructions" } " the current " { $link building } " is set to those." } ; -HELP: set-successors -{ $values { "successor" basic-block } { "blocks" sequence } } -{ $description "Set the successor of each block to " { $slot "successor" } "." } ; - HELP: with-branch { $values { "quot" quotation } { "pair/f" "a pair or f" } } { $description "The pair is either " { $link f } " or a two-tuple containing a " { $link basic-block } " and a " { $link height-state } " two-tuple." } ; diff --git a/basis/compiler/cfg/builder/blocks/blocks-tests.factor b/basis/compiler/cfg/builder/blocks/blocks-tests.factor index 032802f488..f39fec0e0e 100644 --- a/basis/compiler/cfg/builder/blocks/blocks-tests.factor +++ b/basis/compiler/cfg/builder/blocks/blocks-tests.factor @@ -1,13 +1,12 @@ USING: accessors compiler.cfg compiler.cfg.builder.blocks compiler.cfg.stacks -kernel namespaces sequences tools.test ; +compiler.cfg.utilities kernel namespaces sequences tools.test ; IN: compiler.cfg.builder.blocks.tests { { "succ" "succ" "succ" } } [ - "succ" >>number 3 [ ] replicate - [ set-successors ] keep - [ successors>> first number>> ] map + 3 [ ] replicate "succ" >>number + dupd connect-Nto1-bbs [ successors>> first number>> ] map ] unit-test { 33 } [ diff --git a/basis/compiler/cfg/builder/blocks/blocks.factor b/basis/compiler/cfg/builder/blocks/blocks.factor index 972695ae74..7935f95072 100644 --- a/basis/compiler/cfg/builder/blocks/blocks.factor +++ b/basis/compiler/cfg/builder/blocks/blocks.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays compiler.cfg compiler.cfg.instructions -compiler.cfg.stacks compiler.cfg.stacks.local compiler.cfg.utilities kernel +compiler.cfg.stacks compiler.cfg.stacks.local compiler.cfg.utilities fry kernel make math namespaces sequences ; SLOT: in-d SLOT: out-d @@ -55,14 +55,11 @@ IN: compiler.cfg.builder.blocks : with-branch ( quot -- pair/f ) [ begin-branch call end-branch ] with-scope ; inline -: set-successors ( successor blocks -- ) - [ successors>> push ] with each ; - : emit-conditional ( branches -- ) ! branches is a sequence of pairs as above end-basic-block sift [ dup first second height-state set begin-basic-block - [ basic-block get ] dip [ first ] map set-successors + [ first ] map basic-block get connect-Nto1-bbs ] unless-empty ; diff --git a/basis/compiler/cfg/builder/builder-tests.factor b/basis/compiler/cfg/builder/builder-tests.factor index 8d3e5b6490..db3e25e661 100644 --- a/basis/compiler/cfg/builder/builder-tests.factor +++ b/basis/compiler/cfg/builder/builder-tests.factor @@ -280,6 +280,14 @@ IN: compiler.cfg.builder.tests basic-block get successors>> length ] unit-test +! emit-loop-call +{ "bar" } [ + V{ } "foo" insns>block basic-block set + begin-stack-analysis begin-local-analysis [ + V{ } "bar" insns>block emit-loop-call + ] V{ } make drop basic-block get successors>> first number>> +] unit-test + ! begin-cfg SYMBOL: foo diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index 8f4752bc16..96f89725a0 100644 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -5,7 +5,8 @@ compiler.cfg.builder.blocks compiler.cfg.comparisons compiler.cfg.hats compiler.cfg.instructions compiler.cfg.intrinsics compiler.cfg.registers compiler.cfg.stacks compiler.cfg.stacks.local compiler.tree -cpu.architecture fry kernel make math namespaces sequences words ; +compiler.cfg.utilities cpu.architecture fry kernel make math namespaces +sequences words ; IN: compiler.cfg.builder SYMBOL: procedures @@ -61,7 +62,7 @@ GENERIC: emit-node ( node -- ) : emit-loop-call ( basic-block -- ) ##safepoint, ##branch, - basic-block get successors>> push + basic-block get swap connect-bbs end-basic-block ; : emit-call ( word height -- ) diff --git a/basis/compiler/cfg/stacks/finalize/finalize.factor b/basis/compiler/cfg/stacks/finalize/finalize.factor index 02367e9baf..d242e1ebf0 100644 --- a/basis/compiler/cfg/stacks/finalize/finalize.factor +++ b/basis/compiler/cfg/stacks/finalize/finalize.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs compiler.cfg compiler.cfg.instructions -compiler.cfg.predecessors compiler.cfg.rpo +USING: accessors assocs compiler.cfg.checker compiler.cfg +compiler.cfg.instructions compiler.cfg.predecessors compiler.cfg.rpo compiler.cfg.stacks.global compiler.cfg.stacks.height compiler.cfg.stacks.local compiler.cfg.utilities fry kernel locals make math sequences ; @@ -42,6 +42,4 @@ ERROR: bad-peek dst loc ; [ predecessors>> ] keep '[ _ visit-edge ] each ; : finalize-stack-shuffling ( cfg -- ) - [ needs-predecessors ] - [ [ visit-block ] each-basic-block ] - [ cfg-changed ] tri ; + [ [ visit-block ] each-basic-block ] [ cfg-changed ] bi ; diff --git a/basis/compiler/cfg/utilities/utilities-docs.factor b/basis/compiler/cfg/utilities/utilities-docs.factor index 168c40e005..1925a90a49 100644 --- a/basis/compiler/cfg/utilities/utilities-docs.factor +++ b/basis/compiler/cfg/utilities/utilities-docs.factor @@ -1,6 +1,10 @@ USING: compiler.cfg help.markup help.syntax sequences ; IN: compiler.cfg.utilities +HELP: connect-Nto1-bbs +{ $values { "froms" sequence } { "to" basic-block } } +{ $description "Connects all basic blocks in 'froms' so that 'to' is a successor of them all." } ; + HELP: insert-basic-block { $values { "from" basic-block } { "to" basic-block } { "insns" sequence } } { $description "Insert basic block on the edge between 'from' and 'to'." } ; diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor index 8d24125d02..ef6c17d6f2 100644 --- a/basis/compiler/cfg/utilities/utilities.factor +++ b/basis/compiler/cfg/utilities/utilities.factor @@ -90,5 +90,8 @@ IN: compiler.cfg.utilities [ [ successors>> ] dip suffix! drop ] [ predecessors>> swap suffix! drop ] 2bi ; +: connect-Nto1-bbs ( froms to -- ) + '[ _ connect-bbs ] each ; + : make-edges ( block-map edgelist -- ) [ [ of ] with map first2 connect-bbs ] with each ;