basis/compiler/cfg/stacks/height/height.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs fry kernel math
   4 namespaces compiler.cfg.registers ;
   5 IN: compiler.cfg.stacks.height
   6
   7 ! Global stack height tracking done while constructing CFG.
   8 SYMBOLS: ds-heights rs-heights ;
   9
  10 : record-stack-heights ( ds-height rs-height bb -- )
  11     [ ds-heights get set-at ] [ rs-heights get set-at ] bi-curry bi* ;
  12
  13 GENERIC# translate-loc 1 ( loc bb -- loc' )
  14
  15 M: ds-loc translate-loc [ n>> ] [ ds-heights get at ] bi* - <ds-loc> ;
  16 M: rs-loc translate-loc [ n>> ] [ rs-heights get at ] bi* - <rs-loc> ;
  17
  18 : translate-locs ( assoc bb -- assoc' )
  19     '[ [ _ translate-loc ] dip ] assoc-map ;
  20
  21 GENERIC# untranslate-loc 1 ( loc bb -- loc' )
  22
  23 M: ds-loc untranslate-loc [ n>> ] [ ds-heights get at ] bi* + <ds-loc> ;
  24 M: rs-loc untranslate-loc [ n>> ] [ rs-heights get at ] bi* + <rs-loc> ;
  25
  26 : untranslate-locs ( assoc bb -- assoc' )
  27     '[ [ _ untranslate-loc ] dip ] assoc-map ;