basis/compiler/cfg/linear-scan/resolve/resolve.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs combinators
   4 combinators.short-circuit fry kernel locals namespaces
   5 make math sequences hashtables
   6 compiler.cfg.rpo
   7 compiler.cfg.liveness
   8 compiler.cfg.utilities
   9 compiler.cfg.instructions
  10 compiler.cfg.parallel-copy
  11 compiler.cfg.linear-scan.assignment
  12 compiler.cfg.linear-scan.allocation.state ;
  13 IN: compiler.cfg.linear-scan.resolve
  14
  15 SYMBOL: spill-temps
  16
  17 : spill-temp ( reg-class -- n )
  18     spill-temps get [ next-spill-slot ] cache ;
  19
  20 : add-mapping ( from to reg-class -- )
  21     '[ _ 2array ] bi@ 2array , ;
  22
  23 :: resolve-value-data-flow ( bb to vreg -- )
  24     vreg bb vreg-at-end
  25     vreg to vreg-at-start
  26     2dup = [ 2drop ] [ vreg reg-class>> add-mapping ] if ;
  27
  28 : compute-mappings ( bb to -- mappings )
  29     [
  30         dup live-in keys
  31         [ resolve-value-data-flow ] with with each
  32     ] { } make ;
  33
  34 : memory->register ( from to -- )
  35     swap [ first2 ] [ first n>> ] bi* _reload ;
  36
  37 : register->memory ( from to -- )
  38     [ first2 ] [ first n>> ] bi* _spill ;
  39
  40 : temp->register ( from to -- )
  41     nip [ first ] [ second ] [ second spill-temp ] tri _reload ;
  42
  43 : register->temp ( from to -- )
  44     drop [ first2 ] [ second spill-temp ] bi _spill ;
  45
  46 : register->register ( from to -- )
  47     swap [ first ] [ first2 ] bi* _copy ;
  48
  49 SYMBOL: temp
  50
  51 : >insn ( from to -- )
  52     {
  53         { [ over temp eq? ] [ temp->register ] }
  54         { [ dup temp eq? ] [ register->temp ] }
  55         { [ over first spill-slot? ] [ memory->register ] }
  56         { [ dup first spill-slot? ] [ register->memory ] }
  57         [ register->register ]
  58     } cond ;
  59
  60 : mapping-instructions ( alist -- insns )
  61     [ swap ] H{ } assoc-map-as
  62     [ temp [ swap >insn ] parallel-mapping ] { } make ;
  63
  64 : perform-mappings ( bb to mappings -- )
  65     dup empty? [ 3drop ] [
  66         mapping-instructions <simple-block>
  67         insert-basic-block
  68     ] if ;
  69
  70 : resolve-edge-data-flow ( bb to -- )
  71     2dup compute-mappings perform-mappings ;
  72
  73 : resolve-block-data-flow ( bb -- )
  74     dup successors>> [ resolve-edge-data-flow ] with each ;
  75
  76 : resolve-data-flow ( cfg -- )
  77     H{ } clone spill-temps set
  78     [ resolve-block-data-flow ] each-basic-block ;