{-# 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

-- | @RBuilder@ is an intermediate internal data type that is used by parser.
-- It contains information about layout of the ELF file that can be used
-- by `Data.Elf.PrettyPrint.printLayout`
data RBuilder c
    = RBuilderHeader
        { forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbhHeader :: HeaderXX c
        }
    | RBuilderSectionTable
        { forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbstHeader :: HeaderXX c
        }
    | RBuilderSegmentTable
        { forall (c :: ElfClass). RBuilder c -> HeaderXX c
rbptHeader :: HeaderXX c
        }
    | RBuilderSection
        { forall (c :: ElfClass). RBuilder c -> SectionXX c
rbsHeader :: SectionXX c
        , forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
rbsN      :: ElfSectionIndex
        , forall (c :: ElfClass). RBuilder c -> String
rbsName   :: String
        }
    | RBuilderSegment
        { forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpHeader :: 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) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l forall a. Maybe a
Nothing (a
c forall a. a -> [a] -> [a]
: [a]
r)
    foldMap a -> m
f (LZip [a]
l  Maybe a
Nothing  [a]
r) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
L.reverse [a]
l forall a. [a] -> [a] -> [a]
++ [a]
r

-- | `Elf` is a forrest of trees of type `ElfXX`.
-- Trees are composed of `ElfXX` nodes, `ElfSegment` can contain subtrees
data ElfNodeType = Header | SectionTable | SegmentTable | Section | Segment | RawData | RawAlign

-- | List of ELF nodes.
data ElfListXX c where
    ElfListCons :: ElfXX t c -> ElfListXX c -> ElfListXX c
    ElfListNull :: ElfListXX c

-- | Elf is a sigma type where the first entry defines the type of the second one
data Elf = forall a . Elf (SingElfClass a) (ElfListXX a)

-- | Section data may contain a string table.
-- If a section contains a string table with section names, the data
-- for such a section is generated and `esData` should contain `ElfSectionDataStringTable`
data ElfSectionData c
    = ElfSectionData                -- ^ Regular section data
        { forall (c :: ElfClass). ElfSectionData c -> ByteString
esdData :: BSL.ByteString -- ^ The content of the section
        }
    | ElfSectionDataStringTable     -- ^ Section data will be generated from section names
    | ElfSectionDataNoBits          -- ^ SHT_NOBITS uninitialized section data: section has size but no content
        { forall (c :: ElfClass). ElfSectionData c -> WordXX c
esdSize :: WordXX c       -- ^ Size of the section
        }

-- | The type of node that defines Elf structure.
data ElfXX t c where
    ElfHeader ::
        { forall (c :: ElfClass). ElfXX 'Header c -> ElfData
ehData       :: ElfData    -- ^ Data encoding (big- or little-endian)
        , forall (c :: ElfClass). ElfXX 'Header c -> ElfOSABI
ehOSABI      :: ElfOSABI   -- ^ OS/ABI identification
        , forall (c :: ElfClass). ElfXX 'Header c -> Word8
ehABIVersion :: Word8      -- ^ ABI version
        , forall (c :: ElfClass). ElfXX 'Header c -> ElfType
ehType       :: ElfType    -- ^ Object file type
        , forall (c :: ElfClass). ElfXX 'Header c -> ElfMachine
ehMachine    :: ElfMachine -- ^ Machine type
        , forall (c :: ElfClass). ElfXX 'Header c -> WordXX c
ehEntry      :: WordXX c   -- ^ Entry point address
        , forall (c :: ElfClass). ElfXX 'Header c -> Word32
ehFlags      :: Word32     -- ^ Processor-specific flags
        } -> ElfXX 'Header c
    ElfSectionTable :: ElfXX 'SectionTable c
    ElfSegmentTable :: ElfXX 'SegmentTable c
    ElfSection ::
        { forall (c :: ElfClass). ElfXX 'Section c -> String
esName      :: String         -- ^ Section name (NB: string, not offset in the string table)
        , forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esType      :: ElfSectionType -- ^ Section type
        , forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esFlags     :: ElfSectionFlag -- ^ Section attributes
        , forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddr      :: WordXX c       -- ^ Virtual address in memory
        , forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: WordXX c       -- ^ Address alignment boundary
        , forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esEntSize   :: WordXX c       -- ^ Size of entries, if section has table
        , forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esN         :: ElfSectionIndex -- ^ Section number
        , forall (c :: ElfClass). ElfXX 'Section c -> Word32
esInfo      :: Word32         -- ^ Miscellaneous information
        , forall (c :: ElfClass). ElfXX 'Section c -> Word32
esLink      :: Word32         -- ^ Link to other section
        , forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esData      :: ElfSectionData c -- ^ The content of the section
        } -> ElfXX 'Section c
    ElfSegment ::
        { forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentType
epType       :: ElfSegmentType -- ^ Type of segment
        , forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentFlag
epFlags      :: ElfSegmentFlag -- ^ Segment attributes
        , forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epVirtAddr   :: WordXX c       -- ^ Virtual address in memory
        , forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epPhysAddr   :: WordXX c       -- ^ Physical address
        , forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAddMemSize :: WordXX c       -- ^ Add this amount of memory after the section when the section is loaded to memory by execution system.
                                         --   Or, in other words this is how much `pMemSize` is bigger than `pFileSize`
        , forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAlign      :: WordXX c       -- ^ Alignment of segment
        , forall (c :: ElfClass). ElfXX 'Segment c -> ElfListXX c
epData       :: ElfListXX c    -- ^ Content of the segment
        } -> ElfXX 'Segment c
    -- | Some ELF files (some executables) don't bother to define
    -- sections for linking and have just raw data in segments.
    ElfRawData ::
        { forall (c :: ElfClass). ElfXX 'RawData c -> ByteString
edData :: BSL.ByteString -- ^ Raw data in ELF file
        } -> ElfXX 'RawData c
    -- | Align the next data in the ELF file.
    -- The offset of the next data in the ELF file
    -- will be the minimal @x@ such that
    -- @x mod eaAlign == eaOffset mod eaAlign @
    ElfRawAlign ::
        { forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaOffset :: WordXX c -- ^ Align value
        , forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaAlign  :: WordXX c -- ^ Align module
        } -> ElfXX 'RawAlign c

data WBuilderData
    = WBuilderDataHeader
    | 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 ~:

-- | Helper for `ElfListCons`
(~:) :: ElfXX t a -> ElfListXX a -> ElfListXX a
~: :: forall (t :: ElfNodeType) (a :: ElfClass).
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
epData :: ElfListXX a
epAlign :: WordXX a
epAddMemSize :: WordXX a
epPhysAddr :: WordXX a
epVirtAddr :: WordXX a
epFlags :: ElfSegmentFlag
epType :: ElfSegmentType
epData :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfListXX c
epAlign :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAddMemSize :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epPhysAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epVirtAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epFlags :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentFlag
epType :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentType
.. }) ElfListXX a
l) = forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfXX t a
v forall a. Semigroup a => a -> a -> a
<> 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 ElfListXX a
epData forall a. Semigroup a => a -> a -> a
<> 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 ElfListXX a
l
foldMapElfList forall (t' :: ElfNodeType). ElfXX t' a -> m
f (ElfListCons ElfXX t a
v ElfListXX a
l)                     = forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfXX t a
v forall a. Semigroup a => a -> a -> a
<> 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 ElfListXX a
l
foldMapElfList forall (t' :: ElfNodeType). ElfXX t' a -> m
_  ElfListXX a
ElfListNull                          = 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) = forall (t' :: ElfNodeType). ElfXX t' a -> m
f ElfXX t a
v forall a. Semigroup a => a -> a -> a
<> 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 ElfListXX a
l
foldMapElfList' forall (t' :: ElfNodeType). ElfXX t' a -> m
_  ElfListXX a
ElfListNull      = 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 = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList' ((forall a. a -> [a] -> [a]
: []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t' :: ElfNodeType). ElfXX t' a -> m b
f) ElfListXX a
l

