basis/compiler/cfg/stacks/uninitialized/uninitialized.factor

   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
   7
   8 ! Uninitialized stack location analysis.
   9
  10 ! Consider the following sequence of instructions:
  11 ! ##inc-d 2
  12 ! ...
  13 ! ##allot
  14 ! ##replace ... D 0
  15 ! ##replace ... D 1
  16 ! The GC check runs before stack locations 0 and 1 have been
  17 ! initialized, and so the GC needs to scrub them so that they
  18 ! don't get traced. This is achieved by computing uninitialized
  19 ! locations with a dataflow analysis, and recording the
  20 ! information in GC maps. The scrub_contexts() method on
  21 ! vm/gc.cpp reads this information from GC maps and performs
  22 ! the scrubbing.
  23
  24 <PRIVATE
  25
  26 GENERIC: visit-insn ( insn -- )
  27
  28 : handle-inc ( n symbol -- )
  29     [
  30         swap {
  31             { [ dup 0 < ] [ neg short tail ] }
  32             { [ dup 0 > ] [ <byte-array> prepend ] }
  33         } cond
  34     ] change ;
  35
  36 M: ##inc-d visit-insn n>> ds-loc handle-inc ;
  37 M: ##inc-r visit-insn n>> rs-loc handle-inc ;
  38
  39 ERROR: uninitialized-peek insn ;
  40
  41 : visit-peek ( ##peek -- )
  42     dup loc>> [ n>> ] [ class get ] bi ?nth 0 =
  43     [ uninitialized-peek ] [ drop ] if ; inline
  44
  45 M: ##peek visit-insn visit-peek ;
  46
  47 : visit-replace ( ##replace -- )
  48     loc>> [ n>> ] [ class get ] bi
  49     2dup length < [ [ 1 ] 2dip set-nth ] [ 2drop ] if ;
  50
  51 M: ##replace visit-insn visit-replace ;
  52 M: ##replace-imm visit-insn visit-replace ;
  53
  54 M: gc-map-insn visit-insn
  55     gc-map>>
  56     ds-loc get clone >>scrub-d
  57     rs-loc get clone >>scrub-r
  58     drop ;
  59
  60 M: insn visit-insn drop ;
  61
  62 : prepare ( pair -- )
  63     [ first2 [ [ clone ] [ B{ } ] if* ] bi@ ] [ B{ } B{ } ] if*
  64     [ ds-loc set ] [ rs-loc set ] bi* ;
  65
  66 : visit-block ( bb -- ) instructions>> [ visit-insn ] each ;
  67
  68 : finish ( -- pair ) ds-loc get rs-loc get 2array ;
  69
  70 : (join-sets) ( seq1 seq2 -- seq )
  71     2dup [ length ] bi@ max '[ _ 1 pad-tail ] bi@ [ bitand ] 2map ;
  72
  73 PRIVATE>
  74
  75 FORWARD-ANALYSIS: uninitialized
  76
  77 M: uninitialized-analysis transfer-set ( pair bb analysis -- pair' )
  78     drop [ prepare ] dip visit-block finish ;
  79
  80 M: uninitialized-analysis join-sets ( sets bb dfa -- set )
  81     2drop sift [ f ] [ [ ] [ [ (join-sets) ] 2map ] map-reduce ] if-empty ;