60 lines
1.8 KiB
Factor
60 lines
1.8 KiB
Factor
! 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 make math namespaces sequences ;
|
|
IN: compiler.cfg.builder.blocks
|
|
SLOT: in-d
|
|
SLOT: out-d
|
|
|
|
: set-basic-block ( basic-block -- )
|
|
dup begin-local-analysis instructions>> building set ;
|
|
|
|
: end-basic-block ( block -- )
|
|
end-local-analysis building off ;
|
|
|
|
: (begin-basic-block) ( block -- block' )
|
|
<basic-block> dup set-basic-block [ connect-bbs ] keep ;
|
|
|
|
: begin-basic-block ( block -- block' )
|
|
dup end-basic-block (begin-basic-block) ;
|
|
|
|
: emit-trivial-block ( block quot: ( ..a block' -- ..b ) -- block' )
|
|
##branch, swap begin-basic-block
|
|
[ swap call ] keep
|
|
##branch, begin-basic-block ; inline
|
|
|
|
: call-height ( #call -- n )
|
|
[ out-d>> length ] [ in-d>> length ] bi - ;
|
|
|
|
: emit-call-block ( word height block -- )
|
|
t swap kill-block?<< adjust-d ##call, ;
|
|
|
|
: emit-trivial-call ( block word height -- block' )
|
|
rot [ emit-call-block ] emit-trivial-block ;
|
|
|
|
: emit-primitive ( block #call -- block' )
|
|
[ word>> ] [ call-height ] bi emit-trivial-call ;
|
|
|
|
: begin-branch ( block -- block' )
|
|
height-state [ clone-height-state ] change (begin-basic-block) ;
|
|
|
|
: end-branch ( block/f -- pair/f )
|
|
dup [
|
|
##branch,
|
|
end-local-analysis
|
|
height-state get clone-height-state 2array
|
|
] when* ;
|
|
|
|
: with-branch ( block quot: ( ..a block -- ..b block' ) -- pair/f )
|
|
[ [ begin-branch ] dip call end-branch ] with-scope ; inline
|
|
|
|
: emit-conditional ( block branches -- block'/f )
|
|
swap end-basic-block
|
|
sift [ f ] [
|
|
dup first second height-state set
|
|
[ first ] map
|
|
<basic-block> dup set-basic-block
|
|
[ connect-Nto1-bbs ] keep
|
|
] if-empty ;
|