headerInterval :: forall a . SingElfClassI a => HeaderXX a -> Interval (WordXX a)
headerInterval :: forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
headerInterval HeaderXX a
_ = forall a. a -> a -> Interval a
I WordXX a
0 forall a b. (a -> b) -> a -> b
$ forall a. Num a => ElfClass -> a
headerSize forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass 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
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
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
..} = forall a. a -> a -> Interval a
I WordXX a
hShOff forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word16
hShEntSize 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 :: 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
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
..} = forall a. a -> a -> Interval a
I WordXX a
hPhOff forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word16
hPhEntSize 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
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
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
..} = forall a. a -> a -> Interval a
I WordXX a
sOffset if ElfSectionType
sType 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
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: 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
pAlign :: WordXX a
pMemSize :: WordXX a
pFileSize :: WordXX a
pPhysAddr :: WordXX a
pVirtAddr :: WordXX a
pOffset :: WordXX a
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
..} = 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 :: HeaderXX a
rbhHeader :: forall (c :: ElfClass). RBuilder c -> HeaderXX c
..}       = forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
headerInterval HeaderXX a
rbhHeader
rBuilderInterval RBuilderSectionTable{HeaderXX a
rbstHeader :: HeaderXX a
rbstHeader :: forall (c :: ElfClass). RBuilder c -> HeaderXX c
..} = forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
sectionTableInterval HeaderXX a
rbstHeader
rBuilderInterval RBuilderSegmentTable{HeaderXX a
rbptHeader :: HeaderXX a
rbptHeader :: forall (c :: ElfClass). RBuilder c -> HeaderXX c
..} = forall (a :: ElfClass).
SingElfClassI a =>
HeaderXX a -> Interval (WordXX a)
segmentTableInterval HeaderXX a
rbptHeader
rBuilderInterval RBuilderSection{String
ElfSectionIndex
SectionXX a
rbsName :: String
rbsN :: ElfSectionIndex
rbsHeader :: SectionXX a
rbsName :: forall (c :: ElfClass). RBuilder c -> String
rbsN :: forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
rbsHeader :: forall (c :: ElfClass). RBuilder c -> SectionXX c
..}      = forall (a :: ElfClass).
SingElfClassI a =>
SectionXX a -> Interval (WordXX a)
sectionInterval SectionXX a
rbsHeader
rBuilderInterval RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpData :: [RBuilder a]
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
..}      = forall (a :: ElfClass).
SingElfClassI a =>
SegmentXX a -> Interval (WordXX a)
segmentInterval SegmentXX a
rbpHeader
rBuilderInterval RBuilderRawData{Interval (WordXX a)
rbrdInterval :: Interval (WordXX a)
rbrdInterval :: forall (c :: ElfClass). RBuilder c -> Interval (WordXX c)
..}      = Interval (WordXX a)
rbrdInterval
rBuilderInterval RBuilderRawAlign{}       = 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 []                           = forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l forall a. Maybe a
Nothing []
        findInterval' [a]
l (a
x : [a]
xs) | t
e forall {a}. (Ord a, Num a) => a -> Interval a -> Bool
`touches`  a -> Interval t
f a
x  = forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l (forall a. a -> Maybe a
Just a
x) [a]
xs
                                 | t
e forall a. Ord a => a -> a -> Bool
< forall a. Interval a -> a
offset  (a -> Interval t
f a
x) = forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l forall a. Maybe a
Nothing (a
x forall a. a -> [a] -> [a]
: [a]
xs)
                                 | Bool
otherwise         = [a] -> [a] -> LZip a
findInterval' (a
x forall a. a -> [a] -> [a]
: [a]
l) [a]
xs
        touches :: a -> Interval a -> Bool
touches a
a Interval a
i | forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval a
i = a
a forall a. Eq a => a -> a -> Bool
== forall a. Interval a -> a
offset Interval a
i
                    | Bool
otherwise = a
a 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
rbsName :: String
rbsN :: ElfSectionIndex
rbsHeader :: SectionXX a
rbsName :: forall (c :: ElfClass). RBuilder c -> String
rbsN :: forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
rbsHeader :: forall (c :: ElfClass). RBuilder c -> SectionXX c
..}    = String
"section " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ElfSectionIndex
rbsN
showRBuilder' RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpData :: [RBuilder a]
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
..}    = String
"segment " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word16
rbpN
showRBuilder' RBuilderRawData{}      = String
"raw data" -- should not be called
showRBuilder' RBuilderRawAlign{}     = String
"alignment" -- should not be called

showRBuilder :: SingElfClassI a => RBuilder a -> String
showRBuilder :: forall (a :: ElfClass). SingElfClassI a => RBuilder a -> String
showRBuilder RBuilder a
v = forall (c :: ElfClass). RBuilder c -> String
showRBuilder' RBuilder a
v forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
v) forall a. [a] -> [a] -> [a]
++ String
")"

-- showERBList :: SingElfClassI a => [RBuilder a] -> String
-- showERBList l = "[" ++ (L.concat $ L.intersperse ", " $ fmap showRBuilder l) ++ "]"

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 = forall (a :: ElfClass). SingElfClassI a => RBuilder a -> String
showRBuilder RBuilder a
x forall a. [a] -> [a] -> [a]
++ String
" and " forall a. [a] -> [a] -> [a]
++ forall (a :: ElfClass). SingElfClassI a => RBuilder a -> String
showRBuilder RBuilder a
y 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 = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (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 =
            -- (unsafePerformIO $ Prelude.putStrLn $ "Add Empty " ++ showRBuilder t ++ " to " ++ showERBList ts) `seq`
            let
                to' :: WordXX a
to' = forall a. Interval a -> a
offset forall a b. (a -> b) -> a -> b
$ 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) = forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval WordXX a
to' [RBuilder a]
ts

                -- Let `(le, lo)` is the result of `allEmptyStarting a l`.
                -- Then `le` is the initial sublist of `l` each element of which is empty and starts at `a`,
                -- `lo` is the rest of `l`.
                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, []) = (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 = forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
h
                            in if Bool -> Bool
not (forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval (WordXX a)
hi) Bool -> Bool -> Bool
|| (forall a. Interval a -> a
offset Interval (WordXX a)
hi forall a. Eq a => a -> a -> Bool
/= WordXX a
a)
                                then (forall a. [a] -> [a]
L.reverse [RBuilder a]
le, RBuilder a
h forall a. a -> [a] -> [a]
: [RBuilder a]
lo)
                                else ([RBuilder a], [RBuilder a]) -> ([RBuilder a], [RBuilder a])
f (RBuilder a
h 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
rbpData :: [RBuilder a]
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
..} -> do
                    [RBuilder a]
d <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> m [RBuilder a] -> m [RBuilder a]
forall a. [a]
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' forall a b. (a -> b) -> a -> b
$ (SingElfClassI a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderEmpty RBuilder a
t [RBuilder a]
rbpData
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (forall a. a -> Maybe a
Just RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a]
d, Word16
SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
.. }) [RBuilder a]
r
                Just RBuilder a
c ->
                    if forall a. Interval a -> a
offset (forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c) forall a. Eq a => a -> a -> Bool
/= WordXX a
to' then
                        $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError forall a b. (a -> b) -> a -> b
$ 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 forall a. a -> [a] -> [a]
: [RBuilder a]
r)
                        in case RBuilder a
t of
                            RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpData :: [RBuilder a]
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
..} ->
                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (forall a. a -> Maybe a
Just RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a]
ce, Word16
SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
.. }) [RBuilder a]
re'
                            RBuilder a
_ ->
                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l forall a. Maybe a
