unfinished/compiler/cfg/elaboration/elaboration.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel accessors namespaces math layouts sequences locals
   4 combinators compiler.vops compiler.vops.builder
   5 compiler.cfg.builder ;
   6 IN: compiler.cfg.elaboration
   7
   8 ! This pass must run before conversion to machine IR to ensure
   9 ! correctness.
  10
  11 GENERIC: elaborate* ( insn -- )
  12
  13 : slot-shift ( -- n )
  14     tag-bits get cell log2 - ;
  15
  16 :: compute-slot-known-tag ( insn -- addr )
  17     { $1 $2 $3 $4 $5 } temps
  18     init-intrinsic
  19     $1 slot-shift %iconst emit  ! load shift offset
  20     $2 insn slot>> $1 %shr emit ! shift slot by shift offset
  21     $3 insn tag>> %iconst emit  ! load tag number
  22     $4 $2 $3 %isub emit
  23     $5 insn obj>> $4 %iadd emit ! compute slot offset
  24     $5
  25     ;
  26
  27 :: compute-slot-any-tag ( insn -- addr )
  28     { $1 $2 $3 $4 } temps
  29     init-intrinsic
  30     $1 insn obj>> emit-untag    ! untag object
  31     $2 slot-shift %iconst emit  ! load shift offset
  32     $3 insn slot>> $2 %shr emit ! shift slot by shift offset
  33     $4 $1 $3 %iadd emit         ! compute slot offset
  34     $4
  35     ;
  36
  37 : compute-slot ( insn -- addr )
  38     dup tag>> [ compute-slot-known-tag ] [ compute-slot-any-tag ] if ;
  39
  40 M: %%slot elaborate*
  41     [ out>> ] [ compute-slot ] bi %load emit ;
  42
  43 M: %%set-slot elaborate*
  44     [ in>> ] [ compute-slot ] bi %store emit ;
  45
  46 M: object elaborate* , ;
  47
  48 : elaboration ( insns -- insns )
  49     [ [ elaborate* ] each ] { } make ;