basis/compiler/cfg/stacks/stacks.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors biassocs compiler.cfg.registers
   4 compiler.cfg.stacks.finalize compiler.cfg.stacks.global
   5 compiler.cfg.stacks.local compiler.cfg.utilities kernel math
   6 namespaces sequences ;
   7 IN: compiler.cfg.stacks
   8
   9 : begin-stack-analysis ( -- )
  10     <bihash> locs>vregs set
  11     0 0 0 0 height-state boa height-state set ;
  12
  13 : end-stack-analysis ( cfg -- )
  14     {
  15         compute-anticip-sets
  16         compute-live-sets
  17         compute-pending-sets
  18         compute-dead-sets
  19         compute-avail-sets
  20         finalize-stack-shuffling
  21     } apply-passes ;
  22
  23 : create-locs ( loc-class seq -- locs )
  24     [ swap new swap >>n ] with map <reversed> ;
  25
  26 : stack-locs ( loc-class n -- locs )
  27     <iota> create-locs ;
  28
  29 : (load-vregs) ( n loc-class -- vregs )
  30     swap stack-locs [ peek-loc ] map ;
  31
  32 : load-vregs ( n loc-class -- vregs )
  33     [ (load-vregs) ] [ new swap neg >>n inc-stack ] 2bi ;
  34
  35 : store-vregs ( vregs loc-class -- )
  36     over length stack-locs [ replace-loc ] 2each ;
  37
  38 ! Utility
  39 : ds-drop ( -- ) D: -1 inc-stack ;
  40
  41 : ds-peek ( -- vreg ) D: 0 peek-loc ;
  42
  43 : ds-pop ( -- vreg ) ds-peek ds-drop ;
  44
  45 : ds-push ( vreg -- )
  46     D: 1 inc-stack D: 0 replace-loc ;
  47
  48 : (2inputs) ( -- vreg1 vreg2 )
  49     2 ds-loc (load-vregs) first2 ;
  50
  51 : 2inputs ( -- vreg1 vreg2 )
  52     2 ds-loc load-vregs first2 ;
  53
  54 : 3inputs ( -- vreg1 vreg2 vreg3 )
  55     3 ds-loc load-vregs first3 ;
  56
  57 : binary-op ( quot -- )
  58     [ 2inputs ] dip call ds-push ; inline
  59
  60 : unary-op ( quot -- )
  61     [ ds-pop ] dip call ds-push ; inline