Nothing ([RBuilder a]
ce forall a. [a] -> [a] -> [a]
++ (RBuilder a
t forall a. a -> [a] -> [a]
: [RBuilder a]
re'))
                Maybe (RBuilder a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (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 =
            -- (unsafePerformIO $ Prelude.putStrLn $ "Add NonEmpty " ++ showRBuilder t ++ " to " ++ showERBList ts) `seq`
            let
                ti :: Interval (WordXX a)
ti = 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) = forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval (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 = forall (m :: * -> *) a. Monad m => a -> m a
return RBuilder a
x
                addRBuildersNonEmpty [RBuilder a]
ts' RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpData :: [RBuilder a]
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
..} = do
                    [RBuilder a]
d <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> m [RBuilder a] -> m [RBuilder a]
forall a. [a]
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' forall a b. (a -> b) -> a -> b
$ 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]
addRBuilderNonEmpty [RBuilder a]
ts' [RBuilder a]
rbpData
                    forall (m :: * -> *) a. Monad m => a -> m a
return RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a]
d, Word16
SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
.. }
                addRBuildersNonEmpty (RBuilder a
x:[RBuilder a]
_) RBuilder a
y = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c then

                        case RBuilder a
t of

                                -- NB: If a segment A has number greater than segment B and they have same size, then
                                --     segment A contains segment B
                                --     This should be taken into account in the serialization code.
                                RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
rbpData :: [RBuilder a]
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
..} ->

                                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (forall a. a -> Maybe a
Just RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a
c], Word16
SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
.. }) [RBuilder a]
r

                                RBuilder a
_ ->  do

                                    RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
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' forall a b. (a -> b) -> a -> b
$ (SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [RBuilder a
t] RBuilder a
c
                                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r

                    else if forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c 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 -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
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' forall a b. (a -> b) -> a -> b
$ (SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [RBuilder a
t] RBuilder a
c
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r

                    else if Interval (WordXX a)
ti forall a. (Ord a, Num a) => Interval a -> Interval a -> Bool
`contains` forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c then

                        let

                            tir :: WordXX a
tir = forall a. Interval a -> a
offset Interval (WordXX a)
ti forall a. Num a => a -> a -> a
+ forall a. Interval a -> a
size Interval (WordXX a)
ti forall a. Num a => a -> a -> a
- WordXX a
1
                            (LZip [RBuilder a]
l2 Maybe (RBuilder a)
c2' [RBuilder a]
r2) = forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval 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

                                -- add this:     ......[t__________________________]...................
                                -- to this list: ......[c__]......[l2__]...[l2__].....[________].......
                                -- no need to keep the order of l2 as each member of the list will be placed independently from scratch
                                RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
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' forall a b. (a -> b) -> a -> b
$ (SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty (RBuilder a
c forall a. a -> [a] -> [a]
: [RBuilder a]
l2) RBuilder a
t
                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2

                            Just RBuilder a
c2 ->

                                if Interval (WordXX a)
ti forall a. (Ord a, Num a) => Interval a -> Interval a -> Bool
`contains` forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c2 then do

                                    -- add this:     ......[t______________________]........................
                                    -- to this list: ......[c_________]......[c2___]......[________]........
                                    RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
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' forall a b. (a -> b) -> a -> b
$ (SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty (RBuilder a
c forall a. a -> [a] -> [a]
: RBuilder a
c2 forall a. a -> [a] -> [a]
: [RBuilder a]
l2) RBuilder a
t
                                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2
                                else

                                    -- add this:     ......[t_________________].............................
                                    -- to this list: ......[c_________]......[c2___]......[________]........
                                    $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError forall a b. (a -> b) -> a -> b
$ forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
t RBuilder a
c2

                    else

                        -- add this:     ..........[t________].............................
                        -- to this list: ......[c_________]......[_____]......[________]...
                        $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError forall a b. (a -> b) -> a -> b
$ 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 = forall a. Interval a -> a
offset Interval (WordXX a)
ti forall a. Num a => a -> a -> a
+ forall a. Interval a -> a
size Interval (WordXX a)
ti forall a. Num a => a -> a -> a
- WordXX a
1
                        (LZip [RBuilder a]
l2 Maybe (RBuilder a)
c2' [RBuilder a]
r2) = forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval 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

                            -- add this:     ....[t___].........................................
                            -- or this:      ....[t_________________________]...................
                            -- to this list: .............[l2__]...[l2__].....[________]........
                            RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
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' forall a b. (a -> b) -> a -> b
$ (SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [RBuilder a]
l2 RBuilder a
t
                            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2

                        Just RBuilder a
c2 ->

                            if Interval (WordXX a)
ti forall a. (Ord a, Num a) => Interval a -> Interval a -> Bool
`contains` forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c2 then do

                                -- add this:     ....[t_________________________________]........
                                -- to this list: ..........[l2__]..[l2__].....[c2_______]........
                                RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
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' forall a b. (a -> b) -> a -> b
$ (SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty (RBuilder a
c2 forall a. a -> [a] -> [a]
: [RBuilder a]
l2) RBuilder a
t
                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2

                            else

                                -- add this:     ....[t_______________________________]..........
                                -- to this list: ..........[l2__]..[l2__].....[c2_______]........
                                $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError forall a b. (a -> b) -> a -> b
$ forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
t RBuilder a
c2

        ([RBuilder a]
emptyRBs, [RBuilder a]
nonEmptyRBs) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (forall a. (Ord a, Num a) => Interval a -> Bool
I.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval) [RBuilder a]
newts

    in
        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]
addRBuilderNonEmpty [RBuilder a]
nonEmptyRBs [] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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]
addRBuilderEmpty [RBuilder a]
emptyRBs

-- | Find section with a given number
elfFindSection :: forall a m b . (SingElfClassI a, MonadThrow m, Integral b, Show b)
               => ElfListXX a          -- ^ Structured ELF data
               -> b                    -- ^ Number of the section
               -> m (ElfXX 'Section a) -- ^ The section in question
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 forall a. Eq a => a -> a -> Bool
== b
0
    then $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"no section 0"
    else $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a.
MonadThrow m =>
Loc -> String -> Maybe a -> m a
maybeAddContext (String
"no section " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show b
n) Maybe (ElfXX 'Section a)
maybeSection
        where
            maybeSection :: Maybe (ElfXX 'Section a)
maybeSection = forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList 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 :: ElfSectionData a
esLink :: Word32
esInfo :: Word32
esN :: ElfSectionIndex
esEntSize :: WordXX a
esAddrAlign :: WordXX a
esAddr :: WordXX a
esFlags :: ElfSectionFlag
esType :: ElfSectionType
esName :: String
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
..} | ElfSectionIndex
esN forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral b
n = forall a. Maybe a -> First a
First forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ElfXX t a
s
            f ElfXX t a
_ = forall a. Maybe a -> First a
First forall a. Maybe a
Nothing

-- | Find section with a given name
elfFindSectionByName :: forall a m . (SingElfClassI a, MonadThrow m)
                     => ElfListXX a          -- ^ Structured ELF data
                     -> String               -- ^ Section name
                     -> m (ElfXX 'Section a) -- ^ The section in question
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
forall (m :: * -> *) a.
MonadThrow m =>
Loc -> String -> Maybe a -> m a
maybeAddContext (String
"no section \"" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
n forall a. [a] -> [a] -> [a]
++ String
"\"") Maybe (ElfXX 'Section a)
maybeSection
    where
        maybeSection :: Maybe (ElfXX 'Section a)
maybeSection = forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList 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 :: ElfSectionData a
esLink :: Word32
esInfo :: Word32
esN :: ElfSectionIndex
esEntSize :: WordXX a
esAddrAlign :: WordXX a
esAddr :: WordXX a
esFlags :: ElfSectionFlag
esType :: ElfSectionType
esName :: String
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
..} | String
esName forall a. Eq a => a -> a -> Bool
== String
n = forall a. Maybe a -> First a
First forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ElfXX t a
s
        f ElfXX t a
_ = forall a. Maybe a -> First a
First forall a. Maybe a
Nothing

-- | Find ELF header
elfFindHeader :: forall a m . (SingElfClassI a, MonadThrow m)
              => ElfListXX a         -- ^ Structured ELF data
              -> m (ElfXX 'Header a) -- ^ ELF header
elfFindHeader :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadThrow m) =>
ElfListXX a -> m (ElfXX 'Header a)
elfFindHeader ElfListXX a
elfs = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
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 = forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList 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{} = forall a. Maybe a -> First a
First forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ElfXX t a
h
        f ElfXX t a
_ = forall a. Maybe a -> First a
First 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 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 forall a. Bits a => a -> a -> a
.&. (WordXX a
m forall a. Num a => a -> a -> a
- WordXX a
1) forall a. Eq a => a -> a -> Bool
/= WordXX a
0 = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"align module is not power of two " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WordXX a
m
                 | Bool
otherwise          = if WordXX a
a' forall a. Num a => a -> a -> a
+ WordXX a
t' forall a. Ord a => a -> a -> Bool
< WordXX a
a then WordXX a
a' forall a. Num a => a -> a -> a
+ WordXX a
m forall a. Num a => a -> a -> a
+ WordXX a
t' else WordXX a
a' forall a. Num a => a -> a -> a
+ WordXX a
t'
    where
        a' :: WordXX a
a' = WordXX a
a forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement (WordXX a
m forall a. Num a => a -> a -> a
- WordXX a
1)
        t' :: WordXX a
t' = WordXX a
t forall a. Bits a => a -> a -> a
.&. (WordXX a
m 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 = forall a b. (a, b) -> b
snd 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

        -- e, e', ee and lrbie stand for the first occupied byte after the place being fixed
        -- lrbi: last rBuilder interval (begin, size)
        lrbi :: Interval (WordXX a)
lrbi@(I WordXX a
lrbib WordXX a
lrbis) = forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
L.last [RBuilder a]
rBuilders
        lrbie :: WordXX a
lrbie = if forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval (WordXX a)
lrbi then WordXX a
lrbib else WordXX a
lrbib 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 (forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bs'
            where
                bs' :: ByteString
bs' = ByteString -> Int64 -> Int64 -> ByteString
cut ByteString
bs (forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
b) (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) = 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, []) 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) = forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
rb
                        b' :: WordXX a
b' = if forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval (WordXX a)
i then WordXX a
b else WordXX a
b 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 forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'')

                fixRBuilder :: RBuilder a -> RBuilder a
                fixRBuilder :: RBuilder a -> RBuilder a
fixRBuilder RBuilder a
p | forall a. (Ord a, Num a) => Interval a -> Bool
I.empty forall a b. (a -> b) -> a -> b
$ 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
rbpData :: [RBuilder a]
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
..} =
                    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
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
..}
                        where
                            (I WordXX a
b WordXX a
s) = forall (a :: ElfClass).
SingElfClassI a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
p
                            ee :: WordXX a
ee = WordXX a
b forall a. Num a => a -> a -> a
+ WordXX a
s
                            alignHint' :: WordXX a
alignHint' = forall a. Ord a => a -> a -> a
max (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

                -- b is the first free byte
                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 forall a. Ord a => a -> a -> Bool
< WordXX a
ee
                        then
                            if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ WordXX a -> WordXX a -> Bool
allEmpty WordXX a
b WordXX a
s
                                then
                                    forall (c :: ElfClass). Interval (WordXX c) -> RBuilder c
RBuilderRawData (forall a. a -> a -> Interval a
I WordXX a
b WordXX a
s) forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'
                                else
                                    -- check e' < ee means
                                    -- check if next section/segment was actually placed (ee) with greater offset
                                    -- than is required by alignment rules (e')
                                    if WordXX a
e' forall a. Ord a => a -> a -> Bool
< WordXX a
ee Bool -> Bool -> Bool
&& WordXX a
e'' forall a. Eq a => a -> a -> Bool
== WordXX a
ee
                                        then
                                            forall (c :: ElfClass). WordXX c -> WordXX c -> RBuilder c
RBuilderRawAlign WordXX a
ee WordXX a
alignHint forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'
                                        else
                                            [RBuilder a]
rbs'
                        else
                            [RBuilder a]
rbs'
                    where
                        s :: WordXX a
s = WordXX a
ee 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
pAlign :: WordXX a
pMemSize :: WordXX a
pFileSize :: WordXX a
pPhysAddr :: WordXX a
pVirtAddr :: WordXX a
pOffset :: WordXX a
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: 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
..}} : [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
pAlign :: WordXX a
pMemSize :: WordXX a
pFileSize :: WordXX a
pPhysAddr :: WordXX a
pVirtAddr :: WordXX a
pOffset :: WordXX a
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: 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
..}} : [RBuilder a]
_) -> WordXX a
pAlign
                            (RBuilderSection{rbsHeader :: forall (c :: ElfClass). RBuilder c -> SectionXX c
rbsHeader = 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
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
..}} : [RBuilder a]
_) -> WordXX a
sAddrAlign
                            [RBuilder a]
_ -> forall a. Num a => ElfClass -> a
wordSize forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a
                        -- e' here is the address of the next section/segment
                        -- according to the regular alignment rules
                        e' :: WordXX a
e' = 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'' = 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 forall a. Ord a => a -> a -> Bool
< b
0     = forall a. Maybe a
Nothing
    | Bool
otherwise = 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]
_)  = forall a. a -> Maybe a
Just a
x
    go b
j (a
_:[a]
ys) = forall b a. Integral b => b -> [a] -> Maybe a
go (b
j forall a. Num a => a -> a -> a
- b
1) [a]
ys
    go b
_ []     = forall a. Maybe a
Nothing

-- | Parse ELF file and produce [`RBuilder`]
parseRBuilder :: (SingElfClassI a, MonadCatch m)
              => HeaderXX a     -- ^ ELF header
              -> [SectionXX a]  -- ^ Section table
              -> [SegmentXX a]  -- ^ Segment table
              -> BSL.ByteString -- ^ ELF file
              -> 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 :: 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
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
..} [SectionXX a]
ss [SegmentXX a]
ps ByteString
bs = do


    let
        maybeStringSectionData :: Maybe ByteString
