{-# LINE 1 "GHCi/InfoTable.hsc" #-}
{-# LANGUAGE CPP, MagicHash, ScopedTypeVariables #-}

-- Get definitions for the structs, constants & config etc.


-- |
-- Run-time info table support.  This module provides support for
-- creating and reading info tables /in the running program/.
-- We use the RTS data structures directly via hsc2hs.
--
module GHCi.InfoTable
  (
    mkConInfoTable
  ) where

import Prelude -- See note [Why do we import Prelude here?]
import Foreign
import Foreign.C
import GHC.Ptr
import GHC.Exts
import GHC.Exts.Heap
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS

ghciTablesNextToCode :: Bool

{-# LINE 27 "GHCi/InfoTable.hsc" #-}
ghciTablesNextToCode = True

{-# LINE 31 "GHCi/InfoTable.hsc" #-}

-- NOTE: Must return a pointer acceptable for use in the header of a closure.
-- If tables_next_to_code is enabled, then it must point the the 'code' field.
-- Otherwise, it should point to the start of the StgInfoTable.
mkConInfoTable
   :: Int     -- ptr words
   -> Int     -- non-ptr words
   -> Int     -- constr tag
   -> Int     -- pointer tag
   -> ByteString  -- con desc
   -> IO (Ptr StgInfoTable)
      -- resulting info table is allocated with allocateExec(), and
      -- should be freed with freeExec().

mkConInfoTable :: Int -> Int -> Int -> Int -> ByteString -> IO (Ptr StgInfoTable)
mkConInfoTable Int
ptr_words Int
nonptr_words Int
tag Int
ptrtag ByteString
con_desc =
  FunPtr () -> Ptr StgInfoTable
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr (FunPtr () -> Ptr StgInfoTable)
-> IO (FunPtr ()) -> IO (Ptr StgInfoTable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StgInfoTable -> ByteString -> IO (FunPtr ())
newExecConItbl StgInfoTable
itbl ByteString
con_desc
  where
     entry_addr :: EntryFunPtr
entry_addr = [EntryFunPtr]
interpConstrEntry [EntryFunPtr] -> Int -> EntryFunPtr
forall a. [a] -> Int -> a
!! Int
ptrtag
     code' :: ItblCodes
code' = EntryFunPtr -> ItblCodes
mkJumpToAddr EntryFunPtr
entry_addr
     itbl :: StgInfoTable
itbl  = StgInfoTable :: Maybe EntryFunPtr
-> HalfWord
-> HalfWord
-> ClosureType
-> HalfWord
-> Maybe ItblCodes
-> StgInfoTable
StgInfoTable {
                 entry :: Maybe EntryFunPtr
entry = if Bool
ghciTablesNextToCode
                         then Maybe EntryFunPtr
forall a. Maybe a
Nothing
                         else EntryFunPtr -> Maybe EntryFunPtr
forall a. a -> Maybe a
Just EntryFunPtr
entry_addr,
                 ptrs :: HalfWord
ptrs  = Int -> HalfWord
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ptr_words,
                 nptrs :: HalfWord
nptrs = Int -> HalfWord
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nonptr_words,
                 tipe :: ClosureType
tipe  = ClosureType
CONSTR,
                 srtlen :: HalfWord
srtlen = Int -> HalfWord
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tag,
                 code :: Maybe ItblCodes
code  = if Bool
ghciTablesNextToCode
                         then ItblCodes -> Maybe ItblCodes
forall a. a -> Maybe a
Just ItblCodes
code'
                         else Maybe ItblCodes
forall a. Maybe a
Nothing
              }


-- -----------------------------------------------------------------------------
-- Building machine code fragments for a constructor's entry code

funPtrToInt :: FunPtr a -> Int
funPtrToInt :: FunPtr a -> Int
funPtrToInt (FunPtr Addr#
a) = Int# -> Int
I# (Addr# -> Int#
addr2Int# Addr#
a)

data Arch = ArchSPARC
          | ArchPPC
          | ArchX86
          | ArchX86_64
          | ArchAlpha
          | ArchARM
          | ArchARM64
          | ArchPPC64
          | ArchPPC64LE
          | ArchS390X
          | ArchUnknown
 deriving Int -> Arch -> ShowS
[Arch] -> ShowS
Arch -> String
(Int -> Arch -> ShowS)
-> (Arch -> String) -> ([Arch] -> ShowS) -> Show Arch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arch] -> ShowS
$cshowList :: [Arch] -> ShowS
show :: Arch -> String
$cshow :: Arch -> String
showsPrec :: Int -> Arch -> ShowS
$cshowsPrec :: Int -> Arch -> ShowS
Show

platform :: Arch
platform :: Arch
platform =

{-# LINE 92 "GHCi/InfoTable.hsc" #-}
       Arch
ArchX86_64

{-# LINE 112 "GHCi/InfoTable.hsc" #-}

mkJumpToAddr :: EntryFunPtr -> ItblCodes
mkJumpToAddr :: EntryFunPtr -> ItblCodes
mkJumpToAddr EntryFunPtr
a = case Arch
platform of
    Arch
ArchSPARC ->
        -- After some consideration, we'll try this, where
        -- 0x55555555 stands in for the address to jump to.
        -- According to includes/rts/MachRegs.h, %g3 is very
        -- likely indeed to be baggable.
        --
        --   0000 07155555              sethi   %hi(0x55555555), %g3
        --   0004 8610E155              or      %g3, %lo(0x55555555), %g3
        --   0008 81C0C000              jmp     %g3
        --   000c 01000000              nop

        let w32 :: HalfWord
w32 = Int -> HalfWord
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EntryFunPtr -> Int
forall a. FunPtr a -> Int
funPtrToInt EntryFunPtr
a)

            hi22, lo10 :: Word32 -> Word32
            lo10 :: HalfWord -> HalfWord
lo10 HalfWord
x = HalfWord
x HalfWord -> HalfWord -> HalfWord
forall a. Bits a => a -> a -> a
.&. HalfWord
0x3FF
            hi22 :: HalfWord -> HalfWord
hi22 HalfWord
x = (HalfWord
x HalfWord -> Int -> HalfWord
forall a. Bits a => a -> Int -> a
`shiftR` Int
10) HalfWord -> HalfWord -> HalfWord
forall a. Bits a => a -> a -> a
.&. HalfWord
0x3FFFF

        in [HalfWord] -> ItblCodes
forall a b. b -> Either a b
Right [ HalfWord
0x07000000 HalfWord -> HalfWord -> HalfWord
forall a. Bits a => a -> a -> a
.|. (HalfWord -> HalfWord
hi22 HalfWord
w32),
                   HalfWord
0x8610E000 HalfWord -> HalfWord -> HalfWord
forall a. Bits a => a -> a -> a
.|. (HalfWord -> HalfWord
lo10 HalfWord
w32),
                   HalfWord
0x81C0C000,
                   HalfWord
0x01000000 ]

    Arch
ArchPPC ->
        -- We'll use r12, for no particular reason.
        -- 0xDEADBEEF stands for the address:
        -- 3D80DEAD lis r12,0xDEAD
        -- 618CBEEF ori r12,r12,0xBEEF
        -- 7D8903A6 mtctr r12
        -- 4E800420 bctr

        let w32 :: HalfWord
w32 = Int -> HalfWord
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EntryFunPtr -> Int
forall a. FunPtr a -> Int
funPtrToInt EntryFunPtr
a)
            hi16 :: a -> a
hi16 a
x = (a
x a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFFFF
            lo16 :: a -> a
lo16 a
x = a
x a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFFFF
        in [HalfWord] -> ItblCodes
forall a b. b -> Either a b
Right [ HalfWord
0x3D800000 HalfWord -> HalfWord -> HalfWord
forall a. Bits a => a -> a -> a
.|. HalfWord -> HalfWord
forall a. (Bits a, Num a) => a -> a
hi16 HalfWord
w32,
                   HalfWord
0x618C0000 HalfWord -> HalfWord -> HalfWord
forall a. Bits a => a -> a -> a
.|. HalfWord -> HalfWord
forall a. (Bits a, Num a) => a -> a
lo16 HalfWord
w32,
                   HalfWord
0x7D8903A6, HalfWord
0x4E800420 ]

    Arch
ArchX86 ->
        -- Let the address to jump to be 0xWWXXYYZZ.
        -- Generate   movl $0xWWXXYYZZ,%eax  ;  jmp *%eax
        -- which is
        -- B8 ZZ YY XX WW FF E0

        let w32 :: HalfWord
w32 = Int -> HalfWord
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EntryFunPtr -> Int
forall a. FunPtr a -> Int
funPtrToInt EntryFunPtr
a) :: Word32
            insnBytes :: [Word8]
            insnBytes :: [Word8]
insnBytes
               = [Word8
0xB8, HalfWord -> Word8
forall w. Integral w => w -> Word8
byte0 HalfWord
w32, HalfWord -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte1 HalfWord
w32,
                        HalfWord -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte2 HalfWord
w32, HalfWord -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte3 HalfWord
w32,
                  Word8
0xFF, Word8
0xE0]
        in
            [Word8] -> ItblCodes
forall a b. a -> Either a b
Left [Word8]
insnBytes

    Arch
ArchX86_64 ->
        -- Generates:
        --      jmpq *.L1(%rip)
        --      .align 8
        -- .L1:
        --      .quad <addr>
        --
        -- which looks like:
        --     8:   ff 25 02 00 00 00     jmpq   *0x2(%rip)      # 10 <f+0x10>
        -- with addr at 10.
        --
        -- We need a full 64-bit pointer (we can't assume the info table is
        -- allocated in low memory).  Assuming the info pointer is aligned to
        -- an 8-byte boundary, the addr will also be aligned.

        let w64 :: Word64
w64 = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EntryFunPtr -> Int
forall a. FunPtr a -> Int
funPtrToInt EntryFunPtr
a) :: Word64
            insnBytes :: [Word8]
            insnBytes :: [Word8]
insnBytes
               = [Word8
0xff, Word8
0x25, Word8
0x02, Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x00,
                  Word64 -> Word8
forall w. Integral w => w -> Word8
byte0 Word64
w64, Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte1 Word64
w64, Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte2 Word64
w64, Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte3 Word64
w64,
                  Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte4 Word64
w64, Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte5 Word64
w64, Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte6 Word64
w64, Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte7 Word64
w64]
        in
            [Word8] -> ItblCodes
forall a b. a -> Either a b
Left [Word8]
insnBytes

    Arch
ArchAlpha ->
        let w64 :: Word64
w64 = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EntryFunPtr -> Int
forall a. FunPtr a -> Int
funPtrToInt EntryFunPtr
a) :: Word64
        in [HalfWord] -> ItblCodes
forall a b. b -> Either a b
Right [ HalfWord
0xc3800000      -- br   at, .+4
                 , HalfWord
0xa79c000c      -- ldq  at, 12(at)
                 , HalfWord
0x6bfc0000      -- jmp  (at)    # with zero hint -- oh well
                 , HalfWord
0x47ff041f      -- nop
                 , Word64 -> HalfWord
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x0000FFFF)
                 , Word64 -> HalfWord
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0x0000FFFF) ]

    ArchARM { } ->
        -- Generates Arm sequence,
        --      ldr r1, [pc, #0]
        --      bx r1
        --
        -- which looks like:
        --     00000000 <.addr-0x8>:
        --     0:       00109fe5    ldr    r1, [pc]      ; 8 <.addr>
        --     4:       11ff2fe1    bx     r1
        let w32 :: HalfWord
w32 = Int -> HalfWord
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EntryFunPtr -> Int
forall a. FunPtr a -> Int
funPtrToInt EntryFunPtr
a) :: Word32
        in [Word8] -> ItblCodes
