{-# LINE 1 "libraries/ghci/GHCi/InfoTable.hsc" #-}
{-# LANGUAGE CPP, MagicHash, ScopedTypeVariables #-}
module GHCi.InfoTable
(
mkConInfoTable
) where
import Prelude hiding (fail)
import Foreign
import Foreign.C
import GHC.Ptr
import GHC.Exts
import GHC.Exts.Heap
import Data.ByteString (ByteString)
import Control.Monad.Fail
import qualified Data.ByteString as BS
import GHC.Platform.Host (hostPlatformArch)
import GHC.Platform.ArchOS
mkConInfoTable
:: Bool
-> Int
-> Int
-> Int
-> Int
-> ByteString
-> IO (Ptr StgInfoTable)
mkConInfoTable :: Bool
-> Int -> Int -> Int -> Int -> ByteString -> IO (Ptr StgInfoTable)
mkConInfoTable Bool
tables_next_to_code Int
ptr_words Int
nonptr_words Int
tag Int
ptrtag ByteString
con_desc = do
let entry_addr :: EntryFunPtr
entry_addr = [EntryFunPtr]
interpConstrEntry [EntryFunPtr] -> Int -> EntryFunPtr
forall a. HasCallStack => [a] -> Int -> a
!! Int
ptrtag
code' <- if Bool
tables_next_to_code
then ItblCodes -> Maybe ItblCodes
forall a. a -> Maybe a
Just (ItblCodes -> Maybe ItblCodes)
-> IO ItblCodes -> IO (Maybe ItblCodes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EntryFunPtr -> IO ItblCodes
forall (m :: * -> *). MonadFail m => EntryFunPtr -> m ItblCodes
mkJumpToAddr EntryFunPtr
entry_addr
else Maybe ItblCodes -> IO (Maybe ItblCodes)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ItblCodes
forall a. Maybe a
Nothing
let
itbl = StgInfoTable {
entry :: Maybe EntryFunPtr
entry = if Bool
tables_next_to_code
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 = Maybe ItblCodes
code'
}
castFunPtrToPtr <$> newExecConItbl tables_next_to_code itbl con_desc
funPtrToInt :: FunPtr a -> Int
funPtrToInt :: forall a. FunPtr a -> Int
funPtrToInt (FunPtr Addr#
a) = Int# -> Int
I# (Addr# -> Int#
addr2Int# Addr#
a)
mkJumpToAddr :: MonadFail m => EntryFunPtr-> m ItblCodes
mkJumpToAddr :: forall (m :: * -> *). MonadFail m => EntryFunPtr -> m ItblCodes
mkJumpToAddr EntryFunPtr
a = case Arch
hostPlatformArch of
Arch
ArchPPC -> ItblCodes -> m ItblCodes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItblCodes -> m ItblCodes) -> ItblCodes -> m ItblCodes
forall a b. (a -> b) -> a -> b
$
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 -> ItblCodes -> m ItblCodes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItblCodes -> m ItblCodes) -> ItblCodes -> m ItblCodes
forall a b. (a -> b) -> a -> b
$
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 -> ItblCodes -> m ItblCodes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItblCodes -> m ItblCodes) -> ItblCodes -> m ItblCodes
forall a b. (a -> b) -> a -> b
$
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 -> ItblCodes -> m ItblCodes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItblCodes -> m ItblCodes) -> ItblCodes -> m ItblCodes
forall a b. (a -> b) -> a -> b
$
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
, HalfWord
0xa79c000c
, HalfWord
0x6bfc0000
, HalfWord
0x47ff041f
, 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 {} -> ItblCodes -> m ItblCodes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItblCodes -> m ItblCodes) -> ItblCodes -> m ItblCodes
forall a b. (a -> b) -> a -> b
$
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]
ArchAArch64 {} -> ItblCodes -> m ItblCodes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItblCodes -> m ItblCodes) -> ItblCodes -> m ItblCodes
forall a b. (a -> b) -> a -> b
$
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) ]
ArchPPC_64 PPC_64ABI
ELF_V1 -> ItblCodes -> m ItblCodes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItblCodes -> m ItblCodes) -> ItblCodes -> m ItblCodes
forall a b. (a -> b) -> a -> b
$
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]
ArchPPC_64 PPC_64ABI
ELF_V2 -> ItblCodes -> m ItblCodes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItblCodes -> m ItblCodes) -> ItblCodes -> m ItblCodes
forall a b. (a -> b) -> a -> b
$
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 -> ItblCodes -> m ItblCodes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItblCodes -> m ItblCodes) -> ItblCodes -> m ItblCodes
forall a b. (a -> b) -> a -> b
$
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 ]
Arch
ArchRISCV64 -> ItblCodes -> m ItblCodes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItblCodes -> m ItblCodes) -> ItblCodes -> m ItblCodes
forall a b. (a -> b) -> a -> b
$
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
0x00000297
, HalfWord
0x01053283
, HalfWord
0x00028067
, HalfWord
0x00000013
, 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
ArchLoongArch64 -> ItblCodes -> m ItblCodes
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ItblCodes -> m ItblCodes) -> ItblCodes -> m ItblCodes
forall a b. (a -> b) -> a -> b
$
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
0x1c00000c
, HalfWord
0x28c0418c
, HalfWord
0x4c000180
, HalfWord
0x03400000
, 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
arch ->
String -> m ItblCodes
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ItblCodes) -> String -> m ItblCodes
forall a b. (a -> b) -> a -> b
$ String
"mkJumpToAddr: arch is not supported with TABLES_NEXT_TO_CODE ("
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Arch -> String
forall a. Show a => a -> String
show Arch
arch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
byte0 :: (Integral w) => w -> Word8
byte0 :: forall w. Integral w => 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 :: forall w. (Integral w, Bits w) => 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 :: forall w. (Integral w, Bits w) => 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 :: forall w. (Integral w, Bits w) => 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 :: forall w. (Integral w, Bits w) => 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 :: forall w. (Integral w, Bits w) => 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 :: forall w. (Integral w, Bits w) => 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 :: forall w. (Integral w, Bits w) => 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)
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
:: Bool -> Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable
-> IO ()
pokeConItbl :: Bool
-> Ptr StgConInfoTable
-> Ptr StgConInfoTable
-> StgConInfoTable
-> IO ()
pokeConItbl Bool
tables_next_to_code Ptr StgConInfoTable
wr_ptr Ptr StgConInfoTable
_ex_ptr StgConInfoTable
itbl = do
if Bool
tables_next_to_code
then do
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 b. Ptr b -> 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 298 "libraries/ghci/GHCi/InfoTable.hsc" #-}
else do
Ptr StgConInfoTable -> Int -> Ptr Word8 -> IO ()
forall b. Ptr b -> Int -> Ptr Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr StgConInfoTable
wr_ptr Int
itblSize (StgConInfoTable -> Ptr Word8
conDesc StgConInfoTable
itbl)
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 304 "libraries/ghci/GHCi/InfoTable.hsc" #-}
sizeOfEntryCode :: MonadFail m => Bool -> m Int
sizeOfEntryCode :: forall (m :: * -> *). MonadFail m => Bool -> m Int
sizeOfEntryCode Bool
tables_next_to_code
| Bool -> Bool
not Bool
tables_next_to_code = Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
| Bool
otherwise = do
code' <- EntryFunPtr -> m ItblCodes
forall (m :: * -> *). MonadFail m => EntryFunPtr -> m ItblCodes
mkJumpToAddr EntryFunPtr
forall a. HasCallStack => a
undefined
pure $ case code' of
Left ([Word8]
xs :: [Word8]) -> Word8 -> Int
forall a. Storable a => a -> Int
sizeOf (Word8
forall a. HasCallStack => a
undefined :: Word8) Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
xs
Right ([HalfWord]
xs :: [Word32]) -> HalfWord -> Int
forall a. Storable a => a -> Int
sizeOf (HalfWord
forall a. HasCallStack => a
undefined :: Word32) Int -> Int -> Int
forall a. Num a => a -> a -> a
* [HalfWord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HalfWord]
xs
newExecConItbl :: Bool -> StgInfoTable -> ByteString -> IO (FunPtr ())
newExecConItbl :: Bool -> StgInfoTable -> ByteString -> IO (FunPtr ())
newExecConItbl Bool
tables_next_to_code StgInfoTable
obj ByteString
con_desc = do
sz0 <- Bool -> IO Int
forall (m :: * -> *). MonadFail m => Bool -> m Int
sizeOfEntryCode Bool
tables_next_to_code
let lcon_desc = ByteString -> Int
BS.length ByteString
con_desc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
sz = Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CSize) -> Int -> CSize
forall a b. (a -> b) -> a -> b
$ Int
conInfoTableSizeB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sz0
ex_ptr <- fillExecBuffer (sz + fromIntegral lcon_desc) $ \Ptr StgConInfoTable
wr_ptr Ptr StgConInfoTable
ex_ptr -> do
let cinfo :: StgConInfoTable
cinfo = StgConInfoTable { conDesc :: Ptr Word8
conDesc = Ptr StgConInfoTable
ex_ptr Ptr StgConInfoTable -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
sz
, infoTable :: StgInfoTable
infoTable = StgInfoTable
obj }
Bool
-> Ptr StgConInfoTable
-> Ptr StgConInfoTable
-> StgConInfoTable
-> IO ()
pokeConItbl Bool
tables_next_to_code 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` CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
sz) Ptr CChar
src Int
len
let null_off :: Int
null_off = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
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)
pure $ if tables_next_to_code
then castPtrToFunPtr $ ex_ptr `plusPtr` conInfoTableSizeB
else castPtrToFunPtr ex_ptr
fillExecBuffer :: CSize -> (Ptr a -> Ptr a -> IO ()) -> IO (Ptr a)
{-# LINE 346 "libraries/ghci/GHCi/InfoTable.hsc" #-}
data ExecPage
foreign import ccall unsafe "allocateExecPage"
_allocateExecPage :: IO (Ptr ExecPage)
foreign import ccall unsafe "freezeExecPage"
_freezeExecPage :: Ptr ExecPage -> IO ()
fillExecBuffer :: forall a. CSize -> (Ptr a -> Ptr a -> IO ()) -> IO (Ptr a)
fillExecBuffer CSize
sz Ptr a -> Ptr a -> IO ()
cont
| CSize
sz CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
> CSize
4096 = String -> IO (Ptr a)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"withExecBuffer: Too large"
| Bool
otherwise = do
pg <- IO (Ptr ExecPage)
_allocateExecPage
cont (castPtr pg) (castPtr pg)
_freezeExecPage pg
return (castPtr pg)
{-# LINE 385 "libraries/ghci/GHCi/InfoTable.hsc" #-}
wORD_SIZE :: Int
wORD_SIZE :: Int
wORD_SIZE = (Int
8)
{-# LINE 391 "libraries/ghci/GHCi/InfoTable.hsc" #-}
conInfoTableSizeB :: Int
conInfoTableSizeB :: Int
conInfoTableSizeB = Int
wORD_SIZE Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
itblSize