maybeStringSectionData = forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> SectionXX a -> ByteString
getSectionData ByteString
bs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([SectionXX a]
ss 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 :: 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
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
..}) = do
            ByteString
stringSectionData <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a.
MonadThrow m =>
Loc -> String -> Maybe a -> m a
maybeAddContext String
"No string table" Maybe ByteString
maybeStringSectionData
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass).
SectionXX c -> ElfSectionIndex -> String -> RBuilder c
RBuilderSection SectionXX a
s ElfSectionIndex
n forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> String
getString ByteString
stringSectionData forall a b. (a -> b) -> a -> b
$ 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) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass).
SegmentXX c -> Word16 -> [RBuilder c] -> RBuilder c
RBuilderSegment SegmentXX a
p Word16
n []

    [RBuilder a]
sections <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
(ElfSectionIndex, SectionXX a) -> m (RBuilder a)
mkRBuilderSection forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail' forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [ElfSectionIndex
0 .. ] [SectionXX a]
ss
    [RBuilder a]
segments <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
(Word16, SegmentXX a) -> m (RBuilder a)
mkRBuilderSegment forall a b. (a -> b) -> a -> b
$         forall a b. [a] -> [b] -> [(a, b)]
Prelude.zip [Word16
0 .. ] [SegmentXX a]
ps

    let

        header :: RBuilder a
header            = forall (c :: ElfClass). HeaderXX c -> RBuilder c
RBuilderHeader HeaderXX a
hdr
        maybeSectionTable :: Maybe (RBuilder a)
maybeSectionTable = if Word16
hShNum forall a. Eq a => a -> a -> Bool
== Word16
0 then forall a. Maybe a
Nothing else  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). HeaderXX c -> RBuilder c
RBuilderSectionTable HeaderXX a
hdr
        maybeSegmentTable :: Maybe (RBuilder a)
maybeSegmentTable = if Word16
hPhNum forall a. Eq a => a -> a -> Bool
== Word16
0 then forall a. Maybe a
Nothing else  forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). HeaderXX c -> RBuilder c
RBuilderSegmentTable HeaderXX a
hdr

    [RBuilder a]