forall a b. a -> Either a b
Left [ Word8
0x00, Word8
0x10, Word8
0x9f, Word8
0xe5
                , Word8
0x11, Word8
0xff, Word8
0x2f, Word8
0xe1
                , HalfWord -> Word8
forall w. Integral w => w -> Word8
byte0 HalfWord
w32, HalfWord -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte1 HalfWord
w32, HalfWord -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte2 HalfWord
w32, HalfWord -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte3 HalfWord
w32]

    ArchARM64 { } ->
        -- Generates:
        --
        --      ldr     x1, label
        --      br      x1
        -- label:
        --      .quad <addr>
        --
        -- which looks like:
        --     0:       58000041        ldr     x1, <label>
        --     4:       d61f0020        br      x1
       let w64 :: Word64
w64 = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EntryFunPtr -> Int
forall a. FunPtr a -> Int
funPtrToInt EntryFunPtr
a) :: Word64
       in [HalfWord] -> ItblCodes
forall a b. b -> Either a b
Right [ HalfWord
0x58000041
                , HalfWord
0xd61f0020
                , Word64 -> HalfWord
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w64
                , Word64 -> HalfWord
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
w64 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) ]
    Arch
ArchPPC64 ->
        -- We use the compiler's register r12 to read the function
        -- descriptor and the linker's register r11 as a temporary
        -- register to hold the function entry point.
        -- In the medium code model the function descriptor
        -- is located in the first two gigabytes, i.e. the address
        -- of the function pointer is a non-negative 32 bit number.
        -- 0x0EADBEEF stands for the address of the function pointer:
        --    0:   3d 80 0e ad     lis     r12,0x0EAD
        --    4:   61 8c be ef     ori     r12,r12,0xBEEF
        --    8:   e9 6c 00 00     ld      r11,0(r12)
        --    c:   e8 4c 00 08     ld      r2,8(r12)
        --   10:   7d 69 03 a6     mtctr   r11
        --   14:   e9 6c 00 10     ld      r11,16(r12)
        --   18:   4e 80 04 20     bctr
       let  w32 :: HalfWord
