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 <PRIVATE
  10
  11 SYMBOLS: locs preds to-do ready ;
  12
  13 : init-to-do ( bs -- )
  14     to-do get push-all-back ;
  15
  16 : init-ready ( bs -- )
  17     locs get '[ _ key? not ] filter ready get push-all-front ;
  18
  19 : init ( mapping -- )
  20     <dlist> to-do set
  21     <dlist> ready set
  22     [ preds set ]
  23     [ [ nip dup ] H{ } assoc-map-as locs set ]
  24     [ keys [ init-to-do ] [ init-ready ] bi ] tri ;
  25
  26 :: process-ready ( b quot: ( dst src -- ) -- )
  27     b preds get at :> a
  28     a locs get at :> c
  29     b c quot call
  30     b a locs get set-at
  31     a c = a preds get at and [ a ready get push-front ] when ; inline
  32
  33 :: process-to-do ( b temp: ( src -- dst ) quot: ( dst src -- ) -- )
  34     b locs get at b = [
  35         b temp call :> temp
  36         temp b quot call
  37         temp b locs get set-at
  38         b ready get push-front
  39     ] when ; inline
  40
  41 PRIVATE>
  42
  43 :: parallel-mapping ( mapping temp: ( src -- dst ) quot: ( dst src -- ) -- )
  44     ! mapping is a list of { dst src } pairs
  45     [
  46         mapping init
  47         to-do get [
  48             ready get [
  49                 quot process-ready
  50             ] slurp-deque
  51             temp quot process-to-do
  52         ] slurp-deque
  53     ] with-scope ; inline
  54
  55 : parallel-copy ( mapping -- )
  56     next-vreg '[ drop _ ] [ any-rep ##copy, ] parallel-mapping ;
  57
  58 <PRIVATE
  59
  60 SYMBOL: temp-vregs
  61
  62 : temp-vreg ( rep -- vreg )
  63     temp-vregs get [ next-vreg-rep ] cache
  64     [ leader-map get conjoin ] keep ;
  65
  66 PRIVATE>
  67
  68 : parallel-copy-rep ( mapping -- )
  69     ! mapping is a list of { dst src } pairs
  70     H{ } clone temp-vregs set
  71     [ rep-of temp-vreg ] [ dup rep-of ##copy, ] parallel-mapping ;