rbs <- forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
[RBuilder a] -> m [RBuilder a]
addRBuilders forall a b. (a -> b) -> a -> b
$ [RBuilder a
header] forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (RBuilder a)
maybeSectionTable
                                   forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe (RBuilder a)
maybeSegmentTable
                                   forall a. [a] -> [a] -> [a]
++ [RBuilder a]
segments
                                   forall a. [a] -> [a] -> [a]
++ [RBuilder a]
sections
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: 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
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
..} [SectionXX a]
ss [SegmentXX a]
ps ByteString
bs = do

    [RBuilder a]
rbs <- 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 =
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 =
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons forall (c :: ElfClass). ElfXX 'SectionTable c
ElfSectionTable ElfListXX a
l
        rBuilderToElf RBuilderSegmentTable{} ElfListXX a
l =
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons 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 :: 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
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
..}, String
ElfSectionIndex
rbsName :: String
rbsN :: ElfSectionIndex
rbsName :: forall (c :: ElfClass). RBuilder c -> String
rbsN :: forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
..} ElfListXX a
l =
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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     = 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 forall a. Eq a => a -> a -> Bool
== ElfSectionIndex
hShStrNdx
                        then forall (c :: ElfClass). ElfSectionData c
ElfSectionDataStringTable
                        else if ElfSectionType
sType forall a. Eq a => a -> a -> Bool
== ElfSectionType
SHT_NOBITS
                            then forall (c :: ElfClass). WordXX c -> ElfSectionData c
ElfSectionDataNoBits WordXX a
sSize
                            else forall (c :: ElfClass). ByteString -> ElfSectionData c
ElfSectionData forall a b. (a -> b) -> a -> b
$ 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
pAlign :: WordXX a
pMemSize :: WordXX a
pFileSize :: WordXX a
pPhysAddr :: WordXX a
pVirtAddr :: WordXX a
pOffset :: WordXX a
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: 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
..}, [RBuilder a]
Word16
rbpData :: [RBuilder a]
rbpN :: Word16
rbpData :: forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpN :: forall (c :: ElfClass). RBuilder c -> Word16
..} ElfListXX a
l = do
            ElfListXX a
d <- 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 forall (c :: ElfClass). ElfListXX c
ElfListNull [RBuilder a]
rbpData
            WordXX a
addMemSize <- if WordXX a
pMemSize forall a. Eq a => a -> a -> Bool
/= WordXX a
0 Bool -> Bool -> Bool
&& WordXX a
pFileSize forall a. Eq a => a -> a -> Bool
/= WordXX a
0 Bool -> Bool -> Bool
&& WordXX a
pMemSize forall a. Ord a => a -> a -> Bool
< WordXX a
pFileSize
                then $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"memSize < fileSize"
                else forall (m :: * -> *) a. Monad m => a -> m a
return (WordXX a
pMemSize forall a. Num a => a -> a -> a
- WordXX a
pFileSize)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 =
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons (forall (c :: ElfClass). ByteString -> ElfXX 'RawData c
ElfRawData forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> Int64 -> ByteString
cut ByteString
bs (forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
o) (forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
s)) ElfListXX a
l
        rBuilderToElf RBuilderRawAlign{WordXX a
rbraAlign :: WordXX a
rbraOffset :: WordXX a
rbraAlign :: forall (c :: ElfClass). RBuilder c -> WordXX c
rbraOffset :: forall (c :: ElfClass). RBuilder c -> WordXX c
..} ElfListXX a
l =
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: ElfNodeType) (a :: ElfClass).
ElfXX t a -> ElfListXX a -> ElfListXX a
ElfListCons (forall (c :: ElfClass). WordXX c -> WordXX c -> ElfXX 'RawAlign c
ElfRawAlign WordXX a
rbraOffset WordXX a
rbraAlign) ElfListXX a
l

    ElfListXX a
el <- 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 forall (c :: ElfClass). ElfListXX c
ElfListNull [RBuilder a]
rbs --  mapM rBuilderToElf rbs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: ElfClass). SingElfClass a -> ElfListXX a -> Elf
Elf forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass ElfListXX a
el

-- | Parse ELF file
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 <- forall (m :: * -> *). MonadThrow m => ByteString -> m Headers
parseHeaders ByteString
bs
    forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass a
classS 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 = 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 [a]
x  a -> a -> b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> b
f) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
L.zip [a]
x forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
L.tail [a]
x

-- make string table and indexes for it from a list of strings
mkStringTable :: [String] -> (BSL.ByteString, [Int64])
mkStringTable :: [String] -> (ByteString, [Int64])
mkStringTable [String]
sectionNames = (ByteString
stringTable, [Int64]
os)
    where

        -- names:
        -- i for indexes of the section entry in section table
        -- n for section name string
        -- o for offset of the string in the string table
        -- in, io -- for pairs
        -- ins, ios -- for lists of pairs
        -- etc

        ([(Word32, String)]
ins0, [(Word32, String)]
ins) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break ((forall a. Eq a => a -> a -> Bool
/= String
"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (forall (t :: * -> *) a. Foldable t => t a -> Int
L.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
L.zip [(Word32
1 :: Word32) .. ] [String]
sectionNames
        ios0 :: [(Word32, Int64)]
ios0 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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)]
_) = forall {a}.
(ByteString, [(a, Int64)], [(a, String)])
-> (ByteString, [(a, Int64)], [(a, String)])
f (Word8 -> ByteString
BSL.singleton Word8
0, [], forall a. [a] -> [a]
L.reverse [(Word32, String)]
ins)

        os :: [Int64]
os = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ [(Word32, Int64)]
ios0 forall a. [a] -> [a] -> [a]
++ [(Word32, Int64)]
ios

        -- create string table.  If one name is a suffix of another,
        -- allocate only the longest name in string table
        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 forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BSL8.pack String