w32 = Int -> HalfWord
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EntryFunPtr -> Int
forall a. FunPtr a -> Int
funPtrToInt EntryFunPtr
a)
            hi16 :: a -> a
hi16 a
x = (a
x a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFFFF
            lo16 :: a -> a
lo16 a
x = a
x a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFFFF
       in [HalfWord] -> ItblCodes
forall a b. b -> Either a b
Right [ HalfWord
0x3D800000 HalfWord -> HalfWord -> HalfWord
forall a. Bits a => a -> a -> a
.|. HalfWord -> HalfWord
forall a. (Bits a, Num a) => a -> a
hi16 HalfWord
w32,
                  HalfWord
0x618C0000 HalfWord -> HalfWord -> HalfWord
forall a. Bits a => a -> a -> a
.|. HalfWord -> HalfWord
forall a. (Bits a, Num a) => a -> a
lo16 HalfWord
w32,
                  HalfWord
0xE96C0000,
                  HalfWord
0xE84C0008,
                  HalfWord
0x7D6903A6,
                  HalfWord
0xE96C0010,
                  HalfWord
0x4E800420]

    Arch
ArchPPC64LE ->
        -- The ABI requires r12 to point to the function's entry point.
        -- We use the medium code model where code resides in the first
        -- two gigabytes, so loading a non-negative32 bit address
        -- with lis followed by ori is fine.
        -- 0x0EADBEEF stands for the address:
        -- 3D800EAD lis r12,0x0EAD
        -- 618CBEEF ori r12,r12,0xBEEF
        -- 7D8903A6 mtctr r12
        -- 4E800420 bctr

        let w32 :: HalfWord
w32 = Int -> HalfWord
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EntryFunPtr -> Int
forall a. FunPtr a -> Int
funPtrToInt EntryFunPtr
a)
            hi16 :: a -> a
