2008-07-20 05:24:37 -04:00
|
|
|
! Copyright (C) 2008 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
USING: kernel accessors namespaces assocs sequences sets fry ;
|
|
|
|
IN: compiler.cfg
|
|
|
|
|
2008-09-10 23:11:03 -04:00
|
|
|
TUPLE: procedure entry word label ;
|
|
|
|
|
|
|
|
C: <procedure> procedure
|
|
|
|
|
|
|
|
! - "id" is a globally unique id used for hashcode*.
|
|
|
|
! - "number" is assigned by linearization.
|
2008-07-20 05:24:37 -04:00
|
|
|
TUPLE: basic-block < identity-tuple
|
|
|
|
id
|
|
|
|
number
|
2008-09-10 23:11:03 -04:00
|
|
|
label
|
2008-07-20 05:24:37 -04:00
|
|
|
instructions
|
|
|
|
successors
|
2008-09-10 23:11:03 -04:00
|
|
|
predecessors ;
|
2008-07-20 05:24:37 -04:00
|
|
|
|
|
|
|
SYMBOL: next-block-id
|
|
|
|
|
|
|
|
: <basic-block> ( -- basic-block )
|
|
|
|
basic-block new
|
|
|
|
next-block-id counter >>id
|
|
|
|
V{ } clone >>instructions
|
|
|
|
V{ } clone >>successors
|
|
|
|
V{ } clone >>predecessors ;
|
|
|
|
|
|
|
|
M: basic-block hashcode* id>> nip ;
|
|
|
|
|
|
|
|
! Utilities
|
|
|
|
SYMBOL: visited-blocks
|
|
|
|
|
|
|
|
: visit-block ( basic-block quot -- )
|
|
|
|
over visited-blocks get 2dup key?
|
|
|
|
[ 2drop 2drop ] [ conjoin call ] if ; inline
|
|
|
|
|
|
|
|
: (each-block) ( basic-block quot -- )
|
|
|
|
'[
|
2008-09-10 23:11:03 -04:00
|
|
|
_
|
2008-07-20 05:24:37 -04:00
|
|
|
[ call ]
|
2008-09-10 23:11:03 -04:00
|
|
|
[ [ successors>> ] dip '[ _ (each-block) ] each ]
|
2008-07-20 05:24:37 -04:00
|
|
|
2bi
|
|
|
|
] visit-block ; inline
|
|
|
|
|
|
|
|
: each-block ( basic-block quot -- )
|
|
|
|
H{ } clone visited-blocks [ (each-block) ] with-variable ; inline
|