diff options
Diffstat (limited to 'compiler/ghci/ByteCodeInstr.hs')
| -rw-r--r-- | compiler/ghci/ByteCodeInstr.hs | 58 |
1 files changed, 53 insertions, 5 deletions
diff --git a/compiler/ghci/ByteCodeInstr.hs b/compiler/ghci/ByteCodeInstr.hs index 525280290f..07dcd2222a 100644 --- a/compiler/ghci/ByteCodeInstr.hs +++ b/compiler/ghci/ByteCodeInstr.hs @@ -12,6 +12,8 @@ module ByteCodeInstr ( #include "HsVersions.h" #include "../includes/MachDeps.h" +import GhcPrelude + import ByteCodeTypes import GHCi.RemoteTypes import GHCi.FFI (C_ffi_cif) @@ -30,11 +32,7 @@ import PrimOp import SMRep import Data.Word -#if MIN_VERSION_base(4,9,0) import GHC.Stack.CCS (CostCentre) -#else -import GHC.Stack (CostCentre) -#endif -- ---------------------------------------------------------------------------- -- Bytecode instructions @@ -64,6 +62,23 @@ data BCInstr | PUSH_LL !Word16 !Word16{-2 offsets-} | PUSH_LLL !Word16 !Word16 !Word16{-3 offsets-} + -- Push the specified local as a 8, 16, 32 bit value onto the stack. (i.e., + -- the stack will grow by 8, 16 or 32 bits) + | PUSH8 !Word16 + | PUSH16 !Word16 + | PUSH32 !Word16 + + -- Push the specifiec local as a 8, 16, 32 bit value onto the stack, but the + -- value will take the whole word on the stack (i.e., the stack will gorw by + -- a word) + -- This is useful when extracting a packed constructor field for further use. + -- Currently we expect all values on the stack to take full words, except for + -- the ones used for PACK (i.e., actually constracting new data types, in + -- which case we use PUSH{8,16,32}) + | PUSH8_W !Word16 + | PUSH16_W !Word16 + | PUSH32_W !Word16 + -- Push a ptr (these all map to PUSH_G really) | PUSH_G Name | PUSH_PRIMOP PrimOp @@ -73,8 +88,16 @@ data BCInstr | PUSH_ALTS (ProtoBCO Name) | PUSH_ALTS_UNLIFTED (ProtoBCO Name) ArgRep + -- Pushing 8, 16 and 32 bits of padding (for constructors). + | PUSH_PAD8 + | PUSH_PAD16 + | PUSH_PAD32 + -- Pushing literals - | PUSH_UBX Literal Word16 + | PUSH_UBX8 Literal + | PUSH_UBX16 Literal + | PUSH_UBX32 Literal + | PUSH_UBX Literal Word16 -- push this int/float/double/addr, on the stack. Word16 -- is # of words to copy from literal pool. Eitherness reflects -- the difficulty of dealing with MachAddr here, mostly due to @@ -196,6 +219,12 @@ instance Outputable BCInstr where ppr (PUSH_L offset) = text "PUSH_L " <+> ppr offset ppr (PUSH_LL o1 o2) = text "PUSH_LL " <+> ppr o1 <+> ppr o2 ppr (PUSH_LLL o1 o2 o3) = text "PUSH_LLL" <+> ppr o1 <+> ppr o2 <+> ppr o3 + ppr (PUSH8 offset) = text "PUSH8 " <+> ppr offset + ppr (PUSH16 offset) = text "PUSH16 " <+> ppr offset + ppr (PUSH32 offset) = text "PUSH32 " <+> ppr offset + ppr (PUSH8_W offset) = text "PUSH8_W " <+> ppr offset + ppr (PUSH16_W offset) = text "PUSH16_W " <+> ppr offset + ppr (PUSH32_W offset) = text "PUSH32_W " <+> ppr offset ppr (PUSH_G nm) = text "PUSH_G " <+> ppr nm ppr (PUSH_PRIMOP op) = text "PUSH_G " <+> text "GHC.PrimopWrappers." <> ppr op @@ -203,6 +232,13 @@ instance Outputable BCInstr where ppr (PUSH_ALTS bco) = hang (text "PUSH_ALTS") 2 (ppr bco) ppr (PUSH_ALTS_UNLIFTED bco pk) = hang (text "PUSH_ALTS_UNLIFTED" <+> ppr pk) 2 (ppr bco) + ppr PUSH_PAD8 = text "PUSH_PAD8" + ppr PUSH_PAD16 = text "PUSH_PAD16" + ppr PUSH_PAD32 = text "PUSH_PAD32" + + ppr (PUSH_UBX8 lit) = text "PUSH_UBX8" <+> ppr lit + ppr (PUSH_UBX16 lit) = text "PUSH_UBX16" <+> ppr lit + ppr (PUSH_UBX32 lit) = text "PUSH_UBX32" <+> ppr lit ppr (PUSH_UBX lit nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> ppr lit ppr PUSH_APPLY_N = text "PUSH_APPLY_N" ppr PUSH_APPLY_V = text "PUSH_APPLY_V" @@ -271,11 +307,23 @@ bciStackUse STKCHECK{} = 0 bciStackUse PUSH_L{} = 1 bciStackUse PUSH_LL{} = 2 bciStackUse PUSH_LLL{} = 3 +bciStackUse PUSH8{} = 1 -- overapproximation +bciStackUse PUSH16{} = 1 -- overapproximation +bciStackUse PUSH32{} = 1 -- overapproximation on 64bit arch +bciStackUse PUSH8_W{} = 1 -- takes exactly 1 word +bciStackUse PUSH16_W{} = 1 -- takes exactly 1 word +bciStackUse PUSH32_W{} = 1 -- takes exactly 1 word bciStackUse PUSH_G{} = 1 bciStackUse PUSH_PRIMOP{} = 1 bciStackUse PUSH_BCO{} = 1 bciStackUse (PUSH_ALTS bco) = 2 + protoBCOStackUse bco bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco +bciStackUse (PUSH_PAD8) = 1 -- overapproximation +bciStackUse (PUSH_PAD16) = 1 -- overapproximation +bciStackUse (PUSH_PAD32) = 1 -- overapproximation on 64bit arch +bciStackUse (PUSH_UBX8 _) = 1 -- overapproximation +bciStackUse (PUSH_UBX16 _) = 1 -- overapproximation +bciStackUse (PUSH_UBX32 _) = 1 -- overapproximation on 64bit arch bciStackUse (PUSH_UBX _ nw) = fromIntegral nw bciStackUse PUSH_APPLY_N{} = 1 bciStackUse PUSH_APPLY_V{} = 1 |