hi16 a
x = (a
x a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFFFF
            lo16 :: a -> a
lo16 a
x = a
x a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFFFF
        in [HalfWord] -> ItblCodes
forall a b. b -> Either a b
Right [ HalfWord
0x3D800000 HalfWord -> HalfWord -> HalfWord
forall a. Bits a => a -> a -> a
.|. HalfWord -> HalfWord
forall a. (Bits a, Num a) => a -> a
hi16 HalfWord
w32,
                   HalfWord
0x618C0000 HalfWord -> HalfWord -> HalfWord
forall a. Bits a => a -> a -> a
.|. HalfWord -> HalfWord
forall a. (Bits a, Num a) => a -> a
lo16 HalfWord
w32,
                   HalfWord
0x7D8903A6, HalfWord
0x4E800420 ]

    Arch
ArchS390X ->
        -- Let 0xAABBCCDDEEFFGGHH be the address to jump to.
        -- The following code loads the address into scratch
        -- register r1 and jumps to it.
        --
        --    0:   C0 1E AA BB CC DD       llihf   %r1,0xAABBCCDD
        --    6:   C0 19 EE FF GG HH       iilf    %r1,0xEEFFGGHH
        --   12:   07 F1                   br      %r1

        let w64 :: Word64
w64 = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (EntryFunPtr -> Int
forall a. FunPtr a -> Int
funPtrToInt EntryFunPtr
a) :: Word64
        in [Word8] -> ItblCodes
forall a b. a -> Either a b
Left [ Word8
0xC0, Word8
0x1E, Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte7 Word64
w64, Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte6 Word64
w64, Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte5 Word64
w64, Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte4 Word64
w64,
                  Word8
0xC0, Word8
0x19, Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte3 Word64
w64, Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte2 Word64
w64, Word64 -> Word8
forall w. (Integral w, Bits w) => w -> Word8
byte1 Word64
w64, Word64 -> Word8
forall w. Integral w => w -> Word8
byte0 Word64
w64,
                  Word8
0x07, Word8
0xF1 ]

    -- This code must not be called. You either need to
    -- add your architecture as a distinct case or
    -- use non-TABLES_NEXT_TO_CODE mode
    Arch
ArchUnknown -> String -> ItblCodes
forall a. HasCallStack => String -> a
error String
"mkJumpToAddr: ArchUnknown is unsupported"

byte0 :: (Integral w) => w -> Word8
byte0 :: w -> Word8
byte0 w
w = w -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral w
w

byte1, byte2, byte3, byte4, byte5, byte6, byte7
       :: (Integral w, Bits w) => w -> Word8
byte1 :: w -> Word8
byte1 w
w = w -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (w
w w -> Int -> w
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
byte2 :: w -> Word8
byte2 w
w = w -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (w
w w -> Int -> w
forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
byte3 :: w -> Word8
byte3 w
w = w -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (w
w w -> Int -> w
forall a. Bits a => a -> Int -> a
`shiftR` Int
24)
byte4 :: w -> Word8
byte4 w
w = w -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (w
w w -> Int -> w
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
byte5 :: w -> Word8
byte5 w
w = w -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (w
w w -> Int -> w
forall a. Bits a => a -> Int -> a
`shiftR` Int
40)
byte6 :: w -> Word8
byte6 w
w = w -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (w
w w -> Int -> w
forall a. Bits a => a -> Int -> a
`shiftR` Int
48)
byte7 :: w -> Word8
byte7 w
w = w -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (w
w w -> Int -> w
forall a. Bits a => a -> Int -> a
`shiftR` Int
56)


-- -----------------------------------------------------------------------------
-- read & write intfo tables

-- entry point for direct returns for created constr itbls
foreign import ccall "&stg_interp_constr1_entry" stg_interp_constr1_entry :: EntryFunPtr
foreign import ccall "&stg_interp_constr2_entry" stg_interp_constr2_entry :: EntryFunPtr
foreign import ccall "&stg_interp_constr3_entry" stg_interp_constr3_entry :: EntryFunPtr
foreign import ccall "&stg_interp_constr4_entry" stg_interp_constr4_entry :: EntryFunPtr
foreign import ccall "&stg_interp_constr5_entry" stg_interp_constr5_entry :: EntryFunPtr
foreign import ccall "&stg_interp_constr6_entry" stg_interp_constr6_entry :: EntryFunPtr
foreign import ccall "&stg_interp_constr7_entry" stg_interp_constr7_entry :: EntryFunPtr

interpConstrEntry :: [EntryFunPtr]
interpConstrEntry :: [EntryFunPtr]
interpConstrEntry = [ String -> EntryFunPtr
forall a. HasCallStack => String -> a
error String
"pointer tag 0"
                    , EntryFunPtr
stg_interp_constr1_entry
                    , EntryFunPtr
stg_interp_constr2_entry
                    , EntryFunPtr
stg_interp_constr3_entry
                    , EntryFunPtr
stg_interp_constr4_entry
                    , EntryFunPtr
stg_interp_constr5_entry
                    , EntryFunPtr
stg_interp_constr6_entry
                    , EntryFunPtr
stg_interp_constr7_entry ]

data StgConInfoTable = StgConInfoTable {
   StgConInfoTable -> Ptr Word8
conDesc   :: Ptr Word8,
   StgConInfoTable -> StgInfoTable
infoTable :: StgInfoTable
}


pokeConItbl
  :: Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable
  -> IO ()
pokeConItbl :: Ptr StgConInfoTable
-> Ptr StgConInfoTable -> StgConInfoTable -> IO ()
pokeConItbl Ptr StgConInfoTable
wr_ptr Ptr StgConInfoTable
_ex_ptr StgConInfoTable
itbl = do

{-# LINE 340 "GHCi/InfoTable.hsc" #-}
  -- Write the offset to the con_desc from the end of the standard InfoTable
  -- at the first byte.
  let con_desc_offset :: Int
con_desc_offset = StgConInfoTable -> Ptr Word8
conDesc StgConInfoTable
itbl Ptr Word8 -> Ptr Any -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` (Ptr StgConInfoTable
_ex_ptr Ptr StgConInfoTable -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
conInfoTableSizeB)
  ((\Ptr StgConInfoTable
hsc_ptr -> Ptr StgConInfoTable -> Int -> Int -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr StgConInfoTable
hsc_ptr Int
0)) Ptr StgConInfoTable
wr_ptr Int
con_desc_offset
{-# LINE 344 "GHCi/InfoTable.hsc" #-}

{-# LINE 350 "GHCi/InfoTable.hsc" #-}
  Ptr StgInfoTable -> StgInfoTable -> IO ()
pokeItbl (Ptr StgConInfoTable
wr_ptr Ptr StgConInfoTable -> Int -> Ptr StgInfoTable
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` ((Int
8))) (StgConInfoTable -> StgInfoTable
infoTable StgConInfoTable
itbl)
{-# LINE 351 "GHCi/InfoTable.hsc" #-}

sizeOfEntryCode :: Int
sizeOfEntryCode :: Int
sizeOfEntryCode
  | Bool -> Bool
not Bool
ghciTablesNextToCode = Int
0
  | Bool
otherwise =
     case EntryFunPtr -> ItblCodes
mkJumpToAddr EntryFunPtr
forall a. HasCallStack => a
undefined of
       Left  [Word8]
xs -> Word8 -> Int
forall a. Storable a => a -> Int
sizeOf ([Word8] -> Word8
forall a. [a] -> a
head [Word8]
xs) Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
xs
       Right [HalfWord]
xs -> HalfWord -> Int
forall a. Storable a => a -> Int
sizeOf ([HalfWord] -> HalfWord
forall a. [a] -> a
head [HalfWord]
xs) Int -> Int -> Int
forall a. Num a => a -> a -> a
* [HalfWord] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HalfWord]
xs

-- Note: Must return proper pointer for use in a closure
newExecConItbl :: StgInfoTable -> ByteString -> IO (FunPtr ())
newExecConItbl :: StgInfoTable -> ByteString -> IO (FunPtr ())
newExecConItbl StgInfoTable
obj ByteString
con_desc
   = (Ptr (Ptr StgConInfoTable) -> IO (FunPtr ())) -> IO (FunPtr ())
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr StgConInfoTable) -> IO (FunPtr ())) -> IO (FunPtr ()))
-> (Ptr (Ptr StgConInfoTable) -> IO (FunPtr ())) -> IO (FunPtr ())
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr StgConInfoTable)
pcode -> do
        let lcon_desc :: Int
