82 lines
2.3 KiB
Factor
82 lines
2.3 KiB
Factor
! Copyright (C) 2009, 2010 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: kernel sequences byte-arrays namespaces accessors classes math
|
|
math.order fry arrays combinators compiler.cfg.registers
|
|
compiler.cfg.instructions compiler.cfg.dataflow-analysis ;
|
|
IN: compiler.cfg.stacks.uninitialized
|
|
|
|
! Uninitialized stack location analysis.
|
|
|
|
! Consider the following sequence of instructions:
|
|
! ##inc-d 2
|
|
! ...
|
|
! ##allot
|
|
! ##replace ... D 0
|
|
! ##replace ... D 1
|
|
! The GC check runs before stack locations 0 and 1 have been
|
|
! initialized, and so the GC needs to scrub them so that they
|
|
! don't get traced. This is achieved by computing uninitialized
|
|
! locations with a dataflow analysis, and recording the
|
|
! information in GC maps. The scrub_contexts() method on
|
|
! vm/gc.cpp reads this information from GC maps and performs
|
|
! the scrubbing.
|
|
|
|
<PRIVATE
|
|
|
|
GENERIC: visit-insn ( insn -- )
|
|
|
|
: handle-inc ( n symbol -- )
|
|
[
|
|
swap {
|
|
{ [ dup 0 < ] [ neg short tail ] }
|
|
{ [ dup 0 > ] [ <byte-array> prepend ] }
|
|
} cond
|
|
] change ;
|
|
|
|
M: ##inc-d visit-insn n>> ds-loc handle-inc ;
|
|
M: ##inc-r visit-insn n>> rs-loc handle-inc ;
|
|
|
|
ERROR: uninitialized-peek insn ;
|
|
|
|
: visit-peek ( ##peek -- )
|
|
dup loc>> [ n>> ] [ class get ] bi ?nth 0 =
|
|
[ uninitialized-peek ] [ drop ] if ; inline
|
|
|
|
M: ##peek visit-insn visit-peek ;
|
|
|
|
: visit-replace ( ##replace -- )
|
|
loc>> [ n>> ] [ class get ] bi
|
|
2dup length < [ [ 1 ] 2dip set-nth ] [ 2drop ] if ;
|
|
|
|
M: ##replace visit-insn visit-replace ;
|
|
M: ##replace-imm visit-insn visit-replace ;
|
|
|
|
M: gc-map-insn visit-insn
|
|
gc-map>>
|
|
ds-loc get clone >>scrub-d
|
|
rs-loc get clone >>scrub-r
|
|
drop ;
|
|
|
|
M: insn visit-insn drop ;
|
|
|
|
: prepare ( pair -- )
|
|
[ first2 [ [ clone ] [ B{ } ] if* ] bi@ ] [ B{ } B{ } ] if*
|
|
[ ds-loc set ] [ rs-loc set ] bi* ;
|
|
|
|
: visit-block ( bb -- ) instructions>> [ visit-insn ] each ;
|
|
|
|
: finish ( -- pair ) ds-loc get rs-loc get 2array ;
|
|
|
|
: (join-sets) ( seq1 seq2 -- seq )
|
|
2dup [ length ] bi@ max '[ _ 1 pad-tail ] bi@ [ bitand ] 2map ;
|
|
|
|
PRIVATE>
|
|
|
|
FORWARD-ANALYSIS: uninitialized
|
|
|
|
M: uninitialized-analysis transfer-set ( pair bb analysis -- pair' )
|
|
drop [ prepare ] dip visit-block finish ;
|
|
|
|
M: uninitialized-analysis join-sets ( sets analysis -- pair )
|
|
2drop sift [ f ] [ [ ] [ [ (join-sets) ] 2map ] map-reduce ] if-empty ;
|