factor/basis/compiler/cfg/cfg.factor

48 lines
1.1 KiB
Factor
Raw Normal View History

2010-04-27 10:51:00 -04:00
! Copyright (C) 2008, 2010 Slava Pestov.
2008-07-20 05:24:37 -04:00
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math vectors arrays accessors namespaces ;
2008-07-20 05:24:37 -04:00
IN: compiler.cfg
TUPLE: basic-block < identity-tuple
{ id integer }
2008-07-20 05:24:37 -04:00
number
2008-11-03 00:09:31 -05:00
{ instructions vector }
{ successors vector }
2010-04-27 10:51:00 -04:00
{ predecessors vector }
{ kill-block? boolean }
2010-04-27 10:51:00 -04:00
{ unlikely? boolean } ;
2008-07-20 05:24:37 -04:00
2009-05-27 19:58:01 -04:00
: <basic-block> ( -- bb )
2008-07-20 05:24:37 -04:00
basic-block new
2009-11-11 03:40:24 -05:00
\ basic-block counter >>id
2008-07-20 05:24:37 -04:00
V{ } clone >>instructions
V{ } clone >>successors
2009-11-10 22:06:36 -05:00
V{ } clone >>predecessors ;
2008-07-20 05:24:37 -04:00
2009-11-11 03:40:24 -05:00
M: basic-block hashcode* nip id>> ;
TUPLE: cfg { entry basic-block } word label
spill-area-size spill-area-align
stack-frame
frame-pointer?
post-order linear-order
predecessors-valid? dominance-valid? loops-valid? ;
2008-11-03 00:09:31 -05:00
: <cfg> ( entry word label -- cfg )
cfg new
swap >>label
swap >>word
swap >>entry ;
2008-11-03 00:09:31 -05:00
: cfg-changed ( cfg -- cfg )
f >>post-order
f >>linear-order
f >>dominance-valid?
f >>loops-valid? ; inline
: predecessors-changed ( cfg -- cfg )
f >>predecessors-valid? ;
: with-cfg ( ..a cfg quot: ( ..a cfg -- ..b ) -- ..b )
[ dup cfg ] dip with-variable ; inline