lcon_desc = ByteString -> Int
BS.length ByteString
con_desc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1{- null terminator -}
            -- SCARY
            -- This size represents the number of bytes in an StgConInfoTable.
            sz :: CUInt
sz = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
conInfoTableSizeB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sizeOfEntryCode)
               -- Note: we need to allocate the conDesc string next to the info
               -- table, because on a 64-bit platform we reference this string
               -- with a 32-bit offset relative to the info table, so if we
               -- allocated the string separately it might be out of range.
        Ptr StgConInfoTable
wr_ptr <- CUInt -> Ptr (Ptr StgConInfoTable) -> IO (Ptr StgConInfoTable)
forall a. CUInt -> Ptr (Ptr a) -> IO (Ptr a)
_allocateExec (CUInt
sz CUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
+ Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lcon_desc) Ptr (Ptr StgConInfoTable)
pcode
        Ptr StgConInfoTable
ex_ptr <- Ptr (Ptr StgConInfoTable) -> IO (Ptr StgConInfoTable)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr StgConInfoTable)
pcode
        let cinfo :: StgConInfoTable
cinfo = StgConInfoTable :: Ptr Word8 -> StgInfoTable -> StgConInfoTable
StgConInfoTable { conDesc :: Ptr Word8
conDesc = Ptr StgConInfoTable
ex_ptr Ptr StgConInfoTable -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
sz
                                    , infoTable :: StgInfoTable
infoTable = StgInfoTable
obj }
        Ptr StgConInfoTable
