2009-05-27 19:58:01 -04:00
|
|
|
! Copyright (C) 2008, 2009 Slava Pestov.
|
2008-07-20 05:24:37 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2009-05-27 19:58:01 -04:00
|
|
|
USING: kernel arrays vectors accessors
|
|
|
|
namespaces make fry sequences ;
|
2008-07-20 05:24:37 -04:00
|
|
|
IN: compiler.cfg
|
|
|
|
|
|
|
|
TUPLE: basic-block < identity-tuple
|
2008-10-22 19:38:30 -04:00
|
|
|
id
|
2008-07-20 05:24:37 -04:00
|
|
|
number
|
2008-11-03 00:09:31 -05:00
|
|
|
{ instructions vector }
|
|
|
|
{ successors vector }
|
|
|
|
{ predecessors vector } ;
|
2008-07-20 05:24:37 -04:00
|
|
|
|
2009-05-19 18:28:13 -04:00
|
|
|
M: basic-block hashcode* nip id>> ;
|
|
|
|
|
2009-05-27 19:58:01 -04:00
|
|
|
: <basic-block> ( -- bb )
|
2008-07-20 05:24:37 -04:00
|
|
|
basic-block new
|
|
|
|
V{ } clone >>instructions
|
2008-10-22 19:38:30 -04:00
|
|
|
V{ } clone >>successors
|
2008-11-03 00:09:31 -05:00
|
|
|
V{ } clone >>predecessors
|
2008-10-22 19:38:30 -04:00
|
|
|
\ basic-block counter >>id ;
|
2008-07-20 05:24:37 -04:00
|
|
|
|
2009-05-27 19:58:01 -04:00
|
|
|
: add-instructions ( bb quot -- )
|
|
|
|
[ instructions>> building ] dip '[
|
|
|
|
building get pop
|
|
|
|
_ dip
|
|
|
|
building get push
|
|
|
|
] with-variable ; inline
|
|
|
|
|
2009-05-29 14:11:34 -04:00
|
|
|
TUPLE: cfg { entry basic-block } word label spill-counts post-order ;
|
2008-11-03 00:09:31 -05:00
|
|
|
|
2009-05-29 14:11:34 -04:00
|
|
|
: <cfg> ( entry word label -- cfg ) f f cfg boa ;
|
2008-11-03 00:09:31 -05:00
|
|
|
|
2009-05-29 14:11:34 -04:00
|
|
|
TUPLE: mr { instructions array } word label ;
|
2008-07-20 05:24:37 -04:00
|
|
|
|
2008-09-17 20:31:35 -04:00
|
|
|
: <mr> ( instructions word label -- mr )
|
|
|
|
mr new
|
|
|
|
swap >>label
|
|
|
|
swap >>word
|
|
|
|
swap >>instructions ;
|