n 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) forall a. a -> [a] -> [a]
: [(a, Int64)]
iosf' forall a. [a] -> [a] -> [a]
++ [(a, Int64)]
iosf

                ([(a, Int64)]
iosf', [(a, String)]
insf') = [(a, String)] -> ([(a, Int64)], [(a, String)])
ff [(a, String)]
insf

                -- look if there exists a name that is a suffix for the currently allocated name
                -- in the list of unallocated indexed section names
                ff :: [(a, String)] -> ([(a, Int64)], [(a, String)])
ff = 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' forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` String
n
                            then
                                let
                                    o' :: Int64
o' = Int64
o forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
n')
                                in
                                    ((a
i', Int64
o') forall a. a -> [a] -> [a]
: [(a, Int64)]
iosff, [(a, String)]
insff)
                            else ([(a, Int64)]
iosff, (a
i', String
n') 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

    -- FIXME: it's better to match constructor here, but there is a bug that prevents to conclude that
    -- the match is irrefutable:
    -- https://stackoverflow.com/questions/72803815/phantom-type-makes-pattern-matching-irrefutable-but-that-seemingly-does-not-wor
    -- https://gitlab.haskell.org/ghc/ghc/-/issues/15681#note_165436
    -- But if I use lazy pattern match, then some other bug comes up that prevents type inference
    -- on GHC 9.0.2
    ElfXX 'Header a
header' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> m (ElfXX 'Header a) -> m (ElfXX 'Header a)
forall a. [a]
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' forall a b. (a -> b) -> a -> b
$ forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadThrow m) =>
ElfListXX a -> m (ElfXX 'Header a)
elfFindHeader ElfListXX a
elfs

    let

        elfClass :: ElfClass
elfClass = forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass 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 = forall a. Sum a -> a
getSum forall a b. (a -> b) -> a -> b
$ forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList forall {a} {t :: ElfNodeType} {c :: ElfClass}.
Num a =>
ElfXX t c -> Sum a
f ElfListXX a
elfs
            where
                f :: ElfXX t c -> Sum a
f ElfSection{} = forall a. a -> Sum a
Sum a
1
                f ElfXX t c
_ =  forall a. a -> Sum a
Sum a
0

        sectionNames :: [String]
        sectionNames :: [String]
sectionNames = forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList 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 :: ElfSectionData a
esLink :: Word32
esInfo :: Word32
esN :: ElfSectionIndex
esEntSize :: WordXX a
esAddrAlign :: WordXX a
esAddr :: WordXX a
esFlags :: ElfSectionFlag
esType :: ElfSectionType
esName :: String
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
..} = [ 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 = forall a. Sum a -> a
getSum forall a b. (a -> b) -> a -> b
$ forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList forall {a} {t :: ElfNodeType} {c :: ElfClass}.
Num a =>
ElfXX t c -> Sum a
f ElfListXX a
elfs
            where
                f :: ElfXX t c -> Sum a
f ElfSegment{} = forall a. a -> Sum a
Sum a
1
                f ElfXX t c
_ =  forall a. a -> Sum a
Sum a
0

        sectionTable :: Bool
        sectionTable :: Bool
sectionTable = Any -> Bool
getAny forall a b. (a -> b) -> a -> b
$ forall m (a :: ElfClass).
Monoid m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m) -> ElfListXX a -> m
foldMapElfList 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 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        align WordXX a
_ WordXX a
1 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        align WordXX a
t WordXX a
m | WordXX a
m forall a. Bits a => a -> a -> a
.&. (WordXX a
m forall a. Num a => a -> a -> a
- WordXX a
1) forall a. Eq a => a -> a -> Bool
/= WordXX a
0 = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError forall a b. (a -> b) -> a -> b
$ String
"align module is not power of two " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WordXX a
m
                  | Bool
otherwise = do
            WordXX a
offset  <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset
            forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= 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' <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset
            forall (a :: ElfClass). Lens' (WBuilderState a) [WBuilderData]
wbsDataReversed forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ByteString -> WBuilderData
WBuilderDataByteStream (Int64 -> Word8 -> ByteString
BSL.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ WordXX a
offset' forall a. Num a => a -> a -> a
- WordXX a
offset) Word8
0) forall a. a -> [a] -> [a]
:)

        alignWord :: (MonadThrow n, MonadState (WBuilderState a) n) => n ()
        alignWord :: forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
n ()
alignWord = forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
WordXX a -> WordXX a -> n ()
align WordXX a
0 forall a b. (a -> b) -> a -> b
$ forall a. Num a => ElfClass -> a
wordSize forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass 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
_ = 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 = forall b.
ElfListXX a
-> (forall (t' :: ElfNodeType). ElfXX t' a -> b) -> b -> b
lastSection ElfListXX a
l forall (t' :: ElfNodeType). ElfXX t' a -> b
f b
b

        lastSectionIsEmpty :: ElfListXX a -> Bool
        lastSectionIsEmpty :: ElfListXX a -> Bool
lastSectionIsEmpty ElfListXX a
l = forall b.
ElfListXX a
-> (forall (t' :: ElfNodeType). ElfXX t' a -> b) -> b -> b
lastSection ElfListXX a
l 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 :: ElfSectionData c
esLink :: Word32
esInfo :: Word32
esN :: ElfSectionIndex
esEntSize :: WordXX c
esAddrAlign :: WordXX c
esAddr :: WordXX c
esFlags :: ElfSectionFlag
esType :: ElfSectionType
esName :: String
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
.. } = 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
            -- FIXME: add push monad
            forall (a :: ElfClass). Lens' (WBuilderState a) [WBuilderData]
wbsDataReversed forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (WBuilderData
WBuilderDataHeader forall a. a -> [a] -> [a]
:)
            forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= forall a. Num a => ElfClass -> a
headerSize ElfClass
elfClass
        elf2WBuilder ElfXX t a
ElfSectionTable = do
            forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
n ()
alignWord
            forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsShOff
            forall (a :: ElfClass). Lens' (WBuilderState a) [WBuilderData]
wbsDataReversed forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (WBuilderData
WBuilderDataSectionTable forall a. a -> [a] -> [a]
:)
            forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= (forall b. Num b => b
sectionN forall a. Num a => a -> a -> a
+ WordXX a
1) forall a. Num a => a -> a -> a
* forall a. Num a => ElfClass -> a
sectionTableEntrySize ElfClass
elfClass
        elf2WBuilder ElfXX t a
ElfSegmentTable = do
            forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
n ()
alignWord
            forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
assign forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsPhOff
            forall (a :: ElfClass). Lens' (WBuilderState a) [WBuilderData]
wbsDataReversed forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (WBuilderData
WBuilderDataSegmentTable forall a. a -> [a] -> [a]
:)
            forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= forall b. Num b => b
segmentN forall a. Num a => a -> a -> 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 :: ElfSectionData a
esLink :: Word32
esInfo :: Word32
esN :: ElfSectionIndex
esEntSize :: WordXX a
esAddrAlign :: WordXX a
esAddr :: WordXX a
esType :: ElfSectionType
esName :: String
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
..} = do
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word64
f forall a. Bits a => a -> a -> a
.&. forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> a
complement (forall a. Bounded a => a
maxBound @(WordXX a))) forall a. Eq a => a -> a -> Bool
/= Word64
0) do
                $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError forall a b. (a -> b) -> a -> b
$ String
"section flags at section " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ElfSectionIndex
esN forall a. [a] -> [a] -> [a]
++ String
"don't fit"
            -- I don't see any sense in aligning NOBITS section data
            -- still gcc does it for .o files
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ElfSectionType
esType forall a. Eq a => a -> a -> Bool
/= ElfSectionType
SHT_NOBITS Bool -> Bool -> Bool
|| (forall (c :: ElfClass). ElfXX 'Header c -> ElfType
ehType ElfXX 'Header a
header') forall a. Eq a => a -> a -> Bool
== ElfType
ET_REL) do
                forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
WordXX a -> WordXX a -> n ()
align WordXX a
0 WordXX a
esAddrAlign
            (Int64
n, [Int64]
ns) <- forall s (m :: * -> *) r a.
MonadState s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
uses forall (a :: ElfClass). Lens' (WBuilderState a) [Int64]
wbsNameIndexes \case
                Int64
n' : [Int64]
ns' -> (Int64
n', [Int64]
ns')
                [Int64]
_ -> forall a. HasCallStack => String -> a
error String
"internal error: different number of sections in two iterations"
            ElfSectionIndex
shStrNdx' <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall (a :: ElfClass). Lens' (WBuilderState a) ElfSectionIndex
wbsShStrNdx
            let
                (ByteString
d, ElfSectionIndex
shStrNdx, WordXX a
sz) = case ElfSectionData a
esData of
                    ElfSectionData { ByteString
esdData :: ByteString
esdData :: forall (c :: ElfClass). ElfSectionData c -> ByteString
.. } -> (ByteString
esdData, ElfSectionIndex
shStrNdx', forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length ByteString
esdData)
                    ElfSectionData a
ElfSectionDataStringTable -> (ByteString
stringTable, ElfSectionIndex
esN, forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length ByteString
stringTable)
                    ElfSectionDataNoBits { WordXX a
esdSize :: WordXX a
esdSize :: forall (c :: ElfClass). ElfSectionData c -> WordXX c
.. } -> (ByteString
BSL.empty, ElfSectionIndex
shStrNdx', WordXX a
esdSize)
                sName :: Word32
sName = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n                 -- Word32
                sType :: ElfSectionType
sType = ElfSectionType
esType                         -- ElfSectionType
                sFlags :: WordXX a
sFlags = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
f
                sAddr :: WordXX a
sAddr = WordXX a
esAddr                         -- WXX c
                sSize :: WordXX a
sSize = WordXX a
sz                             -- WXX c
                sLink :: Word32
sLink = Word32
esLink                         -- Word32
                sInfo :: Word32
sInfo = Word32
esInfo                         -- Word32
                sAddrAlign :: WordXX a
sAddrAlign = WordXX a
esAddrAlign               -- WXX c
                sEntSize :: WordXX a
sEntSize = WordXX a
esEntSize                   -- WXX c
            WordXX a
sOffset <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset                   -- WXX c
            forall (a :: ElfClass).
