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(..),
   8                        nameOfProtoBCO, bciStackUse ) where
   9
  10 #include "HsVersions.h"
  11
  12 import Outputable
  13 import Name             ( Name )
  14 import Id               ( Id )
  15 import CoreSyn
  16 import PprCore          ( pprCoreExpr, pprCoreAlt )
  17 import Literal          ( Literal )
  18 import PrimRep          ( PrimRep )
  19 import DataCon          ( DataCon )
  20 import VarSet           ( VarSet )
  21 import PrimOp           ( PrimOp )
  22 import Foreign          ( Addr )
  23
  24 \end{code}
  25
  26 %************************************************************************
  27 %*                                                                      *
  28 \subsection{Bytecodes, and Outputery.}
  29 %*                                                                      *
  30 %************************************************************************
  31
  32 \begin{code}
  33
  34 data ProtoBCO a
  35    = ProtoBCO a                         -- name, in some sense
  36               [BCInstr]                 -- instrs
  37                                         -- what the BCO came from
  38               (Either [AnnAlt Id VarSet]
  39                       (AnnExpr Id VarSet))
  40               [Addr]                    -- malloc'd; free when BCO is GCd
  41
  42 nameOfProtoBCO (ProtoBCO nm insns origin malloced) = nm
  43
  44 type LocalLabel = Int
  45
  46 data BCInstr
  47    -- Messing with the stack
  48    = ARGCHECK  Int
  49    | STKCHECK  Int
  50    -- Push locals (existing bits of the stack)
  51    | PUSH_L    Int{-offset-}
  52    | PUSH_LL   Int Int{-2 offsets-}
  53    | PUSH_LLL  Int Int Int{-3 offsets-}
  54    -- Push a ptr
  55    | PUSH_G    (Either Name PrimOp)
  56    -- Push an alt continuation
  57    | PUSH_AS   Name PrimRep     -- push alts and BCO_ptr_ret_info
  58                                 -- PrimRep so we know which itbl
  59    -- Pushing literals
  60    | PUSH_UBX  (Either Literal Addr)
  61                Int      -- push this int/float/double/addr, NO TAG, on the stack
  62                         -- Int is # of words to copy from literal pool
  63                         -- Eitherness reflects the difficulty of dealing with
  64                         -- MachAddr here, mostly due to the excessive
  65                         -- (and unnecessary) restrictions imposed by the designers
  66                         -- of the new Foreign library.  In particular it is quite
  67                         -- impossible to convert an Addr to any other integral type,
  68                         -- and it appears impossible to get hold of the bits of an
  69                         -- addr, even though we need to to assemble BCOs.
  70
  71    | PUSH_TAG  Int      -- push this tag on the stack
  72
  73    | SLIDE     Int{-this many-} Int{-down by this much-}
  74    -- To do with the heap
  75    | ALLOC     Int      -- make an AP_UPD with this many payload words, zeroed
  76    | MKAP      Int{-ptr to AP_UPD is this far down stack-} Int{-# words-}
  77    | UNPACK    Int      -- unpack N ptr words from t.o.s Constr
  78    | UPK_TAG   Int Int Int
  79                         -- unpack N non-ptr words from offset M in constructor
  80                         -- K words down the stack
  81    | PACK      DataCon Int
  82                         -- after assembly, the DataCon is an index into the
  83                         -- itbl array
  84    -- For doing case trees
  85    | LABEL     LocalLabel
  86    | TESTLT_I  Int    LocalLabel
  87    | TESTEQ_I  Int    LocalLabel
  88    | TESTLT_F  Float  LocalLabel
  89    | TESTEQ_F  Float  LocalLabel
  90    | TESTLT_D  Double LocalLabel
  91    | TESTEQ_D  Double LocalLabel
  92
  93    -- The Int value is a constructor number and therefore
  94    -- stored in the insn stream rather than as an offset into
  95    -- the literal pool.
  96    | TESTLT_P  Int    LocalLabel
  97    | TESTEQ_P  Int    LocalLabel
  98
  99    | CASEFAIL
 100    | JMP              LocalLabel
 101
 102    -- For doing calls to C (via glue code generated by ByteCodeFFI)
 103    | CCALL            Addr      -- of the glue code
 104    | SWIZZLE          Int Int   -- to the ptr N words down the stack,
 105                                 -- add M (interpreted as a signed 16-bit entity)
 106
 107    -- To Infinity And Beyond
 108    | ENTER
 109    | RETURN    PrimRep
 110                -- unboxed value on TOS.  Use tag to find underlying ret itbl
 111                -- and return as per that.
 112
 113
 114 instance Outputable a => Outputable (ProtoBCO a) where
 115    ppr (ProtoBCO name instrs origin malloced)
 116       = (text "ProtoBCO" <+> ppr name <+> text (show malloced) <> colon)
 117         $$ nest 6 (vcat (map ppr instrs))
 118         $$ case origin of
 119               Left alts -> vcat (map (pprCoreAlt.deAnnAlt) alts)
 120               Right rhs -> pprCoreExpr (deAnnotate rhs)
 121
 122 instance Outputable BCInstr where
 123    ppr (STKCHECK n)          = text "STKCHECK" <+> int n
 124    ppr (ARGCHECK n)          = text "ARGCHECK" <+> int n
 125    ppr (PUSH_L offset)       = text "PUSH_L  " <+> int offset
 126    ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> int o1 <+> int o2
 127    ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> int o1 <+> int o2 <+> int o3
 128    ppr (PUSH_G (Left nm))    = text "PUSH_G  " <+> ppr nm
 129    ppr (PUSH_G (Right op))   = text "PUSH_G  " <+> text "PrelPrimopWrappers."
 130                                                <> ppr op
 131    ppr (PUSH_AS nm pk)       = text "PUSH_AS " <+> ppr nm <+> ppr pk
 132
 133    ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (int nw) <+> ppr lit
 134    ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (int nw) <+> text (show aa)
 135
 136    ppr (PUSH_TAG n)          = text "PUSH_TAG" <+> int n
 137    ppr (SLIDE n d)           = text "SLIDE   " <+> int n <+> int d
 138    ppr (ALLOC sz)            = text "ALLOC   " <+> int sz
 139    ppr (MKAP offset sz)      = text "MKAP    " <+> int sz <+> text "words,"
 140                                                <+> int offset <+> text "stkoff"
 141    ppr (UNPACK sz)           = text "UNPACK  " <+> int sz
 142    ppr (UPK_TAG n m k)       = text "UPK_TAG " <+> int n <> text "words"
 143                                                <+> int m <> text "conoff"
 144                                                <+> int k <> text "stkoff"
 145    ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
 146    ppr (LABEL     lab)       = text "__"       <> int lab <> colon
 147    ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> int lab
 148    ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> int lab
 149    ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> int lab
 150    ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> int lab
 151    ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> int lab
 152    ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> int lab
 153    ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> int i <+> text "__" <> int lab
 154    ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> int i <+> text "__" <> int lab
 155    ppr (JMP lab)             = text "JMP"      <+> int lab
 156    ppr CASEFAIL              = text "CASEFAIL"
 157    ppr ENTER                 = text "ENTER"
 158    ppr (RETURN pk)           = text "RETURN  " <+> ppr pk
 159    ppr (CCALL marshall_addr) = text "CCALL   " <+> text "marshall code at"
 160                                                <+> text (show marshall_addr)
 161    ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> int stkoff
 162                                                <+> text "by" <+> int n
 163
 164 -- The stack use, in words, of each bytecode insn.  These _must_ be
 165 -- correct, or overestimates of reality, to be safe.
 166 bciStackUse :: BCInstr -> Int
 167 bciStackUse (STKCHECK n)          = 0
 168 bciStackUse (ARGCHECK n)          = 0
 169 bciStackUse (PUSH_L offset)       = 1
 170 bciStackUse (PUSH_LL o1 o2)       = 2
 171 bciStackUse (PUSH_LLL o1 o2 o3)   = 3
 172 bciStackUse (PUSH_G globalish)    = 1
 173 bciStackUse (PUSH_AS nm pk)       = 2
 174 bciStackUse (PUSH_UBX lit nw)     = nw
 175 bciStackUse (PUSH_TAG n)          = 1
 176 bciStackUse (ALLOC sz)            = 1
 177 bciStackUse (UNPACK sz)           = sz
 178 bciStackUse (UPK_TAG n m k)       = n + 1{-tag-}
 179 bciStackUse (LABEL     lab)       = 0
 180 bciStackUse (TESTLT_I  i lab)     = 0
 181 bciStackUse (TESTEQ_I  i lab)     = 0
 182 bciStackUse (TESTLT_F  f lab)     = 0
 183 bciStackUse (TESTEQ_F  f lab)     = 0
 184 bciStackUse (TESTLT_D  d lab)     = 0
 185 bciStackUse (TESTEQ_D  d lab)     = 0
 186 bciStackUse (TESTLT_P  i lab)     = 0
 187 bciStackUse (TESTEQ_P  i lab)     = 0
 188 bciStackUse CASEFAIL              = 0
 189 bciStackUse (JMP lab)             = 0
 190 bciStackUse ENTER                 = 0
 191 bciStackUse (RETURN pk)           = 0
 192 bciStackUse (CCALL marshall_addr) = 0
 193 bciStackUse (SWIZZLE stkoff n)    = 0
 194
 195 -- These insns actually reduce stack use, but we need the high-tide level,
 196 -- so can't use this info.  Not that it matters much.
 197 bciStackUse (SLIDE n d)           = 0
 198 bciStackUse (MKAP offset sz)      = 0
 199 bciStackUse (PACK dcon sz)        = 1 -- worst case is PACK 0 words
 200
 201 \end{code}