1 ! Copyright (C) 2009 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: namespaces assocs kernel fry accessors sequences make math locals
4 combinators compiler.cfg compiler.cfg.hats compiler.cfg.instructions
5 compiler.cfg.utilities compiler.cfg.rpo compiler.cfg.stacks.local
6 compiler.cfg.stacks.global compiler.cfg.stacks.height
7 compiler.cfg.predecessors ;
8 IN: compiler.cfg.stacks.finalize
10 ! This pass inserts peeks and replaces.
12 :: inserting-peeks ( from to -- assoc )
13 ! A peek is inserted on an edge if the destination anticipates
14 ! the stack location, the source does not anticipate it and
15 ! it is not available from the source in a register.
17 from anticip-out from avail-out assoc-union
20 :: inserting-replaces ( from to -- assoc )
21 ! A replace is inserted on an edge if two conditions hold:
22 ! - the location is not dead at the destination, OR
23 ! the location is live at the destination but not available
25 ! - the location is pending in the source but not the destination
26 from pending-out to pending-in assoc-diff
27 to dead-in to live-in to anticip-in assoc-diff assoc-diff
30 : each-insertion ( assoc bb quot: ( vreg loc -- ) -- )
31 '[ drop [ loc>vreg ] [ _ untranslate-loc ] bi @ ] assoc-each ; inline
33 ERROR: bad-peek dst loc ;
35 : insert-peeks ( from to -- )
36 [ inserting-peeks ] keep
37 [ dup n>> 0 < [ bad-peek ] [ ##peek ] if ] each-insertion ;
39 : insert-replaces ( from to -- )
40 [ inserting-replaces ] keep
41 [ dup n>> 0 < [ 2drop ] [ ##replace ] if ] each-insertion ;
43 : visit-edge ( from to -- )
44 ! If both blocks are subroutine calls, don't bother
46 2dup [ kill-block? ] both? [ 2drop ] [
47 2dup [ [ insert-replaces ] [ insert-peeks ] 2bi ] V{ } make
48 [ 2drop ] [ insert-simple-basic-block ] if-empty
51 : visit-block ( bb -- )
52 [ predecessors>> ] keep '[ _ visit-edge ] each ;
54 : finalize-stack-shuffling ( cfg -- cfg' )
57 dup [ visit-block ] each-basic-block