Lens' (WBuilderState a) [(ElfSectionIndex, SectionXX a)]
wbsSections forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= ((ElfSectionIndex
esN, SectionXX { Word32
ElfSectionType
WordXX a
sOffset :: WordXX a
sEntSize :: WordXX a
sAddrAlign :: WordXX a
sInfo :: Word32
sLink :: Word32
sSize :: WordXX a
sAddr :: WordXX a
sFlags :: WordXX a
sType :: ElfSectionType
sName :: Word32
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
.. }) forall a. a -> [a] -> [a]
:)
            forall (a :: ElfClass). Lens' (WBuilderState a) [WBuilderData]
wbsDataReversed forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ByteString -> WBuilderData
WBuilderDataByteStream ByteString
d forall a. a -> [a] -> [a]
:)
            forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
d)
            forall (a :: ElfClass). Lens' (WBuilderState a) ElfSectionIndex
wbsShStrNdx forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= ElfSectionIndex
shStrNdx
            forall (a :: ElfClass). Lens' (WBuilderState a) [Int64]
wbsNameIndexes 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
epData :: ElfListXX a
epAlign :: WordXX a
epAddMemSize :: WordXX a
epPhysAddr :: WordXX a
epVirtAddr :: WordXX a
epFlags :: ElfSegmentFlag
epType :: ElfSegmentType
epData :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfListXX c
epAlign :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epAddMemSize :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epPhysAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epVirtAddr :: forall (c :: ElfClass). ElfXX 'Segment c -> WordXX c
epFlags :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentFlag
epType :: forall (c :: ElfClass). ElfXX 'Segment c -> ElfSegmentType
.. } = do
            forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
WordXX a -> WordXX a -> n ()
align WordXX a
epVirtAddr WordXX a
epAlign
            WordXX a
offset <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (a :: ElfClass) b.
Monad m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m b)
-> ElfListXX a -> m [b]
mapMElfList forall (n :: * -> *) (t :: ElfNodeType).
(MonadThrow n, MonadState (WBuilderState a) n) =>
ElfXX t a -> n ()
elf2WBuilder ElfListXX a
epData
            WordXX a
offset' <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset
            let
                -- allocate one more byte in the end of segment if there exists an empty section
                -- at the end so that that empty section will go to the current segment
                add1 :: Bool
add1 = ElfListXX a -> Bool
lastSectionIsEmpty ElfListXX a
epData Bool -> Bool -> Bool
&& WordXX a
offset 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' forall a. Num a => a -> a -> a
- WordXX a
offset 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 forall a. Num a => a -> a -> a
+ WordXX a
epAddMemSize
                pAlign :: WordXX a
pAlign = WordXX a
epAlign
            forall (a :: ElfClass). Lens' (WBuilderState a) [SegmentXX a]
wbsSegmentsReversed forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (SegmentXX { ElfSegmentType
ElfSegmentFlag
WordXX a
pAlign :: WordXX a
pMemSize :: WordXX a
pFileSize :: WordXX a
pPhysAddr :: WordXX a
pVirtAddr :: WordXX a
pOffset :: WordXX a
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
pAlign :: WordXX a
pMemSize :: WordXX a
pFileSize :: WordXX a
pPhysAddr :: WordXX a
pVirtAddr :: WordXX a
pOffset :: WordXX a
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
.. } forall a. a -> [a] -> [a]
:)
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
add1 do
                forall (a :: ElfClass). Lens' (WBuilderState a) [WBuilderData]
wbsDataReversed 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) forall a. a -> [a] -> [a]
:)
                forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= WordXX a
1
        elf2WBuilder ElfRawData { ByteString
edData :: ByteString
edData :: forall (c :: ElfClass). ElfXX 'RawData c -> ByteString
.. } = do
            forall (a :: ElfClass). Lens' (WBuilderState a) [WBuilderData]
wbsDataReversed forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (ByteString -> WBuilderData
WBuilderDataByteStream ByteString
edData forall a. a -> [a] -> [a]
:)
            forall (a :: ElfClass). Lens' (WBuilderState a) (WordXX a)
wbsOffset forall s (m :: * -> *) a.
(MonadState s m, Num a) =>
ASetter' s a -> a -> m ()
+= forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
edData)
        elf2WBuilder ElfRawAlign { WordXX a
eaAlign :: WordXX a
eaOffset :: WordXX a
eaAlign :: forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
eaOffset :: forall (c :: ElfClass). ElfXX 'RawAlign c -> WordXX c
.. } = 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
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [(ElfSectionIndex, SectionXX a)]
ss forall a. Eq a => a -> a -> Bool
/= forall b. Num b => b
sectionN) (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 forall a. Ord a => a -> a -> Ordering
`compare` a
rn
                sorted :: [(ElfSectionIndex, SectionXX a)]
sorted = forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy 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 forall a. Num a => a -> a -> a
+ a
1 forall a. Eq a => a -> a -> Bool
== a
rn
                checkNeibours :: Bool
checkNeibours = forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> (a -> a -> b) -> [b]
neighbours [(ElfSectionIndex, SectionXX a)]
sorted forall {a} {b} {b}. (Eq a, Num a) => (a, b) -> (a, b) -> Bool
next

            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
checkNeibours ($Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"sections are not consistent")
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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
_wbsNameIndexes :: [Int64]
_wbsShStrNdx :: ElfSectionIndex
_wbsShOff :: WordXX a
_wbsPhOff :: WordXX a
_wbsOffset :: WordXX a
_wbsDataReversed :: [WBuilderData]
_wbsSegmentsReversed :: [SegmentXX a]
_wbsSections :: [(ElfSectionIndex, SectionXX a)]
_wbsNameIndexes :: forall (a :: ElfClass). WBuilderState a -> [Int64]
_wbsShStrNdx :: forall (a :: ElfClass). WBuilderState a -> ElfSectionIndex
_wbsShOff :: forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsPhOff :: forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsOffset :: forall (a :: ElfClass). WBuilderState a -> WordXX a
_wbsDataReversed :: forall (a :: ElfClass). WBuilderState a -> [WBuilderData]
_wbsSegmentsReversed :: forall (a :: ElfClass). WBuilderState a -> [SegmentXX a]
_wbsSections :: forall (a :: ElfClass).
WBuilderState a -> [(ElfSectionIndex, SectionXX a)]
..} = 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
ehFlags :: Word32
ehEntry :: WordXX a
ehMachine :: ElfMachine
ehType :: ElfType
ehABIVersion :: Word8
ehOSABI :: ElfOSABI
ehData :: ElfData
ehFlags :: forall (c :: ElfClass). ElfXX 'Header c -> Word32
ehEntry :: forall (c :: ElfClass). ElfXX 'Header c -> WordXX c
ehMachine :: forall (c :: ElfClass). ElfXX 'Header c -> ElfMachine
ehType :: forall (c :: ElfClass). ElfXX 'Header c -> ElfType
ehABIVersion :: forall (c :: ElfClass). ElfXX 'Header c -> Word8
ehOSABI :: forall (c :: ElfClass). ElfXX 'Header c -> ElfOSABI
ehData :: forall (c :: ElfClass). ElfXX 'Header c -> ElfData
..} ->
                            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  = forall a. Num a => ElfClass -> a
segmentTableEntrySize ElfClass
elfClass
                                hPhNum :: Word16
hPhNum      = forall b. Num b => b
segmentN :: Word16
                                hShEntSize :: Word16
hShEntSize  = forall a. Num a => ElfClass -> a
sectionTableEntrySize ElfClass
elfClass
                                hShNum :: Word16
hShNum      = (if Bool
sectionTable then forall b. Num b => b
sectionN forall a. Num a => a -> a -> a
+ Word16
1 else Word16
0) :: Word16
                                hShStrNdx :: ElfSectionIndex
hShStrNdx   = ElfSectionIndex
_wbsShStrNdx

                                h :: H.Header
                                h :: Header
h = 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
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
..}
                            in
                                forall a. Binary a => a -> ByteString
encode Header
h
                f WBuilderDataByteStream {ByteString
wbdData :: ByteString
wbdData :: WBuilderData -> ByteString
..} = ByteString
wbdData
                f WBuilderData
