ghc/compiler/ghci/ByteCodeInstr.lhs

   1 %
   2 % (c) The University of Glasgow 2000
   3 %
   4 \section[ByteCodeInstrs]{Bytecode instruction definitions}
   5
   6 \begin{code}
   7 module ByteCodeInstr ( BCInstr(..), ProtoBCO(..), nameOfProtoBCO ) where
   8
   9 #include "HsVersions.h"
  10
  11 import Outputable
  12 import Name             ( Name )
  13 import Id               ( Id )
  14 import CoreSyn
  15 import PprCore          ( pprCoreExpr, pprCoreAlt )
  16 import Literal          ( Literal )
  17 import PrimRep          ( PrimRep )
  18 import DataCon          ( DataCon )
  19 import VarSet           ( VarSet )
  20 import PrimOp           ( PrimOp )
  21
  22 \end{code}
  23
  24 %************************************************************************
  25 %*                                                                      *
  26 \subsection{Bytecodes, and Outputery.}
  27 %*                                                                      *
  28 %************************************************************************
  29
  30 \begin{code}
  31
  32 data ProtoBCO a
  33    = ProtoBCO a                         -- name, in some sense
  34               [BCInstr]                 -- instrs
  35                                         -- what the BCO came from
  36               (Either [AnnAlt Id VarSet]
  37                       (AnnExpr Id VarSet))
  38
  39 nameOfProtoBCO (ProtoBCO nm insns origin) = nm
  40
  41 type LocalLabel = Int
  42
  43 data BCInstr
  44    -- Messing with the stack
  45    = ARGCHECK  Int
  46    -- Push locals (existing bits of the stack)
  47    | PUSH_L    Int{-offset-}
  48    | PUSH_LL   Int Int{-2 offsets-}
  49    | PUSH_LLL  Int Int Int{-3 offsets-}
  50    -- Push a ptr
  51    | PUSH_G    (Either Name PrimOp)
  52    -- Push an alt continuation
  53    | PUSH_AS   Name PrimRep     -- push alts and BCO_ptr_ret_info
  54                                 -- PrimRep so we know which itbl
  55    -- Pushing literals
  56    | PUSH_UBX  Literal  Int
  57                         -- push this int/float/double, NO TAG, on the stack
  58                         -- Int is # of words to copy from literal pool
  59    | PUSH_TAG  Int      -- push this tag on the stack
  60
  61    | SLIDE     Int{-this many-} Int{-down by this much-}
  62    -- To do with the heap
  63    | ALLOC     Int      -- make an AP_UPD with this many payload words, zeroed
  64    | MKAP      Int{-ptr to AP_UPD is this far down stack-} Int{-# words-}
  65    | UNPACK    Int      -- unpack N ptr words from t.o.s Constr
  66    | UPK_TAG   Int Int Int
  67                         -- unpack N non-ptr words from offset M in constructor
  68                         -- K words down the stack
  69    | PACK      DataCon Int
  70                         -- after assembly, the DataCon is an index into the
  71                         -- itbl array
  72    -- For doing case trees
  73    | LABEL     LocalLabel
  74    | TESTLT_I  Int    LocalLabel
  75    | TESTEQ_I  Int    LocalLabel
  76    | TESTLT_F  Float  LocalLabel
  77    | TESTEQ_F  Float  LocalLabel
  78    | TESTLT_D  Double LocalLabel
  79    | TESTEQ_D  Double LocalLabel
  80
  81    -- The Int value is a constructor number and therefore
  82    -- stored in the insn stream rather than as an offset into
  83    -- the literal pool.
  84    | TESTLT_P  Int    LocalLabel
  85    | TESTEQ_P  Int    LocalLabel
  86
  87    | CASEFAIL
  88    -- To Infinity And Beyond
  89    | ENTER
  90    | RETURN     PrimRep
  91                 -- unboxed value on TOS.  Use tag to find underlying ret itbl
  92                 -- and return as per that.
  93
  94
  95 instance Outputable BCInstr where
  96    ppr (ARGCHECK n)          = text "ARGCHECK" <+> int n
  97    ppr (PUSH_L offset)       = text "PUSH_L  " <+> int offset
  98    ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> int o1 <+> int o2
  99    ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> int o1 <+> int o2 <+> int o3
 100    ppr (PUSH_G (Left nm))    = text "PUSH_G  " <+> ppr nm
 101    ppr (PUSH_G (Right op))   = text "PUSH_G  " <+> text "PrelPrimopWrappers."
 102                                                <> ppr op
 103    ppr (PUSH_AS nm pk)       = text "PUSH_AS " <+> ppr nm <+> ppr pk
 104    ppr (PUSH_UBX lit nw)     = text "PUSH_UBX" <+> parens (int nw) <+> ppr lit
 105    ppr (PUSH_TAG n)          = text "PUSH_TAG" <+> int n
 106    ppr (SLIDE n d)           = text "SLIDE   " <+> int n <+> int d
 107    ppr (ALLOC sz)            = text "ALLOC   " <+> int sz
 108    ppr (MKAP offset sz)      = text "MKAP    " <+> int sz <+> text "words,"
 109                                                <+> int offset <+> text "stkoff"
 110    ppr (UNPACK sz)           = text "UNPACK  " <+> int sz
 111    ppr (UPK_TAG n m k)       = text "UPK_TAG " <+> int n <> text "words"
 112                                                <+> int m <> text "conoff"
 113                                                <+> int k <> text "stkoff"
 114    ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
 115    ppr (LABEL     lab)       = text "__"       <> int lab <> colon
 116    ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> int lab
 117    ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> int lab
 118    ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> int lab
 119    ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> int lab
 120    ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> int lab
 121    ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> int lab
 122    ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> int i <+> text "__" <> int lab
 123    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> int i <+> text "__" <> int lab
 124    ppr CASEFAIL              = text "CASEFAIL"
 125    ppr ENTER                 = text "ENTER"
 126    ppr (RETURN pk)           = text "RETURN  " <+> ppr pk
 127
 128 instance Outputable a => Outputable (ProtoBCO a) where
 129    ppr (ProtoBCO name instrs origin)
 130       = (text "ProtoBCO" <+> ppr name <> colon)
 131         $$ nest 6 (vcat (map ppr instrs))
 132         $$ case origin of
 133               Left alts -> vcat (map (pprCoreAlt.deAnnAlt) alts)
 134               Right rhs -> pprCoreExpr (deAnnotate rhs)
 135 \end{code}