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.
|
2015-11-02 12:40:13 -05:00
|
|
|
USING: accessors compiler.cfg.stack-frame kernel layouts math
|
|
|
|
namespaces vectors ;
|
2008-07-20 05:24:37 -04:00
|
|
|
IN: compiler.cfg
|
|
|
|
|
|
|
|
TUPLE: basic-block < identity-tuple
|
2015-04-13 17:22:41 -04:00
|
|
|
number
|
|
|
|
{ instructions vector }
|
|
|
|
{ successors vector }
|
|
|
|
{ predecessors vector }
|
2016-05-02 19:16:50 -04:00
|
|
|
{ kill-block? boolean }
|
2016-09-07 19:58:30 -04:00
|
|
|
height
|
2016-08-29 06:07:47 -04:00
|
|
|
replaces
|
|
|
|
peeks
|
|
|
|
kills ;
|
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
|
|
|
|
V{ } clone >>instructions
|
2008-10-22 19:38:30 -04:00
|
|
|
V{ } clone >>successors
|
2009-11-10 22:06:36 -05:00
|
|
|
V{ } clone >>predecessors ;
|
2008-07-20 05:24:37 -04:00
|
|
|
|
2015-04-12 23:27:09 -04:00
|
|
|
TUPLE: cfg
|
|
|
|
{ entry basic-block }
|
|
|
|
word
|
|
|
|
label
|
|
|
|
stack-frame
|
|
|
|
frame-pointer?
|
|
|
|
post-order linear-order
|
|
|
|
predecessors-valid? dominance-valid? loops-valid? ;
|
2008-11-03 00:09:31 -05:00
|
|
|
|
2015-03-24 12:38:42 -04:00
|
|
|
: <cfg> ( word label entry -- cfg )
|
2009-08-07 18:44:50 -04:00
|
|
|
cfg new
|
2015-03-24 12:38:42 -04:00
|
|
|
swap >>entry
|
2009-08-07 18:44:50 -04:00
|
|
|
swap >>label
|
2015-04-12 23:27:09 -04:00
|
|
|
swap >>word
|
2015-11-02 12:40:13 -05:00
|
|
|
stack-frame new cell >>spill-area-align >>stack-frame ;
|
2008-11-03 00:09:31 -05:00
|
|
|
|
2014-12-10 10:14:08 -05:00
|
|
|
: cfg-changed ( cfg -- )
|
2009-08-08 21:02:56 -04:00
|
|
|
f >>post-order
|
|
|
|
f >>linear-order
|
|
|
|
f >>dominance-valid?
|
2014-12-10 10:14:08 -05:00
|
|
|
f >>loops-valid? drop ; inline
|
2009-08-08 21:02:56 -04:00
|
|
|
|
2014-12-10 10:14:08 -05:00
|
|
|
: predecessors-changed ( cfg -- )
|
|
|
|
f >>predecessors-valid? drop ;
|
2009-08-08 21:02:56 -04:00
|
|
|
|
2010-03-09 02:38:10 -05:00
|
|
|
: with-cfg ( ..a cfg quot: ( ..a cfg -- ..b ) -- ..b )
|
2009-08-08 21:02:56 -04:00
|
|
|
[ dup cfg ] dip with-variable ; inline
|
2015-11-02 12:40:13 -05:00
|
|
|
|
|
|
|
: local-allot-offset ( n -- offset )
|
|
|
|
cfg get stack-frame>> allot-area-base>> + ;
|
|
|
|
|
|
|
|
: spill-offset ( n -- offset )
|
|
|
|
cfg get stack-frame>> spill-area-base>> + ;
|