WBuilderDataSectionTable =
                    forall a.
(Binary (Le a), Binary (Be a)) =>
ElfData -> [a] -> ByteString
serializeBList (forall (c :: ElfClass). ElfXX 'Header c -> ElfData
ehData ElfXX 'Header a
header') forall a b. (a -> b) -> a -> b
$ forall (a :: ElfClass). SingElfClassI a => SectionXX a
zeroSection forall a. a -> [a] -> [a]
: [SectionXX a]
sections
                f WBuilderData
WBuilderDataSegmentTable =
                    forall a.
(Binary (Le a), Binary (Be a)) =>
ElfData -> [a] -> ByteString
serializeBList (forall (c :: ElfClass). ElfXX 'Header c -> ElfData
ehData ElfXX 'Header a
header') forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
L.reverse [SegmentXX a]
_wbsSegmentsReversed

            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WBuilderData -> ByteString
f forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
L.reverse [WBuilderData]
_wbsDataReversed

    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (forall (m :: * -> *) (a :: ElfClass) b.
Monad m =>
(forall (t' :: ElfNodeType). ElfXX t' a -> m b)
-> ElfListXX a -> m [b]
mapMElfList forall (n :: * -> *) (t :: ElfNodeType).
(MonadThrow n, MonadState (WBuilderState a) n) =>
ElfXX t a -> n ()
elf2WBuilder ElfListXX a
elfs) forall (a :: ElfClass). SingElfClassI a => WBuilderState a
wbStateInit{ _wbsNameIndexes :: [Int64]
_wbsNameIndexes = [Int64]
nameIndexes } forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WBuilderState a -> m ByteString
wbState2ByteString

-- | Serialze ELF file
serializeElf :: MonadCatch m => Elf -> m BSL.ByteString
serializeElf :: forall (m :: * -> *). MonadCatch m => Elf -> m ByteString
serializeElf (Elf SingElfClass a
classS ElfListXX a
ls) = forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass a
classS forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadCatch m) =>
ElfListXX a -> m ByteString
serializeElf' ElfListXX a
ls

-------------------------------------------------------------------------------
--
-------------------------------------------------------------------------------

-- FIXME: move this to a separate file

-- | Parsed ELF symbol table entry. NB: This is work in progress
data ElfSymbolXX c =
    ElfSymbolXX
        { forall (c :: ElfClass). ElfSymbolXX c -> String
steName  :: String           -- ^ Symbol name (NB: String, not string index)
        , forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolBinding
steBind  :: ElfSymbolBinding -- ^ Symbol binding attributes
        , forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolType
steType  :: ElfSymbolType    -- ^ Symbol Type
        , forall (c :: ElfClass). ElfSymbolXX c -> ElfSectionIndex
steShNdx :: ElfSectionIndex  -- ^ Section table index
        , forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steValue :: WordXX c         -- ^ Symbol value
        , forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steSize  :: WordXX c         -- ^ Size of object
        }

getStringFromData :: BSL.ByteString -> Word32 -> String
getStringFromData :: ByteString -> Word32 -> String
getStringFromData ByteString
stringTable Word32
offset = ByteString -> String
BSL8.unpack forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
BSL.takeWhile (forall a. Eq a => a -> a -> Bool
/= Word8
0) forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop (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
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
stSize :: WordXX a
stValue :: WordXX a
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
..} =
    let
        steName :: String
steName  = ByteString -> Word32 -> String
getStringFromData ByteString
stringTable Word32
stName
        steBind :: ElfSymbolBinding
steBind  = Word8 -> ElfSymbolBinding
ElfSymbolBinding forall a b. (a -> b) -> a -> b
$ Word8
stInfo forall a. Bits a => a -> Int -> a
`shiftR` Int
4
        steType :: ElfSymbolType
steType  = Word8 -> ElfSymbolType
ElfSymbolType forall a b. (a -> b) -> a -> b
$ Word8
stInfo 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
steSize :: WordXX a
steValue :: WordXX a
steShNdx :: ElfSectionIndex
steType :: ElfSymbolType
steBind :: ElfSymbolBinding
steName :: String
steSize :: WordXX a
steValue :: WordXX a
steShNdx :: ElfSectionIndex
steType :: ElfSymbolType
steBind :: ElfSymbolBinding
steName :: String
..}

-- | Parse symbol table
parseSymbolTable :: (MonadThrow m, SingElfClassI a)
                 => ElfData           -- ^ Endianness of the ELF file
                 -> ElfXX 'Section a  -- ^ Parsed section such that @`sectionIsSymbolTable` . `sType`@ is true.
                 -> ElfListXX a       -- ^ Structured ELF data
                 -> m [ElfSymbolXX a] -- ^ Symbol table
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 :: ElfSectionData a
esLink :: Word32
esInfo :: Word32
esN :: ElfSectionIndex
esEntSize :: WordXX a
esAddrAlign :: WordXX a
esAddr :: WordXX a
esFlags :: ElfSectionFlag
esType :: ElfSectionType
esName :: String
esData :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionData c
esLink :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esInfo :: forall (c :: ElfClass). ElfXX 'Section c -> Word32
esN :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionIndex
esEntSize :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esAddr :: forall (c :: ElfClass). ElfXX 'Section c -> WordXX c
esFlags :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionFlag
esType :: forall (c :: ElfClass). ElfXX 'Section c -> ElfSectionType
esName :: forall (c :: ElfClass). ElfXX 'Section c -> String
.. }) 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 } -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
st
        ElfXX 'Section a
_ -> $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"wrong symbol table section data"

    ElfXX 'Section a
section <- 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 } -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
st
        ElfXX 'Section a
_ -> $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"wrong string table section data"

    [SymbolXX a]
st <- forall (m :: * -> *) a.
(MonadThrow m, Binary (Le a), Binary (Be a)) =>
ElfData -> ByteString -> m [a]
parseBList ElfData
d ByteString
symbolTable
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> SymbolXX a -> ElfSymbolXX a
mkElfSymbolTableEntry ByteString
stringTable 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
steSize :: WordXX a
steValue :: WordXX a
steShNdx :: ElfSectionIndex
steType :: ElfSymbolType
steBind :: ElfSymbolBinding
steName :: String
steSize :: forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steValue :: forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steShNdx :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSectionIndex
steType :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolType
steBind :: forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolBinding
steName :: forall (c :: ElfClass). ElfSymbolXX c -> String
..} =
    let
        ElfSymbolBinding Word8
b = ElfSymbolBinding
steBind
        ElfSymbolType Word8
t = ElfSymbolType
steType

        stName :: Word32
stName  = Word32
nameIndex
        stInfo :: Word8
stInfo  = Word8
b forall a. Bits a => a -> Int -> a
`shift` Int
4 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
stSize :: WordXX a
stValue :: WordXX a
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
..}

-- | Serialize symbol table
serializeSymbolTable :: (MonadThrow m, SingElfClassI a)
                     => ElfData                            -- ^ Endianness of the ELF file
                     -> [ElfSymbolXX a]                    -- ^ Symbol table
                     -> m (BSL.ByteString, BSL.ByteString) -- ^ Pair of symbol table section data and string table section data
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 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (c :: ElfClass). ElfSymbolXX c -> String
steName [ElfSymbolXX a]
ss
        ssWithNameIndexes :: [(ElfSymbolXX a, Int64)]
ssWithNameIndexes = 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) = forall (a :: ElfClass). Word32 -> ElfSymbolXX a -> SymbolXX a
mkSymbolTableEntry (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) ElfSymbolXX a
s

        symbolTable :: ByteString
symbolTable = forall a.
(Binary (Le a), Binary (Be a)) =>
ElfData -> [a] -> ByteString
serializeBList ElfData
d forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: ElfClass). (ElfSymbolXX a, Int64) -> SymbolXX a
f [(ElfSymbolXX a, Int64)]
ssWithNameIndexes

    forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
symbolTable, ByteString
stringTable)