basis/compiler/cfg/parallel-copy/parallel-copy.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs compiler.cfg.instructions compiler.cfg.registers
   4 compiler.cfg.ssa.destruction.leaders cpu.architecture deques
   5 dlists fry kernel locals namespaces sequences ;
   6 FROM: sets => conjoin ;
   7 IN: compiler.cfg.parallel-copy
   8
   9 ! Revisiting Out-of-SSA Translation for Correctness, Code Quality, and Efficiency
  10 ! http://hal.archives-ouvertes.fr/docs/00/34/99/25/PDF/OutSSA-RR.pdf,
  11 ! Algorithm 1
  12
  13 <PRIVATE
  14
  15 SYMBOLS: locs preds to-do ready ;
  16
  17 : init-to-do ( bs -- )
  18     to-do get push-all-back ;
  19
  20 : init-ready ( bs -- )
  21     locs get '[ _ key? not ] filter ready get push-all-front ;
  22
  23 : init ( mapping -- )
  24     <dlist> to-do set
  25     <dlist> ready set
  26     [ preds set ]
  27     [ [ nip dup ] H{ } assoc-map-as locs set ]
  28     [ keys [ init-to-do ] [ init-ready ] bi ] tri ;
  29
  30 :: process-ready ( b quot: ( dst src -- ) -- )
  31     b preds get at :> a
  32     a locs get at :> c
  33     b c quot call
  34     b a locs get set-at
  35     a c = a preds get at and [ a ready get push-front ] when ; inline
  36
  37 :: process-to-do ( b temp: ( src -- dst ) quot: ( dst src -- ) -- )
  38     ! Note that we check if b = loc(b), not b = loc(pred(b)) as the
  39     ! paper suggests. Confirmed by one of the authors at
  40     ! http://www.reddit.com/comments/93253/some_lecture_notes_on_ssa_form/c0bco4f
  41     b locs get at b = [
  42         b temp call :> temp
  43         temp b quot call
  44         temp b locs get set-at
  45         b ready get push-front
  46     ] when ; inline
  47
  48 PRIVATE>
  49
  50 :: parallel-mapping ( mapping temp: ( src -- dst ) quot: ( dst src -- ) -- )
  51     ! mapping is a list of { dst src } pairs
  52     [
  53         mapping init
  54         to-do get [
  55             ready get [
  56                 quot process-ready
  57             ] slurp-deque
  58             temp quot process-to-do
  59         ] slurp-deque
  60     ] with-scope ; inline
  61
  62 : parallel-copy ( mapping -- )
  63     ! mapping is a list of { dst src } pairs
  64     next-vreg '[ drop _ ] [ any-rep ##copy, ] parallel-mapping ;
  65
  66 <PRIVATE
  67
  68 SYMBOL: temp-vregs
  69
  70 : temp-vreg ( rep -- vreg )
  71     temp-vregs get [ next-vreg-rep ] cache
  72     [ leader-map get conjoin ] keep ;
  73
  74 PRIVATE>
  75
  76 : parallel-copy-rep ( mapping -- )
  77     ! mapping is a list of { dst src } pairs
  78     H{ } clone temp-vregs set
  79     [ rep-of temp-vreg ] [ dup rep-of ##copy, ] parallel-mapping ;