basis/compiler/cfg/builder/alien/params/params.factor

   1 ! Copyright (C) 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: cpu.architecture fry kernel layouts math math.order
   4 namespaces sequences vectors assocs ;
   5 IN: compiler.cfg.builder.alien.params
   6
   7 SYMBOL: stack-params
   8
   9 : alloc-stack-param ( rep -- n )
  10     stack-params get
  11     [ rep-size cell align stack-params +@ ] dip ;
  12
  13 : ?dummy-stack-params ( rep -- )
  14     dummy-stack-params? [ alloc-stack-param drop ] [ drop ] if ;
  15
  16 : ?dummy-int-params ( rep -- )
  17     dummy-int-params? [
  18         rep-size cell /i 1 max
  19         [ int-regs get [ pop* ] unless-empty ] times
  20     ] [ drop ] if ;
  21
  22 : ?dummy-fp-params ( rep -- )
  23     drop dummy-fp-params? [ float-regs get [ pop* ] unless-empty ] when ;
  24
  25 GENERIC: next-reg-param ( rep -- reg )
  26
  27 M: int-rep next-reg-param
  28     [ ?dummy-stack-params ] [ ?dummy-fp-params ] bi
  29     int-regs get pop ;
  30
  31 M: float-rep next-reg-param
  32     [ ?dummy-stack-params ] [ ?dummy-int-params ] bi
  33     float-regs get pop ;
  34
  35 M: double-rep next-reg-param
  36     [ ?dummy-stack-params ] [ ?dummy-int-params ] bi
  37     float-regs get pop ;
  38
  39 : reg-class-full? ( reg-class -- ? ) get empty? ;
  40
  41 : init-reg-class ( abi reg-class -- )
  42     [ swap param-regs at <reversed> >vector ] keep set ;
  43
  44 : init-regs ( regs -- )
  45     [ <reversed> >vector swap set ] assoc-each ;
  46
  47 : with-param-regs ( abi quot -- )
  48     '[ param-regs init-regs 0 stack-params set @ ] with-scope ; inline
  49
  50 : next-return-reg ( rep -- reg ) reg-class-of get pop ;
  51
  52 : with-return-regs ( quot -- )
  53     '[ return-regs init-regs @ ] with-scope ; inline