68 lines
1.8 KiB
Factor
68 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 fry kernel
|
|
make math namespaces sequences ;
|
|
SLOT: in-d
|
|
SLOT: out-d
|
|
IN: compiler.cfg.builder.blocks
|
|
|
|
: set-basic-block ( basic-block -- )
|
|
[ basic-block set ]
|
|
[ instructions>> building set ]
|
|
[ begin-local-analysis ] tri ;
|
|
|
|
: end-basic-block ( -- )
|
|
basic-block get [ end-local-analysis ] when*
|
|
building off
|
|
basic-block off ;
|
|
|
|
: (begin-basic-block) ( -- )
|
|
<basic-block> basic-block get [ over connect-bbs ] when* set-basic-block ;
|
|
|
|
: begin-basic-block ( -- )
|
|
basic-block get [ end-local-analysis ] when*
|
|
(begin-basic-block) ;
|
|
|
|
: emit-trivial-block ( quot -- )
|
|
##branch, begin-basic-block
|
|
call
|
|
##branch, begin-basic-block ; inline
|
|
|
|
: make-kill-block ( -- )
|
|
basic-block get t >>kill-block? drop ;
|
|
|
|
: call-height ( #call -- n )
|
|
[ out-d>> length ] [ in-d>> length ] bi - ;
|
|
|
|
: emit-call-block ( word height -- )
|
|
adjust-d ##call, make-kill-block ;
|
|
|
|
: emit-primitive ( node -- )
|
|
[
|
|
[ word>> ] [ call-height ] bi emit-call-block
|
|
] emit-trivial-block ;
|
|
|
|
: begin-branch ( -- )
|
|
height-state [ clone-height-state ] change
|
|
(begin-basic-block) ;
|
|
|
|
: end-branch ( -- pair/f )
|
|
basic-block get dup [
|
|
##branch,
|
|
end-local-analysis
|
|
height-state get clone-height-state 2array
|
|
] when* ;
|
|
|
|
: with-branch ( quot -- pair/f )
|
|
[ begin-branch call end-branch ] with-scope ; inline
|
|
|
|
: emit-conditional ( branches -- )
|
|
! branches is a sequence of pairs as above
|
|
end-basic-block
|
|
sift [
|
|
dup first second height-state set
|
|
begin-basic-block
|
|
[ first ] map basic-block get connect-Nto1-bbs
|
|
] unless-empty ;
|