{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Internal.Elf where
import Control.Exception.ChainedException
import Data.Elf.Constants
import Data.Elf.Headers hiding (Header)
import qualified Data.Elf.Headers as H
import Data.Interval as I
import Control.Lens.Combinators hiding (contains)
import Control.Lens.Operators
import Control.Monad
import Control.Monad.Catch
import Control.Monad.State as MS
import Data.Binary
import Data.Bits as Bin
import Data.ByteString.Lazy.Char8 as BSL8
import Data.ByteString.Lazy as BSL
import Data.Foldable
import Data.Int
import qualified Data.List as L
import Data.Maybe
import Data.Monoid
data RBuilder c
=
{ :: HeaderXX c
}
| RBuilderSectionTable
{ :: HeaderXX c
}
| RBuilderSegmentTable
{ :: HeaderXX c
}
| RBuilderSection
{ :: SectionXX c
, forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
rbsN :: ElfSectionIndex
, forall (c :: ElfClass). RBuilder c -> String
rbsName :: String
}
| RBuilderSegment
{ :: SegmentXX c
, forall (c :: ElfClass). RBuilder c -> Word16
rbpN :: Word16
, forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpData :: [RBuilder c]
}
| RBuilderRawData
{ forall (c :: ElfClass). RBuilder c -> Interval (WordXX c)
rbrdInterval :: Interval (WordXX c)
}
| RBuilderRawAlign
{ forall (c :: ElfClass). RBuilder c -> WordXX c
rbraOffset :: WordXX c
, forall (c :: ElfClass). RBuilder c -> WordXX c
rbraAlign :: WordXX c
}
data LZip a = LZip [a] (Maybe a) [a]
instance Foldable LZip where
foldMap :: forall m a. Monoid m => (a -> m) -> LZip a -> m
foldMap a -> m
f (LZip [a]
l (Just a
c) [a]
r) = (a -> m) -> LZip a -> m
forall m a. Monoid m => (a -> m) -> LZip a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (LZip a -> m) -> LZip a -> m
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe a -> [a] -> LZip a
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l Maybe a
forall a. Maybe a
Nothing (a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
r)
foldMap a -> m
f (LZip [a]
l Maybe a
Nothing [a]
r) = (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f ([a] -> m) -> [a] -> m
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
r
data ElfNodeType = | SectionTable | SegmentTable | Section | Segment | RawData | RawAlign
data ElfListXX c where
ElfListCons :: ElfXX t c -> ElfListXX c -> ElfListXX c
ElfListNull :: ElfListXX c
data Elf = forall a . Elf (SingElfClass a) (ElfListXX a)
data ElfSectionData c
= ElfSectionData
{ forall (c :: ElfClass). ElfSectionData c -> ByteString
esdData :: BSL.ByteString
}
| ElfSectionDataStringTable
| ElfSectionDataNoBits
{ forall (c :: ElfClass). ElfSectionData c -> WordXX c
esdSize :: WordXX c
}
data ElfXX t c where
::
{ forall (c :: ElfClass). ElfXX 'Header c -> ElfData
ehData :: ElfData
, forall (c :: ElfClass). ElfXX 'Header c -> ElfOSABI
ehOSABI :: ElfOSABI
, forall (c :: ElfClass). ElfXX 'Header c -> Word8
ehABIVersion :: Word8
, forall (c :: ElfClass). ElfXX 'Header c -> ElfType
ehType :: ElfType
, forall (c :: ElfClass). ElfXX 'Header c -> ElfMachine
ehMachine :: ElfMachine
, forall (c :: ElfClass). ElfXX 'Header c -> WordXX c
ehEntry :: WordXX c
, forall (c :: ElfClass). ElfXX 'Header c -> Word32
ehFlags :: Word32
} -> ElfXX 'Header c
ElfSectionTable :: ElfXX 'SectionTable c
ElfSegmentTable :: ElfXX 'SegmentTable c
ElfSection ::
{ forall (c :: ElfClass). ElfXX 'Section c -> String
esName :: String
, forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esType :: ElfSectionType
, forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esFlags :: ElfSectionFlag
, forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddr :: WordXX c
, forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: WordXX c
, forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize :: WordXX c
, forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esN :: ElfSectionIndex
, forall (c :: ElfClass). ElfXX 'Section c -> Word32
esInfo :: Word32
, forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink :: Word32
, forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esData :: ElfSectionData c
} -> ElfXX 'Section c
ElfSegment ::
{ forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentType
epType :: ElfSegmentType
, forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentFlag
epFlags :: ElfSegmentFlag
, forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epVirtAddr :: WordXX c
, forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epPhysAddr :: WordXX c
, forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAddMemSize :: WordXX c
, forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAlign :: WordXX c
, forall (c :: ElfClass). ElfXX 'Segment c -> ElfListXX c
epData :: ElfListXX c
} -> ElfXX 'Segment c
ElfRawData ::
{ forall (c :: ElfClass). ElfXX 'RawData c -> ByteString
edData :: BSL.ByteString
} -> ElfXX 'RawData c
ElfRawAlign ::
{ forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaOffset :: WordXX c
, forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaAlign :: WordXX c
} -> ElfXX 'RawAlign c
data WBuilderData
=
| WBuilderDataByteStream { WBuilderData -> ByteString
wbdData :: BSL.ByteString }
| WBuilderDataSectionTable
| WBuilderDataSegmentTable
data WBuilderState a =
WBuilderState
{ forall (a :: ElfClass).
WBuilderState a -> [(ElfSectionIndex, SectionXX a)]
_wbsSections :: [(ElfSectionIndex, SectionXX a)]
, forall (a :: ElfClass). WBuilderState a -> [SegmentXX a]
_wbsSegmentsReversed :: [SegmentXX a]
, forall (a :: ElfClass). WBuilderState a -> [WBuilderData]
_wbsDataReversed :: [WBuilderData]
, forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsOffset :: WordXX a
, forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsPhOff :: WordXX a
, forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsShOff :: WordXX a
, forall (a :: ElfClass). WBuilderState a -> ElfSectionIndex
_wbsShStrNdx :: ElfSectionIndex
, forall (a :: ElfClass). WBuilderState a -> [Int64]
_wbsNameIndexes :: [Int64]
}
makeLenses ''WBuilderState
infixr 9 ~:
(~:) :: ElfXX t a -> ElfListXX a -> ElfListXX a
~: :: forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
(~:) = ElfXX t a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons
foldMapElfList :: Monoid m => (forall t' . (ElfXX t' a -> m)) -> ElfListXX a -> m
foldMapElfList :: forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList forall (t' :: ElfNodeType). ElfXX t' a -> m
f (ElfListCons v :: ElfXX t a
v@(ElfSegment { ElfSegmentType
ElfSegmentFlag
WordXX a
ElfListXX a
epType :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentType
epFlags :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentFlag
epVirtAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epPhysAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAddMemSize :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAlign :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epData :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfListXX c
epType :: ElfSegmentType
epFlags :: ElfSegmentFlag
epVirtAddr :: WordXX a
epPhysAddr :: WordXX a
epAddMemSize :: WordXX a
epAlign :: WordXX a
epData :: ElfListXX a
.. }) ElfListXX a
l) = ElfXX t a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfXX t a
v m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfListXX a
epData m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfListXX a
l
foldMapElfList forall (t' :: ElfNodeType). ElfXX t' a -> m
f (ElfListCons ElfXX t a
v ElfListXX a
l) = ElfXX t a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfXX t a
v m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfListXX a
l
foldMapElfList forall (t' :: ElfNodeType). ElfXX t' a -> m
_ ElfListXX a
ElfListNull = m
forall a. Monoid a => a
mempty
foldMapElfList' :: Monoid m => (forall t' . (ElfXX t' a -> m)) -> ElfListXX a -> m
foldMapElfList' :: forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList' forall (t' :: ElfNodeType). ElfXX t' a -> m
f (ElfListCons ElfXX t a
v ElfListXX a
l) = ElfXX t a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfXX t a
v m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList' ElfXX t' a -> m
forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfListXX a
l
foldMapElfList' forall (t' :: ElfNodeType). ElfXX t' a -> m
_ ElfListXX a
ElfListNull = m
forall a. Monoid a => a
mempty
mapMElfList :: Monad m => (forall t' . (ElfXX t' a -> m b)) -> ElfListXX a -> m [b]
mapMElfList :: forall (m :: * -> *) (a :: ElfClass) b.
Monad m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m b)
-> ElfListXX a -> m [b]
mapMElfList forall (t' :: ElfNodeType). ElfXX t' a -> m b
f ElfListXX a
l = [m b] -> m [b]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([m b] -> m [b]) -> [m b] -> m [b]
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType). ElfXX t' a -> [m b])
-> ElfListXX a -> [m b]
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList' ((m b -> [m b] -> [m b]
forall a. a -> [a] -> [a]
: []) (m b -> [m b]) -> (ElfXX t' a -> m b) -> ElfXX t' a -> [m b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfXX t' a -> m b
forall (t' :: ElfNodeType). ElfXX t' a -> m b
f) ElfListXX a
l
headerInterval :: forall a . SingElfClassI a => HeaderXX a -> Interval (WordXX a)
HeaderXX a
_ = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
0 (WordXX a -> Interval (WordXX a))
-> WordXX a -> Interval (WordXX a)
forall a b. (a -> b) -> a -> b
$ ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
headerSize (ElfClass -> WordXX a) -> ElfClass -> WordXX a
forall a b. (a -> b) -> a -> b
$ SingElfClass a -> ElfClass
forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass (SingElfClass a -> ElfClass) -> SingElfClass a -> ElfClass
forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a
sectionTableInterval :: SingElfClassI a => HeaderXX a -> Interval (WordXX a)
sectionTableInterval :: forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
sectionTableInterval HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX a
hPhOff :: WordXX a
hShOff :: WordXX a
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
..} = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
hShOff (WordXX a -> Interval (WordXX a))
-> WordXX a -> Interval (WordXX a)
forall a b. (a -> b) -> a -> b
$ Word16 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> WordXX a) -> Word16 -> WordXX a
forall a b. (a -> b) -> a -> b
$ Word16
hShEntSize Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
hShNum
segmentTableInterval :: SingElfClassI a => HeaderXX a -> Interval (WordXX a)
segmentTableInterval :: forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
segmentTableInterval HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX a
hPhOff :: WordXX a
hShOff :: WordXX a
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
..} = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
hPhOff (WordXX a -> Interval (WordXX a))
-> WordXX a -> Interval (WordXX a)
forall a b. (a -> b) -> a -> b
$ Word16 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> WordXX a) -> Word16 -> WordXX a
forall a b. (a -> b) -> a -> b
$ Word16
hPhEntSize Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
hPhNum
sectionInterval :: SingElfClassI a => SectionXX a -> Interval (WordXX a)
sectionInterval :: forall (a :: ElfClass).
SingElfClassI a =>
SectionXX a -> Interval (WordXX a)
sectionInterval SectionXX{Word32
ElfSectionType
WordXX a
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX a
sAddr :: WordXX a
sOffset :: WordXX a
sSize :: WordXX a
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX a
sEntSize :: WordXX a
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sName :: forall (c :: ElfClass). SectionXX c -> Word32
..} = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
sOffset if ElfSectionType
sType ElfSectionType -> ElfSectionType -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSectionType
SHT_NOBITS then WordXX a
0 else WordXX a
sSize
segmentInterval :: SingElfClassI a => SegmentXX a -> Interval (WordXX a)
segmentInterval :: forall (a :: ElfClass).
SingElfClassI a =>
SegmentXX a -> Interval (WordXX a)
segmentInterval SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX a
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pType :: ElfSegmentType
pFlags :: ElfSegmentFlag
pOffset :: WordXX a
pVirtAddr :: WordXX a
pPhysAddr :: WordXX a
pFileSize :: WordXX a
pMemSize :: WordXX a
pAlign :: WordXX a
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
..} = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
pOffset WordXX a
pFileSize
rBuilderInterval :: SingElfClassI a => RBuilder a -> Interval (WordXX a)
rBuilderInterval :: forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilderHeader{HeaderXX a
rbhHeader :: forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbhHeader :: HeaderXX a
..} = HeaderXX a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
headerInterval HeaderXX a
rbhHeader
rBuilderInterval RBuilderSectionTable{HeaderXX a
rbstHeader :: forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbstHeader :: HeaderXX a
..} = HeaderXX a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
sectionTableInterval HeaderXX a
rbstHeader
rBuilderInterval RBuilderSegmentTable{HeaderXX a
rbptHeader :: forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbptHeader :: HeaderXX a
..} = HeaderXX a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
segmentTableInterval HeaderXX a
rbptHeader
rBuilderInterval RBuilderSection{String
ElfSectionIndex
SectionXX a
rbsHeader :: forall (c :: ElfClass). RBuilder c -> SectionXX c
rbsN :: forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
rbsName :: forall (c :: ElfClass). RBuilder c -> String
rbsHeader :: SectionXX a
rbsN :: ElfSectionIndex
rbsName :: String
..} = SectionXX a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
SectionXX a -> Interval (WordXX a)
sectionInterval SectionXX a
rbsHeader
rBuilderInterval RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..} = SegmentXX a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
SegmentXX a -> Interval (WordXX a)
segmentInterval SegmentXX a
rbpHeader
rBuilderInterval RBuilderRawData{Interval (WordXX a)
rbrdInterval :: forall (c :: ElfClass). RBuilder c -> Interval (WordXX c)
rbrdInterval :: Interval (WordXX a)
..} = Interval (WordXX a)
rbrdInterval
rBuilderInterval RBuilderRawAlign{} = String -> Interval (WordXX a)
forall a. HasCallStack => String -> a
error String
"Internal error: rBuilderInterval is not defined for RBuilderRawAlign"
findInterval :: (Ord t, Num t) => (a -> Interval t) -> t -> [a] -> LZip a
findInterval :: forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval a -> Interval t
f t
e = [a] -> [a] -> LZip a
findInterval' []
where
findInterval' :: [a] -> [a] -> LZip a
findInterval' [a]
l [] = [a] -> Maybe a -> [a] -> LZip a
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l Maybe a
forall a. Maybe a
Nothing []
findInterval' [a]
l (a
x : [a]
xs) | t
e t -> Interval t -> Bool
forall {a}. (Ord a, Num a) => a -> Interval a -> Bool
`touches` a -> Interval t
f a
x = [a] -> Maybe a -> [a] -> LZip a
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l (a -> Maybe a
forall a. a -> Maybe a
Just a
x) [a]
xs
| t
e t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< Interval t -> t
forall a. Interval a -> a
offset (a -> Interval t
f a
x) = [a] -> Maybe a -> [a] -> LZip a
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l Maybe a
forall a. Maybe a
Nothing (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
| Bool
otherwise = [a] -> [a] -> LZip a
findInterval' (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
l) [a]
xs
touches :: a -> Interval a -> Bool
touches a
a Interval a
i | Interval a -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval a
i = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> a
forall a. Interval a -> a
offset Interval a
i
| Bool
otherwise = a
a a -> Interval a -> Bool
forall {a}. (Ord a, Num a) => a -> Interval a -> Bool
`member` Interval a
i
showRBuilder' :: RBuilder a -> String
showRBuilder' :: forall (c :: ElfClass). RBuilder c -> String
showRBuilder' RBuilderHeader{} = String
"header"
showRBuilder' RBuilderSectionTable{} = String
"section table"
showRBuilder' RBuilderSegmentTable{} = String
"segment table"
showRBuilder' RBuilderSection{String
ElfSectionIndex
SectionXX a
rbsHeader :: forall (c :: ElfClass). RBuilder c -> SectionXX c
rbsN :: forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
rbsName :: forall (c :: ElfClass). RBuilder c -> String
rbsHeader :: SectionXX a
rbsN :: ElfSectionIndex
rbsName :: String
..} = String
"section " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ElfSectionIndex -> String
forall a. Show a => a -> String
show ElfSectionIndex
rbsN
showRBuilder' RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..} = String
"segment " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word16 -> String
forall a. Show a => a -> String
show Word16
rbpN
showRBuilder' RBuilderRawData{} = String
"raw data"
showRBuilder' RBuilderRawAlign{} = String
"alignment"
showRBuilder :: SingElfClassI a => RBuilder a -> String
showRBuilder :: forall (a :: ElfClass). SingElfClassI a => RBuilder a -> String
showRBuilder RBuilder a
v = RBuilder a -> String
forall (c :: ElfClass). RBuilder c -> String
showRBuilder' RBuilder a
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Interval (WordXX a) -> String
forall a. Show a => a -> String
show (RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
v) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
intersectMessage :: SingElfClassI a => RBuilder a -> RBuilder a -> String
intersectMessage :: forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
x RBuilder a
y = RBuilder a -> String
forall (a :: ElfClass). SingElfClassI a => RBuilder a -> String
showRBuilder RBuilder a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RBuilder a -> String
forall (a :: ElfClass). SingElfClassI a => RBuilder a -> String
showRBuilder RBuilder a
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" intersect"
addRBuilders :: forall a m . (SingElfClassI a, MonadCatch m) => [RBuilder a] -> m [RBuilder a]
addRBuilders :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> m [RBuilder a]
addRBuilders [RBuilder a]
newts =
let
addRBuilders' :: (a -> b -> m b) -> t a -> b -> m b
addRBuilders' a -> b -> m b
f t a
newts' b
l = (b -> a -> m b) -> b -> t a -> m b
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((a -> b -> m b) -> b -> a -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> m b
f) b
l t a
newts'
addRBuilderEmpty :: (SingElfClassI a, MonadCatch m) => RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderEmpty :: (SingElfClassI a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderEmpty RBuilder a
t [RBuilder a]
ts =
let
to' :: WordXX a
to' = Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset (Interval (WordXX a) -> WordXX a)
-> Interval (WordXX a) -> WordXX a
forall a b. (a -> b) -> a -> b
$ RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
t
(LZip [RBuilder a]
l Maybe (RBuilder a)
c' [RBuilder a]
r) = (RBuilder a -> Interval (WordXX a))
-> WordXX a -> [RBuilder a] -> LZip (RBuilder a)
forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval WordXX a
to' [RBuilder a]
ts
allEmptyStartingAt :: WordXX a -> [RBuilder a] -> ([RBuilder a], [RBuilder a])
allEmptyStartingAt :: WordXX a -> [RBuilder a] -> ([RBuilder a], [RBuilder a])
allEmptyStartingAt WordXX a
a [RBuilder a]
ls = ([RBuilder a], [RBuilder a]) -> ([RBuilder a], [RBuilder a])
f ([], [RBuilder a]
ls)
where
f :: ([RBuilder a], [RBuilder a]) -> ([RBuilder a], [RBuilder a])
f ([RBuilder a]
le, []) = ([RBuilder a] -> [RBuilder a]
forall a. [a] -> [a]
L.reverse [RBuilder a]
le, [])
f ([RBuilder a]
le, RBuilder a
h : [RBuilder a]
lo) =
let
hi :: Interval (WordXX a)
hi = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
h
in if Bool -> Bool
not (Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval (WordXX a)
hi) Bool -> Bool -> Bool
|| (Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset Interval (WordXX a)
hi WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
a)
then ([RBuilder a] -> [RBuilder a]
forall a. [a] -> [a]
L.reverse [RBuilder a]
le, RBuilder a
h RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
lo)
else ([RBuilder a], [RBuilder a]) -> ([RBuilder a], [RBuilder a])
f (RBuilder a
h RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
le, [RBuilder a]
lo)
in case Maybe (RBuilder a)
c' of
Just RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..} -> do
[RBuilder a]
d <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a] -> m [RBuilder a]
(Loc -> String -> m [RBuilder a] -> m [RBuilder a])
-> String -> Loc -> m [RBuilder a] -> m [RBuilder a]
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m [RBuilder a] -> m [RBuilder a])
-> m [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ (SingElfClassI a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderEmpty RBuilder a
t [RBuilder a]
rbpData
[RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a]
d, Word16
SegmentXX a
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
.. }) [RBuilder a]
r
Just RBuilder a
c ->
if Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset (RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c) WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
to' then
$Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a]
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m [RBuilder a]) -> String -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
t RBuilder a
c
else
let
([RBuilder a]
ce, [RBuilder a]
re') = WordXX a -> [RBuilder a] -> ([RBuilder a], [RBuilder a])
allEmptyStartingAt WordXX a
to' (RBuilder a
c RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
r)
in case RBuilder a
t of
RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..} ->
[RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a]
ce, Word16
SegmentXX a
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
.. }) [RBuilder a]
re'
RBuilder a
_ ->
[RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l Maybe (RBuilder a)
forall a. Maybe a
Nothing ([RBuilder a]
ce [RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ (RBuilder a
t RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
re'))
Maybe (RBuilder a)
Nothing -> [RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
t) [RBuilder a]
r
addRBuilderNonEmpty :: (SingElfClassI a, MonadCatch m) => RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderNonEmpty :: (SingElfClassI a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderNonEmpty RBuilder a
t [RBuilder a]
ts =
let
ti :: Interval (WordXX a)
ti = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
t
(LZip [RBuilder a]
l Maybe (RBuilder a)
c' [RBuilder a]
r) = (RBuilder a -> Interval (WordXX a))
-> WordXX a -> [RBuilder a] -> LZip (RBuilder a)
forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval (Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset Interval (WordXX a)
ti) [RBuilder a]
ts
addRBuildersNonEmpty :: (SingElfClassI a, MonadCatch m) => [RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty :: (SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [] RBuilder a
x = RBuilder a -> m (RBuilder a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return RBuilder a
x
addRBuildersNonEmpty [RBuilder a]
ts' RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..} = do
[RBuilder a]
d <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a] -> m [RBuilder a]
(Loc -> String -> m [RBuilder a] -> m [RBuilder a])
-> String -> Loc -> m [RBuilder a] -> m [RBuilder a]
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m [RBuilder a] -> m [RBuilder a])
-> m [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ (RBuilder a -> [RBuilder a] -> m [RBuilder a])
-> [RBuilder a] -> [RBuilder a] -> m [RBuilder a]
forall {t :: * -> *} {m :: * -> *} {a} {b}.
(Foldable t, Monad m) =>
(a -> b -> m b) -> t a -> b -> m b
addRBuilders' (SingElfClassI a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderNonEmpty [RBuilder a]
ts' [RBuilder a]
rbpData
RBuilder a -> m (RBuilder a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a]
d, Word16
SegmentXX a
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
.. }
addRBuildersNonEmpty (RBuilder a
x:[RBuilder a]
_) RBuilder a
y = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a)
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m (RBuilder a)) -> String -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
x RBuilder a
y
in case Maybe (RBuilder a)
c' of
Just RBuilder a
c ->
if Interval (WordXX a)
ti Interval (WordXX a) -> Interval (WordXX a) -> Bool
forall a. Eq a => a -> a -> Bool
== RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c then
case RBuilder a
t of
RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..} ->
[RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a
c], Word16
SegmentXX a
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
.. }) [RBuilder a]
r
RBuilder a
_ -> do
RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [RBuilder a
t] RBuilder a
c
[RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r
else if RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c Interval (WordXX a) -> Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Interval a -> Bool
`contains` Interval (WordXX a)
ti then do
RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [RBuilder a
t] RBuilder a
c
[RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r
else if Interval (WordXX a)
ti Interval (WordXX a) -> Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Interval a -> Bool
`contains` RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c then
let
tir :: WordXX a
tir = Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset Interval (WordXX a)
ti WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
size Interval (WordXX a)
ti WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1
(LZip [RBuilder a]
l2 Maybe (RBuilder a)
c2' [RBuilder a]
r2) = (RBuilder a -> Interval (WordXX a))
-> WordXX a -> [RBuilder a] -> LZip (RBuilder a)
forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval WordXX a
tir [RBuilder a]
r
in case Maybe (RBuilder a)
c2' of
Maybe (RBuilder a)
Nothing -> do
RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty (RBuilder a
c RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
l2) RBuilder a
t
[RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2
Just RBuilder a
c2 ->
if Interval (WordXX a)
ti Interval (WordXX a) -> Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Interval a -> Bool
`contains` RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c2 then do
RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty (RBuilder a
c RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: RBuilder a
c2 RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
l2) RBuilder a
t
[RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2
else
$Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a]
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m [RBuilder a]) -> String -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
t RBuilder a
c2
else
$Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a]
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m [RBuilder a]) -> String -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
t RBuilder a
c
Maybe (RBuilder a)
Nothing ->
let
tir :: WordXX a
tir = Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset Interval (WordXX a)
ti WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
size Interval (WordXX a)
ti WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1
(LZip [RBuilder a]
l2 Maybe (RBuilder a)
c2' [RBuilder a]
r2) = (RBuilder a -> Interval (WordXX a))
-> WordXX a -> [RBuilder a] -> LZip (RBuilder a)
forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval WordXX a
tir [RBuilder a]
r
in case Maybe (RBuilder a)
c2' of
Maybe (RBuilder a)
Nothing -> do
RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [RBuilder a]
l2 RBuilder a
t
[RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2
Just RBuilder a
c2 ->
if Interval (WordXX a)
ti Interval (WordXX a) -> Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Interval a -> Bool
`contains` RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c2 then do
RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty (RBuilder a
c2 RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
l2) RBuilder a
t
[RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall a. LZip a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2
else
$Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a]
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m [RBuilder a]) -> String -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
t RBuilder a
c2
([RBuilder a]
emptyRBs, [RBuilder a]
nonEmptyRBs) = (RBuilder a -> Bool)
-> [RBuilder a] -> ([RBuilder a], [RBuilder a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty (Interval (WordXX a) -> Bool)
-> (RBuilder a -> Interval (WordXX a)) -> RBuilder a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval) [RBuilder a]
newts
in
(RBuilder a -> [RBuilder a] -> m [RBuilder a])
-> [RBuilder a] -> [RBuilder a] -> m [RBuilder a]
forall {t :: * -> *} {m :: * -> *} {a} {b}.
(Foldable t, Monad m) =>
(a -> b -> m b) -> t a -> b -> m b
addRBuilders' (SingElfClassI a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderNonEmpty [RBuilder a]
nonEmptyRBs [] m [RBuilder a]
-> ([RBuilder a] -> m [RBuilder a]) -> m [RBuilder a]
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (RBuilder a -> [RBuilder a] -> m [RBuilder a])
-> [RBuilder a] -> [RBuilder a] -> m [RBuilder a]
forall {t :: * -> *} {m :: * -> *} {a} {b}.
(Foldable t, Monad m) =>
(a -> b -> m b) -> t a -> b -> m b
addRBuilders' (SingElfClassI a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderEmpty [RBuilder a]
emptyRBs
elfFindSection :: forall a m b . (SingElfClassI a, MonadThrow m, Integral b, Show b)
=> ElfListXX a
-> b
-> m (ElfXX 'Section a)
elfFindSection :: forall (a :: ElfClass) (m :: * -> *) b.
(SingElfClassI a, MonadThrow m, Integral b, Show b) =>
ElfListXX a -> b -> m (ElfXX 'Section a)
elfFindSection ElfListXX a
elfs b
n = if b
n b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
0
then $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (ElfXX 'Section a)
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"no section 0"
else $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> Maybe (ElfXX 'Section a) -> m (ElfXX 'Section a)
forall (m :: * -> *) a.
MonadThrow m =>
Loc -> String -> Maybe a -> m a
maybeAddContext (String
"no section " String -> String -> String
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Show a => a -> String
show b
n) Maybe (ElfXX 'Section a)
maybeSection
where
maybeSection :: Maybe (ElfXX 'Section a)
maybeSection = First (ElfXX 'Section a) -> Maybe (ElfXX 'Section a)
forall a. First a -> Maybe a
getFirst (First (ElfXX 'Section a) -> Maybe (ElfXX 'Section a))
-> First (ElfXX 'Section a) -> Maybe (ElfXX 'Section a)
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType).
ElfXX t' a -> First (ElfXX 'Section a))
-> ElfListXX a -> First (ElfXX 'Section a)
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> First (ElfXX 'Section a)
forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Section a)
f ElfListXX a
elfs
f :: ElfXX t a -> First (ElfXX 'Section a)
f :: forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Section a)
f s :: ElfXX t a
s@ElfSection{String
Word32
ElfSectionType
ElfSectionFlag
ElfSectionIndex
WordXX a
ElfSectionData a
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esName :: String
esType :: ElfSectionType
esFlags :: ElfSectionFlag
esAddr :: WordXX a
esAddrAlign :: WordXX a
esEntSize :: WordXX a
esN :: ElfSectionIndex
esInfo :: Word32
esLink :: Word32
esData :: ElfSectionData a
..} | ElfSectionIndex
esN ElfSectionIndex -> ElfSectionIndex -> Bool
forall a. Eq a => a -> a -> Bool
== b -> ElfSectionIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n = Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a)
forall a. Maybe a -> First a
First (Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a))
-> Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'Section a -> Maybe (ElfXX 'Section a)
forall a. a -> Maybe a
Just ElfXX t a
ElfXX 'Section a
s
f ElfXX t a
_ = Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a)
forall a. Maybe a -> First a
First Maybe (ElfXX 'Section a)
forall a. Maybe a
Nothing
elfFindSectionByName :: forall a m . (SingElfClassI a, MonadThrow m)
=> ElfListXX a
-> String
-> m (ElfXX 'Section a)
elfFindSectionByName :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadThrow m) =>
ElfListXX a -> String -> m (ElfXX 'Section a)
elfFindSectionByName ElfListXX a
elfs String
n = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> Maybe (ElfXX 'Section a) -> m (ElfXX 'Section a)
forall (m :: * -> *) a.
MonadThrow m =>
Loc -> String -> Maybe a -> m a
maybeAddContext (String
"no section \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"") Maybe (ElfXX 'Section a)
maybeSection
where
maybeSection :: Maybe (ElfXX 'Section a)
maybeSection = First (ElfXX 'Section a) -> Maybe (ElfXX 'Section a)
forall a. First a -> Maybe a
getFirst (First (ElfXX 'Section a) -> Maybe (ElfXX 'Section a))
-> First (ElfXX 'Section a) -> Maybe (ElfXX 'Section a)
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType).
ElfXX t' a -> First (ElfXX 'Section a))
-> ElfListXX a -> First (ElfXX 'Section a)
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> First (ElfXX 'Section a)
forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Section a)
f ElfListXX a
elfs
f :: ElfXX t a -> First (ElfXX 'Section a)
f :: forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Section a)
f s :: ElfXX t a
s@ElfSection{String
Word32
ElfSectionType
ElfSectionFlag
ElfSectionIndex
WordXX a
ElfSectionData a
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esName :: String
esType :: ElfSectionType
esFlags :: ElfSectionFlag
esAddr :: WordXX a
esAddrAlign :: WordXX a
esEntSize :: WordXX a
esN :: ElfSectionIndex
esInfo :: Word32
esLink :: Word32
esData :: ElfSectionData a
..} | String
esName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n = Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a)
forall a. Maybe a -> First a
First (Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a))
-> Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'Section a -> Maybe (ElfXX 'Section a)
forall a. a -> Maybe a
Just ElfXX t a
ElfXX 'Section a
s
f ElfXX t a
_ = Maybe (ElfXX 'Section a) -> First (ElfXX 'Section a)
forall a. Maybe a -> First a
First Maybe (ElfXX 'Section a)
forall a. Maybe a
Nothing
elfFindHeader :: forall a m . (SingElfClassI a, MonadThrow m)
=> ElfListXX a
-> m (ElfXX 'Header a)
ElfListXX a
elfs = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> Maybe (ElfXX 'Header a) -> m (ElfXX 'Header a)
forall (m :: * -> *) a.
MonadThrow m =>
Loc -> String -> Maybe a -> m a
maybeAddContext String
"no header" Maybe (ElfXX 'Header a)
maybeHeader
where
maybeHeader :: Maybe (ElfXX 'Header a)
maybeHeader = First (ElfXX 'Header a) -> Maybe (ElfXX 'Header a)
forall a. First a -> Maybe a
getFirst (First (ElfXX 'Header a) -> Maybe (ElfXX 'Header a))
-> First (ElfXX 'Header a) -> Maybe (ElfXX 'Header a)
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Header a))
-> ElfListXX a -> First (ElfXX 'Header a)
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> First (ElfXX 'Header a)
forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Header a)
f ElfListXX a
elfs
f :: ElfXX t a -> First (ElfXX 'Header a)
f :: forall (t' :: ElfNodeType). ElfXX t' a -> First (ElfXX 'Header a)
f h :: ElfXX t a
h@ElfHeader{} = Maybe (ElfXX 'Header a) -> First (ElfXX 'Header a)
forall a. Maybe a -> First a
First (Maybe (ElfXX 'Header a) -> First (ElfXX 'Header a))
-> Maybe (ElfXX 'Header a) -> First (ElfXX 'Header a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'Header a -> Maybe (ElfXX 'Header a)
forall a. a -> Maybe a
Just ElfXX t a
ElfXX 'Header a
h
f ElfXX t a
_ = Maybe (ElfXX 'Header a) -> First (ElfXX 'Header a)
forall a. Maybe a -> First a
First Maybe (ElfXX 'Header a)
forall a. Maybe a
Nothing
cut :: BSL.ByteString -> Int64 -> Int64 -> BSL.ByteString
cut :: ByteString -> Int64 -> Int64 -> ByteString
cut ByteString
content Int64
offset Int64
size = Int64 -> ByteString -> ByteString
BSL.take Int64
size (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop Int64
offset ByteString
content
tail' :: [a] -> [a]
tail' :: forall a. [a] -> [a]
tail' [] = []
tail' (a
_ : [a]
xs) = [a]
xs
nextOffset :: SingElfClassI a => WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset :: forall (a :: ElfClass).
SingElfClassI a =>
WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset WordXX a
_ WordXX a
0 WordXX a
a = WordXX a
a
nextOffset WordXX a
t WordXX a
m WordXX a
a | WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Bits a => a -> a -> a
.&. (WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1) WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
0 = String -> WordXX a
forall a. HasCallStack => String -> a
error (String -> WordXX a) -> String -> WordXX a
forall a b. (a -> b) -> a -> b
$ String
"align module is not power of two " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WordXX a -> String
forall a. Show a => a -> String
show WordXX a
m
| Bool
otherwise = if WordXX a
a' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
t' WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
a then WordXX a
a' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
t' else WordXX a
a' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
t'
where
a' :: WordXX a
a' = WordXX a
a WordXX a -> WordXX a -> WordXX a
forall a. Bits a => a -> a -> a
.&. WordXX a -> WordXX a
forall a. Bits a => a -> a
complement (WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1)
t' :: WordXX a
t' = WordXX a
t WordXX a -> WordXX a -> WordXX a
forall a. Bits a => a -> a -> a
.&. (WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1)
addRawData :: forall a . SingElfClassI a => BSL.ByteString -> [RBuilder a] -> [RBuilder a]
addRawData :: forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> [RBuilder a] -> [RBuilder a]
addRawData ByteString
_ [] = []
addRawData ByteString
bs [RBuilder a]
rBuilders = (WordXX a, [RBuilder a]) -> [RBuilder a]
forall a b. (a, b) -> b
snd ((WordXX a, [RBuilder a]) -> [RBuilder a])
-> (WordXX a, [RBuilder a]) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ WordXX a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
addRawData' WordXX a
0 (WordXX a
lrbie, [RBuilder a]
rBuilders)
where
lrbi :: Interval (WordXX a)
lrbi@(I WordXX a
lrbib WordXX a
lrbis) = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval (RBuilder a -> Interval (WordXX a))
-> RBuilder a -> Interval (WordXX a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a
forall a. HasCallStack => [a] -> a
L.last [RBuilder a]
rBuilders
lrbie :: WordXX a
lrbie = if Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval (WordXX a)
lrbi then WordXX a
lrbib else WordXX a
lrbib WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
lrbis
allEmpty :: WordXX a -> WordXX a -> Bool
allEmpty :: WordXX a -> WordXX a -> Bool
allEmpty WordXX a
b WordXX a
s = (Word8 -> Bool) -> ByteString -> Bool
BSL.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bs'
where
bs' :: ByteString
bs' = ByteString -> Int64 -> Int64 -> ByteString
cut ByteString
bs (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
b) (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
s)
addRawData' :: WordXX a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
addRawData' :: WordXX a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
addRawData' WordXX a
alignHint (WordXX a
e, [RBuilder a]
rbs) = (RBuilder a
-> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a]))
-> (WordXX a, [RBuilder a])
-> [RBuilder a]
-> (WordXX a, [RBuilder a])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr RBuilder a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
f (WordXX a
e, []) ([RBuilder a] -> (WordXX a, [RBuilder a]))
-> [RBuilder a] -> (WordXX a, [RBuilder a])
forall a b. (a -> b) -> a -> b
$ (RBuilder a -> RBuilder a) -> [RBuilder a] -> [RBuilder a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RBuilder a -> RBuilder a
fixRBuilder [RBuilder a]
rbs
where
f :: RBuilder a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
f RBuilder a
rb (WordXX a
e', [RBuilder a]
rbs') =
let
i :: Interval (WordXX a)
i@(I WordXX a
b WordXX a
s) = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
rb
b' :: WordXX a
b' = if Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval (WordXX a)
i then WordXX a
b else WordXX a
b WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
s
rbs'' :: [RBuilder a]
rbs'' = WordXX a -> WordXX a -> [RBuilder a] -> [RBuilder a]
addRaw WordXX a
b' WordXX a
e' [RBuilder a]
rbs'
in
(WordXX a
b, RBuilder a
rb RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'')
fixRBuilder :: RBuilder a -> RBuilder a
fixRBuilder :: RBuilder a -> RBuilder a
fixRBuilder RBuilder a
p | Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty (Interval (WordXX a) -> Bool) -> Interval (WordXX a) -> Bool
forall a b. (a -> b) -> a -> b
$ RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
p = RBuilder a
p
fixRBuilder p :: RBuilder a
p@RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpData :: [RBuilder a]
..} =
RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = WordXX a -> WordXX a -> [RBuilder a] -> [RBuilder a]
addRaw WordXX a
b WordXX a
ee' [RBuilder a]
rbs', Word16
SegmentXX a
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
..}
where
(I WordXX a
b WordXX a
s) = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
p
ee :: WordXX a
ee = WordXX a
b WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
s
alignHint' :: WordXX a
alignHint' = WordXX a -> WordXX a -> WordXX a
forall a. Ord a => a -> a -> a
max (SegmentXX a -> WordXX a
forall (c :: ElfClass). SegmentXX c -> WordXX c
pAlign SegmentXX a
rbpHeader) WordXX a
alignHint
(WordXX a
ee', [RBuilder a]
rbs') = WordXX a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
addRawData' WordXX a
alignHint' (WordXX a
ee, [RBuilder a]
rbpData)
fixRBuilder RBuilder a
x = RBuilder a
x
addRaw :: WordXX a -> WordXX a -> [RBuilder a] -> [RBuilder a]
addRaw :: WordXX a -> WordXX a -> [RBuilder a] -> [RBuilder a]
addRaw WordXX a
b WordXX a
ee [RBuilder a]
rbs' =
if WordXX a
b WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
ee
then
if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ WordXX a -> WordXX a -> Bool
allEmpty WordXX a
b WordXX a
s
then
Interval (WordXX a) -> RBuilder a
forall (c :: ElfClass). Interval (WordXX c) -> RBuilder c
RBuilderRawData (WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
b WordXX a
s) RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'
else
if WordXX a
e' WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
ee Bool -> Bool -> Bool
&& WordXX a
e'' WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
== WordXX a
ee
then
WordXX a -> WordXX a -> RBuilder a
forall (c :: ElfClass). WordXX c -> WordXX c -> RBuilder c
RBuilderRawAlign WordXX a
ee WordXX a
alignHint RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'
else
[RBuilder a]
rbs'
else
[RBuilder a]
rbs'
where
s :: WordXX a
s = WordXX a
ee WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
b
eAddr :: WordXX a
eAddr = case [RBuilder a]
rbs' of
(RBuilderSegment{rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpHeader = SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX a
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
pType :: ElfSegmentType
pFlags :: ElfSegmentFlag
pOffset :: WordXX a
pVirtAddr :: WordXX a
pPhysAddr :: WordXX a
pFileSize :: WordXX a
pMemSize :: WordXX a
pAlign :: WordXX a
..}} : [RBuilder a]
_) -> WordXX a
pVirtAddr
[RBuilder a]
_ -> WordXX a
0
eAddrAlign :: WordXX a
eAddrAlign = case [RBuilder a]
rbs' of
(RBuilderSegment{rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpHeader = SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX a
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
pType :: ElfSegmentType
pFlags :: ElfSegmentFlag
pOffset :: WordXX a
pVirtAddr :: WordXX a
pPhysAddr :: WordXX a
pFileSize :: WordXX a
pMemSize :: WordXX a
pAlign :: WordXX a
..}} : [RBuilder a]
_) -> WordXX a
pAlign
(RBuilderSection{rbsHeader :: forall (c :: ElfClass). RBuilder c -> SectionXX c
rbsHeader = SectionXX{Word32
ElfSectionType
WordXX a
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sName :: forall (c :: ElfClass). SectionXX c -> Word32
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX a
sAddr :: WordXX a
sOffset :: WordXX a
sSize :: WordXX a
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX a
sEntSize :: WordXX a
..}} : [RBuilder a]
_) -> WordXX a
sAddrAlign
[RBuilder a]
_ -> ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
wordSize (ElfClass -> WordXX a) -> ElfClass -> WordXX a
forall a b. (a -> b) -> a -> b
$ SingElfClass a -> ElfClass
forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass (SingElfClass a -> ElfClass) -> SingElfClass a -> ElfClass
forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a
e' :: WordXX a
e' = WordXX a -> WordXX a -> WordXX a -> WordXX a
forall (a :: ElfClass).
SingElfClassI a =>
WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset WordXX a
eAddr WordXX a
eAddrAlign WordXX a
b
e'' :: WordXX a
e'' = WordXX a -> WordXX a -> WordXX a -> WordXX a
forall (a :: ElfClass).
SingElfClassI a =>
WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset WordXX a
ee WordXX a
alignHint WordXX a
b
infix 9 !!?
(!!?) :: (Integral b) => [a] -> b -> Maybe a
!!? :: forall b a. Integral b => [a] -> b -> Maybe a
(!!?) [a]
xs b
i
| b
i b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0 = Maybe a
forall a. Maybe a
Nothing
| Bool
otherwise = b -> [a] -> Maybe a
forall b a. Integral b => b -> [a] -> Maybe a
go b
i [a]
xs
where
go :: (Integral b) => b -> [a] -> Maybe a
go :: forall b a. Integral b => b -> [a] -> Maybe a
go b
0 (a
x:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
go b
j (a
_:[a]
ys) = b -> [a] -> Maybe a
forall b a. Integral b => b -> [a] -> Maybe a
go (b
j b -> b -> b
forall a. Num a => a -> a -> a
- b
1) [a]
ys
go b
_ [] = Maybe a
forall a. Maybe a
Nothing
parseRBuilder :: (SingElfClassI a, MonadCatch m)
=> HeaderXX a
-> [SectionXX a]
-> [SegmentXX a]
-> BSL.ByteString
-> m [RBuilder a]
parseRBuilder :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
HeaderXX a
-> [SectionXX a] -> [SegmentXX a] -> ByteString -> m [RBuilder a]
parseRBuilder hdr :: HeaderXX a
hdr@HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX a
hPhOff :: WordXX a
hShOff :: WordXX a
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
..} [SectionXX a]
ss [SegmentXX a]
ps ByteString
bs = do
let
maybeStringSectionData :: Maybe ByteString
maybeStringSectionData = ByteString -> SectionXX a -> ByteString
forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> SectionXX a -> ByteString
getSectionData ByteString
bs (SectionXX a -> ByteString)
-> Maybe (SectionXX a) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([SectionXX a]
ss [SectionXX a] -> ElfSectionIndex -> Maybe (SectionXX a)
forall b a. Integral b => [a] -> b -> Maybe a
!!? ElfSectionIndex
hShStrNdx)
mkRBuilderSection :: (SingElfClassI a, MonadCatch m) => (ElfSectionIndex, SectionXX a) -> m (RBuilder a)
mkRBuilderSection :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
(ElfSectionIndex, SectionXX a) -> m (RBuilder a)
mkRBuilderSection (ElfSectionIndex
n, s :: SectionXX a
s@SectionXX{Word32
ElfSectionType
WordXX a
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sName :: forall (c :: ElfClass). SectionXX c -> Word32
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX a
sAddr :: WordXX a
sOffset :: WordXX a
sSize :: WordXX a
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX a
sEntSize :: WordXX a
..}) = do
ByteString
stringSectionData <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> Maybe ByteString -> m ByteString
forall (m :: * -> *) a.
MonadThrow m =>
Loc -> String -> Maybe a -> m a
maybeAddContext String
"No string table" Maybe ByteString
maybeStringSectionData
RBuilder a -> m (RBuilder a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RBuilder a -> m (RBuilder a)) -> RBuilder a -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ SectionXX a -> ElfSectionIndex -> String -> RBuilder a
forall (c :: ElfClass).
SectionXX c -> ElfSectionIndex -> String -> RBuilder c
RBuilderSection SectionXX a
s ElfSectionIndex
n (String -> RBuilder a) -> String -> RBuilder a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> String
getString ByteString
stringSectionData (Int64 -> String) -> Int64 -> String
forall a b. (a -> b) -> a -> b
$ Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sName
mkRBuilderSegment :: (SingElfClassI a, MonadCatch m) => (Word16, SegmentXX a) -> m (RBuilder a)
mkRBuilderSegment :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
(Word16, SegmentXX a) -> m (RBuilder a)
mkRBuilderSegment (Word16
n, SegmentXX a
p) = RBuilder a -> m (RBuilder a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RBuilder a -> m (RBuilder a)) -> RBuilder a -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ SegmentXX a -> Word16 -> [RBuilder a] -> RBuilder a
forall (c :: ElfClass).
SegmentXX c -> Word16 -> [RBuilder c] -> RBuilder c
RBuilderSegment SegmentXX a
p Word16
n []
[RBuilder a]
sections <- ((ElfSectionIndex, SectionXX a) -> m (RBuilder a))
-> [(ElfSectionIndex, SectionXX a)] -> m [RBuilder a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ElfSectionIndex, SectionXX a) -> m (RBuilder a)
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
(ElfSectionIndex, SectionXX a) -> m (RBuilder a)
mkRBuilderSection ([(ElfSectionIndex, SectionXX a)] -> m [RBuilder a])
-> [(ElfSectionIndex, SectionXX a)] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [(ElfSectionIndex, SectionXX a)]
-> [(ElfSectionIndex, SectionXX a)]
forall a. [a] -> [a]
tail' ([(ElfSectionIndex, SectionXX a)]
-> [(ElfSectionIndex, SectionXX a)])
-> [(ElfSectionIndex, SectionXX a)]
-> [(ElfSectionIndex, SectionXX a)]
forall a b. (a -> b) -> a -> b
$ [ElfSectionIndex]
-> [SectionXX a] -> [(ElfSectionIndex, SectionXX a)]
forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [ElfSectionIndex
0 .. ] [SectionXX a]
ss
[RBuilder a]
segments <- ((Word16, SegmentXX a) -> m (RBuilder a))
-> [(Word16, SegmentXX a)] -> m [RBuilder a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Word16, SegmentXX a) -> m (RBuilder a)
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
(Word16, SegmentXX a) -> m (RBuilder a)
mkRBuilderSegment ([(Word16, SegmentXX a)] -> m [RBuilder a])
-> [(Word16, SegmentXX a)] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [Word16] -> [SegmentXX a] -> [(Word16, SegmentXX a)]
forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [Word16
0 .. ] [SegmentXX a]
ps
let
header :: RBuilder a
header = HeaderXX a -> RBuilder a
forall (c :: ElfClass). HeaderXX c -> RBuilder c
RBuilderHeader HeaderXX a
hdr
maybeSectionTable :: Maybe (RBuilder a)
maybeSectionTable = if Word16
hShNum Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0 then Maybe (RBuilder a)
forall a. Maybe a
Nothing else RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just (RBuilder a -> Maybe (RBuilder a))
-> RBuilder a -> Maybe (RBuilder a)
forall a b. (a -> b) -> a -> b
$ HeaderXX a -> RBuilder a
forall (c :: ElfClass). HeaderXX c -> RBuilder c
RBuilderSectionTable HeaderXX a
hdr
maybeSegmentTable :: Maybe (RBuilder a)
maybeSegmentTable = if Word16
hPhNum Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0 then Maybe (RBuilder a)
forall a. Maybe a
Nothing else RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just (RBuilder a -> Maybe (RBuilder a))
-> RBuilder a -> Maybe (RBuilder a)
forall a b. (a -> b) -> a -> b
$ HeaderXX a -> RBuilder a
forall (c :: ElfClass). HeaderXX c -> RBuilder c
RBuilderSegmentTable HeaderXX a
hdr
[RBuilder a]
rbs <- [RBuilder a] -> m [RBuilder a]
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> m [RBuilder a]
addRBuilders ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a
header] [RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ Maybe (RBuilder a) -> [RBuilder a]
forall a. Maybe a -> [a]
maybeToList Maybe (RBuilder a)
maybeSectionTable
[RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ Maybe (RBuilder a) -> [RBuilder a]
forall a. Maybe a -> [a]
maybeToList Maybe (RBuilder a)
maybeSegmentTable
[RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ [RBuilder a]
segments
[RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ [RBuilder a]
sections
[RBuilder a] -> m [RBuilder a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ ByteString -> [RBuilder a] -> [RBuilder a]
forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> [RBuilder a] -> [RBuilder a]
addRawData ByteString
bs [RBuilder a]
rbs
parseElf' :: forall a m . (SingElfClassI a, MonadCatch m) =>
HeaderXX a ->
[SectionXX a] ->
[SegmentXX a] ->
BSL.ByteString -> m Elf
parseElf' :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
HeaderXX a -> [SectionXX a] -> [SegmentXX a] -> ByteString -> m Elf
parseElf' hdr :: HeaderXX a
hdr@HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX a
hPhOff :: WordXX a
hShOff :: WordXX a
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
..} [SectionXX a]
ss [SegmentXX a]
ps ByteString
bs = do
[RBuilder a]
rbs <- HeaderXX a
-> [SectionXX a] -> [SegmentXX a] -> ByteString -> m [RBuilder a]
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
HeaderXX a
-> [SectionXX a] -> [SegmentXX a] -> ByteString -> m [RBuilder a]
parseRBuilder HeaderXX a
hdr [SectionXX a]
ss [SegmentXX a]
ps ByteString
bs
let
rBuilderToElf :: RBuilder a -> ElfListXX a -> m (ElfListXX a)
rBuilderToElf :: RBuilder a -> ElfListXX a -> m (ElfListXX a)
rBuilderToElf RBuilderHeader{} ElfListXX a
l =
ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'Header a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons ElfHeader
{ ehData :: ElfData
ehData = ElfData
hData
, ehOSABI :: ElfOSABI
ehOSABI = ElfOSABI
hOSABI
, ehABIVersion :: Word8
ehABIVersion = Word8
hABIVersion
, ehType :: ElfType
ehType = ElfType
hType
, ehMachine :: ElfMachine
ehMachine = ElfMachine
hMachine
, ehEntry :: WordXX a
ehEntry = WordXX a
hEntry
, ehFlags :: Word32
ehFlags = Word32
hFlags
} ElfListXX a
l
rBuilderToElf RBuilderSectionTable{} ElfListXX a
l =
ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'SectionTable a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons ElfXX 'SectionTable a
forall (c :: ElfClass). ElfXX 'SectionTable c
ElfSectionTable ElfListXX a
l
rBuilderToElf RBuilderSegmentTable{} ElfListXX a
l =
ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'SegmentTable a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons ElfXX 'SegmentTable a
forall (c :: ElfClass). ElfXX 'SegmentTable c
ElfSegmentTable ElfListXX a
l
rBuilderToElf RBuilderSection{ rbsHeader :: forall (c :: ElfClass). RBuilder c -> SectionXX c
rbsHeader = s :: SectionXX a
s@SectionXX{Word32
ElfSectionType
WordXX a
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sName :: forall (c :: ElfClass). SectionXX c -> Word32
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX a
sAddr :: WordXX a
sOffset :: WordXX a
sSize :: WordXX a
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX a
sEntSize :: WordXX a
..}, String
ElfSectionIndex
rbsN :: forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
rbsName :: forall (c :: ElfClass). RBuilder c -> String
rbsN :: ElfSectionIndex
rbsName :: String
..} ElfListXX a
l =
ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'Section a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons ElfSection
{ esName :: String
esName = String
rbsName
, esType :: ElfSectionType
esType = ElfSectionType
sType
, esFlags :: ElfSectionFlag
esFlags = WordXX a -> ElfSectionFlag
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
sFlags
, esAddr :: WordXX a
esAddr = WordXX a
sAddr
, esAddrAlign :: WordXX a
esAddrAlign = WordXX a
sAddrAlign
, esEntSize :: WordXX a
esEntSize = WordXX a
sEntSize
, esN :: ElfSectionIndex
esN = ElfSectionIndex
rbsN
, esInfo :: Word32
esInfo = Word32
sInfo
, esLink :: Word32
esLink = Word32
sLink
, esData :: ElfSectionData a
esData =
if ElfSectionIndex
rbsN ElfSectionIndex -> ElfSectionIndex -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSectionIndex
hShStrNdx
then ElfSectionData a
forall (c :: ElfClass). ElfSectionData c
ElfSectionDataStringTable
else if ElfSectionType
sType ElfSectionType -> ElfSectionType -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSectionType
SHT_NOBITS
then WordXX a -> ElfSectionData a
forall (c :: ElfClass). WordXX c -> ElfSectionData c
ElfSectionDataNoBits WordXX a
sSize
else ByteString -> ElfSectionData a
forall (c :: ElfClass). ByteString -> ElfSectionData c
ElfSectionData (ByteString -> ElfSectionData a) -> ByteString -> ElfSectionData a
forall a b. (a -> b) -> a -> b
$ ByteString -> SectionXX a -> ByteString
forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> SectionXX a -> ByteString
getSectionData ByteString
bs SectionXX a
s
} ElfListXX a
l
rBuilderToElf RBuilderSegment{ rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpHeader = SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX a
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
pType :: ElfSegmentType
pFlags :: ElfSegmentFlag
pOffset :: WordXX a
pVirtAddr :: WordXX a
pPhysAddr :: WordXX a
pFileSize :: WordXX a
pMemSize :: WordXX a
pAlign :: WordXX a
..}, [RBuilder a]
Word16
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpN :: Word16
rbpData :: [RBuilder a]
..} ElfListXX a
l = do
ElfListXX a
d <- (RBuilder a -> ElfListXX a -> m (ElfListXX a))
-> ElfListXX a -> [RBuilder a] -> m (ElfListXX a)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM RBuilder a -> ElfListXX a -> m (ElfListXX a)
rBuilderToElf ElfListXX a
forall (c :: ElfClass). ElfListXX c
ElfListNull [RBuilder a]
rbpData
WordXX a
addMemSize <- if WordXX a
pMemSize WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
0 Bool -> Bool -> Bool
&& WordXX a
pFileSize WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
0 Bool -> Bool -> Bool
&& WordXX a
pMemSize WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
pFileSize
then $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (WordXX a)
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"memSize < fileSize"
else WordXX a -> m (WordXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (WordXX a
pMemSize WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
pFileSize)
ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'Segment a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons ElfSegment
{ epType :: ElfSegmentType
epType = ElfSegmentType
pType
, epFlags :: ElfSegmentFlag
epFlags = ElfSegmentFlag
pFlags
, epVirtAddr :: WordXX a
epVirtAddr = WordXX a
pVirtAddr
, epPhysAddr :: WordXX a
epPhysAddr = WordXX a
pPhysAddr
, epAddMemSize :: WordXX a
epAddMemSize = WordXX a
addMemSize
, epAlign :: WordXX a
epAlign = WordXX a
pAlign
, epData :: ElfListXX a
epData = ElfListXX a
d
} ElfListXX a
l
rBuilderToElf RBuilderRawData{ rbrdInterval :: forall (c :: ElfClass). RBuilder c -> Interval (WordXX c)
rbrdInterval = I WordXX a
o WordXX a
s } ElfListXX a
l =
ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'RawData a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons (ByteString -> ElfXX 'RawData a
forall (c :: ElfClass). ByteString -> ElfXX 'RawData c
ElfRawData (ByteString -> ElfXX 'RawData a) -> ByteString -> ElfXX 'RawData a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> Int64 -> ByteString
cut ByteString
bs (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
o) (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
s)) ElfListXX a
l
rBuilderToElf RBuilderRawAlign{WordXX a
rbraOffset :: forall (c :: ElfClass). RBuilder c -> WordXX c
rbraAlign :: forall (c :: ElfClass). RBuilder c -> WordXX c
rbraOffset :: WordXX a
rbraAlign :: WordXX a
..} ElfListXX a
l =
ElfListXX a -> m (ElfListXX a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfListXX a -> m (ElfListXX a)) -> ElfListXX a -> m (ElfListXX a)
forall a b. (a -> b) -> a -> b
$ ElfXX 'RawAlign a -> ElfListXX a -> ElfListXX a
forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons (WordXX a -> WordXX a -> ElfXX 'RawAlign a
forall (c :: ElfClass). WordXX c -> WordXX c -> ElfXX 'RawAlign c
ElfRawAlign WordXX a
rbraOffset WordXX a
rbraAlign) ElfListXX a
l
ElfListXX a
el <- (RBuilder a -> ElfListXX a -> m (ElfListXX a))
-> ElfListXX a -> [RBuilder a] -> m (ElfListXX a)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM RBuilder a -> ElfListXX a -> m (ElfListXX a)
rBuilderToElf ElfListXX a
forall (c :: ElfClass). ElfListXX c
ElfListNull [RBuilder a]
rbs
Elf -> m Elf
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Elf -> m Elf) -> Elf -> m Elf
forall a b. (a -> b) -> a -> b
$ SingElfClass a -> ElfListXX a -> Elf
forall (a :: ElfClass). SingElfClass a -> ElfListXX a -> Elf
Elf SingElfClass a
forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass ElfListXX a
el
parseElf :: MonadCatch m => BSL.ByteString -> m Elf
parseElf :: forall (m :: * -> *). MonadCatch m => ByteString -> m Elf
parseElf ByteString
bs = do
Headers SingElfClass a
classS HeaderXX a
hdr [SectionXX a]
ss [SegmentXX a]
ps <- ByteString -> m Headers
forall (m :: * -> *). MonadThrow m => ByteString -> m Headers
parseHeaders ByteString
bs
SingElfClass a
-> (SingElfClassI a =>
HeaderXX a
-> [SectionXX a] -> [SegmentXX a] -> ByteString -> m Elf)
-> HeaderXX a
-> [SectionXX a]
-> [SegmentXX a]
-> ByteString
-> m Elf
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass a
classS HeaderXX a -> [SectionXX a] -> [SegmentXX a] -> ByteString -> m Elf
SingElfClassI a =>
HeaderXX a -> [SectionXX a] -> [SegmentXX a] -> ByteString -> m Elf
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
HeaderXX a -> [SectionXX a] -> [SegmentXX a] -> ByteString -> m Elf
parseElf' HeaderXX a
hdr [SectionXX a]
ss [SegmentXX a]
ps ByteString
bs
wbStateInit :: forall a . SingElfClassI a => WBuilderState a
wbStateInit :: forall (a :: ElfClass). SingElfClassI a => WBuilderState a
wbStateInit = WBuilderState
{ _wbsSections :: [(ElfSectionIndex, SectionXX a)]
_wbsSections = []
, _wbsSegmentsReversed :: [SegmentXX a]
_wbsSegmentsReversed = []
, _wbsDataReversed :: [WBuilderData]
_wbsDataReversed = []
, _wbsOffset :: WordXX a
_wbsOffset = WordXX a
0
, _wbsPhOff :: WordXX a
_wbsPhOff = WordXX a
0
, _wbsShOff :: WordXX a
_wbsShOff = WordXX a
0
, _wbsShStrNdx :: ElfSectionIndex
_wbsShStrNdx = ElfSectionIndex
0
, _wbsNameIndexes :: [Int64]
_wbsNameIndexes = []
}
zeroSection :: forall a . SingElfClassI a => SectionXX a
zeroSection :: forall (a :: ElfClass). SingElfClassI a => SectionXX a
zeroSection = Word32
-> ElfSectionType
-> WordXX a
-> WordXX a
-> WordXX a
-> WordXX a
-> Word32
-> Word32
-> WordXX a
-> WordXX a
-> SectionXX a
forall (c :: ElfClass).
Word32
-> ElfSectionType
-> WordXX c
-> WordXX c
-> WordXX c
-> WordXX c
-> Word32
-> Word32
-> WordXX c
-> WordXX c
-> SectionXX c
SectionXX Word32
0 ElfSectionType
0 WordXX a
0 WordXX a
0 WordXX a
0 WordXX a
0 Word32
0 Word32
0 WordXX a
0 WordXX a
0
neighbours :: [a] -> (a -> a -> b) -> [b]
neighbours :: forall a b. [a] -> (a -> a -> b) -> [b]
neighbours [] a -> a -> b
_ = []
neighbours x :: [a]
x@(a
_:[a]
xtail) a -> a -> b
f = ((a, a) -> b) -> [(a, a)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a -> b) -> (a, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> b
f) ([(a, a)] -> [b]) -> [(a, a)] -> [b]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [a]
x [a]
xtail
mkStringTable :: [String] -> (BSL.ByteString, [Int64])
mkStringTable :: [String] -> (ByteString, [Int64])
mkStringTable [String]
sectionNames = (ByteString
stringTable, [Int64]
os)
where
([(Word32, String)]
ins0, [(Word32, String)]
ins) = ((Word32, String) -> Bool)
-> [(Word32, String)] -> ([(Word32, String)], [(Word32, String)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") (String -> Bool)
-> ((Word32, String) -> String) -> (Word32, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32, String) -> String
forall a b. (a, b) -> b
snd) ([(Word32, String)] -> ([(Word32, String)], [(Word32, String)]))
-> [(Word32, String)] -> ([(Word32, String)], [(Word32, String)])
forall a b. (a -> b) -> a -> b
$ ((Word32, String) -> Int)
-> [(Word32, String)] -> [(Word32, String)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length (String -> Int)
-> ((Word32, String) -> String) -> (Word32, String) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32, String) -> String
forall a b. (a, b) -> b
snd) ([(Word32, String)] -> [(Word32, String)])
-> [(Word32, String)] -> [(Word32, String)]
forall a b. (a -> b) -> a -> b
$ [Word32] -> [String] -> [(Word32, String)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [(Word32
1 :: Word32) .. ] [String]
sectionNames
ios0 :: [(Word32, Int64)]
ios0 = ((Word32, String) -> (Word32, Int64))
-> [(Word32, String)] -> [(Word32, Int64)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32, String) -> (Word32, Int64)
forall {b} {a} {b}. Num b => (a, b) -> (a, b)
f' [(Word32, String)]
ins0
where
f' :: (a, b) -> (a, b)
f' (a
i, b
_) = (a
i, b
0)
(ByteString
stringTable, [(Word32, Int64)]
ios, [(Word32, String)]
_) = (ByteString, [(Word32, Int64)], [(Word32, String)])
-> (ByteString, [(Word32, Int64)], [(Word32, String)])
forall {a}.
(ByteString, [(a, Int64)], [(a, String)])
-> (ByteString, [(a, Int64)], [(a, String)])
f (Word8 -> ByteString
BSL.singleton Word8
0, [], [(Word32, String)] -> [(Word32, String)]
forall a. [a] -> [a]
L.reverse [(Word32, String)]
ins)
os :: [Int64]
os = ((Word32, Int64) -> Int64) -> [(Word32, Int64)] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32, Int64) -> Int64
forall a b. (a, b) -> b
snd ([(Word32, Int64)] -> [Int64]) -> [(Word32, Int64)] -> [Int64]
forall a b. (a -> b) -> a -> b
$ ((Word32, Int64) -> Word32)
-> [(Word32, Int64)] -> [(Word32, Int64)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (Word32, Int64) -> Word32
forall a b. (a, b) -> a
fst ([(Word32, Int64)] -> [(Word32, Int64)])
-> [(Word32, Int64)] -> [(Word32, Int64)]
forall a b. (a -> b) -> a -> b
$ [(Word32, Int64)]
ios0 [(Word32, Int64)] -> [(Word32, Int64)] -> [(Word32, Int64)]
forall a. [a] -> [a] -> [a]
++ [(Word32, Int64)]
ios
f :: (ByteString, [(a, Int64)], [(a, String)])
-> (ByteString, [(a, Int64)], [(a, String)])
f x :: (ByteString, [(a, Int64)], [(a, String)])
x@(ByteString
_, [(a, Int64)]
_, []) = (ByteString, [(a, Int64)], [(a, String)])
x
f (ByteString
st, [(a, Int64)]
iosf, (a
i, String
n) : [(a, String)]
insf) = (ByteString, [(a, Int64)], [(a, String)])
-> (ByteString, [(a, Int64)], [(a, String)])
f (ByteString
st', [(a, Int64)]
iosf'', [(a, String)]
insf')
where
st' :: ByteString
st' = ByteString
st ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BSL8.pack String
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BSL.singleton Word8
0
o :: Int64
o = ByteString -> Int64
BSL.length ByteString
st
iosf'' :: [(a, Int64)]
iosf'' = (a
i, Int64
o) (a, Int64) -> [(a, Int64)] -> [(a, Int64)]
forall a. a -> [a] -> [a]
: [(a, Int64)]
iosf' [(a, Int64)] -> [(a, Int64)] -> [(a, Int64)]
forall a. [a] -> [a] -> [a]
++ [(a, Int64)]
iosf
([(a, Int64)]
iosf', [(a, String)]
insf') = [(a, String)] -> ([(a, Int64)], [(a, String)])
ff [(a, String)]
insf
ff :: [(a, String)] -> ([(a, Int64)], [(a, String)])
ff = ((a, String)
-> ([(a, Int64)], [(a, String)]) -> ([(a, Int64)], [(a, String)]))
-> ([(a, Int64)], [(a, String)])
-> [(a, String)]
-> ([(a, Int64)], [(a, String)])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr (a, String)
-> ([(a, Int64)], [(a, String)]) -> ([(a, Int64)], [(a, String)])
fff ([], [])
where
fff :: (a, String)
-> ([(a, Int64)], [(a, String)]) -> ([(a, Int64)], [(a, String)])
fff (a
i', String
n') ([(a, Int64)]
iosff, [(a, String)]
insff) = if String
n' String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` String
n
then
let
o' :: Int64
o' = Int64
o Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
n')
in
((a
i', Int64
o') (a, Int64) -> [(a, Int64)] -> [(a, Int64)]
forall a. a -> [a] -> [a]
: [(a, Int64)]
iosff, [(a, String)]
insff)
else ([(a, Int64)]
iosff, (a
i', String
n') (a, String) -> [(a, String)] -> [(a, String)]
forall a. a -> [a] -> [a]
: [(a, String)]
insff)
serializeElf' :: forall a m . (SingElfClassI a, MonadCatch m) => ElfListXX a -> m BSL.ByteString
serializeElf' :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
ElfListXX a -> m ByteString
serializeElf' ElfListXX a
elfs = do
ElfXX 'Header a
header' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (ElfXX 'Header a) -> m (ElfXX 'Header a)
(Loc -> String -> m (ElfXX 'Header a) -> m (ElfXX 'Header a))
-> String -> Loc -> m (ElfXX 'Header a) -> m (ElfXX 'Header a)
forall a. [a]
forall a b c. (a -> b -> c) -> b -> a -> c
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (ElfXX 'Header a) -> m (ElfXX 'Header a))
-> m (ElfXX 'Header a) -> m (ElfXX 'Header a)
forall a b. (a -> b) -> a -> b
$ ElfListXX a -> m (ElfXX 'Header a)
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadThrow m) =>
ElfListXX a -> m (ElfXX 'Header a)
elfFindHeader ElfListXX a
elfs
let
elfClass :: ElfClass
elfClass = SingElfClass a -> ElfClass
forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass (SingElfClass a -> ElfClass) -> SingElfClass a -> ElfClass
forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a
sectionN :: Num b => b
sectionN :: forall b. Num b => b
sectionN = Sum b -> b
forall a. Sum a -> a
getSum (Sum b -> b) -> Sum b -> b
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType). ElfXX t' a -> Sum b)
-> ElfListXX a -> Sum b
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> Sum b
forall {a} {t :: ElfNodeType} {c :: ElfClass}.
Num a =>
ElfXX t c -> Sum a
forall (t' :: ElfNodeType). ElfXX t' a -> Sum b
f ElfListXX a
elfs
where
f :: ElfXX t c -> Sum a
f ElfSection{} = a -> Sum a
forall a. a -> Sum a
Sum a
1
f ElfXX t c
_ = a -> Sum a
forall a. a -> Sum a
Sum a
0
sectionNames :: [String]
sectionNames :: [String]
sectionNames = (forall (t' :: ElfNodeType). ElfXX t' a -> [String])
-> ElfListXX a -> [String]
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> [String]
forall (t' :: ElfNodeType). ElfXX t' a -> [String]
f ElfListXX a
elfs
where
f :: ElfXX t a -> [String]
f :: forall (t' :: ElfNodeType). ElfXX t' a -> [String]
f ElfSection{String
Word32
ElfSectionType
ElfSectionFlag
ElfSectionIndex
WordXX a
ElfSectionData a
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esName :: String
esType :: ElfSectionType
esFlags :: ElfSectionFlag
esAddr :: WordXX a
esAddrAlign :: WordXX a
esEntSize :: WordXX a
esN :: ElfSectionIndex
esInfo :: Word32
esLink :: Word32
esData :: ElfSectionData a
..} = [ String
esName ]
f ElfXX t a
_ = []
(ByteString
stringTable, [Int64]
nameIndexes) = [String] -> (ByteString, [Int64])
mkStringTable [String]
sectionNames
segmentN :: Num b => b
segmentN :: forall b. Num b => b
segmentN = Sum b -> b
forall a. Sum a -> a
getSum (Sum b -> b) -> Sum b -> b
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType). ElfXX t' a -> Sum b)
-> ElfListXX a -> Sum b
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> Sum b
forall {a} {t :: ElfNodeType} {c :: ElfClass}.
Num a =>
ElfXX t c -> Sum a
forall (t' :: ElfNodeType). ElfXX t' a -> Sum b
f ElfListXX a
elfs
where
f :: ElfXX t c -> Sum a
f ElfSegment{} = a -> Sum a
forall a. a -> Sum a
Sum a
1
f ElfXX t c
_ = a -> Sum a
forall a. a -> Sum a
Sum a
0
sectionTable :: Bool
sectionTable :: Bool
sectionTable = Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType). ElfXX t' a -> Any)
-> ElfListXX a -> Any
forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList ElfXX t' a -> Any
forall (t' :: ElfNodeType). ElfXX t' a -> Any
forall {t :: ElfNodeType} {c :: ElfClass}. ElfXX t c -> Any
f ElfListXX a
elfs
where
f :: ElfXX t c -> Any
f ElfXX t c
ElfSectionTable = Bool -> Any
Any Bool
True
f ElfXX t c
_ = Bool -> Any
Any Bool
False
align :: (MonadThrow n, MonadState (WBuilderState a) n) => WordXX a -> WordXX a -> n ()
align :: forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
WordXX a -> WordXX a -> n ()
align WordXX a
_ WordXX a
0 = () -> n ()
forall a. a -> n a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
align WordXX a
_ WordXX a
1 = () -> n ()
forall a. a -> n a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
align WordXX a
t WordXX a
m | WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Bits a => a -> a -> a
.&. (WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1) WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
0 = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> n ()
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> n ()) -> String -> n ()
forall a b. (a -> b) -> a -> b
$ String
"align module is not power of two " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WordXX a -> String
forall a. Show a => a -> String
show WordXX a
m
| Bool
otherwise = do
WordXX a
offset <- Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset
(WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= WordXX a -> WordXX a -> WordXX a -> WordXX a
forall (a :: ElfClass).
SingElfClassI a =>
WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset WordXX a
t WordXX a
m WordXX a
offset
WordXX a
offset' <- Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset
([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ByteString -> WBuilderData
WBuilderDataByteStream (Int64 -> Word8 -> ByteString
BSL.replicate (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordXX a -> Int64) -> WordXX a -> Int64
forall a b. (a -> b) -> a -> b
$ WordXX a
offset' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
offset) Word8
0) WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)
alignWord :: (MonadThrow n, MonadState (WBuilderState a) n) => n ()
alignWord :: forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
n ()
alignWord = WordXX a -> WordXX a -> n ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
WordXX a -> WordXX a -> n ()
align WordXX a
0 (WordXX a -> n ()) -> WordXX a -> n ()
forall a b. (a -> b) -> a -> b
$ ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
wordSize (ElfClass -> WordXX a) -> ElfClass -> WordXX a
forall a b. (a -> b) -> a -> b
$ SingElfClass a -> ElfClass
forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass (SingElfClass a -> ElfClass) -> SingElfClass a -> ElfClass
forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a
dataIsEmpty :: ElfSectionData c -> Bool
dataIsEmpty :: forall (c :: ElfClass). ElfSectionData c -> Bool
dataIsEmpty (ElfSectionData ByteString
bs) = ByteString -> Bool
BSL.null ByteString
bs
dataIsEmpty ElfSectionData c
ElfSectionDataStringTable = ByteString -> Bool
BSL.null ByteString
stringTable
dataIsEmpty (ElfSectionDataNoBits WordXX c
_) = Bool
True
lastSection :: ElfListXX a -> (forall t' . (ElfXX t' a -> b)) -> b -> b
lastSection :: forall b.
ElfListXX a
-> (forall (t' :: ElfNodeType). ElfXX t' a -> b) -> b -> b
lastSection ElfListXX a
ElfListNull forall (t' :: ElfNodeType). ElfXX t' a -> b
_ b
b = b
b
lastSection (ElfListCons ElfXX t a
v ElfListXX a
ElfListNull) forall (t' :: ElfNodeType). ElfXX t' a -> b
f b
_ = ElfXX t a -> b
forall (t' :: ElfNodeType). ElfXX t' a -> b
f ElfXX t a
v
lastSection (ElfListCons ElfXX t a
_ ElfListXX a
l) forall (t' :: ElfNodeType). ElfXX t' a -> b
f b
b = ElfListXX a
-> (forall (t' :: ElfNodeType). ElfXX t' a -> b) -> b -> b
forall b.
ElfListXX a
-> (forall (t' :: ElfNodeType). ElfXX t' a -> b) -> b -> b
lastSection ElfListXX a
l ElfXX t' a -> b
forall (t' :: ElfNodeType). ElfXX t' a -> b
f b
b
lastSectionIsEmpty :: ElfListXX a -> Bool
lastSectionIsEmpty :: ElfListXX a -> Bool
lastSectionIsEmpty ElfListXX a
l = ElfListXX a
-> (forall (t' :: ElfNodeType). ElfXX t' a -> Bool) -> Bool -> Bool
forall b.
ElfListXX a
-> (forall (t' :: ElfNodeType). ElfXX t' a -> b) -> b -> b
lastSection ElfListXX a
l ElfXX t' a -> Bool
forall (t' :: ElfNodeType). ElfXX t' a -> Bool
forall {t :: ElfNodeType} {c :: ElfClass}. ElfXX t c -> Bool
f Bool
False
where
f :: ElfXX t c -> Bool
f ElfSection { String
Word32
ElfSectionType
ElfSectionFlag
ElfSectionIndex
WordXX c
ElfSectionData c
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esName :: String
esType :: ElfSectionType
esFlags :: ElfSectionFlag
esAddr :: WordXX c
esAddrAlign :: WordXX c
esEntSize :: WordXX c
esN :: ElfSectionIndex
esInfo :: Word32
esLink :: Word32
esData :: ElfSectionData c
.. } = ElfSectionData c -> Bool
forall (c :: ElfClass). ElfSectionData c -> Bool
dataIsEmpty ElfSectionData c
esData
f ElfXX t c
_ = Bool
False
elf2WBuilder :: (MonadThrow n, MonadState (WBuilderState a) n) => ElfXX t a -> n ()
elf2WBuilder :: forall (n :: * -> *) (t :: ElfNodeType).
(MonadThrow n, MonadState (WBuilderState a) n) =>
ElfXX t a -> n ()
elf2WBuilder ElfHeader{} = do
([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (WBuilderData
WBuilderDataHeader WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)
(WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
headerSize ElfClass
elfClass
elf2WBuilder ElfXX t a
ElfSectionTable = do
n ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
n ()
alignWord
Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset n (WordXX a) -> (WordXX a -> n ()) -> n ()
forall a b. n a -> (a -> n b) -> n b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsShOff
([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (WBuilderData
WBuilderDataSectionTable WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)
(WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= (WordXX a
forall b. Num b => b
sectionN WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
1) WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
* ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
sectionTableEntrySize ElfClass
elfClass
elf2WBuilder ElfXX t a
ElfSegmentTable = do
n ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
n ()
alignWord
Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset n (WordXX a) -> (WordXX a -> n ()) -> n ()
forall a b. n a -> (a -> n b) -> n b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign (WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsPhOff
([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (WBuilderData
WBuilderDataSegmentTable WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)
(WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= WordXX a
forall b. Num b => b
segmentN WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
* ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
segmentTableEntrySize ElfClass
elfClass
elf2WBuilder ElfSection{esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esFlags = ElfSectionFlag Word64
f, String
Word32
ElfSectionType
ElfSectionIndex
WordXX a
ElfSectionData a
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esName :: String
esType :: ElfSectionType
esAddr :: WordXX a
esAddrAlign :: WordXX a
esEntSize :: WordXX a
esN :: ElfSectionIndex
esInfo :: Word32
esLink :: Word32
esData :: ElfSectionData a
..} = do
Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word64
f Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. WordXX a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordXX a -> WordXX a
forall a. Bits a => a -> a
complement (forall a. Bounded a => a
maxBound @(WordXX a))) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0) do
$Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> n ()
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> n ()) -> String -> n ()
forall a b. (a -> b) -> a -> b
$ String
"section flags at section " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ElfSectionIndex -> String
forall a. Show a => a -> String
show ElfSectionIndex
esN String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"don't fit"
Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ElfSectionType
esType ElfSectionType -> ElfSectionType -> Bool
forall a. Eq a => a -> a -> Bool
/= ElfSectionType
SHT_NOBITS Bool -> Bool -> Bool
|| (ElfXX 'Header a -> ElfType
forall (c :: ElfClass). ElfXX 'Header c -> ElfType
ehType ElfXX 'Header a
header') ElfType -> ElfType -> Bool
forall a. Eq a => a -> a -> Bool
== ElfType
ET_REL) do
WordXX a -> WordXX a -> n ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
WordXX a -> WordXX a -> n ()
align WordXX a
0 WordXX a
esAddrAlign
(Int64
n, [Int64]
ns) <- LensLike' (Const (Int64, [Int64])) (WBuilderState a) [Int64]
-> ([Int64] -> (Int64, [Int64])) -> n (Int64, [Int64])
forall s (m :: * -> *) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses LensLike' (Const (Int64, [Int64])) (WBuilderState a) [Int64]
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([Int64] -> f [Int64]) -> WBuilderState a -> f (WBuilderState a)
wbsNameIndexes \case
Int64
n' : [Int64]
ns' -> (Int64
n', [Int64]
ns')
[Int64]
_ -> String -> (Int64, [Int64])
forall a. HasCallStack => String -> a
error String
"internal error: different number of sections in two iterations"
ElfSectionIndex
shStrNdx' <- Getting ElfSectionIndex (WBuilderState a) ElfSectionIndex
-> n ElfSectionIndex
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting ElfSectionIndex (WBuilderState a) ElfSectionIndex
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(ElfSectionIndex -> f ElfSectionIndex)
-> WBuilderState a -> f (WBuilderState a)
wbsShStrNdx
let
(ByteString
d, ElfSectionIndex
shStrNdx, WordXX a
sz) = case ElfSectionData a
esData of
ElfSectionData { ByteString
esdData :: forall (c :: ElfClass). ElfSectionData c -> ByteString
esdData :: ByteString
.. } -> (ByteString
esdData, ElfSectionIndex
shStrNdx', Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> WordXX a) -> Int64 -> WordXX a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length ByteString
esdData)
ElfSectionData a
ElfSectionDataStringTable -> (ByteString
stringTable, ElfSectionIndex
esN, Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> WordXX a) -> Int64 -> WordXX a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length ByteString
stringTable)
ElfSectionDataNoBits { WordXX a
esdSize :: forall (c :: ElfClass). ElfSectionData c -> WordXX c
esdSize :: WordXX a
.. } -> (ByteString
BSL.empty, ElfSectionIndex
shStrNdx', WordXX a
esdSize)
sName :: Word32
sName = Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n
sType :: ElfSectionType
sType = ElfSectionType
esType
sFlags :: WordXX a
sFlags = Word64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
f
sAddr :: WordXX a
sAddr = WordXX a
esAddr
sSize :: WordXX a
sSize = WordXX a
sz
sLink :: Word32
sLink = Word32
esLink
sInfo :: Word32
sInfo = Word32
esInfo
sAddrAlign :: WordXX a
sAddrAlign = WordXX a
esAddrAlign
sEntSize :: WordXX a
sEntSize = WordXX a
esEntSize
WordXX a
sOffset <- Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset
([(ElfSectionIndex, SectionXX a)]
-> Identity [(ElfSectionIndex, SectionXX a)])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([(ElfSectionIndex, SectionXX a)]
-> f [(ElfSectionIndex, SectionXX a)])
-> WBuilderState a -> f (WBuilderState a)
wbsSections (([(ElfSectionIndex, SectionXX a)]
-> Identity [(ElfSectionIndex, SectionXX a)])
-> WBuilderState a -> Identity (WBuilderState a))
-> ([(ElfSectionIndex, SectionXX a)]
-> [(ElfSectionIndex, SectionXX a)])
-> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((ElfSectionIndex
esN, SectionXX { Word32
ElfSectionType
WordXX a
sEntSize :: WordXX a
sAddrAlign :: WordXX a
sInfo :: Word32
sLink :: Word32
sSize :: WordXX a
sOffset :: WordXX a
sAddr :: WordXX a
sFlags :: WordXX a
sType :: ElfSectionType
sName :: Word32
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX a
sAddr :: WordXX a
sSize :: WordXX a
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX a
sEntSize :: WordXX a
sOffset :: WordXX a
.. }) (ElfSectionIndex, SectionXX a)
-> [(ElfSectionIndex, SectionXX a)]
-> [(ElfSectionIndex, SectionXX a)]
forall a. a -> [a] -> [a]
:)
([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ByteString -> WBuilderData
WBuilderDataByteStream ByteString
d WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)
(WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
d)
(ElfSectionIndex -> Identity ElfSectionIndex)
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(ElfSectionIndex -> f ElfSectionIndex)
-> WBuilderState a -> f (WBuilderState a)
wbsShStrNdx ((ElfSectionIndex -> Identity ElfSectionIndex)
-> WBuilderState a -> Identity (WBuilderState a))
-> ElfSectionIndex -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ElfSectionIndex
shStrNdx
([Int64] -> Identity [Int64])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([Int64] -> f [Int64]) -> WBuilderState a -> f (WBuilderState a)
wbsNameIndexes (([Int64] -> Identity [Int64])
-> WBuilderState a -> Identity (WBuilderState a))
-> [Int64] -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [Int64]
ns
elf2WBuilder ElfSegment { ElfSegmentType
ElfSegmentFlag
WordXX a
ElfListXX a
epType :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentType
epFlags :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentFlag
epVirtAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epPhysAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAddMemSize :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAlign :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epData :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfListXX c
epType :: ElfSegmentType
epFlags :: ElfSegmentFlag
epVirtAddr :: WordXX a
epPhysAddr :: WordXX a
epAddMemSize :: WordXX a
epAlign :: WordXX a
epData :: ElfListXX a
.. } = do
WordXX a -> WordXX a -> n ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
WordXX a -> WordXX a -> n ()
align WordXX a
epVirtAddr WordXX a
epAlign
WordXX a
offset <- Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset
n [()] -> n ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (n [()] -> n ()) -> n [()] -> n ()
forall a b. (a -> b) -> a -> b
$ (forall (t' :: ElfNodeType). ElfXX t' a -> n ())
-> ElfListXX a -> n [()]
forall (m :: * -> *) (a :: ElfClass) b.
Monad m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m b)
-> ElfListXX a -> m [b]
mapMElfList ElfXX t' a -> n ()
forall (t' :: ElfNodeType). ElfXX t' a -> n ()
forall (n :: * -> *) (t :: ElfNodeType).
(MonadThrow n, MonadState (WBuilderState a) n) =>
ElfXX t a -> n ()
elf2WBuilder ElfListXX a
epData
WordXX a
offset' <- Getting (WordXX a) (WBuilderState a) (WordXX a) -> n (WordXX a)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (WordXX a) (WBuilderState a) (WordXX a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset
let
add1 :: Bool
add1 = ElfListXX a -> Bool
lastSectionIsEmpty ElfListXX a
epData Bool -> Bool -> Bool
&& WordXX a
offset WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
offset'
pType :: ElfSegmentType
pType = ElfSegmentType
epType
pFlags :: ElfSegmentFlag
pFlags = ElfSegmentFlag
epFlags
pOffset :: WordXX a
pOffset = WordXX a
offset
pVirtAddr :: WordXX a
pVirtAddr = WordXX a
epVirtAddr
pPhysAddr :: WordXX a
pPhysAddr = WordXX a
epPhysAddr
pFileSize :: WordXX a
pFileSize = WordXX a
offset' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
offset WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ if Bool
add1 then WordXX a
1 else WordXX a
0
pMemSize :: WordXX a
pMemSize = WordXX a
pFileSize WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
epAddMemSize
pAlign :: WordXX a
pAlign = WordXX a
epAlign
([SegmentXX a] -> Identity [SegmentXX a])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([SegmentXX a] -> f [SegmentXX a])
-> WBuilderState a -> f (WBuilderState a)
wbsSegmentsReversed (([SegmentXX a] -> Identity [SegmentXX a])
-> WBuilderState a -> Identity (WBuilderState a))
-> ([SegmentXX a] -> [SegmentXX a]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (SegmentXX { ElfSegmentType
ElfSegmentFlag
WordXX a
pMemSize :: WordXX a
pFileSize :: WordXX a
pAlign :: WordXX a
pPhysAddr :: WordXX a
pVirtAddr :: WordXX a
pOffset :: WordXX a
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
pType :: ElfSegmentType
pFlags :: ElfSegmentFlag
pOffset :: WordXX a
pVirtAddr :: WordXX a
pPhysAddr :: WordXX a
pFileSize :: WordXX a
pMemSize :: WordXX a
pAlign :: WordXX a
.. } SegmentXX a -> [SegmentXX a] -> [SegmentXX a]
forall a. a -> [a] -> [a]
:)
Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
add1 do
([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ByteString -> WBuilderData
WBuilderDataByteStream (Word8 -> ByteString
BSL.singleton Word8
0) WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)
(WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= WordXX a
1
elf2WBuilder ElfRawData { ByteString
edData :: forall (c :: ElfClass). ElfXX 'RawData c -> ByteString
edData :: ByteString
.. } = do
([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
([WBuilderData] -> f [WBuilderData])
-> WBuilderState a -> f (WBuilderState a)
wbsDataReversed (([WBuilderData] -> Identity [WBuilderData])
-> WBuilderState a -> Identity (WBuilderState a))
-> ([WBuilderData] -> [WBuilderData]) -> n ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ByteString -> WBuilderData
WBuilderDataByteStream ByteString
edData WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
:)
(WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a)
forall (a :: ElfClass) (f :: * -> *).
Functor f =>
(WordXX a -> f (WordXX a))
-> WBuilderState a -> f (WBuilderState a)
wbsOffset ((WordXX a -> Identity (WordXX a))
-> WBuilderState a -> Identity (WBuilderState a))
-> WordXX a -> n ()
forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
edData)
elf2WBuilder ElfRawAlign { WordXX a
eaOffset :: forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaAlign :: forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaOffset :: WordXX a
eaAlign :: WordXX a
.. } = WordXX a -> WordXX a -> n ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
WordXX a -> WordXX a -> n ()
align WordXX a
eaOffset WordXX a
eaAlign
fixSections :: [(ElfSectionIndex, SectionXX a)] -> m [SectionXX a]
fixSections :: [(ElfSectionIndex, SectionXX a)] -> m [SectionXX a]
fixSections [(ElfSectionIndex, SectionXX a)]
ss = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(ElfSectionIndex, SectionXX a)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [(ElfSectionIndex, SectionXX a)]
ss Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall b. Num b => b
sectionN) (String -> m ()
forall a. HasCallStack => String -> a
error String
"internal error: L.length ss /= sectionN")
let
f :: (a, b) -> (a, b) -> Ordering
f (a
ln, b
_) (a
rn, b
_) = a
ln a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
rn
sorted :: [(ElfSectionIndex, SectionXX a)]
sorted = ((ElfSectionIndex, SectionXX a)
-> (ElfSectionIndex, SectionXX a) -> Ordering)
-> [(ElfSectionIndex, SectionXX a)]
-> [(ElfSectionIndex, SectionXX a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (ElfSectionIndex, SectionXX a)
-> (ElfSectionIndex, SectionXX a) -> Ordering
forall {a} {b} {b}. Ord a => (a, b) -> (a, b) -> Ordering
f [(ElfSectionIndex, SectionXX a)]
ss
next :: (a, b) -> (a, b) -> Bool
next (a
ln, b
_) (a
rn, b
_) = a
ln a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
rn
checkNeibours :: Bool
checkNeibours = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ [(ElfSectionIndex, SectionXX a)]
-> ((ElfSectionIndex, SectionXX a)
-> (ElfSectionIndex, SectionXX a) -> Bool)
-> [Bool]
forall a b. [a] -> (a -> a -> b) -> [b]
neighbours [(ElfSectionIndex, SectionXX a)]
sorted (ElfSectionIndex, SectionXX a)
-> (ElfSectionIndex, SectionXX a) -> Bool
forall {a} {b} {b}. (Eq a, Num a) => (a, b) -> (a, b) -> Bool
next
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
checkNeibours ($Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m ()
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"sections are not consistent")
[SectionXX a] -> m [SectionXX a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SectionXX a] -> m [SectionXX a])
-> [SectionXX a] -> m [SectionXX a]
forall a b. (a -> b) -> a -> b
$ ((ElfSectionIndex, SectionXX a) -> SectionXX a)
-> [(ElfSectionIndex, SectionXX a)] -> [SectionXX a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ElfSectionIndex, SectionXX a) -> SectionXX a
forall a b. (a, b) -> b
snd [(ElfSectionIndex, SectionXX a)]
sorted
wbState2ByteString :: WBuilderState a -> m BSL.ByteString
wbState2ByteString :: WBuilderState a -> m ByteString
wbState2ByteString WBuilderState{[Int64]
[(ElfSectionIndex, SectionXX a)]
[SegmentXX a]
[WBuilderData]
ElfSectionIndex
WordXX a
_wbsSections :: forall (a :: ElfClass).
WBuilderState a -> [(ElfSectionIndex, SectionXX a)]
_wbsSegmentsReversed :: forall (a :: ElfClass). WBuilderState a -> [SegmentXX a]
_wbsDataReversed :: forall (a :: ElfClass). WBuilderState a -> [WBuilderData]
_wbsOffset :: forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsPhOff :: forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsShOff :: forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsShStrNdx :: forall (a :: ElfClass). WBuilderState a -> ElfSectionIndex
_wbsNameIndexes :: forall (a :: ElfClass). WBuilderState a -> [Int64]
_wbsSections :: [(ElfSectionIndex, SectionXX a)]
_wbsSegmentsReversed :: [SegmentXX a]
_wbsDataReversed :: [WBuilderData]
_wbsOffset :: WordXX a
_wbsPhOff :: WordXX a
_wbsShOff :: WordXX a
_wbsShStrNdx :: ElfSectionIndex
_wbsNameIndexes :: [Int64]
..} = do
[SectionXX a]
sections <- [(ElfSectionIndex, SectionXX a)] -> m [SectionXX a]
fixSections [(ElfSectionIndex, SectionXX a)]
_wbsSections
let
f :: WBuilderData -> ByteString
f WBuilderData
WBuilderDataHeader =
case ElfXX 'Header a
header' of
ElfHeader{Word8
Word32
ElfOSABI
ElfType
ElfMachine
WordXX a
ElfData
ehData :: forall (c :: ElfClass). ElfXX 'Header c -> ElfData
ehOSABI :: forall (c :: ElfClass). ElfXX 'Header c -> ElfOSABI
ehABIVersion :: forall (c :: ElfClass). ElfXX 'Header c -> Word8
ehType :: forall (c :: ElfClass). ElfXX 'Header c -> ElfType
ehMachine :: forall (c :: ElfClass). ElfXX 'Header c -> ElfMachine
ehEntry :: forall (c :: ElfClass). ElfXX 'Header c -> WordXX c
ehFlags :: forall (c :: ElfClass). ElfXX 'Header c -> Word32
ehData :: ElfData
ehOSABI :: ElfOSABI
ehABIVersion :: Word8
ehType :: ElfType
ehMachine :: ElfMachine
ehEntry :: WordXX a
ehFlags :: Word32
..} ->
let
hData :: ElfData
hData = ElfData
ehData
hOSABI :: ElfOSABI
hOSABI = ElfOSABI
ehOSABI
hABIVersion :: Word8
hABIVersion = Word8
ehABIVersion
hType :: ElfType
hType = ElfType
ehType
hMachine :: ElfMachine
hMachine = ElfMachine
ehMachine
hEntry :: WordXX a
hEntry = WordXX a
ehEntry
hPhOff :: WordXX a
hPhOff = WordXX a
_wbsPhOff
hShOff :: WordXX a
hShOff = WordXX a
_wbsShOff
hFlags :: Word32
hFlags = Word32
ehFlags
hPhEntSize :: Word16
hPhEntSize = ElfClass -> Word16
forall a. Num a => ElfClass -> a
segmentTableEntrySize ElfClass
elfClass
hPhNum :: Word16
hPhNum = Word16
forall b. Num b => b
segmentN :: Word16
hShEntSize :: Word16
hShEntSize = ElfClass -> Word16
forall a. Num a => ElfClass -> a
sectionTableEntrySize ElfClass
elfClass
hShNum :: Word16
hShNum = (if Bool
sectionTable then Word16
forall b. Num b => b
sectionN Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1 else Word16
0) :: Word16
hShStrNdx :: ElfSectionIndex
hShStrNdx = ElfSectionIndex
_wbsShStrNdx
h :: H.Header
h :: Header
h = SingElfClass a -> HeaderXX a -> Header
forall (a :: ElfClass). SingElfClass a -> HeaderXX a -> Header
H.Header (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hShStrNdx :: ElfSectionIndex
hShNum :: Word16
hShEntSize :: Word16
hPhNum :: Word16
hPhEntSize :: Word16
hFlags :: Word32
hShOff :: WordXX a
hPhOff :: WordXX a
hEntry :: WordXX a
hMachine :: ElfMachine
hType :: ElfType
hABIVersion :: Word8
hOSABI :: ElfOSABI
hData :: ElfData
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX a
hPhOff :: WordXX a
hShOff :: WordXX a
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
..}
in
Header -> ByteString
forall a. Binary a => a -> ByteString
encode Header
h
f WBuilderDataByteStream {ByteString
wbdData :: WBuilderData -> ByteString
wbdData :: ByteString
..} = ByteString
wbdData
f WBuilderData
WBuilderDataSectionTable =
ElfData -> [SectionXX a] -> ByteString
forall a.
(Binary (Le a), Binary (Be a)) =>
ElfData -> [a] -> ByteString
serializeBList (ElfXX 'Header a -> ElfData
forall (c :: ElfClass). ElfXX 'Header c -> ElfData
ehData ElfXX 'Header a
header') ([SectionXX a] -> ByteString) -> [SectionXX a] -> ByteString
forall a b. (a -> b) -> a -> b
$ SectionXX a
forall (a :: ElfClass). SingElfClassI a => SectionXX a
zeroSection SectionXX a -> [SectionXX a] -> [SectionXX a]
forall a. a -> [a] -> [a]
: [SectionXX a]
sections
f WBuilderData
WBuilderDataSegmentTable =
ElfData -> [SegmentXX a] -> ByteString
forall a.
(Binary (Le a), Binary (Be a)) =>
ElfData -> [a] -> ByteString
serializeBList (ElfXX 'Header a -> ElfData
forall (c :: ElfClass). ElfXX 'Header c -> ElfData
ehData ElfXX 'Header a
header') ([SegmentXX a] -> ByteString) -> [SegmentXX a] -> ByteString
forall a b. (a -> b) -> a -> b
$ [SegmentXX a] -> [SegmentXX a]
forall a. [a] -> [a]
L.reverse [SegmentXX a]
_wbsSegmentsReversed
ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ (WBuilderData -> ByteString) -> [WBuilderData] -> ByteString
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WBuilderData -> ByteString
f ([WBuilderData] -> ByteString) -> [WBuilderData] -> ByteString
forall a b. (a -> b) -> a -> b
$ [WBuilderData] -> [WBuilderData]
forall a. [a] -> [a]
L.reverse [WBuilderData]
_wbsDataReversed
StateT (WBuilderState a) m [()]
-> WBuilderState a -> m (WBuilderState a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ((forall (t' :: ElfNodeType).
ElfXX t' a -> StateT (WBuilderState a) m ())
-> ElfListXX a -> StateT (WBuilderState a) m [()]
forall (m :: * -> *) (a :: ElfClass) b.
Monad m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m b)
-> ElfListXX a -> m [b]
mapMElfList ElfXX t' a -> StateT (WBuilderState a) m ()
forall (t' :: ElfNodeType).
ElfXX t' a -> StateT (WBuilderState a) m ()
forall (n :: * -> *) (t :: ElfNodeType).
(MonadThrow n, MonadState (WBuilderState a) n) =>
ElfXX t a -> n ()
elf2WBuilder ElfListXX a
elfs) WBuilderState a
forall (a :: ElfClass). SingElfClassI a => WBuilderState a
wbStateInit{ _wbsNameIndexes = nameIndexes } m (WBuilderState a)
-> (WBuilderState a -> m ByteString) -> m ByteString
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WBuilderState a -> m ByteString
wbState2ByteString
serializeElf :: MonadCatch m => Elf -> m BSL.ByteString
serializeElf :: forall (m :: * -> *). MonadCatch m => Elf -> m ByteString
serializeElf (Elf SingElfClass a
classS ElfListXX a
ls) = SingElfClass a
-> (SingElfClassI a => ElfListXX a -> m ByteString)
-> ElfListXX a
-> m ByteString
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass a
classS SingElfClassI a => ElfListXX a -> m ByteString
ElfListXX a -> m ByteString
forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
ElfListXX a -> m ByteString
serializeElf' ElfListXX a
ls
data ElfSymbolXX c =
ElfSymbolXX
{ forall (c :: ElfClass). ElfSymbolXX c -> String
steName :: String
, forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolBinding
steBind :: ElfSymbolBinding
, forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolType
steType :: ElfSymbolType
, forall (c :: ElfClass). ElfSymbolXX c -> ElfSectionIndex
steShNdx :: ElfSectionIndex
, forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steValue :: WordXX c
, forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steSize :: WordXX c
}
getStringFromData :: BSL.ByteString -> Word32 -> String
getStringFromData :: ByteString -> Word32 -> String
getStringFromData ByteString
stringTable Word32
offset = ByteString -> String
BSL8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
BSL.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offset) ByteString
stringTable
mkElfSymbolTableEntry :: SingElfClassI a => BSL.ByteString -> SymbolXX a -> ElfSymbolXX a
mkElfSymbolTableEntry :: forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> SymbolXX a -> ElfSymbolXX a
mkElfSymbolTableEntry ByteString
stringTable SymbolXX{Word8
Word32
ElfSectionIndex
WordXX a
stName :: Word32
stInfo :: Word8
stOther :: Word8
stShNdx :: ElfSectionIndex
stValue :: WordXX a
stSize :: WordXX a
stSize :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stValue :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stShNdx :: forall (c :: ElfClass). SymbolXX c -> ElfSectionIndex
stOther :: forall (c :: ElfClass). SymbolXX c -> Word8
stInfo :: forall (c :: ElfClass). SymbolXX c -> Word8
stName :: forall (c :: ElfClass). SymbolXX c -> Word32
..} =
let
steName :: String
steName = ByteString -> Word32 -> String
getStringFromData ByteString
stringTable Word32
stName
steBind :: ElfSymbolBinding
steBind = Word8 -> ElfSymbolBinding
ElfSymbolBinding (Word8 -> ElfSymbolBinding) -> Word8 -> ElfSymbolBinding
forall a b. (a -> b) -> a -> b
$ Word8
stInfo Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
steType :: ElfSymbolType
steType = Word8 -> ElfSymbolType
ElfSymbolType (Word8 -> ElfSymbolType) -> Word8 -> ElfSymbolType
forall a b. (a -> b) -> a -> b
$ Word8
stInfo Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0f
steShNdx :: ElfSectionIndex
steShNdx = ElfSectionIndex
stShNdx
steValue :: WordXX a
steValue = WordXX a
stValue
steSize :: WordXX a
steSize = WordXX a
stSize
in
ElfSymbolXX{String
ElfSymbolType
ElfSymbolBinding
ElfSectionIndex
WordXX a
steName :: String
steBind :: ElfSymbolBinding
steType :: ElfSymbolType
steShNdx :: ElfSectionIndex
steValue :: WordXX a
steSize :: WordXX a
steName :: String
steBind :: ElfSymbolBinding
steType :: ElfSymbolType
steShNdx :: ElfSectionIndex
steValue :: WordXX a
steSize :: WordXX a
..}
parseSymbolTable :: (MonadThrow m, SingElfClassI a)
=> ElfData
-> ElfXX 'Section a
-> ElfListXX a
-> m [ElfSymbolXX a]
parseSymbolTable :: forall (m :: * -> *) (a :: ElfClass).
(MonadThrow m, SingElfClassI a) =>
ElfData -> ElfXX 'Section a -> ElfListXX a -> m [ElfSymbolXX a]
parseSymbolTable ElfData
d symbolTableSection :: ElfXX 'Section a
symbolTableSection@(ElfSection { String
Word32
ElfSectionType
ElfSectionFlag
ElfSectionIndex
WordXX a
ElfSectionData a
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esName :: String
esType :: ElfSectionType
esFlags :: ElfSectionFlag
esAddr :: WordXX a
esAddrAlign :: WordXX a
esEntSize :: WordXX a
esN :: ElfSectionIndex
esInfo :: Word32
esLink :: Word32
esData :: ElfSectionData a
.. }) ElfListXX a
elfs = do
ByteString
symbolTable <- case ElfXX 'Section a
symbolTableSection of
ElfSection{ esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esData = ElfSectionData ByteString
st } -> ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
st
ElfXX 'Section a
_ -> $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m ByteString
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"wrong symbol table section data"
ElfXX 'Section a
section <- ElfListXX a -> Word32 -> m (ElfXX 'Section a)
forall (a :: ElfClass) (m :: * -> *) b.
(SingElfClassI a, MonadThrow m, Integral b, Show b) =>
ElfListXX a -> b -> m (ElfXX 'Section a)
elfFindSection ElfListXX a
elfs Word32
esLink
ByteString
stringTable <- case ElfXX 'Section a
section of
ElfSection{ esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esData = ElfSectionData ByteString
st } -> ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
st
ElfXX 'Section a
_ -> $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m ByteString
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"wrong string table section data"
[SymbolXX a]
st <- ElfData -> ByteString -> m [SymbolXX a]
forall (m :: * -> *) a.
(MonadThrow m, Binary (Le a), Binary (Be a)) =>
ElfData -> ByteString -> m [a]
parseBList ElfData
d ByteString
symbolTable
[ElfSymbolXX a] -> m [ElfSymbolXX a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> SymbolXX a -> ElfSymbolXX a
forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> SymbolXX a -> ElfSymbolXX a
mkElfSymbolTableEntry ByteString
stringTable (SymbolXX a -> ElfSymbolXX a) -> [SymbolXX a] -> [ElfSymbolXX a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SymbolXX a]
st)
mkSymbolTableEntry :: Word32 -> ElfSymbolXX a -> SymbolXX a
mkSymbolTableEntry :: forall (a :: ElfClass). Word32 -> ElfSymbolXX a -> SymbolXX a
mkSymbolTableEntry Word32
nameIndex ElfSymbolXX{String
ElfSymbolType
ElfSymbolBinding
ElfSectionIndex
WordXX a
steName :: forall (c :: ElfClass). ElfSymbolXX c -> String
steBind :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolBinding
steType :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolType
steShNdx :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSectionIndex
steValue :: forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steSize :: forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steName :: String
steBind :: ElfSymbolBinding
steType :: ElfSymbolType
steShNdx :: ElfSectionIndex
steValue :: WordXX a
steSize :: WordXX a
..} =
let
ElfSymbolBinding Word8
b = ElfSymbolBinding
steBind
ElfSymbolType Word8
t = ElfSymbolType
steType
stName :: Word32
stName = Word32
nameIndex
stInfo :: Word8
stInfo = Word8
b Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shift` Int
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
t
stOther :: Word8
stOther = Word8
0 :: Word8
stShNdx :: ElfSectionIndex
stShNdx = ElfSectionIndex
steShNdx
stValue :: WordXX a
stValue = WordXX a
steValue
stSize :: WordXX a
stSize = WordXX a
steSize
in
SymbolXX{Word8
Word32
ElfSectionIndex
WordXX a
stSize :: WordXX a
stValue :: WordXX a
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
stName :: Word32
stInfo :: Word8
stOther :: Word8
stShNdx :: ElfSectionIndex
stValue :: WordXX a
stSize :: WordXX a
..}
serializeSymbolTable :: (MonadThrow m, SingElfClassI a)
=> ElfData
-> [ElfSymbolXX a]
-> m (BSL.ByteString, BSL.ByteString)
serializeSymbolTable :: forall (m :: * -> *) (a :: ElfClass).
(MonadThrow m, SingElfClassI a) =>
ElfData -> [ElfSymbolXX a] -> m (ByteString, ByteString)
serializeSymbolTable ElfData
d [ElfSymbolXX a]
ss = do
let
(ByteString
stringTable, [Int64]
stringIndexes) = [String] -> (ByteString, [Int64])
mkStringTable ([String] -> (ByteString, [Int64]))
-> [String] -> (ByteString, [Int64])
forall a b. (a -> b) -> a -> b
$ (ElfSymbolXX a -> String) -> [ElfSymbolXX a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElfSymbolXX a -> String
forall (c :: ElfClass). ElfSymbolXX c -> String
steName [ElfSymbolXX a]
ss
ssWithNameIndexes :: [(ElfSymbolXX a, Int64)]
ssWithNameIndexes = [ElfSymbolXX a] -> [Int64] -> [(ElfSymbolXX a, Int64)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [ElfSymbolXX a]
ss [Int64]
stringIndexes
f :: (ElfSymbolXX a, Int64) -> SymbolXX a
f :: forall (a :: ElfClass). (ElfSymbolXX a, Int64) -> SymbolXX a
f (ElfSymbolXX a
s, Int64
n) = Word32 -> ElfSymbolXX a -> SymbolXX a
forall (a :: ElfClass). Word32 -> ElfSymbolXX a -> SymbolXX a
mkSymbolTableEntry (Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) ElfSymbolXX a
s
symbolTable :: ByteString
symbolTable = ElfData -> [SymbolXX a] -> ByteString
forall a.
(Binary (Le a), Binary (Be a)) =>
ElfData -> [a] -> ByteString
serializeBList ElfData
d ([SymbolXX a] -> ByteString) -> [SymbolXX a] -> ByteString
forall a b. (a -> b) -> a -> b
$ ((ElfSymbolXX a, Int64) -> SymbolXX a)
-> [(ElfSymbolXX a, Int64)] -> [SymbolXX a]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ElfSymbolXX a, Int64) -> SymbolXX a
forall (a :: ElfClass). (ElfSymbolXX a, Int64) -> SymbolXX a
f [(ElfSymbolXX a, Int64)]
ssWithNameIndexes
(ByteString, ByteString) -> m (ByteString, ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
symbolTable, ByteString
stringTable)