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

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: assocs compiler.cfg.instructions compiler.cfg.registers
   4 compiler.cfg.ssa.destruction.leaders compiler.utilities
   5 cpu.architecture deques dlists kernel make namespaces sequences ;
   6 IN: compiler.cfg.parallel-copy
   7
   8 <PRIVATE
   9
  10 SYMBOLS: locs preds to-do ready ;
  11
  12 : init-to-do ( bs -- )
  13     to-do get push-all-back ;
  14
  15 : init-ready ( bs -- )
  16     locs get '[ _ key? ] reject ready get push-all-front ;
  17
  18 : init ( mapping -- )
  19     <dlist> to-do set
  20     <dlist> ready set
  21     [ preds set ]
  22     [ [ nip dup ] H{ } assoc-map-as locs set ]
  23     [ keys [ init-to-do ] [ init-ready ] bi ] tri ;
  24
  25 :: process-ready ( b quot: ( dst src -- ) -- )
  26     b preds get at :> a
  27     a locs get at :> c
  28     b c quot call
  29     b a locs get set-at
  30     a c = a preds get at and [ a ready get push-front ] when ; inline
  31
  32 :: process-to-do ( b temp: ( src -- dst ) quot: ( dst src -- ) -- )
  33     b locs get at b = [
  34         b temp call :> temp
  35         temp b quot call
  36         temp b locs get set-at
  37         b ready get push-front
  38     ] when ; inline
  39
  40 PRIVATE>
  41
  42 :: parallel-mapping ( mapping temp: ( src -- dst ) quot: ( dst src -- ) -- )
  43     [
  44         mapping init
  45         to-do get [
  46             ready get [
  47                 quot process-ready
  48             ] slurp-deque
  49             temp quot process-to-do
  50         ] slurp-deque
  51     ] with-scope ; inline
  52
  53 : parallel-copy ( mapping -- insns )
  54     [ next-vreg '[ drop _ ] [ any-rep ##copy, ] parallel-mapping ] { } make ;
  55
  56 <PRIVATE
  57
  58 SYMBOL: temp-vregs
  59
  60 : temp-vreg ( rep -- vreg )
  61     temp-vregs get [ next-vreg-rep ] cache
  62     [ leader-map get conjoin ] keep ;
  63
  64 PRIVATE>
  65
  66 : parallel-copy-rep ( mapping -- insns )
  67     [
  68         H{ } clone temp-vregs set
  69         [ rep-of temp-vreg ] [ dup rep-of ##copy, ] parallel-mapping
  70     ] { } make ;