1 ! Copyright (C) 2009, 2010 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel sequences byte-arrays namespaces accessors classes math
4 math.order fry arrays combinators compiler.cfg.registers
5 compiler.cfg.instructions compiler.cfg.dataflow-analysis ;
6 IN: compiler.cfg.stacks.uninitialized
8 ! Uninitialized stack location analysis.
10 ! Consider the following sequence of instructions:
15 ! The GC check runs before stack locations 0 and 1 have been initialized,
16 ! and it needs to zero them out so that GC doesn't try to trace them.
20 GENERIC: visit-insn ( insn -- )
22 : handle-inc ( n symbol -- )
25 { [ dup 0 < ] [ neg short tail ] }
26 { [ dup 0 > ] [ <byte-array> prepend ] }
30 M: ##inc-d visit-insn n>> ds-loc handle-inc ;
32 M: ##inc-r visit-insn n>> rs-loc handle-inc ;
34 ERROR: uninitialized-peek insn ;
37 dup loc>> [ n>> ] [ class get ] bi ?nth 0 =
38 [ uninitialized-peek ] [ drop ] if ;
40 M: ##replace visit-insn
41 loc>> [ n>> ] [ class get ] bi
42 2dup length < [ [ 1 ] 2dip set-nth ] [ 2drop ] if ;
44 M: insn visit-insn drop ;
47 [ first2 [ [ clone ] [ B{ } ] if* ] bi@ ] [ B{ } B{ } ] if*
48 [ ds-loc set ] [ rs-loc set ] bi* ;
50 : visit-block ( bb -- ) instructions>> [ visit-insn ] each ;
52 : finish ( -- pair ) ds-loc get rs-loc get 2array ;
54 : (join-sets) ( seq1 seq2 -- seq )
55 2dup [ length ] bi@ max '[ _ 1 pad-tail ] bi@ [ bitand ] 2map ;
57 : (uninitialized-locs) ( seq quot -- seq' )
58 [ [ drop 0 = ] pusher [ each-index ] dip ] dip map ; inline
62 FORWARD-ANALYSIS: uninitialized
64 M: uninitialized-analysis transfer-set ( pair bb analysis -- pair' )
65 drop [ prepare ] dip visit-block finish ;
67 M: uninitialized-analysis join-sets ( sets analysis -- pair )
68 2drop sift [ f ] [ [ ] [ [ (join-sets) ] 2map ] map-reduce ] if-empty ;
70 : uninitialized-locs ( bb -- locs )
71 uninitialized-in dup [
73 [ [ <ds-loc> ] (uninitialized-locs) ]
74 [ [ <rs-loc> ] (uninitialized-locs) ]