{-# LINE 1 "src/Data/Array/Accelerate/LLVM/Native/Link/MachO.chs" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Data.Array.Accelerate.LLVM.Native.Link.MachO (
loadObject,
) where
import Data.Array.Accelerate.Error
import Data.Array.Accelerate.LLVM.Native.Link.Object
import Data.Array.Accelerate.Lifetime
import qualified Data.Array.Accelerate.Debug as Debug
import Control.Applicative
import Control.Monad
import Data.Bits
import Data.ByteString ( ByteString )
import Data.Maybe ( catMaybes )
import Data.Serialize.Get
import Data.Vector ( Vector )
import Data.Word
import Foreign.C
import Foreign.ForeignPtr
import Foreign.ForeignPtr.Unsafe
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable
import GHC.ForeignPtr ( mallocPlainForeignPtrAlignedBytes )
import GHC.Prim ( addr2Int#, int2Word# )
import GHC.Ptr ( Ptr(..) )
import GHC.Word ( Word64(..) )
import System.IO.Unsafe
import System.Posix.DynamicLinker
import Text.Printf
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Short as BS
import qualified Data.ByteString.Unsafe as B
import qualified Data.Vector as V
import Prelude as P
loadObject :: HasCallStack => ByteString -> IO (FunctionTable, ObjectCode)
loadObject :: ByteString -> IO (FunctionTable, ObjectCode)
loadObject ByteString
obj =
case ByteString -> Either String (Vector Symbol, Vector LoadSegment)
parseObject ByteString
obj of
Left String
err -> String -> IO (FunctionTable, ObjectCode)
forall a. HasCallStack => String -> a
internalError String
err
Right (Vector Symbol
symtab, Vector LoadSegment
lcs) -> HasCallStack =>
ByteString
-> Vector Symbol
-> Vector LoadSegment
-> IO (FunctionTable, ObjectCode)
ByteString
-> Vector Symbol
-> Vector LoadSegment
-> IO (FunctionTable, ObjectCode)
loadSegments ByteString
obj Vector Symbol
symtab Vector LoadSegment
lcs
loadSegments :: HasCallStack => ByteString -> Vector Symbol -> Vector LoadSegment -> IO (FunctionTable, ObjectCode)
loadSegments :: ByteString
-> Vector Symbol
-> Vector LoadSegment
-> IO (FunctionTable, ObjectCode)
loadSegments ByteString
obj Vector Symbol
symtab Vector LoadSegment
lcs = do
Vector Segment
segs <- (LoadSegment -> IO Segment)
-> Vector LoadSegment -> IO (Vector Segment)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM (HasCallStack =>
ByteString -> Vector Symbol -> LoadSegment -> IO Segment
ByteString -> Vector Symbol -> LoadSegment -> IO Segment
loadSegment ByteString
obj Vector Symbol
symtab) Vector LoadSegment
lcs
let extern :: Symbol -> Bool
extern Symbol{Bool
Word8
Word64
ByteString
sym_extern :: Symbol -> Bool
sym_segment :: Symbol -> Word8
sym_value :: Symbol -> Word64
sym_name :: Symbol -> ByteString
sym_extern :: Bool
sym_segment :: Word8
sym_value :: Word64
sym_name :: ByteString
..} = Bool
sym_extern Bool -> Bool -> Bool
&& Word8
sym_segment Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0
resolve :: Symbol -> (ShortByteString, FunPtr b)
resolve Symbol{Bool
Word8
Word64
ByteString
sym_extern :: Bool
sym_segment :: Word8
sym_value :: Word64
sym_name :: ByteString
sym_extern :: Symbol -> Bool
sym_segment :: Symbol -> Word8
sym_value :: Symbol -> Word64
sym_name :: Symbol -> ByteString
..} =
let Segment Int
_ ForeignPtr Word8
fp = Vector Segment
segs Vector Segment -> Int -> Segment
forall a. Vector a -> Int -> a
V.! (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
sym_segmentWord8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
-Word8
1))
name :: ShortByteString
name = ByteString -> ShortByteString
BS.toShort (Int -> ByteString -> ByteString
B8.take (ByteString -> Int
B8.length ByteString
sym_name Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
65) ByteString
sym_name)
addr :: FunPtr b
addr = Ptr Any -> FunPtr b
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr (ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fp Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sym_value)
in
(ShortByteString
name, FunPtr b
forall b. FunPtr b
addr)
funtab :: FunctionTable
funtab = [Function] -> FunctionTable
FunctionTable ([Function] -> FunctionTable) -> [Function] -> FunctionTable
forall a b. (a -> b) -> a -> b
$ Vector Function -> [Function]
forall a. Vector a -> [a]
V.toList (Vector Function -> [Function]) -> Vector Function -> [Function]
forall a b. (a -> b) -> a -> b
$ (Symbol -> Function) -> Vector Symbol -> Vector Function
forall a b. (a -> b) -> Vector a -> Vector b
V.map Symbol -> Function
forall b. Symbol -> (ShortByteString, FunPtr b)
resolve ((Symbol -> Bool) -> Vector Symbol -> Vector Symbol
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter Symbol -> Bool
extern Vector Symbol
symtab)
objectcode :: [Segment]
objectcode = Vector Segment -> [Segment]
forall a. Vector a -> [a]
V.toList Vector Segment
segs
ObjectCode
objectcode' <- [Segment] -> IO ObjectCode
forall a. a -> IO (Lifetime a)
newLifetime [Segment]
objectcode
ObjectCode -> IO () -> IO ()
forall a. Lifetime a -> IO () -> IO ()
addFinalizer ObjectCode
objectcode' (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Flag -> String -> IO ()
Debug.traceIO Flag
Debug.dump_gc (String
"gc: unload module: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionTable -> String
forall a. Show a => a -> String
show FunctionTable
funtab)
[Segment] -> (Segment -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Segment]
objectcode ((Segment -> IO ()) -> IO ()) -> (Segment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Segment Int
vmsize ForeignPtr Word8
oc_fp) -> do
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
oc_fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
oc_p -> do
Ptr Word8 -> Int -> Int -> IO ()
mprotect Ptr Word8
oc_p Int
vmsize (Int
0x1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0x2)
(FunctionTable, ObjectCode) -> IO (FunctionTable, ObjectCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (FunctionTable
funtab, ObjectCode
objectcode')
loadSegment :: HasCallStack => ByteString -> Vector Symbol -> LoadSegment -> IO Segment
loadSegment :: ByteString -> Vector Symbol -> LoadSegment -> IO Segment
loadSegment ByteString
obj Vector Symbol
symtab seg :: LoadSegment
seg@LoadSegment{Int
ByteString
Vector LoadSection
seg_sections :: LoadSegment -> Vector LoadSection
seg_filesize :: LoadSegment -> Int
seg_fileoff :: LoadSegment -> Int
seg_vmsize :: LoadSegment -> Int
seg_vmaddr :: LoadSegment -> Int
seg_name :: LoadSegment -> ByteString
seg_sections :: Vector LoadSection
seg_filesize :: Int
seg_fileoff :: Int
seg_vmsize :: Int
seg_vmaddr :: Int
seg_name :: ByteString
..} = do
let
pagesize :: Int
pagesize = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
c_getpagesize
pad :: a -> a -> a
pad a
align a
n = (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
align a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> a -> a
forall a. Bits a => a -> a -> a
.&. (a -> a
forall a. Bits a => a -> a
complement (a
align a -> a -> a
forall a. Num a => a -> a -> a
- a
1))
seg_vmsize' :: Int
seg_vmsize' = Int -> Int -> Int
forall a. (Bits a, Num a) => a -> a -> a
pad Int
16 Int
seg_vmsize
segsize :: Int
segsize = Int -> Int -> Int
forall a. (Bits a, Num a) => a -> a -> a
pad Int
pagesize (Int
seg_vmsize' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Vector Symbol -> Int
forall a. Vector a -> Int
V.length Vector Symbol
symtab Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16))
ForeignPtr Word8
seg_fp <- Int -> Int -> IO (ForeignPtr Word8)
forall a. Int -> Int -> IO (ForeignPtr a)
mallocPlainForeignPtrAlignedBytes Int
segsize Int
pagesize
()
_ <- ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
seg_fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
seg_p -> do
Ptr Word8 -> Word8 -> Int -> IO ()
forall a. Ptr a -> Word8 -> Int -> IO ()
fillBytes Ptr Word8
seg_p Word8
0 Int
segsize
let jump_p :: Ptr b
jump_p = Ptr Word8
seg_p Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
seg_vmsize'
(Int -> Symbol -> IO ()) -> Vector Symbol -> IO ()
forall (m :: * -> *) a b.
Monad m =>
(Int -> a -> m b) -> Vector a -> m ()
V.imapM_ (Ptr Word8 -> Int -> Symbol -> IO ()
makeJumpIsland Ptr Word8
forall b. Ptr b
jump_p) Vector Symbol
symtab
(LoadSection -> IO ()) -> Vector LoadSection -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (HasCallStack =>
ByteString
-> Vector Symbol
-> LoadSegment
-> Ptr Word8
-> Ptr Word8
-> LoadSection
-> IO ()
ByteString
-> Vector Symbol
-> LoadSegment
-> Ptr Word8
-> Ptr Word8
-> LoadSection
-> IO ()
loadSection ByteString
obj Vector Symbol
symtab LoadSegment
seg Ptr Word8
seg_p Ptr Word8
forall b. Ptr b
jump_p) Vector LoadSection
seg_sections
Ptr Word8 -> Int -> Int -> IO ()
mprotect Ptr Word8
seg_p Int
segsize (Int
0x1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
0x4)
Segment -> IO Segment
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ForeignPtr Word8 -> Segment
Segment Int
segsize ForeignPtr Word8
seg_fp)
makeJumpIsland :: Ptr Word8 -> Int -> Symbol -> IO ()
makeJumpIsland :: Ptr Word8 -> Int -> Symbol -> IO ()
makeJumpIsland Ptr Word8
jump_p Int
symbolnum Symbol{Bool
Word8
Word64
ByteString
sym_extern :: Bool
sym_segment :: Word8
sym_value :: Word64
sym_name :: ByteString
sym_extern :: Symbol -> Bool
sym_segment :: Symbol -> Word8
sym_value :: Symbol -> Word64
sym_name :: Symbol -> ByteString
..} = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
sym_extern Bool -> Bool -> Bool
&& Word8
sym_segment Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let
target :: Ptr Word64
target = Ptr Word8
jump_p Ptr Word8 -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
symbolnum Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16) :: Ptr Word64
instr :: Ptr Word8
instr = Ptr Word64
target Ptr Word64 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8 :: Ptr Word8
Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word64
target Word64
sym_value
Ptr Word8 -> [Word8] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Word8
instr [ Word8
0xFF, Word8
0x25, Word8
0xF2, Word8
0xFF, Word8
0xFF, Word8
0xFF ]
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
loadSection :: HasCallStack => ByteString -> Vector Symbol -> LoadSegment -> Ptr Word8 -> Ptr Word8 -> LoadSection -> IO ()
loadSection :: ByteString
-> Vector Symbol
-> LoadSegment
-> Ptr Word8
-> Ptr Word8
-> LoadSection
-> IO ()
loadSection ByteString
obj Vector Symbol
symtab LoadSegment
seg Ptr Word8
seg_p Ptr Word8
jump_p sec :: LoadSection
sec@LoadSection{Int
ByteString
Vector RelocationInfo
sec_relocs :: LoadSection -> Vector RelocationInfo
sec_align :: LoadSection -> Int
sec_offset :: LoadSection -> Int
sec_size :: LoadSection -> Int
sec_addr :: LoadSection -> Int
sec_segname :: LoadSection -> ByteString
sec_secname :: LoadSection -> ByteString
sec_relocs :: Vector RelocationInfo
sec_align :: Int
sec_offset :: Int
sec_size :: Int
sec_addr :: Int
sec_segname :: ByteString
sec_secname :: ByteString
..} = do
let (ForeignPtr Word8
obj_fp, Int
obj_offset, Int
_) = ByteString -> (ForeignPtr Word8, Int, Int)
B.toForeignPtr ByteString
obj
ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
obj_fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
obj_p -> do
let src :: Ptr b
src = Ptr Word8
obj_p Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
obj_offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sec_offset)
dst :: Ptr b
dst = Ptr Word8
seg_p Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
sec_addr
Ptr Any -> Ptr Any -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Any
forall b. Ptr b
dst Ptr Any
forall b. Ptr b
src Int
sec_size
(RelocationInfo -> IO ()) -> Vector RelocationInfo -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (HasCallStack =>
Vector Symbol
-> LoadSegment
-> Ptr Word8
-> Ptr Word8
-> LoadSection
-> RelocationInfo
-> IO ()
Vector Symbol
-> LoadSegment
-> Ptr Word8
-> Ptr Word8
-> LoadSection
-> RelocationInfo
-> IO ()
processRelocation Vector Symbol
symtab LoadSegment
seg Ptr Word8
seg_p Ptr Word8
jump_p LoadSection
sec) Vector RelocationInfo
sec_relocs
processRelocation :: HasCallStack => Vector Symbol -> LoadSegment -> Ptr Word8 -> Ptr Word8 -> LoadSection -> RelocationInfo -> IO ()
processRelocation :: Vector Symbol
-> LoadSegment
-> Ptr Word8
-> Ptr Word8
-> LoadSection
-> RelocationInfo
-> IO ()
processRelocation Vector Symbol
symtab LoadSegment{} Ptr Word8
seg_p Ptr Word8
jump_p LoadSection
sec RelocationInfo{Bool
Int
RelocationType
ri_type :: RelocationInfo -> RelocationType
ri_extern :: RelocationInfo -> Bool
ri_pcrel :: RelocationInfo -> Bool
ri_length :: RelocationInfo -> Int
ri_symbolnum :: RelocationInfo -> Int
ri_address :: RelocationInfo -> Int
ri_type :: RelocationType
ri_extern :: Bool
ri_pcrel :: Bool
ri_length :: Int
ri_symbolnum :: Int
ri_address :: Int
..}
| RelocationType
ri_type RelocationType -> RelocationType -> Bool
forall a. Eq a => a -> a -> Bool
== RelocationType
X86_64_RELOC_GOT Bool -> Bool -> Bool
||
RelocationType
ri_type RelocationType -> RelocationType -> Bool
forall a. Eq a => a -> a -> Bool
== RelocationType
X86_64_RELOC_GOT_LOAD
= String -> IO ()
forall a. HasCallStack => String -> a
internalError String
"Global offset table relocations not handled yet"
| Bool
ri_extern
= let value :: Word64
value = Symbol -> Word64
sym_value (Vector Symbol
symtab Vector Symbol -> Int -> Symbol
forall a. Vector a -> Int -> a
V.! Int
ri_symbolnum)
value_rel :: Word64
value_rel = Word64
value Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
pc' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
2 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
ri_length
in
case Bool
ri_pcrel of
Bool
False -> Word64 -> IO ()
relocate Word64
value
Bool
True -> if (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
value_rel::Word32) :: Word64) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
value_rel
then Word64 -> IO ()
relocate Word64
value_rel
else do
let value' :: Word64
value' = Ptr Any -> Word64
forall a. Ptr a -> Word64
castPtrToWord64 (Ptr Word8
jump_p Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
ri_symbolnum Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8))
value'_rel :: Word64
value'_rel = Word64
value' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
pc' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
2 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
ri_length
Word64 -> IO ()
relocate Word64
value'_rel
| Bool
otherwise
= () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
pc :: Ptr Word8
pc :: Ptr Word8
pc = Ptr Word8
seg_p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (LoadSection -> Int
sec_addr LoadSection
sec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ri_address)
pc' :: Word64
pc' = Ptr Word8 -> Word64
forall a. Ptr a -> Word64
castPtrToWord64 Ptr Word8
pc
addend :: (Integral a, Storable a) => Ptr a -> Word64 -> IO a
addend :: Ptr a -> Word64 -> IO a
addend Ptr a
p Word64
x = do
a
base <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
case RelocationType
ri_type of
RelocationType
X86_64_RELOC_SUBTRACTOR -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
base Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
x)
RelocationType
_ -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
base Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
x)
relocate :: Word64 -> IO ()
relocate :: Word64 -> IO ()
relocate Word64
x =
case Int
ri_length of
Int
0 -> let p' :: Ptr Word8
p' = Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
pc :: Ptr Word8 in Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
p' (Word8 -> IO ()) -> IO Word8 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Word8 -> Word64 -> IO Word8
forall a. (Integral a, Storable a) => Ptr a -> Word64 -> IO a
addend Ptr Word8
p' Word64
x
Int
1 -> let p' :: Ptr Word16
p' = Ptr Word8 -> Ptr Word16
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
pc :: Ptr Word16 in Ptr Word16 -> Word16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word16
p' (Word16 -> IO ()) -> IO Word16 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Word16 -> Word64 -> IO Word16
forall a. (Integral a, Storable a) => Ptr a -> Word64 -> IO a
addend Ptr Word16
p' Word64
x
Int
2 -> let p' :: Ptr Word32
p' = Ptr Word8 -> Ptr Word32
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
pc :: Ptr Word32 in Ptr Word32 -> Word32 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word32
p' (Word32 -> IO ()) -> IO Word32 -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Word32 -> Word64 -> IO Word32
forall a. (Integral a, Storable a) => Ptr a -> Word64 -> IO a
addend Ptr Word32
p' Word64
x
Int
_ -> String -> IO ()
forall a. HasCallStack => String -> a
internalError String
"unhandled relocation size"
data Peek = Peek
{ Peek -> Bool
is64Bit :: !Bool
, Peek -> Get Word16
getWord16 :: !(Get Word16)
, Peek -> Get Word32
getWord32 :: !(Get Word32)
, Peek -> Get Word64
getWord64 :: !(Get Word64)
}
data LoadCommand
= LC_Segment {-# UNPACK #-} !LoadSegment
| LC_SymbolTable {-# UNPACK #-} !(Vector Symbol)
data LoadSegment = LoadSegment
{ LoadSegment -> ByteString
seg_name :: {-# UNPACK #-} !ByteString
, LoadSegment -> Int
seg_vmaddr :: {-# UNPACK #-} !Int
, LoadSegment -> Int
seg_vmsize :: {-# UNPACK #-} !Int
, LoadSegment -> Int
seg_fileoff :: {-# UNPACK #-} !Int
, LoadSegment -> Int
seg_filesize :: {-# UNPACK #-} !Int
, LoadSegment -> Vector LoadSection
seg_sections :: {-# UNPACK #-} !(Vector LoadSection)
}
deriving Int -> LoadSegment -> String -> String
[LoadSegment] -> String -> String
LoadSegment -> String
(Int -> LoadSegment -> String -> String)
-> (LoadSegment -> String)
-> ([LoadSegment] -> String -> String)
-> Show LoadSegment
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LoadSegment] -> String -> String
$cshowList :: [LoadSegment] -> String -> String
show :: LoadSegment -> String
$cshow :: LoadSegment -> String
showsPrec :: Int -> LoadSegment -> String -> String
$cshowsPrec :: Int -> LoadSegment -> String -> String
Show
data LoadSection = LoadSection
{ LoadSection -> ByteString
sec_secname :: {-# UNPACK #-} !ByteString
, LoadSection -> ByteString
sec_segname :: {-# UNPACK #-} !ByteString
, LoadSection -> Int
sec_addr :: {-# UNPACK #-} !Int
, LoadSection -> Int
sec_size :: {-# UNPACK #-} !Int
, LoadSection -> Int
sec_offset :: {-# UNPACK #-} !Int
, LoadSection -> Int
sec_align :: {-# UNPACK #-} !Int
, LoadSection -> Vector RelocationInfo
sec_relocs :: {-# UNPACK #-} !(Vector RelocationInfo)
}
deriving Int -> LoadSection -> String -> String
[LoadSection] -> String -> String
LoadSection -> String
(Int -> LoadSection -> String -> String)
-> (LoadSection -> String)
-> ([LoadSection] -> String -> String)
-> Show LoadSection
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LoadSection] -> String -> String
$cshowList :: [LoadSection] -> String -> String
show :: LoadSection -> String
$cshow :: LoadSection -> String
showsPrec :: Int -> LoadSection -> String -> String
$cshowsPrec :: Int -> LoadSection -> String -> String
Show
data RelocationInfo = RelocationInfo
{ RelocationInfo -> Int
ri_address :: {-# UNPACK #-} !Int
, RelocationInfo -> Int
ri_symbolnum :: {-# UNPACK #-} !Int
, RelocationInfo -> Int
ri_length :: {-# UNPACK #-} !Int
, RelocationInfo -> Bool
ri_pcrel :: !Bool
, RelocationInfo -> Bool
ri_extern :: !Bool
, RelocationInfo -> RelocationType
ri_type :: !RelocationType
}
deriving Int -> RelocationInfo -> String -> String
[RelocationInfo] -> String -> String
RelocationInfo -> String
(Int -> RelocationInfo -> String -> String)
-> (RelocationInfo -> String)
-> ([RelocationInfo] -> String -> String)
-> Show RelocationInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RelocationInfo] -> String -> String
$cshowList :: [RelocationInfo] -> String -> String
show :: RelocationInfo -> String
$cshow :: RelocationInfo -> String
showsPrec :: Int -> RelocationInfo -> String -> String
$cshowsPrec :: Int -> RelocationInfo -> String -> String
Show
data Symbol = Symbol
{ Symbol -> ByteString
sym_name :: {-# UNPACK #-} !ByteString
, Symbol -> Word64
sym_value :: {-# UNPACK #-} !Word64
, Symbol -> Word8
sym_segment :: {-# UNPACK #-} !Word8
, Symbol -> Bool
sym_extern :: !Bool
}
deriving Int -> Symbol -> String -> String
[Symbol] -> String -> String
Symbol -> String
(Int -> Symbol -> String -> String)
-> (Symbol -> String)
-> ([Symbol] -> String -> String)
-> Show Symbol
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Symbol] -> String -> String
$cshowList :: [Symbol] -> String -> String
show :: Symbol -> String
$cshow :: Symbol -> String
showsPrec :: Int -> Symbol -> String -> String
$cshowsPrec :: Int -> Symbol -> String -> String
Show
data RelocationType = X86_64_RELOC_UNSIGNED
| X86_64_RELOC_SIGNED
| X86_64_RELOC_BRANCH
| X86_64_RELOC_GOT_LOAD
| X86_64_RELOC_GOT
| X86_64_RELOC_SUBTRACTOR
| X86_64_RELOC_SIGNED_1
| X86_64_RELOC_SIGNED_2
| X86_64_RELOC_SIGNED_4
| X86_64_RELOC_TLV
deriving (Int -> RelocationType
RelocationType -> Int
RelocationType -> [RelocationType]
RelocationType -> RelocationType
RelocationType -> RelocationType -> [RelocationType]
RelocationType
-> RelocationType -> RelocationType -> [RelocationType]
(RelocationType -> RelocationType)
-> (RelocationType -> RelocationType)
-> (Int -> RelocationType)
-> (RelocationType -> Int)
-> (RelocationType -> [RelocationType])
-> (RelocationType -> RelocationType -> [RelocationType])
-> (RelocationType -> RelocationType -> [RelocationType])
-> (RelocationType
-> RelocationType -> RelocationType -> [RelocationType])
-> Enum RelocationType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: RelocationType
-> RelocationType -> RelocationType -> [RelocationType]
$cenumFromThenTo :: RelocationType
-> RelocationType -> RelocationType -> [RelocationType]
enumFromTo :: RelocationType -> RelocationType -> [RelocationType]
$cenumFromTo :: RelocationType -> RelocationType -> [RelocationType]
enumFromThen :: RelocationType -> RelocationType -> [RelocationType]
$cenumFromThen :: RelocationType -> RelocationType -> [RelocationType]
enumFrom :: RelocationType -> [RelocationType]
$cenumFrom :: RelocationType -> [RelocationType]
fromEnum :: RelocationType -> Int
$cfromEnum :: RelocationType -> Int
toEnum :: Int -> RelocationType
$ctoEnum :: Int -> RelocationType
pred :: RelocationType -> RelocationType
$cpred :: RelocationType -> RelocationType
succ :: RelocationType -> RelocationType
$csucc :: RelocationType -> RelocationType
Enum,RelocationType -> RelocationType -> Bool
(RelocationType -> RelocationType -> Bool)
-> (RelocationType -> RelocationType -> Bool) -> Eq RelocationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelocationType -> RelocationType -> Bool
$c/= :: RelocationType -> RelocationType -> Bool
== :: RelocationType -> RelocationType -> Bool
$c== :: RelocationType -> RelocationType -> Bool
Eq,Int -> RelocationType -> String -> String
[RelocationType] -> String -> String
RelocationType -> String
(Int -> RelocationType -> String -> String)
-> (RelocationType -> String)
-> ([RelocationType] -> String -> String)
-> Show RelocationType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RelocationType] -> String -> String
$cshowList :: [RelocationType] -> String -> String
show :: RelocationType -> String
$cshow :: RelocationType -> String
showsPrec :: Int -> RelocationType -> String -> String
$cshowsPrec :: Int -> RelocationType -> String -> String
Show)
{-# LINE 346 "src/Data/Array/Accelerate/LLVM/Native/Link/MachO.chs" #-}
parseObject :: ByteString -> Either String (Vector Symbol, Vector LoadSegment)
parseObject :: ByteString -> Either String (Vector Symbol, Vector LoadSegment)
parseObject ByteString
obj = do
((Peek
p, Int
ncmd, Int
_), ByteString
rest) <- Get (Peek, Int, Int)
-> ByteString
-> Int
-> Either String ((Peek, Int, Int), ByteString)
forall a.
Get a -> ByteString -> Int -> Either String (a, ByteString)
runGetState Get (Peek, Int, Int)
readHeader ByteString
obj Int
0
[LoadCommand]
cmds <- [Maybe LoadCommand] -> [LoadCommand]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe LoadCommand] -> [LoadCommand])
-> Either String [Maybe LoadCommand] -> Either String [LoadCommand]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Maybe LoadCommand]
-> ByteString -> Either String [Maybe LoadCommand]
forall a. Get a -> ByteString -> Either String a
runGet (Int -> Get (Maybe LoadCommand) -> Get [Maybe LoadCommand]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
ncmd (Peek -> ByteString -> Get (Maybe LoadCommand)
readLoadCommand Peek
p ByteString
obj)) ByteString
rest
let
lc :: [LoadSegment]
lc = [ LoadSegment
x | LC_Segment LoadSegment
x <- [LoadCommand]
cmds ]
st :: [Vector Symbol]
st = [ Vector Symbol
x | LC_SymbolTable Vector Symbol
x <- [LoadCommand]
cmds ]
(Vector Symbol, Vector LoadSegment)
-> Either String (Vector Symbol, Vector LoadSegment)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Vector Symbol] -> Vector Symbol
forall a. [Vector a] -> Vector a
V.concat [Vector Symbol]
st, Int -> [LoadSegment] -> Vector LoadSegment
forall a. Int -> [a] -> Vector a
V.fromListN Int
ncmd [LoadSegment]
lc)
readHeader :: Get (Peek, Int, Int)
= do
Word32
magic <- Get Word32
getWord32le
p :: Peek
p@Peek{Bool
Get Word16
Get Word32
Get Word64
getWord64 :: Get Word64
getWord32 :: Get Word32
getWord16 :: Get Word16
is64Bit :: Bool
getWord64 :: Peek -> Get Word64
getWord32 :: Peek -> Get Word32
getWord16 :: Peek -> Get Word16
is64Bit :: Peek -> Bool
..} <- case Word32
magic of
Word32
0xfeedface -> Peek -> Get Peek
forall (m :: * -> *) a. Monad m => a -> m a
return (Peek -> Get Peek) -> Peek -> Get Peek
forall a b. (a -> b) -> a -> b
$ Bool -> Get Word16 -> Get Word32 -> Get Word64 -> Peek
Peek Bool
False Get Word16
getWord16le Get Word32
getWord32le Get Word64
getWord64le
Word32
0xcefaedfe -> Peek -> Get Peek
forall (m :: * -> *) a. Monad m => a -> m a
return (Peek -> Get Peek) -> Peek -> Get Peek
forall a b. (a -> b) -> a -> b
$ Bool -> Get Word16 -> Get Word32 -> Get Word64 -> Peek
Peek Bool
False Get Word16
getWord16be Get Word32
getWord32be Get Word64
getWord64be
Word32
0xfeedfacf -> Peek -> Get Peek
forall (m :: * -> *) a. Monad m => a -> m a
return (Peek -> Get Peek) -> Peek -> Get Peek
forall a b. (a -> b) -> a -> b
$ Bool -> Get Word16 -> Get Word32 -> Get Word64 -> Peek
Peek Bool
True Get Word16
getWord16le Get Word32
getWord32le Get Word64
getWord64le
Word32
0xcffaedfe -> Peek -> Get Peek
forall (m :: * -> *) a. Monad m => a -> m a
return (Peek -> Get Peek) -> Peek -> Get Peek
forall a b. (a -> b) -> a -> b
$ Bool -> Get Word16 -> Get Word32 -> Get Word64 -> Peek
Peek Bool
True Get Word16
getWord16be Get Word32
getWord32be Get Word64
getWord64be
Word32
m -> String -> Get Peek
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
"unknown magic: %x" Word32
m)
Word32
cpu_type <- Get Word32
getWord32
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
cpu_type Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0x1000007) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected x86_64 object file"
Int -> Get ()
skip Int
4
{-# LINE 404 "src/Data/Array/Accelerate/LLVM/Native/Link/MachO.chs" #-}
Word32
filetype <- Get Word32
getWord32
case Word32
filetype of
Word32
0x1 -> () -> Get ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Word32
_ -> String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected object file"
Int
ncmds <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
sizeofcmds <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int -> Get ()
skip (Int -> Get ()) -> Int -> Get ()
forall a b. (a -> b) -> a -> b
$ case Bool
is64Bit of
Bool
True -> Int
8
Bool
False -> Int
4
(Peek, Int, Int) -> Get (Peek, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Peek
p, Int
ncmds, Int
sizeofcmds)
readLoadCommand :: Peek -> ByteString -> Get (Maybe LoadCommand)
readLoadCommand :: Peek -> ByteString -> Get (Maybe LoadCommand)
readLoadCommand p :: Peek
p@Peek{Bool
Get Word16
Get Word32
Get Word64
getWord64 :: Get Word64
getWord32 :: Get Word32
getWord16 :: Get Word16
is64Bit :: Bool
getWord64 :: Peek -> Get Word64
getWord32 :: Peek -> Get Word32
getWord16 :: Peek -> Get Word16
is64Bit :: Peek -> Bool
..} ByteString
obj = do
Word32
cmd <- Get Word32
getWord32
Int
cmdsize <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
let required :: Bool
required = Word32 -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Word32 -> Bool) -> Word32 -> Bool
forall a b. (a -> b) -> a -> b
$ Word32
cmd Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x80000000
{-# LINE 433 "src/Data/Array/Accelerate/LLVM/Native/Link/MachO.chs" #-}
case Word32
cmd Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. (Word32 -> Word32
forall a. Bits a => a -> a
complement Word32
0x80000000) of
Word32
0x1 -> LoadCommand -> Maybe LoadCommand
forall a. a -> Maybe a
Just (LoadCommand -> Maybe LoadCommand)
-> (LoadSegment -> LoadCommand) -> LoadSegment -> Maybe LoadCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadSegment -> LoadCommand
LC_Segment (LoadSegment -> Maybe LoadCommand)
-> Get LoadSegment -> Get (Maybe LoadCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peek -> ByteString -> Get LoadSegment
readLoadSegment Peek
p ByteString
obj
Word32
0x19 -> LoadCommand -> Maybe LoadCommand
forall a. a -> Maybe a
Just (LoadCommand -> Maybe LoadCommand)
-> (LoadSegment -> LoadCommand) -> LoadSegment -> Maybe LoadCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoadSegment -> LoadCommand
LC_Segment (LoadSegment -> Maybe LoadCommand)
-> Get LoadSegment -> Get (Maybe LoadCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peek -> ByteString -> Get LoadSegment
readLoadSegment Peek
p ByteString
obj
Word32
0x2 -> LoadCommand -> Maybe LoadCommand
forall a. a -> Maybe a
Just (LoadCommand -> Maybe LoadCommand)
-> (Vector Symbol -> LoadCommand)
-> Vector Symbol
-> Maybe LoadCommand
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Symbol -> LoadCommand
LC_SymbolTable (Vector Symbol -> Maybe LoadCommand)
-> Get (Vector Symbol) -> Get (Maybe LoadCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peek -> ByteString -> Get (Vector Symbol)
readLoadSymbolTable Peek
p ByteString
obj
Word32
0xb -> Maybe LoadCommand -> () -> Maybe LoadCommand
forall a b. a -> b -> a
const Maybe LoadCommand
forall a. Maybe a
Nothing (() -> Maybe LoadCommand) -> Get () -> Get (Maybe LoadCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peek -> ByteString -> Get ()
readDynamicSymbolTable Peek
p ByteString
obj
Word32
0xc -> String -> Get (Maybe LoadCommand)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unhandled LC_LOAD_DYLIB"
Word32
this -> do if Bool
required
then String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
"unknown load command required for execution: 0x%x" Word32
this)
else String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
"skipping load command: 0x%x" Word32
this)
Int -> Get ()
skip (Int
cmdsize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8)
Maybe LoadCommand -> Get (Maybe LoadCommand)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LoadCommand
forall a. Maybe a
Nothing
readLoadSegment :: Peek -> ByteString -> Get LoadSegment
readLoadSegment :: Peek -> ByteString -> Get LoadSegment
readLoadSegment p :: Peek
p@Peek{Bool
Get Word16
Get Word32
Get Word64
getWord64 :: Get Word64
getWord32 :: Get Word32
getWord16 :: Get Word16
is64Bit :: Bool
getWord64 :: Peek -> Get Word64
getWord32 :: Peek -> Get Word32
getWord16 :: Peek -> Get Word16
is64Bit :: Peek -> Bool
..} ByteString
obj =
if Bool
is64Bit
then Peek -> ByteString -> Get LoadSegment
readLoadSegment64 Peek
p ByteString
obj
else Peek -> ByteString -> Get LoadSegment
readLoadSegment32 Peek
p ByteString
obj
readLoadSegment32 :: Peek -> ByteString -> Get LoadSegment
readLoadSegment32 :: Peek -> ByteString -> Get LoadSegment
readLoadSegment32 p :: Peek
p@Peek{Bool
Get Word16
Get Word32
Get Word64
getWord64 :: Get Word64
getWord32 :: Get Word32
getWord16 :: Get Word16
is64Bit :: Bool
getWord64 :: Peek -> Get Word64
getWord32 :: Peek -> Get Word32
getWord16 :: Peek -> Get Word16
is64Bit :: Peek -> Bool
..} ByteString
obj = do
ByteString
name <- (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
16
Int
vmaddr <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
vmsize <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
fileoff <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
filesize <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int -> Get ()
skip (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
Int
nsect <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int -> Get ()
skip Int
4
String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"LC_SEGMENT: Mem: 0x%09x-0x09%x" Int
vmaddr (Int
vmaddr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vmsize))
Vector LoadSection
secs <- Int -> Get LoadSection -> Get (Vector LoadSection)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
nsect (Peek -> ByteString -> Get LoadSection
readLoadSection32 Peek
p ByteString
obj)
LoadSegment -> Get LoadSegment
forall (m :: * -> *) a. Monad m => a -> m a
return LoadSegment :: ByteString
-> Int -> Int -> Int -> Int -> Vector LoadSection -> LoadSegment
LoadSegment
{ seg_name :: ByteString
seg_name = ByteString
name
, seg_vmaddr :: Int
seg_vmaddr = Int
vmaddr
, seg_vmsize :: Int
seg_vmsize = Int
vmsize
, seg_fileoff :: Int
seg_fileoff = Int
fileoff
, seg_filesize :: Int
seg_filesize = Int
filesize
, seg_sections :: Vector LoadSection
seg_sections = Vector LoadSection
secs
}
readLoadSegment64 :: Peek -> ByteString -> Get LoadSegment
readLoadSegment64 :: Peek -> ByteString -> Get LoadSegment
readLoadSegment64 p :: Peek
p@Peek{Bool
Get Word16
Get Word32
Get Word64
getWord64 :: Get Word64
getWord32 :: Get Word32
getWord16 :: Get Word16
is64Bit :: Bool
getWord64 :: Peek -> Get Word64
getWord32 :: Peek -> Get Word32
getWord16 :: Peek -> Get Word16
is64Bit :: Peek -> Bool
..} ByteString
obj = do
ByteString
name <- (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
16
Int
vmaddr <- Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Get Word64 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64
Int
vmsize <- Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Get Word64 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64
Int
fileoff <- Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Get Word64 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64
Int
filesize <- Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Get Word64 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64
Int -> Get ()
skip (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4)
Int
nsect <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int -> Get ()
skip Int
4
String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"LC_SEGMENT_64: Mem: 0x%09x-0x%09x" Int
vmaddr (Int
vmaddr Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vmsize))
Vector LoadSection
secs <- Int -> Get LoadSection -> Get (Vector LoadSection)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
nsect (Peek -> ByteString -> Get LoadSection
readLoadSection64 Peek
p ByteString
obj)
LoadSegment -> Get LoadSegment
forall (m :: * -> *) a. Monad m => a -> m a
return LoadSegment :: ByteString
-> Int -> Int -> Int -> Int -> Vector LoadSection -> LoadSegment
LoadSegment
{ seg_name :: ByteString
seg_name = ByteString
name
, seg_vmaddr :: Int
seg_vmaddr = Int
vmaddr
, seg_vmsize :: Int
seg_vmsize = Int
vmsize
, seg_fileoff :: Int
seg_fileoff = Int
fileoff
, seg_filesize :: Int
seg_filesize = Int
filesize
, seg_sections :: Vector LoadSection
seg_sections = Vector LoadSection
secs
}
readLoadSection32 :: Peek -> ByteString -> Get LoadSection
readLoadSection32 :: Peek -> ByteString -> Get LoadSection
readLoadSection32 p :: Peek
p@Peek{Bool
Get Word16
Get Word32
Get Word64
getWord64 :: Get Word64
getWord32 :: Get Word32
getWord16 :: Get Word16
is64Bit :: Bool
getWord64 :: Peek -> Get Word64
getWord32 :: Peek -> Get Word32
getWord16 :: Peek -> Get Word16
is64Bit :: Peek -> Bool
..} ByteString
obj = do
ByteString
secname <- (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
16
ByteString
segname <- (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
16
Int
addr <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
size <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
offset <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
align <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
reloff <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
nreloc <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int -> Get ()
skip Int
12
String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> Int -> Int -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
" Mem: 0x%09x-0x%09x %s.%s" Int
addr (Int
addrInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
size) (ByteString -> String
B8.unpack ByteString
segname) (ByteString -> String
B8.unpack ByteString
secname))
Vector RelocationInfo
relocs <- (String -> Get (Vector RelocationInfo))
-> (Vector RelocationInfo -> Get (Vector RelocationInfo))
-> Either String (Vector RelocationInfo)
-> Get (Vector RelocationInfo)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get (Vector RelocationInfo)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Vector RelocationInfo -> Get (Vector RelocationInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Vector RelocationInfo)
-> Get (Vector RelocationInfo))
-> Either String (Vector RelocationInfo)
-> Get (Vector RelocationInfo)
forall a b. (a -> b) -> a -> b
$ Get (Vector RelocationInfo)
-> ByteString -> Either String (Vector RelocationInfo)
forall a. Get a -> ByteString -> Either String a
runGet (Int -> Get RelocationInfo -> Get (Vector RelocationInfo)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
nreloc (Peek -> Get RelocationInfo
loadRelocation Peek
p)) (Int -> ByteString -> ByteString
B.drop Int
reloff ByteString
obj)
LoadSection -> Get LoadSection
forall (m :: * -> *) a. Monad m => a -> m a
return LoadSection :: ByteString
-> ByteString
-> Int
-> Int
-> Int
-> Int
-> Vector RelocationInfo
-> LoadSection
LoadSection
{ sec_secname :: ByteString
sec_secname = ByteString
secname
, sec_segname :: ByteString
sec_segname = ByteString
segname
, sec_addr :: Int
sec_addr = Int
addr
, sec_size :: Int
sec_size = Int
size
, sec_offset :: Int
sec_offset = Int
offset
, sec_align :: Int
sec_align = Int
align
, sec_relocs :: Vector RelocationInfo
sec_relocs = Vector RelocationInfo
relocs
}
readLoadSection64 :: Peek -> ByteString -> Get LoadSection
readLoadSection64 :: Peek -> ByteString -> Get LoadSection
readLoadSection64 p :: Peek
p@Peek{Bool
Get Word16
Get Word32
Get Word64
getWord64 :: Get Word64
getWord32 :: Get Word32
getWord16 :: Get Word16
is64Bit :: Bool
getWord64 :: Peek -> Get Word64
getWord32 :: Peek -> Get Word32
getWord16 :: Peek -> Get Word16
is64Bit :: Peek -> Bool
..} ByteString
obj = do
ByteString
secname <- (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
16
ByteString
segname <- (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getBytes Int
16
Int
addr <- Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Get Word64 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64
Int
size <- Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Get Word64 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64
Int
offset <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
align <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
reloff <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
nreloc <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int -> Get ()
skip Int
16
String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> Int -> Int -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
" Mem: 0x%09x-0x%09x %s.%s" Int
addr (Int
addrInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
size) (ByteString -> String
B8.unpack ByteString
segname) (ByteString -> String
B8.unpack ByteString
secname))
Vector RelocationInfo
relocs <- (String -> Get (Vector RelocationInfo))
-> (Vector RelocationInfo -> Get (Vector RelocationInfo))
-> Either String (Vector RelocationInfo)
-> Get (Vector RelocationInfo)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get (Vector RelocationInfo)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Vector RelocationInfo -> Get (Vector RelocationInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Vector RelocationInfo)
-> Get (Vector RelocationInfo))
-> Either String (Vector RelocationInfo)
-> Get (Vector RelocationInfo)
forall a b. (a -> b) -> a -> b
$ Get (Vector RelocationInfo)
-> ByteString -> Either String (Vector RelocationInfo)
forall a. Get a -> ByteString -> Either String a
runGet (Int -> Get RelocationInfo -> Get (Vector RelocationInfo)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
nreloc (Peek -> Get RelocationInfo
loadRelocation Peek
p)) (Int -> ByteString -> ByteString
B.drop Int
reloff ByteString
obj)
LoadSection -> Get LoadSection
forall (m :: * -> *) a. Monad m => a -> m a
return LoadSection :: ByteString
-> ByteString
-> Int
-> Int
-> Int
-> Int
-> Vector RelocationInfo
-> LoadSection
LoadSection
{ sec_secname :: ByteString
sec_secname = ByteString
secname
, sec_segname :: ByteString
sec_segname = ByteString
segname
, sec_addr :: Int
sec_addr = Int
addr
, sec_size :: Int
sec_size = Int
size
, sec_offset :: Int
sec_offset = Int
offset
, sec_align :: Int
sec_align = Int
align
, sec_relocs :: Vector RelocationInfo
sec_relocs = Vector RelocationInfo
relocs
}
loadRelocation :: Peek -> Get RelocationInfo
loadRelocation :: Peek -> Get RelocationInfo
loadRelocation Peek{Bool
Get Word16
Get Word32
Get Word64
getWord64 :: Get Word64
getWord32 :: Get Word32
getWord16 :: Get Word16
is64Bit :: Bool
getWord64 :: Peek -> Get Word64
getWord32 :: Peek -> Get Word32
getWord16 :: Peek -> Get Word16
is64Bit :: Peek -> Bool
..} = do
Int
addr <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Word32
val <- Get Word32
getWord32
let symbol :: Word32
symbol = Word32
val Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFFFFFF
pcrel :: Bool
pcrel = Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
val Int
24
extern :: Bool
extern = Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
val Int
27
len :: Word32
len = (Word32
val Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
25) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x3
rtype :: Word32
rtype = (Word32
val Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
28) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xF
rtype' :: RelocationType
rtype' = Int -> RelocationType
forall a. Enum a => Int -> a
toEnum (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
rtype)
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ Int
addr Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x80000000) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unhandled scatted relocation info"
String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String
-> Int -> String -> Word32 -> Word32 -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
" Reloc: 0x%04x to %s %d: length=%d, pcrel=%s, type=%s" Int
addr (if Bool
extern then String
"symbol" else String
"section") Word32
symbol Word32
len (Bool -> String
forall a. Show a => a -> String
show Bool
pcrel) (RelocationType -> String
forall a. Show a => a -> String
show RelocationType
rtype'))
RelocationInfo -> Get RelocationInfo
forall (m :: * -> *) a. Monad m => a -> m a
return RelocationInfo :: Int
-> Int -> Int -> Bool -> Bool -> RelocationType -> RelocationInfo
RelocationInfo
{ ri_address :: Int
ri_address = Int
addr
, ri_symbolnum :: Int
ri_symbolnum = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
symbol
, ri_pcrel :: Bool
ri_pcrel = Bool
pcrel
, ri_extern :: Bool
ri_extern = Bool
extern
, ri_length :: Int
ri_length = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
len
, ri_type :: RelocationType
ri_type = RelocationType
rtype'
}
readLoadSymbolTable :: Peek -> ByteString -> Get (Vector Symbol)
readLoadSymbolTable :: Peek -> ByteString -> Get (Vector Symbol)
readLoadSymbolTable p :: Peek
p@Peek{Bool
Get Word16
Get Word32
Get Word64
getWord64 :: Get Word64
getWord32 :: Get Word32
getWord16 :: Get Word16
is64Bit :: Bool
getWord64 :: Peek -> Get Word64
getWord32 :: Peek -> Get Word32
getWord16 :: Peek -> Get Word16
is64Bit :: Peek -> Bool
..} ByteString
obj = do
Int
symoff <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
nsyms <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Int
stroff <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Word32
strsize <- Get Word32
getWord32
String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message String
"LC_SYMTAB"
String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> Int -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
" symbol table is at offset 0x%x (%d), %d entries" Int
symoff Int
symoff Int
nsyms)
String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> Int -> Int -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
" string table is at offset 0x%x (%d), %d bytes" Int
stroff Int
stroff Word32
strsize)
let symbols :: ByteString
symbols = Int -> ByteString -> ByteString
B.drop Int
symoff ByteString
obj
strtab :: ByteString
strtab = Int -> ByteString -> ByteString
B.drop Int
stroff ByteString
obj
(String -> Get (Vector Symbol))
-> (Vector Symbol -> Get (Vector Symbol))
-> Either String (Vector Symbol)
-> Get (Vector Symbol)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Get (Vector Symbol)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Vector Symbol -> Get (Vector Symbol)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (Vector Symbol) -> Get (Vector Symbol))
-> Either String (Vector Symbol) -> Get (Vector Symbol)
forall a b. (a -> b) -> a -> b
$ Get (Vector Symbol) -> ByteString -> Either String (Vector Symbol)
forall a. Get a -> ByteString -> Either String a
runGet (Int -> Get Symbol -> Get (Vector Symbol)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
nsyms (Peek -> ByteString -> Get Symbol
loadSymbol Peek
p ByteString
strtab)) ByteString
symbols
readDynamicSymbolTable :: Peek -> ByteString -> Get ()
readDynamicSymbolTable :: Peek -> ByteString -> Get ()
readDynamicSymbolTable Peek{Bool
Get Word16
Get Word32
Get Word64
getWord64 :: Get Word64
getWord32 :: Get Word32
getWord16 :: Get Word16
is64Bit :: Bool
getWord64 :: Peek -> Get Word64
getWord32 :: Peek -> Get Word32
getWord16 :: Peek -> Get Word16
is64Bit :: Peek -> Bool
..} ByteString
_obj = do
if Bool -> Bool
not Bool
Debug.debuggingIsEnabled
then Int -> Get ()
skip (Int
80 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8)
else do
Word32
ilocalsym <- Get Word32
getWord32
Word32
nlocalsym <- Get Word32
getWord32
Word32
iextdefsym <- Get Word32
getWord32
Word32
nextdefsym <- Get Word32
getWord32
Word32
iundefsym <- Get Word32
getWord32
Word32
nundefsym <- Get Word32
getWord32
Int -> Get ()
skip Int
4
Word32
ntoc <- Get Word32
getWord32
Int -> Get ()
skip Int
4
Word32
nmodtab <- Get Word32
getWord32
Int -> Get ()
skip Int
12
Word32
nindirectsyms <- Get Word32
getWord32
Int -> Get ()
skip Int
16
String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message String
"LC_DYSYMTAB:"
if Word32
nlocalsym Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
then String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> Word32 -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
" %d local symbols at index %d" Word32
nlocalsym Word32
ilocalsym)
else String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> String
forall r. PrintfType r => String -> r
printf String
" No local symbols")
if Word32
nextdefsym Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
then String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> Word32 -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
" %d external symbols at index %d" Word32
nextdefsym Word32
iextdefsym)
else String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> String
forall r. PrintfType r => String -> r
printf String
" No external symbols")
if Word32
nundefsym Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
then String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> Word32 -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
" %d undefined symbols at index %d" Word32
nundefsym Word32
iundefsym)
else String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> String
forall r. PrintfType r => String -> r
printf String
" No undefined symbols")
if Word32
ntoc Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
then String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
" %d table of contents entries" Word32
ntoc)
else String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> String
forall r. PrintfType r => String -> r
printf String
" No table of contents")
if Word32
nmodtab Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
then String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
" %d module table entries" Word32
nmodtab)
else String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> String
forall r. PrintfType r => String -> r
printf String
" No module table")
if Word32
nindirectsyms Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
then String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> Word32 -> String
forall r. PrintfType r => String -> r
printf String
" %d indirect symbols" Word32
nindirectsyms)
else String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> String
forall r. PrintfType r => String -> r
printf String
" No indirect symbols")
loadSymbol :: Peek -> ByteString -> Get Symbol
loadSymbol :: Peek -> ByteString -> Get Symbol
loadSymbol Peek{Bool
Get Word16
Get Word32
Get Word64
getWord64 :: Get Word64
getWord32 :: Get Word32
getWord16 :: Get Word16
is64Bit :: Bool
getWord64 :: Peek -> Get Word64
getWord32 :: Peek -> Get Word32
getWord16 :: Peek -> Get Word16
is64Bit :: Peek -> Bool
..} ByteString
strtab = do
Int
n_strx <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
Word8
n_flag <- Get Word8
getWord8
Word8
n_sect <- Get Word8
getWord8
Int -> Get ()
skip Int
2
Word64
n_value <- case Bool
is64Bit of
Bool
True -> Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> Get Word64 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64
Bool
False -> Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32
let
str :: ByteString
str | Int
n_strx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = ByteString
B.empty
| Bool
otherwise = (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (Int -> ByteString -> ByteString
B.drop Int
n_strx ByteString
strtab)
name :: ByteString
name
| ByteString -> Int
B.length ByteString
str Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& ByteString -> Char
B8.head ByteString
str Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' = ByteString -> ByteString
B.tail ByteString
str
| Bool
otherwise = ByteString
str
n_stab :: Word8
n_stab = Word8
n_flag Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xe0
n_type :: Word8
n_type = Word8
n_flag Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xe
n_ext :: Word8
n_ext = Word8
n_flag Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x1
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
n_stab Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unhandled symbolic debugging entry (stab)"
case Word8
n_type of
Word8
0x0 -> do
FunPtr ()
funptr <- ByteString -> Get (FunPtr ())
resolveSymbol ByteString
name
String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
" %s: external symbol found at %s" (ByteString -> String
B8.unpack ByteString
name) (FunPtr () -> String
forall a. Show a => a -> String
show FunPtr ()
funptr))
Symbol -> Get Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return Symbol :: ByteString -> Word64 -> Word8 -> Bool -> Symbol
Symbol
{ sym_name :: ByteString
sym_name = ByteString
name
, sym_extern :: Bool
sym_extern = Word8 -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool Word8
n_ext
, sym_segment :: Word8
sym_segment = Word8
n_sect
, sym_value :: Word64
sym_value = Ptr Any -> Word64
forall a. Ptr a -> Word64
castPtrToWord64 (FunPtr () -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr ()
funptr)
}
Word8
0xe -> do
String -> Get ()
forall (m :: * -> *). Monad m => String -> m ()
message (String -> String -> Word8 -> Word64 -> String
forall r. PrintfType r => String -> r
printf String
" %s: local symbol in section %d at 0x%02x" (ByteString -> String
B8.unpack ByteString
name) Word8
n_sect Word64
n_value)
Symbol -> Get Symbol
forall (m :: * -> *) a. Monad m => a -> m a
return Symbol :: ByteString -> Word64 -> Word8 -> Bool -> Symbol
Symbol
{ sym_name :: ByteString
sym_name = ByteString
name
, sym_extern :: Bool
sym_extern = Word8 -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool Word8
n_ext
, sym_segment :: Word8
sym_segment = Word8
n_sect
, sym_value :: Word64
sym_value = Word64
n_value
}
Word8
0x2 -> String -> Get Symbol
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unhandled absolute symbol"
Word8
0xc -> String -> Get Symbol
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unhandled prebound (dylib) symbol"
Word8
0xa -> String -> Get Symbol
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unhandled indirect symbol"
Word8
_ -> String -> Get Symbol
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown symbol type"
resolveSymbol :: ByteString -> Get (FunPtr ())
resolveSymbol :: ByteString -> Get (FunPtr ())
resolveSymbol ByteString
name
= IO (Get (FunPtr ())) -> Get (FunPtr ())
forall a. IO a -> a
unsafePerformIO
(IO (Get (FunPtr ())) -> Get (FunPtr ()))
-> IO (Get (FunPtr ())) -> Get (FunPtr ())
forall a b. (a -> b) -> a -> b
$ ByteString
-> (CString -> IO (Get (FunPtr ()))) -> IO (Get (FunPtr ()))
forall a. ByteString -> (CString -> IO a) -> IO a
B.unsafeUseAsCString ByteString
name ((CString -> IO (Get (FunPtr ()))) -> IO (Get (FunPtr ())))
-> (CString -> IO (Get (FunPtr ()))) -> IO (Get (FunPtr ()))
forall a b. (a -> b) -> a -> b
$ \CString
c_name -> do
FunPtr ()
addr <- Ptr () -> CString -> IO (FunPtr ())
forall a. Ptr () -> CString -> IO (FunPtr a)
c_dlsym (DL -> Ptr ()
packDL DL
Default) CString
c_name
if FunPtr ()
addr FunPtr () -> FunPtr () -> Bool
forall a. Eq a => a -> a -> Bool
== FunPtr ()
forall b. FunPtr b
nullFunPtr
then do
String
err <- IO String
dlerror
Get (FunPtr ()) -> IO (Get (FunPtr ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Get (FunPtr ())
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (FunPtr ())) -> String -> Get (FunPtr ())
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"failed to resolve symbol %s: %s" (ByteString -> String
B8.unpack ByteString
name) String
err)
else do
Get (FunPtr ()) -> IO (Get (FunPtr ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (FunPtr () -> Get (FunPtr ())
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr ()
addr)
castPtrToWord64 :: Ptr a -> Word64
castPtrToWord64 :: Ptr a -> Word64
castPtrToWord64 (Ptr Addr#
addr#) = Word# -> Word64
W64# (Int# -> Word#
int2Word# (Addr# -> Int#
addr2Int# Addr#
addr#))
mprotect :: Ptr Word8 -> Int -> Int -> IO ()
mprotect :: Ptr Word8 -> Int -> Int -> IO ()
mprotect Ptr Word8
addr Int
len Int
prot
= String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"mprotect"
(IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr () -> CSize -> CInt -> IO CInt
c_mprotect (Ptr Word8 -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
addr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
prot)
foreign import ccall unsafe "mprotect"
c_mprotect :: Ptr () -> CSize -> CInt -> IO CInt
foreign import ccall unsafe "getpagesize"
c_getpagesize :: CInt
{-# INLINE trace #-}
trace :: String -> a -> a
trace :: String -> a -> a
trace String
msg = Flag -> String -> a -> a
forall a. Flag -> String -> a -> a
Debug.trace Flag
Debug.dump_ld (String
"ld: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg)
{-# INLINE message #-}
message :: Monad m => String -> m ()
message :: String -> m ()
message String
msg = String -> m () -> m ()
forall a. String -> a -> a
trace String
msg (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())