-> Ptr StgConInfoTable -> StgConInfoTable -> IO ()
pokeConItbl Ptr StgConInfoTable
wr_ptr Ptr StgConInfoTable
ex_ptr StgConInfoTable
cinfo
        ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
con_desc ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
src, Int
len) ->
            Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (Ptr StgConInfoTable -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr StgConInfoTable
wr_ptr Ptr Any -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
sz) Ptr CChar
src Int
len
        let null_off :: Int
null_off = CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
con_desc)
        Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr StgConInfoTable -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr StgConInfoTable
wr_ptr Ptr Any -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
null_off) (Word8
0 :: Word8)
        CUInt -> Ptr StgConInfoTable -> IO ()
forall a. CUInt -> Ptr a -> IO ()
_flushExec CUInt
sz Ptr StgConInfoTable
ex_ptr -- Cache flush (if needed)

{-# LINE 383 "GHCi/InfoTable.hsc" #-}
        FunPtr () -> IO (FunPtr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr ()
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr (Ptr StgConInfoTable
ex_ptr Ptr StgConInfoTable -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
conInfoTableSizeB))

{-# LINE 387 "GHCi/InfoTable.hsc" #-}

foreign import ccall unsafe "allocateExec"
  _allocateExec :: CUInt -> Ptr (Ptr a) -> IO (Ptr a)

foreign import ccall unsafe "flushExec"
  _flushExec :: CUInt -> Ptr a -> IO ()

-- -----------------------------------------------------------------------------
-- Constants and config

wORD_SIZE :: Int
wORD_SIZE :: Int
wORD_SIZE = (Int
8)
{-# LINE 399 "GHCi/InfoTable.hsc" #-}

conInfoTableSizeB :: Int
conInfoTableSizeB :: Int
conInfoTableSizeB = Int
wORD_SIZE Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
itblSize