{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE InstanceSigs #-}
{-# 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
import Data.Interval as I

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
import Data.Singletons
import Data.Singletons.Sigma

-- import System.IO.Unsafe

headerInterval :: forall a . IsElfClass a => HeaderXX a -> Interval (WordXX a)
headerInterval :: forall (a :: ElfClass).
IsElfClass a =>
HeaderXX a -> Interval (WordXX a)
headerInterval HeaderXX a
_ = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
0 (WordXX a -> Interval (WordXX a))
-> WordXX a -> Interval (WordXX a)
forall a b. (a -> b) -> a -> b
$ ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
headerSize (ElfClass -> WordXX a) -> ElfClass -> WordXX a
forall a b. (a -> b) -> a -> b
$ Sing a -> Demote ElfClass
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing (Sing a -> Demote ElfClass) -> Sing a -> Demote ElfClass
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). SingI a => Sing a
forall (a :: ElfClass). SingI a => Sing a
sing @a

sectionTableInterval :: IsElfClass a => HeaderXX a -> Interval (WordXX a)
sectionTableInterval :: forall (a :: ElfClass).
IsElfClass 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
..} = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
hShOff (WordXX a -> Interval (WordXX a))
-> WordXX a -> Interval (WordXX a)
forall a b. (a -> b) -> a -> b
$ Word16 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> WordXX a) -> Word16 -> WordXX a
forall a b. (a -> b) -> a -> b
$ Word16
hShEntSize Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
hShNum

segmentTableInterval :: IsElfClass a => HeaderXX a -> Interval (WordXX a)
segmentTableInterval :: forall (a :: ElfClass).
IsElfClass 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
..} = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
hPhOff (WordXX a -> Interval (WordXX a))
-> WordXX a -> Interval (WordXX a)
forall a b. (a -> b) -> a -> b
$ Word16 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> WordXX a) -> Word16 -> WordXX a
forall a b. (a -> b) -> a -> b
$ Word16
hPhEntSize Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
hPhNum

sectionInterval :: IsElfClass a => SectionXX a -> Interval (WordXX a)
sectionInterval :: forall (a :: ElfClass).
IsElfClass 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
..} = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
sOffset if ElfSectionType
sType ElfSectionType -> ElfSectionType -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSectionType
SHT_NOBITS then WordXX a
0 else WordXX a
sSize

segmentInterval :: IsElfClass a => SegmentXX a -> Interval (WordXX a)
segmentInterval :: forall (a :: ElfClass).
IsElfClass 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
..} = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
pOffset WordXX a
pFileSize

-- | @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
        }

rBuilderInterval :: IsElfClass a => RBuilder a -> Interval (WordXX a)
rBuilderInterval :: forall (a :: ElfClass).
IsElfClass a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilderHeader{HeaderXX a
rbhHeader :: HeaderXX a
rbhHeader :: forall (c :: ElfClass). RBuilder c -> HeaderXX c
..}       = HeaderXX a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass 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
..} = HeaderXX a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass 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
..} = HeaderXX a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass 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
..}      = SectionXX a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass 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
..}      = SegmentXX a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass 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{}       = Interval (WordXX a)
forall a. HasCallStack => a
undefined -- FIXME

data LZip a = LZip [a] (Maybe a) [a]

instance Foldable LZip where
    foldMap :: forall m a. Monoid m => (a -> m) -> LZip a -> m
foldMap a -> m
f (LZip [a]
l  (Just a
c) [a]
r) = (a -> m) -> LZip a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (LZip a -> m) -> LZip a -> m
forall a b. (a -> b) -> a -> b
$ [a] -> Maybe a -> [a] -> LZip a
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l Maybe a
forall a. Maybe a
Nothing (a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
r)
    foldMap a -> m
f (LZip [a]
l  Maybe a
Nothing  [a]
r) = (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f ([a] -> m) -> [a] -> m
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
l [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
r

findInterval :: (Ord t, Num t) => (a -> Interval t) -> t -> [a] -> LZip a
findInterval :: forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval a -> Interval t
f t
e = [a] -> [a] -> LZip a
findInterval' []
    where
        findInterval' :: [a] -> [a] -> LZip a
findInterval' [a]
l []                           = [a] -> Maybe a -> [a] -> LZip a
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l Maybe a
forall a. Maybe a
Nothing []
        findInterval' [a]
l (a
x : [a]
xs) | t
e t -> Interval t -> Bool
forall {a}. (Ord a, Num a) => a -> Interval a -> Bool
`touches`  a -> Interval t
f a
x  = [a] -> Maybe a -> [a] -> LZip a
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l (a -> Maybe a
forall a. a -> Maybe a
Just a
x) [a]
xs
                                 | t
e t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< Interval t -> t
forall a. Interval a -> a
offset  (a -> Interval t
f a
x) = [a] -> Maybe a -> [a] -> LZip a
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [a]
l Maybe a
forall a. Maybe a
Nothing (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
                                 | Bool
otherwise         = [a] -> [a] -> LZip a
findInterval' (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
l) [a]
xs
        touches :: a -> Interval a -> Bool
touches a
a Interval a
i | Interval a -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval a
i = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Interval a -> a
forall a. Interval a -> a
offset Interval a
i
                    | Bool
otherwise = a
a a -> Interval a -> Bool
forall {a}. (Ord a, Num a) => a -> Interval a -> Bool
`member` Interval a
i

showRBuilder' :: RBuilder a -> String
showRBuilder' :: forall (c :: ElfClass). RBuilder c -> String
showRBuilder' RBuilderHeader{}       = String
"header"
showRBuilder' RBuilderSectionTable{} = String
"section table"
showRBuilder' RBuilderSegmentTable{} = String
"segment table"
showRBuilder' RBuilderSection{String
ElfSectionIndex
SectionXX a
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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ElfSectionIndex -> String
forall a. Show a => a -> String
show ElfSectionIndex
rbsN
showRBuilder' RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word16 -> String
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 :: IsElfClass a => RBuilder a -> String
showRBuilder :: forall (a :: ElfClass). IsElfClass a => RBuilder a -> String
showRBuilder RBuilder a
v = RBuilder a -> String
forall (c :: ElfClass). RBuilder c -> String
showRBuilder' RBuilder a
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Interval (WordXX a) -> String
forall a. Show a => a -> String
show (RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
v) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

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

intersectMessage :: IsElfClass a => RBuilder a -> RBuilder a -> String
intersectMessage :: forall (a :: ElfClass).
IsElfClass a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
x RBuilder a
y = RBuilder a -> String
forall (a :: ElfClass). IsElfClass a => RBuilder a -> String
showRBuilder RBuilder a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" and " String -> String -> String
forall a. [a] -> [a] -> [a]
++ RBuilder a -> String
forall (a :: ElfClass). IsElfClass a => RBuilder a -> String
showRBuilder RBuilder a
y String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" intersect"

addRBuilders :: forall a m . (IsElfClass a, MonadCatch m) => [RBuilder a] -> m [RBuilder a]
addRBuilders :: forall (a :: ElfClass) (m :: * -> *).
(IsElfClass a, MonadCatch m) =>
[RBuilder a] -> m [RBuilder a]
addRBuilders [RBuilder a]
newts =
    let
        addRBuilders' :: (a -> b -> m b) -> t a -> b -> m b
addRBuilders' a -> b -> m b
f t a
newts' b
l = (b -> a -> m b) -> b -> t a -> m b
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ((a -> b -> m b) -> b -> a -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> m b
f) b
l t a
newts'

        addRBuilderEmpty :: (IsElfClass a, MonadCatch m) => RBuilder a -> [RBuilder a] -> m [RBuilder a]
        addRBuilderEmpty :: (IsElfClass 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 = Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset (Interval (WordXX a) -> WordXX a)
-> Interval (WordXX a) -> WordXX a
forall a b. (a -> b) -> a -> b
$ RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
t
                (LZip [RBuilder a]
l Maybe (RBuilder a)
c' [RBuilder a]
r) = (RBuilder a -> Interval (WordXX a))
-> WordXX a -> [RBuilder a] -> LZip (RBuilder a)
forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass 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, []) = ([RBuilder a] -> [RBuilder a]
forall a. [a] -> [a]
L.reverse [RBuilder a]
le, [])
                        f ([RBuilder a]
le, RBuilder a
h : [RBuilder a]
lo) =
                            let
                                hi :: Interval (WordXX a)
hi = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
h
                            in if Bool -> Bool
not (Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval (WordXX a)
hi) Bool -> Bool -> Bool
|| (Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset Interval (WordXX a)
hi WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
a)
                                then ([RBuilder a] -> [RBuilder a]
forall a. [a] -> [a]
L.reverse [RBuilder a]
le, RBuilder a
h RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
lo)
                                else ([RBuilder a], [RBuilder a]) -> ([RBuilder a], [RBuilder a])
f (RBuilder a
h RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
le, [RBuilder a]
lo)
            in case Maybe (RBuilder a)
c' of
                Just RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
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 -> String -> m [RBuilder a] -> m [RBuilder a]
(Loc -> String -> m [RBuilder a] -> m [RBuilder a])
-> String -> Loc -> m [RBuilder a] -> m [RBuilder a]
forall a. [a]
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m [RBuilder a] -> m [RBuilder a])
-> m [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ (IsElfClass a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderEmpty RBuilder a
t [RBuilder a]
rbpData
                    [RBuilder a] -> m [RBuilder a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a]
d, Word16
SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
.. }) [RBuilder a]
r
                Just RBuilder a
c ->
                    if Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset (RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
c) WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
to then
                        $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a]
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m [RBuilder a]) -> String -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
IsElfClass a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
t RBuilder a
c
                    else
                        let
                            ([RBuilder a]
ce, [RBuilder a]
re) = WordXX a -> [RBuilder a] -> ([RBuilder a], [RBuilder a])
allEmptyStartingAt WordXX a
to (RBuilder a
c RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
r)
                        in case RBuilder a
t of
                            RBuilderSegment{[RBuilder a]
Word16
SegmentXX a
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
..} ->
                                [RBuilder a] -> m [RBuilder a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a]
ce, Word16
SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
rbpN :: Word16
rbpHeader :: SegmentXX a
.. }) [RBuilder a]
re
                            RBuilder a
_ ->
                                [RBuilder a] -> m [RBuilder a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l Maybe (RBuilder a)
forall a. Maybe a
Nothing ([RBuilder a]
ce [RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ (RBuilder a
t RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
re))
                Maybe (RBuilder a)
Nothing -> [RBuilder a] -> m [RBuilder a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
t) [RBuilder a]
r

        addRBuilderNonEmpty :: (IsElfClass a, MonadCatch m) => RBuilder a -> [RBuilder a] -> m [RBuilder a]
        addRBuilderNonEmpty :: (IsElfClass 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 = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
t
                (LZip [RBuilder a]
l Maybe (RBuilder a)
c' [RBuilder a]
r) = (RBuilder a -> Interval (WordXX a))
-> WordXX a -> [RBuilder a] -> LZip (RBuilder a)
forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval (Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset Interval (WordXX a)
ti) [RBuilder a]
ts

                addRBuildersNonEmpty :: (IsElfClass a, MonadCatch m) => [RBuilder a] -> RBuilder a -> m (RBuilder a)
                addRBuildersNonEmpty :: (IsElfClass a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [] RBuilder a
x = RBuilder a -> m (RBuilder a)
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 -> String -> m [RBuilder a] -> m [RBuilder a]
(Loc -> String -> m [RBuilder a] -> m [RBuilder a])
-> String -> Loc -> m [RBuilder a] -> m [RBuilder a]
forall a. [a]
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m [RBuilder a] -> m [RBuilder a])
-> m [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ (RBuilder a -> [RBuilder a] -> m [RBuilder a])
-> [RBuilder a] -> [RBuilder a] -> m [RBuilder a]
forall {t :: * -> *} {m :: * -> *} {a} {b}.
(Foldable t, Monad m) =>
(a -> b -> m b) -> t a -> b -> m b
addRBuilders' (IsElfClass a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderNonEmpty [RBuilder a]
ts' [RBuilder a]
rbpData
                    RBuilder a -> m (RBuilder a)
forall (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
Loc -> String -> m (RBuilder a)
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m (RBuilder a)) -> String -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
IsElfClass a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
x RBuilder a
y

            in case Maybe (RBuilder a)
c' of

                Just RBuilder a
c ->

                    if Interval (WordXX a)
ti Interval (WordXX a) -> Interval (WordXX a) -> Bool
forall a. Eq a => a -> a -> Bool
== RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass 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
..} ->

                                    [RBuilder a] -> m [RBuilder a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilderSegment{ rbpData :: [RBuilder a]
rbpData = [RBuilder a
c], Word16
SegmentXX a
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 -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(IsElfClass a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [RBuilder a
t] RBuilder a
c
                                    [RBuilder a] -> m [RBuilder a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r

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

                        RBuilder a
c'' <- $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(IsElfClass a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [RBuilder a
t] RBuilder a
c
                        [RBuilder a] -> m [RBuilder a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r

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

                        let

                            tir :: WordXX a
tir = Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset Interval (WordXX a)
ti WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
size Interval (WordXX a)
ti WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1
                            (LZip [RBuilder a]
l2 Maybe (RBuilder a)
c2' [RBuilder a]
r2) = (RBuilder a -> Interval (WordXX a))
-> WordXX a -> [RBuilder a] -> LZip (RBuilder a)
forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass 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 -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(IsElfClass a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty (RBuilder a
c RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
l2) RBuilder a
t
                                [RBuilder a] -> m [RBuilder a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2

                            Just RBuilder a
c2 ->

                                if Interval (WordXX a)
ti Interval (WordXX a) -> Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Interval a -> Bool
`contains` RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass 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 -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(IsElfClass a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty (RBuilder a
c RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: RBuilder a
c2 RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
l2) RBuilder a
t
                                    [RBuilder a] -> m [RBuilder a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2
                                else

                                    -- add this:     ......[t_________________].............................
                                    -- to this list: ......[c_________]......[c2___]......[________]........
                                    $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [RBuilder a]
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m [RBuilder a]) -> String -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
IsElfClass 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
Loc -> String -> m [RBuilder a]
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m [RBuilder a]) -> String -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ RBuilder a -> RBuilder a -> String
forall (a :: ElfClass).
IsElfClass a =>
RBuilder a -> RBuilder a -> String
intersectMessage RBuilder a
t RBuilder a
c

                Maybe (RBuilder a)
Nothing ->

                    let
                        tir :: WordXX a
tir = Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
offset Interval (WordXX a)
ti WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ Interval (WordXX a) -> WordXX a
forall a. Interval a -> a
size Interval (WordXX a)
ti WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1
                        (LZip [RBuilder a]
l2 Maybe (RBuilder a)
c2' [RBuilder a]
r2) = (RBuilder a -> Interval (WordXX a))
-> WordXX a -> [RBuilder a] -> LZip (RBuilder a)
forall t a.
(Ord t, Num t) =>
(a -> Interval t) -> t -> [a] -> LZip a
findInterval RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass 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 -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(IsElfClass a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty [RBuilder a]
l2 RBuilder a
t
                            [RBuilder a] -> m [RBuilder a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2

                        Just RBuilder a
c2 ->

                            if Interval (WordXX a)
ti Interval (WordXX a) -> Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Interval a -> Bool
`contains` RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass 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 -> String -> m (RBuilder a) -> m (RBuilder a)
(Loc -> String -> m (RBuilder a) -> m (RBuilder a))
-> String -> Loc -> m (RBuilder a) -> m (RBuilder a)
forall a. [a]
forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
rightSection :: forall a b c. (a -> b -> c) -> b -> a -> c
addContextX :: forall (m :: * -> *) a. MonadCatch m => Loc -> String -> m a -> m a
addContext' (m (RBuilder a) -> m (RBuilder a))
-> m (RBuilder a) -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a -> m (RBuilder a)
(IsElfClass a, MonadCatch m) =>
[RBuilder a] -> RBuilder a -> m (RBuilder a)
addRBuildersNonEmpty (RBuilder a
c2 RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
l2) RBuilder a
t
                                [RBuilder a] -> m [RBuilder a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ LZip (RBuilder a) -> [RBuilder a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (LZip (RBuilder a) -> [RBuilder a])
-> LZip (RBuilder a) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a]
-> Maybe (RBuilder a) -> [RBuilder a] -> LZip (RBuilder a)
forall a. [a] -> Maybe a -> [a] -> LZip a
LZip [RBuilder a]
l (RBuilder a -> Maybe (RBuilder a)
forall a. a -> Maybe a
Just RBuilder a
c'') [RBuilder a]
r2

                            else

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

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

    in
        (RBuilder a -> [RBuilder a] -> m [RBuilder a])
-> [RBuilder a] -> [RBuilder a] -> m [RBuilder a]
forall {t :: * -> *} {m :: * -> *} {a} {b}.
(Foldable t, Monad m) =>
(a -> b -> m b) -> t a -> b -> m b
addRBuilders' (IsElfClass a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderNonEmpty [RBuilder a]
nonEmptyRBs [] m [RBuilder a]
-> ([RBuilder a] -> m [RBuilder a]) -> m [RBuilder a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (RBuilder a -> [RBuilder a] -> m [RBuilder a])
-> [RBuilder a] -> [RBuilder a] -> m [RBuilder a]
forall {t :: * -> *} {m :: * -> *} {a} {b}.
(Foldable t, Monad m) =>
(a -> b -> m b) -> t a -> b -> m b
addRBuilders' (IsElfClass a, MonadCatch m) =>
RBuilder a -> [RBuilder a] -> m [RBuilder a]
RBuilder a -> [RBuilder a] -> m [RBuilder a]
addRBuilderEmpty [RBuilder a]
emptyRBs

-- FIXME: Use validity (https://hackage.haskell.org/package/validity) for constraints on the Elf type (???)

-- | `Elf` is a forrest of trees of type `ElfXX`.
-- Trees are composed of `ElfXX` nodes, `ElfSegment` can contain subtrees
newtype ElfList c = ElfList [ElfXX c]

-- | Elf is a sigma type where `ElfClass` defines the type of `ElfList`
type Elf = Sigma ElfClass (TyCon1 ElfList)

-- | 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 c
    = ElfHeader
        { forall (c :: ElfClass). ElfXX c -> ElfData
ehData       :: ElfData    -- ^ Data encoding (big- or little-endian)
        , forall (c :: ElfClass). ElfXX c -> ElfOSABI
ehOSABI      :: ElfOSABI   -- ^ OS/ABI identification
        , forall (c :: ElfClass). ElfXX c -> Word8
ehABIVersion :: Word8      -- ^ ABI version
        , forall (c :: ElfClass). ElfXX c -> ElfType
ehType       :: ElfType    -- ^ Object file type
        , forall (c :: ElfClass). ElfXX c -> ElfMachine
ehMachine    :: ElfMachine -- ^ Machine type
        , forall (c :: ElfClass). ElfXX c -> WordXX c
ehEntry      :: WordXX c   -- ^ Entry point address
        , forall (c :: ElfClass). ElfXX c -> Word32
ehFlags      :: Word32     -- ^ Processor-specific flags
        }
    | ElfSectionTable
    | ElfSegmentTable
    | ElfSection
        { forall (c :: ElfClass). ElfXX c -> String
esName      :: String         -- ^ Section name (NB: string, not offset in the string table)
        , forall (c :: ElfClass). ElfXX c -> ElfSectionType
esType      :: ElfSectionType -- ^ Section type
        , forall (c :: ElfClass). ElfXX c -> ElfSectionFlag
esFlags     :: ElfSectionFlag -- ^ Section attributes
        , forall (c :: ElfClass). ElfXX c -> WordXX c
esAddr      :: WordXX c       -- ^ Virtual address in memory
        , forall (c :: ElfClass). ElfXX c -> WordXX c
esAddrAlign :: WordXX c       -- ^ Address alignment boundary
        , forall (c :: ElfClass). ElfXX c -> WordXX c
esEntSize   :: WordXX c       -- ^ Size of entries, if section has table
        , forall (c :: ElfClass). ElfXX c -> ElfSectionIndex
esN         :: ElfSectionIndex -- ^ Section number
        , forall (c :: ElfClass). ElfXX c -> Word32
esInfo      :: Word32         -- ^ Miscellaneous information
        , forall (c :: ElfClass). ElfXX c -> Word32
esLink      :: Word32         -- ^ Link to other section
        , forall (c :: ElfClass). ElfXX c -> ElfSectionData c
esData      :: ElfSectionData c -- ^ The content of the section
        }
    | ElfSegment
        { forall (c :: ElfClass). ElfXX c -> ElfSegmentType
epType       :: ElfSegmentType -- ^ Type of segment
        , forall (c :: ElfClass). ElfXX c -> ElfSegmentFlag
epFlags      :: ElfSegmentFlag -- ^ Segment attributes
        , forall (c :: ElfClass). ElfXX c -> WordXX c
epVirtAddr   :: WordXX c       -- ^ Virtual address in memory
        , forall (c :: ElfClass). ElfXX c -> WordXX c
epPhysAddr   :: WordXX c       -- ^ Physical address
        , forall (c :: ElfClass). ElfXX 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 c -> WordXX c
epAlign      :: WordXX c       -- ^ Alignment of segment
        , forall (c :: ElfClass). ElfXX c -> [ElfXX c]
epData       :: [ElfXX c]      -- ^ Content of the segment
        }
    | ElfRawData -- ^ Some ELF files (some executables) don't bother to define
                 -- sections for linking and have just raw data in segments.
        { forall (c :: ElfClass). ElfXX c -> ByteString
edData :: BSL.ByteString -- ^ Raw data in ELF file
        }
    | ElfRawAlign -- ^ 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 @
        { forall (c :: ElfClass). ElfXX c -> WordXX c
eaOffset :: WordXX c -- ^ Align value
        , forall (c :: ElfClass). ElfXX c -> WordXX c
eaAlign  :: WordXX c -- ^ Align module
        }

foldMapElf :: Monoid m => (ElfXX a -> m) -> ElfXX a -> m
foldMapElf :: forall m (a :: ElfClass).
Monoid m =>
(ElfXX a -> m) -> ElfXX a -> m
foldMapElf ElfXX a -> m
f e :: ElfXX a
e@ElfSegment{[ElfXX a]
ElfSegmentType
ElfSegmentFlag
WordXX a
epData :: [ElfXX a]
epAlign :: WordXX a
epAddMemSize :: WordXX a
epPhysAddr :: WordXX a
epVirtAddr :: WordXX a
epFlags :: ElfSegmentFlag
epType :: ElfSegmentType
epData :: forall (c :: ElfClass). ElfXX c -> [ElfXX c]
epAlign :: forall (c :: ElfClass). ElfXX c -> WordXX c
epAddMemSize :: forall (c :: ElfClass). ElfXX c -> WordXX c
epPhysAddr :: forall (c :: ElfClass). ElfXX c -> WordXX c
epVirtAddr :: forall (c :: ElfClass). ElfXX c -> WordXX c
epFlags :: forall (c :: ElfClass). ElfXX c -> ElfSegmentFlag
epType :: forall (c :: ElfClass). ElfXX c -> ElfSegmentType
..} = ElfXX a -> m
f ElfXX a
e m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (ElfXX a -> m) -> [ElfXX a] -> m
forall m (a :: ElfClass).
Monoid m =>
(ElfXX a -> m) -> [ElfXX a] -> m
foldMapElfList ElfXX a -> m
f [ElfXX a]
epData
foldMapElf ElfXX a -> m
f ElfXX a
e = ElfXX a -> m
f ElfXX a
e

foldMapElfList :: Monoid m => (ElfXX a -> m) -> [ElfXX a] -> m
foldMapElfList :: forall m (a :: ElfClass).
Monoid m =>
(ElfXX a -> m) -> [ElfXX a] -> m
foldMapElfList ElfXX a -> m
f = (ElfXX a -> m) -> [ElfXX a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((ElfXX a -> m) -> ElfXX a -> m
forall m (a :: ElfClass).
Monoid m =>
(ElfXX a -> m) -> ElfXX a -> m
foldMapElf ElfXX a -> m
f)

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

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

-- | Find ELF header
elfFindHeader :: forall a m . (SingI a, MonadThrow m)
              => [ElfXX a]   -- ^ Structured ELF data
              -> m (ElfXX a) -- ^ ELF header
elfFindHeader :: forall (a :: ElfClass) (m :: * -> *).
(SingI a, MonadThrow m) =>
[ElfXX a] -> m (ElfXX a)
elfFindHeader [ElfXX a]
elfs = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> Maybe (ElfXX a) -> m (ElfXX a)
forall (m :: * -> *) a.
MonadThrow m =>
Loc -> String -> Maybe a -> m a
maybeAddContext String
"no header" Maybe (ElfXX a)
maybeHeader
    where
        maybeHeader :: Maybe (ElfXX a)
maybeHeader = First (ElfXX a) -> Maybe (ElfXX a)
forall a. First a -> Maybe a
getFirst (First (ElfXX a) -> Maybe (ElfXX a))
-> First (ElfXX a) -> Maybe (ElfXX a)
forall a b. (a -> b) -> a -> b
$ (ElfXX a -> First (ElfXX a)) -> [ElfXX a] -> First (ElfXX a)
forall m (a :: ElfClass).
Monoid m =>
(ElfXX a -> m) -> [ElfXX a] -> m
foldMapElfList ElfXX a -> First (ElfXX a)
forall {c :: ElfClass}. ElfXX c -> First (ElfXX c)
f [ElfXX a]
elfs
        f :: ElfXX c -> First (ElfXX c)
f h :: ElfXX c
h@ElfHeader{} = Maybe (ElfXX c) -> First (ElfXX c)
forall a. Maybe a -> First a
First (Maybe (ElfXX c) -> First (ElfXX c))
-> Maybe (ElfXX c) -> First (ElfXX c)
forall a b. (a -> b) -> a -> b
$ ElfXX c -> Maybe (ElfXX c)
forall a. a -> Maybe a
Just ElfXX c
h
        f ElfXX c
_ = Maybe (ElfXX c) -> First (ElfXX c)
forall a. Maybe a -> First a
First Maybe (ElfXX c)
forall a. Maybe a
Nothing

-- | Get string from string table
getString :: BSL.ByteString -- ^ Section data of a string table section
          -> Int64          -- ^ Offset to the start of the string in that data
          -> String
getString :: ByteString -> Int64 -> String
getString ByteString
bs Int64
offset = ByteString -> String
BSL8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
BSL.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop Int64
offset ByteString
bs

cut :: BSL.ByteString -> Int64 -> Int64 -> BSL.ByteString
cut :: ByteString -> Int64 -> Int64 -> ByteString
cut ByteString
content Int64
offset Int64
size = Int64 -> ByteString -> ByteString
BSL.take Int64
size (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop Int64
offset ByteString
content

-- | Get section data
getSectionData :: IsElfClass a
               => BSL.ByteString -- ^ ELF file
               -> SectionXX a    -- ^ Parsed section entry
               -> BSL.ByteString -- ^ Section Data
getSectionData :: forall (a :: ElfClass).
IsElfClass a =>
ByteString -> SectionXX a -> ByteString
getSectionData ByteString
bs 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
..} = ByteString -> Int64 -> Int64 -> ByteString
cut ByteString
bs Int64
o Int64
s
    where
        o :: Int64
o = WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
sOffset
        s :: Int64
s = WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
sSize

tail' :: [a] -> [a]
tail' :: forall a. [a] -> [a]
tail' [] = []
tail' (a
_ : [a]
xs) = [a]
xs

nextOffset :: IsElfClass a => WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset :: forall (a :: ElfClass).
IsElfClass a =>
WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset WordXX a
_ WordXX a
0 WordXX a
a = WordXX a
a
nextOffset WordXX a
t WordXX a
m WordXX a
a | WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Bits a => a -> a -> a
.&. (WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1) WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
0 = String -> WordXX a
forall a. HasCallStack => String -> a
error (String -> WordXX a) -> String -> WordXX a
forall a b. (a -> b) -> a -> b
$ String
"align module is not power of two " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WordXX a -> String
forall a. Show a => a -> String
show WordXX a
m
                 | Bool
otherwise          = if WordXX a
a' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
t' WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
a then WordXX a
a' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
t' else WordXX a
a' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
t'
    where
        a' :: WordXX a
a' = WordXX a
a WordXX a -> WordXX a -> WordXX a
forall a. Bits a => a -> a -> a
.&. WordXX a -> WordXX a
forall a. Bits a => a -> a
complement (WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1)
        t' :: WordXX a
t' = WordXX a
t WordXX a -> WordXX a -> WordXX a
forall a. Bits a => a -> a -> a
.&. (WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1)

addRawData :: forall a . IsElfClass a => BSL.ByteString -> [RBuilder a] -> [RBuilder a]
addRawData :: forall (a :: ElfClass).
IsElfClass a =>
ByteString -> [RBuilder a] -> [RBuilder a]
addRawData ByteString
_ [] = []
addRawData ByteString
bs [RBuilder a]
rBuilders = (WordXX a, [RBuilder a]) -> [RBuilder a]
forall a b. (a, b) -> b
snd ((WordXX a, [RBuilder a]) -> [RBuilder a])
-> (WordXX a, [RBuilder a]) -> [RBuilder a]
forall a b. (a -> b) -> a -> b
$ WordXX a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
addRawData' WordXX a
0 (WordXX a
lrbie, [RBuilder a]
rBuilders)
    where

        -- 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) = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval (RBuilder a -> Interval (WordXX a))
-> RBuilder a -> Interval (WordXX a)
forall a b. (a -> b) -> a -> b
$ [RBuilder a] -> RBuilder a
forall a. [a] -> a
L.last [RBuilder a]
rBuilders
        lrbie :: WordXX a
lrbie = if Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval (WordXX a)
lrbi then WordXX a
lrbib else WordXX a
lrbib WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
lrbis

        allEmpty :: WordXX a -> WordXX a -> Bool
        allEmpty :: WordXX a -> WordXX a -> Bool
allEmpty WordXX a
b WordXX a
s = (Word8 -> Bool) -> ByteString -> Bool
BSL.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bs'
            where
                bs' :: ByteString
bs' = ByteString -> Int64 -> Int64 -> ByteString
cut ByteString
bs (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
b) (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
s)

        addRawData' :: WordXX a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
        addRawData' :: WordXX a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
addRawData' WordXX a
alignHint (WordXX a
e, [RBuilder a]
rbs) = (RBuilder a
 -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a]))
-> (WordXX a, [RBuilder a])
-> [RBuilder a]
-> (WordXX a, [RBuilder a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr RBuilder a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
f (WordXX a
e, []) ([RBuilder a] -> (WordXX a, [RBuilder a]))
-> [RBuilder a] -> (WordXX a, [RBuilder a])
forall a b. (a -> b) -> a -> b
$ (RBuilder a -> RBuilder a) -> [RBuilder a] -> [RBuilder a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RBuilder a -> RBuilder a
fixRBuilder [RBuilder a]
rbs
            where
                f :: RBuilder a -> (WordXX a, [RBuilder a]) -> (WordXX a, [RBuilder a])
f RBuilder a
rb (WordXX a
e', [RBuilder a]
rbs') =
                    let
                        i :: Interval (WordXX a)
i@(I WordXX a
b WordXX a
s) = RBuilder a -> Interval (WordXX a)
forall (a :: ElfClass).
IsElfClass a =>
RBuilder a -> Interval (WordXX a)
rBuilderInterval RBuilder a
rb
                        b' :: WordXX a
b' = if Interval (WordXX a) -> Bool
forall a. (Ord a, Num a) => Interval a -> Bool
I.empty Interval (WordXX a)
i then WordXX a
b else WordXX a
b WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
s
                        rbs'' :: [RBuilder a]
rbs'' = WordXX a -> WordXX a -> [RBuilder a] -> [RBuilder a]
addRaw WordXX a
b' WordXX a
e' [RBuilder a]
rbs'
                    in
                        (WordXX a
b, RBuilder a
rb RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'')

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

                -- 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 WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
ee
                        then
                            if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ WordXX a -> WordXX a -> Bool
allEmpty WordXX a
b WordXX a
s
                                then
                                    Interval (WordXX a) -> RBuilder a
forall (c :: ElfClass). Interval (WordXX c) -> RBuilder c
RBuilderRawData (WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
b WordXX a
s) RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'
                                else
                                    -- 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' WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
ee Bool -> Bool -> Bool
&& WordXX a
e'' WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
== WordXX a
ee
                                        then
                                            WordXX a -> WordXX a -> RBuilder a
forall (c :: ElfClass). WordXX c -> WordXX c -> RBuilder c
RBuilderRawAlign WordXX a
ee WordXX a
alignHint RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'
                                        else
                                            [RBuilder a]
rbs'
                        else
                            [RBuilder a]
rbs'
                    where
                        s :: WordXX a
s = WordXX a
ee WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
b
                        eAddr :: WordXX a
eAddr = case [RBuilder a]
rbs' of
                            (RBuilderSegment{rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpHeader = SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX a
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]
_ -> ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
wordSize (ElfClass -> WordXX a) -> ElfClass -> WordXX a
forall a b. (a -> b) -> a -> b
$ Sing a -> Demote ElfClass
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing (Sing a -> Demote ElfClass) -> Sing a -> Demote ElfClass
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). SingI a => Sing a
forall (a :: ElfClass). SingI a => Sing a
sing @a
                        -- e' here is the address of the next section/segment
                        -- according to the regular alignment rules
                        e' :: WordXX a
e' = WordXX a -> WordXX a -> WordXX a -> WordXX a
forall (a :: ElfClass).
IsElfClass a =>
WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset WordXX a
eAddr WordXX a
eAddrAlign WordXX a
b
                        e'' :: WordXX a
e'' = WordXX a -> WordXX a -> WordXX a -> WordXX a
forall (a :: ElfClass).
IsElfClass a =>
WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset WordXX a
ee WordXX a
alignHint WordXX a
b

infix 9 !!?

(!!?) :: (Integral b) => [a] -> b -> Maybe a
!!? :: forall b a. Integral b => [a] -> b -> Maybe a
(!!?) [a]
xs b
i
    | b
i b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0     = Maybe a
forall a. Maybe a
Nothing
    | Bool
otherwise = b -> [a] -> Maybe a
forall b a. Integral b => b -> [a] -> Maybe a
go b
i [a]
xs
  where
    go :: (Integral b) => b -> [a] -> Maybe a
    go :: forall b a. Integral b => b -> [a] -> Maybe a
go b
0 (a
x:[a]
_)  = a -> Maybe a
forall a. a -> Maybe a
Just a
x
    go b
j (a
_:[a]
ys) = b -> [a] -> Maybe a
forall b a. Integral b => b -> [a] -> Maybe a
go (b
j b -> b -> b
forall a. Num a => a -> a -> a
- b
1) [a]
ys
    go b
_ []     = Maybe a
forall a. Maybe a
Nothing

-- | Parse ELF file and produce [`RBuilder`]
parseRBuilder :: (IsElfClass 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 :: * -> *).
(IsElfClass 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 = ByteString -> SectionXX a -> ByteString
forall (a :: ElfClass).
IsElfClass a =>
ByteString -> SectionXX a -> ByteString
getSectionData ByteString
bs (SectionXX a -> ByteString)
-> Maybe (SectionXX a) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([SectionXX a]
ss [SectionXX a] -> ElfSectionIndex -> Maybe (SectionXX a)
forall b a. Integral b => [a] -> b -> Maybe a
!!? ElfSectionIndex
hShStrNdx)

        mkRBuilderSection :: (SingI a, MonadCatch m) => (ElfSectionIndex, SectionXX a) -> m (RBuilder a)
        mkRBuilderSection :: forall (a :: ElfClass) (m :: * -> *).
(SingI 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
Loc -> String -> Maybe ByteString -> m ByteString
forall (m :: * -> *) a.
MonadThrow m =>
Loc -> String -> Maybe a -> m a
maybeAddContext String
"No string table" Maybe ByteString
maybeStringSectionData
            RBuilder a -> m (RBuilder a)
forall (m :: * -> *) a. Monad m => a -> m a
return (RBuilder a -> m (RBuilder a)) -> RBuilder a -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ SectionXX a -> ElfSectionIndex -> String -> RBuilder a
forall (c :: ElfClass).
SectionXX c -> ElfSectionIndex -> String -> RBuilder c
RBuilderSection SectionXX a
s ElfSectionIndex
n (String -> RBuilder a) -> String -> RBuilder a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> String
getString ByteString
stringSectionData (Int64 -> String) -> Int64 -> String
forall a b. (a -> b) -> a -> b
$ Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sName

        mkRBuilderSegment :: (SingI a, MonadCatch m) => (Word16, SegmentXX a) -> m (RBuilder a)
        mkRBuilderSegment :: forall (a :: ElfClass) (m :: * -> *).
(SingI a, MonadCatch m) =>
(Word16, SegmentXX a) -> m (RBuilder a)
mkRBuilderSegment (Word16
n, SegmentXX a
p) = RBuilder a -> m (RBuilder a)
forall (m :: * -> *) a. Monad m => a -> m a
return (RBuilder a -> m (RBuilder a)) -> RBuilder a -> m (RBuilder a)
forall a b. (a -> b) -> a -> b
$ SegmentXX a -> Word16 -> [RBuilder a] -> RBuilder a
forall (c :: ElfClass).
SegmentXX c -> Word16 -> [RBuilder c] -> RBuilder c
RBuilderSegment SegmentXX a
p Word16
n []

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

    let

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

    [RBuilder a]
rbs <- [RBuilder a] -> m [RBuilder a]
forall (a :: ElfClass) (m :: * -> *).
(IsElfClass a, MonadCatch m) =>
[RBuilder a] -> m [RBuilder a]
addRBuilders ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ [RBuilder a
header] [RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ Maybe (RBuilder a) -> [RBuilder a]
forall a. Maybe a -> [a]
maybeToList Maybe (RBuilder a)
maybeSectionTable
                                   [RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ Maybe (RBuilder a) -> [RBuilder a]
forall a. Maybe a -> [a]
maybeToList Maybe (RBuilder a)
maybeSegmentTable
                                   [RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ [RBuilder a]
segments
                                   [RBuilder a] -> [RBuilder a] -> [RBuilder a]
forall a. [a] -> [a] -> [a]
++ [RBuilder a]
sections
    [RBuilder a] -> m [RBuilder a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([RBuilder a] -> m [RBuilder a]) -> [RBuilder a] -> m [RBuilder a]
forall a b. (a -> b) -> a -> b
$ ByteString -> [RBuilder a] -> [RBuilder a]
forall (a :: ElfClass).
IsElfClass a =>
ByteString -> [RBuilder a] -> [RBuilder a]
addRawData ByteString
bs [RBuilder a]
rbs

parseElf' :: forall a m . (IsElfClass a, MonadCatch m) =>
                                            HeaderXX a ->
                                         [SectionXX a] ->
                                         [SegmentXX a] ->
                                        BSL.ByteString -> m Elf
parseElf' :: forall (a :: ElfClass) (m :: * -> *).
(IsElfClass 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 <- HeaderXX a
-> [SectionXX a] -> [SegmentXX a] -> ByteString -> m [RBuilder a]
forall (a :: ElfClass) (m :: * -> *).
(IsElfClass 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 -> m (ElfXX a)
        rBuilderToElf :: RBuilder a -> m (ElfXX a)
rBuilderToElf RBuilderHeader{} =
            ElfXX a -> m (ElfXX a)
forall (m :: * -> *) a. Monad m => a -> m a
return 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
                }
        rBuilderToElf RBuilderSectionTable{} =
            ElfXX a -> m (ElfXX a)
forall (m :: * -> *) a. Monad m => a -> m a
return ElfXX a
forall (c :: ElfClass). ElfXX c
ElfSectionTable
        rBuilderToElf RBuilderSegmentTable{} =
            ElfXX a -> m (ElfXX a)
forall (m :: * -> *) a. Monad m => a -> m a
return ElfXX a
forall (c :: ElfClass). ElfXX c
ElfSegmentTable
        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
..} =
            ElfXX a -> m (ElfXX a)
forall (m :: * -> *) a. Monad m => a -> m a
return ElfSection
                { esName :: String
esName      = String
rbsName
                , esType :: ElfSectionType
esType      = ElfSectionType
sType
                , esFlags :: ElfSectionFlag
esFlags     = WordXX a -> ElfSectionFlag
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
sFlags
                , esAddr :: WordXX a
esAddr      = WordXX a
sAddr
                , esAddrAlign :: WordXX a
esAddrAlign = WordXX a
sAddrAlign
                , esEntSize :: WordXX a
esEntSize   = WordXX a
sEntSize
                , esN :: ElfSectionIndex
esN         = ElfSectionIndex
rbsN
                , esInfo :: Word32
esInfo      = Word32
sInfo
                , esLink :: Word32
esLink      = Word32
sLink
                , esData :: ElfSectionData a
esData      =
                    if ElfSectionIndex
rbsN ElfSectionIndex -> ElfSectionIndex -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSectionIndex
hShStrNdx
                        then ElfSectionData a
forall (c :: ElfClass). ElfSectionData c
ElfSectionDataStringTable
                        else if ElfSectionType
sType ElfSectionType -> ElfSectionType -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSectionType
SHT_NOBITS
                            then WordXX a -> ElfSectionData a
forall (c :: ElfClass). WordXX c -> ElfSectionData c
ElfSectionDataNoBits WordXX a
sSize
                            else ByteString -> ElfSectionData a
forall (c :: ElfClass). ByteString -> ElfSectionData c
ElfSectionData (ByteString -> ElfSectionData a) -> ByteString -> ElfSectionData a
forall a b. (a -> b) -> a -> b
$ ByteString -> SectionXX a -> ByteString
forall (a :: ElfClass).
IsElfClass a =>
ByteString -> SectionXX a -> ByteString
getSectionData ByteString
bs SectionXX a
s
                }
        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
..} = do
            [ElfXX a]
d <- (RBuilder a -> m (ElfXX a)) -> [RBuilder a] -> m [ElfXX a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RBuilder a -> m (ElfXX a)
rBuilderToElf [RBuilder a]
rbpData
            WordXX a
addMemSize <- if WordXX a
pMemSize WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
0 Bool -> Bool -> Bool
&& WordXX a
pFileSize WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
0 Bool -> Bool -> Bool
&& WordXX a
pMemSize WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
pFileSize
                then $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (WordXX a)
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"memSize < fileSize"
                else WordXX a -> m (WordXX a)
forall (m :: * -> *) a. Monad m => a -> m a
return (WordXX a
pMemSize WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
pFileSize)
            ElfXX a -> m (ElfXX a)
forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: [ElfXX a]
epData        = [ElfXX a]
d
                }
        rBuilderToElf RBuilderRawData{ rbrdInterval :: forall (c :: ElfClass). RBuilder c -> Interval (WordXX c)
rbrdInterval = I WordXX a
o WordXX a
s } =
            ElfXX a -> m (ElfXX a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfXX a -> m (ElfXX a)) -> ElfXX a -> m (ElfXX a)
forall a b. (a -> b) -> a -> b
$ ByteString -> ElfXX a
forall (c :: ElfClass). ByteString -> ElfXX c
ElfRawData (ByteString -> ElfXX a) -> ByteString -> ElfXX a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64 -> Int64 -> ByteString
cut ByteString
bs (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
o) (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
s)
        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
..} =
            ElfXX a -> m (ElfXX a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfXX a -> m (ElfXX a)) -> ElfXX a -> m (ElfXX a)
forall a b. (a -> b) -> a -> b
$ WordXX a -> WordXX a -> ElfXX a
forall (c :: ElfClass). WordXX c -> WordXX c -> ElfXX c
ElfRawAlign WordXX a
rbraOffset WordXX a
rbraAlign

    [ElfXX a]
el <- (RBuilder a -> m (ElfXX a)) -> [RBuilder a] -> m [ElfXX a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RBuilder a -> m (ElfXX a)
rBuilderToElf [RBuilder a]
rbs
    Elf -> m Elf
forall (m :: * -> *) a. Monad m => a -> m a
return (Elf -> m Elf) -> Elf -> m Elf
forall a b. (a -> b) -> a -> b
$ Sing a
forall {k} (a :: k). SingI a => Sing a
sing Sing a -> (TyCon1 ElfList @@ a) -> Elf
forall s (a :: s ~> *) (fst :: s).
Sing fst -> (a @@ fst) -> Sigma s a
:&: [ElfXX a] -> ElfList a
forall (c :: ElfClass). [ElfXX c] -> ElfList c
ElfList [ElfXX a]
el

-- | Parse ELF file
parseElf :: MonadCatch m => BSL.ByteString -> m Elf
parseElf :: forall (m :: * -> *). MonadCatch m => ByteString -> m Elf
parseElf ByteString
bs = do
    Sing fst
classS :&: HeadersXX (HeaderXX fst
hdr, [SectionXX fst]
ss, [SegmentXX fst]
ps) <- ByteString -> m (Sigma ElfClass (TyCon1 HeadersXX))
forall (m :: * -> *).
MonadThrow m =>
ByteString -> m (Sigma ElfClass (TyCon1 HeadersXX))
parseHeaders ByteString
bs
    Sing fst
-> (IsElfClass fst =>
    HeaderXX fst
    -> [SectionXX fst] -> [SegmentXX fst] -> ByteString -> m Elf)
-> HeaderXX fst
-> [SectionXX fst]
-> [SegmentXX fst]
-> ByteString
-> m Elf
forall (c :: ElfClass) a. Sing c -> (IsElfClass c => a) -> a
withElfClass Sing fst
classS IsElfClass fst =>
HeaderXX fst
-> [SectionXX fst] -> [SegmentXX fst] -> ByteString -> m Elf
forall (a :: ElfClass) (m :: * -> *).
(IsElfClass a, MonadCatch m) =>
HeaderXX a -> [SectionXX a] -> [SegmentXX a] -> ByteString -> m Elf
parseElf' HeaderXX fst
hdr [SectionXX fst]
ss [SegmentXX fst]
ps ByteString
bs

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

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]
        }

wbStateInit :: forall a . IsElfClass a => WBuilderState a
wbStateInit :: forall (a :: ElfClass). IsElfClass 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 . IsElfClass a => SectionXX a
zeroSection :: forall (a :: ElfClass). IsElfClass a => SectionXX a
zeroSection = Word32
-> ElfSectionType
-> WordXX a
-> WordXX a
-> WordXX a
-> WordXX a
-> Word32
-> Word32
-> WordXX a
-> WordXX a
-> SectionXX a
forall (c :: ElfClass).
Word32
-> ElfSectionType
-> WordXX c
-> WordXX c
-> WordXX c
-> WordXX c
-> Word32
-> Word32
-> WordXX c
-> WordXX c
-> SectionXX c
SectionXX Word32
0 ElfSectionType
0 WordXX a
0 WordXX a
0 WordXX a
0 WordXX a
0 Word32
0 Word32
0 WordXX a
0 WordXX a
0

neighbours :: [a] -> (a -> a -> b) -> [b]
neighbours :: forall a b. [a] -> (a -> a -> b) -> [b]
neighbours [] a -> a -> b
_ = []
neighbours [a]
x  a -> a -> b
f = ((a, a) -> b) -> [(a, a)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a -> b) -> (a, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> b
f) ([(a, a)] -> [b]) -> [(a, a)] -> [b]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [a]
x ([a] -> [(a, a)]) -> [a] -> [(a, a)]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
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) = ((Word32, String) -> Bool)
-> [(Word32, String)] -> ([(Word32, String)], [(Word32, String)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") (String -> Bool)
-> ((Word32, String) -> String) -> (Word32, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32, String) -> String
forall a b. (a, b) -> b
snd) ([(Word32, String)] -> ([(Word32, String)], [(Word32, String)]))
-> [(Word32, String)] -> ([(Word32, String)], [(Word32, String)])
forall a b. (a -> b) -> a -> b
$ ((Word32, String) -> Int)
-> [(Word32, String)] -> [(Word32, String)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length (String -> Int)
-> ((Word32, String) -> String) -> (Word32, String) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32, String) -> String
forall a b. (a, b) -> b
snd) ([(Word32, String)] -> [(Word32, String)])
-> [(Word32, String)] -> [(Word32, String)]
forall a b. (a -> b) -> a -> b
$ [Word32] -> [String] -> [(Word32, String)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [(Word32
1 :: Word32) .. ] [String]
sectionNames
        ios0 :: [(Word32, Int64)]
ios0 = ((Word32, String) -> (Word32, Int64))
-> [(Word32, String)] -> [(Word32, Int64)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32, String) -> (Word32, Int64)
forall {b} {a} {b}. Num b => (a, b) -> (a, b)
f' [(Word32, String)]
ins0
            where
                f' :: (a, b) -> (a, b)
f' (a
i, b
_) = (a
i, b
0)

        (ByteString
stringTable, [(Word32, Int64)]
ios, [(Word32, String)]
_) = (ByteString, [(Word32, Int64)], [(Word32, String)])
-> (ByteString, [(Word32, Int64)], [(Word32, String)])
forall {a}.
(ByteString, [(a, Int64)], [(a, String)])
-> (ByteString, [(a, Int64)], [(a, String)])
f (Word8 -> ByteString
BSL.singleton Word8
0, [], [(Word32, String)] -> [(Word32, String)]
forall a. [a] -> [a]
L.reverse [(Word32, String)]
ins)

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

        -- 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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BSL8.pack String
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BSL.singleton Word8
0
                o :: Int64
o = ByteString -> Int64
BSL.length ByteString
st
                iosf'' :: [(a, Int64)]
iosf'' = (a
i, Int64
o) (a, Int64) -> [(a, Int64)] -> [(a, Int64)]
forall a. a -> [a] -> [a]
: [(a, Int64)]
iosf' [(a, Int64)] -> [(a, Int64)] -> [(a, Int64)]
forall a. [a] -> [a] -> [a]
++ [(a, Int64)]
iosf

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

                -- 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 = ((a, String)
 -> ([(a, Int64)], [(a, String)]) -> ([(a, Int64)], [(a, String)]))
-> ([(a, Int64)], [(a, String)])
-> [(a, String)]
-> ([(a, Int64)], [(a, String)])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
L.foldr (a, String)
-> ([(a, Int64)], [(a, String)]) -> ([(a, Int64)], [(a, String)])
fff ([], [])
                    where
                        fff :: (a, String)
-> ([(a, Int64)], [(a, String)]) -> ([(a, Int64)], [(a, String)])
fff (a
i', String
n') ([(a, Int64)]
iosff, [(a, String)]
insff) = if String
n' String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` String
n
                            then
                                let
                                    o' :: Int64
o' = Int64
o Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
n')
                                in
                                    ((a
i', Int64
o') (a, Int64) -> [(a, Int64)] -> [(a, Int64)]
forall a. a -> [a] -> [a]
: [(a, Int64)]
iosff, [(a, String)]
insff)
                            else ([(a, Int64)]
iosff, (a
i', String
n') (a, String) -> [(a, String)] -> [(a, String)]
forall a. a -> [a] -> [a]
: [(a, String)]
insff)

-- FIXME: rewrite serializeElf using lenses (???)
serializeElf' :: forall a m . (IsElfClass a, MonadThrow m) => [ElfXX a] -> m BSL.ByteString
serializeElf' :: forall (a :: ElfClass) (m :: * -> *).
(IsElfClass a, MonadThrow m) =>
[ElfXX a] -> m ByteString
serializeElf' [ElfXX a]
elfs = do

    (ElfXX a
header', ElfData
hData') <- do
        ElfXX a
header <- [ElfXX a] -> m (ElfXX a)
forall (a :: ElfClass) (m :: * -> *).
(SingI a, MonadThrow m) =>
[ElfXX a] -> m (ElfXX a)
elfFindHeader [ElfXX a]
elfs
        case ElfXX 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 c -> Word32
ehEntry :: forall (c :: ElfClass). ElfXX c -> WordXX c
ehMachine :: forall (c :: ElfClass). ElfXX c -> ElfMachine
ehType :: forall (c :: ElfClass). ElfXX c -> ElfType
ehABIVersion :: forall (c :: ElfClass). ElfXX c -> Word8
ehOSABI :: forall (c :: ElfClass). ElfXX c -> ElfOSABI
ehData :: forall (c :: ElfClass). ElfXX c -> ElfData
..} -> (ElfXX a, ElfData) -> m (ElfXX a, ElfData)
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfXX a
header, ElfData
ehData)
            ElfXX a
_ -> $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m (ElfXX a, ElfData)
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"not a header" -- FIXME

    let

        elfClass :: Demote ElfClass
elfClass = Sing a -> Demote ElfClass
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing (Sing a -> Demote ElfClass) -> Sing a -> Demote ElfClass
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). SingI a => Sing a
forall (a :: ElfClass). SingI a => Sing a
sing @a

        sectionN :: Num b => b
        sectionN :: forall b. Num b => b
sectionN = Sum b -> b
forall a. Sum a -> a
getSum (Sum b -> b) -> Sum b -> b
forall a b. (a -> b) -> a -> b
$ (ElfXX a -> Sum b) -> [ElfXX a] -> Sum b
forall m (a :: ElfClass).
Monoid m =>
(ElfXX a -> m) -> [ElfXX a] -> m
foldMapElfList ElfXX a -> Sum b
forall {a} {c :: ElfClass}. Num a => ElfXX c -> Sum a
f [ElfXX a]
elfs
            where
                f :: ElfXX c -> Sum a
f ElfSection{} = a -> Sum a
forall a. a -> Sum a
Sum a
1
                f ElfXX c
_ =  a -> Sum a
forall a. a -> Sum a
Sum a
0

        sectionNames :: [String]
        sectionNames :: [String]
sectionNames = (ElfXX a -> [String]) -> [ElfXX a] -> [String]
forall m (a :: ElfClass).
Monoid m =>
(ElfXX a -> m) -> [ElfXX a] -> m
foldMapElfList ElfXX a -> [String]
forall {c :: ElfClass}. ElfXX c -> [String]
f [ElfXX a]
elfs
            where
                f :: ElfXX c -> [String]
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 c -> ElfSectionData c
esLink :: forall (c :: ElfClass). ElfXX c -> Word32
esInfo :: forall (c :: ElfClass). ElfXX c -> Word32
esN :: forall (c :: ElfClass). ElfXX c -> ElfSectionIndex
esEntSize :: forall (c :: ElfClass). ElfXX c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX c -> WordXX c
esAddr :: forall (c :: ElfClass). ElfXX c -> WordXX c
esFlags :: forall (c :: ElfClass). ElfXX c -> ElfSectionFlag
esType :: forall (c :: ElfClass). ElfXX c -> ElfSectionType
esName :: forall (c :: ElfClass). ElfXX c -> String
..} = [ String
esName ]
                f ElfXX c
_ = []

        (ByteString
stringTable, [Int64]
nameIndexes) = [String] -> (ByteString, [Int64])
mkStringTable [String]
sectionNames

        segmentN :: Num b => b
        segmentN :: forall b. Num b => b
segmentN = Sum b -> b
forall a. Sum a -> a
getSum (Sum b -> b) -> Sum b -> b
forall a b. (a -> b) -> a -> b
$ (ElfXX a -> Sum b) -> [ElfXX a] -> Sum b
forall m (a :: ElfClass).
Monoid m =>
(ElfXX a -> m) -> [ElfXX a] -> m
foldMapElfList ElfXX a -> Sum b
forall {a} {c :: ElfClass}. Num a => ElfXX c -> Sum a
f [ElfXX a]
elfs
            where
                f :: ElfXX c -> Sum a
f ElfSegment{} = a -> Sum a
forall a. a -> Sum a
Sum a
1
                f ElfXX c
_ =  a -> Sum a
forall a. a -> Sum a
Sum a
0

        sectionTable :: Bool
        sectionTable :: Bool
sectionTable = Any -> Bool
getAny (Any -> Bool) -> Any -> Bool
forall a b. (a -> b) -> a -> b
$ (ElfXX a -> Any) -> [ElfXX a] -> Any
forall m (a :: ElfClass).
Monoid m =>
(ElfXX a -> m) -> [ElfXX a] -> m
foldMapElfList ElfXX a -> Any
forall {c :: ElfClass}. ElfXX c -> Any
f [ElfXX a]
elfs
            where
                f :: ElfXX c -> Any
f ElfXX c
ElfSectionTable =  Bool -> Any
Any Bool
True
                f ElfXX c
_ = Bool -> Any
Any Bool
False

        align :: MonadThrow n => WordXX a -> WordXX a -> WBuilderState a -> n (WBuilderState a)
        align :: forall (n :: * -> *).
MonadThrow n =>
WordXX a -> WordXX a -> WBuilderState a -> n (WBuilderState a)
align WordXX a
_ WordXX a
0 WBuilderState a
x = WBuilderState a -> n (WBuilderState a)
forall (m :: * -> *) a. Monad m => a -> m a
return WBuilderState a
x
        align WordXX a
_ WordXX a
1 WBuilderState a
x = WBuilderState a -> n (WBuilderState a)
forall (m :: * -> *) a. Monad m => a -> m a
return WBuilderState a
x
        align WordXX a
t WordXX a
m 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)]
..} | WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Bits a => a -> a -> a
.&. (WordXX a
m WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
1) WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
0 = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> n (WBuilderState a)
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> n (WBuilderState a)) -> String -> n (WBuilderState a)
forall a b. (a -> b) -> a -> b
$ String
"align module is not power of two " String -> String -> String
forall a. [a] -> [a] -> [a]
++ WordXX a -> String
forall a. Show a => a -> String
show WordXX a
m
                                    | Bool
otherwise =
            let
                wbsOffset' :: WordXX a
wbsOffset' = WordXX a -> WordXX a -> WordXX a -> WordXX a
forall (a :: ElfClass).
IsElfClass a =>
WordXX a -> WordXX a -> WordXX a -> WordXX a
nextOffset WordXX a
t WordXX a
m WordXX a
wbsOffset
                d :: WBuilderData
d = ByteString -> WBuilderData
WBuilderDataByteStream (ByteString -> WBuilderData) -> ByteString -> WBuilderData
forall a b. (a -> b) -> a -> b
$ Int64 -> Word8 -> ByteString
BSL.replicate (WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordXX a -> Int64) -> WordXX a -> Int64
forall a b. (a -> b) -> a -> b
$ WordXX a
wbsOffset' WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
wbsOffset) Word8
0
            in
                WBuilderState a -> n (WBuilderState a)
forall (m :: * -> *) a. Monad m => a -> m a
return WBuilderState
                    { wbsDataReversed :: [WBuilderData]
wbsDataReversed = WBuilderData
d WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
: [WBuilderData]
wbsDataReversed
                    , wbsOffset :: WordXX a
wbsOffset = WordXX a
wbsOffset'
                    , [Int64]
[(ElfSectionIndex, SectionXX a)]
[SegmentXX a]
ElfSectionIndex
WordXX a
wbsNameIndexes :: [Int64]
wbsShStrNdx :: ElfSectionIndex
wbsShOff :: WordXX a
wbsPhOff :: WordXX a
wbsSegmentsReversed :: [SegmentXX a]
wbsSections :: [(ElfSectionIndex, SectionXX a)]
wbsNameIndexes :: [Int64]
wbsShStrNdx :: ElfSectionIndex
wbsShOff :: WordXX a
wbsPhOff :: WordXX a
wbsSegmentsReversed :: [SegmentXX a]
wbsSections :: [(ElfSectionIndex, SectionXX a)]
..
                    }

        alignWord :: MonadThrow n => WBuilderState a -> n (WBuilderState a)
        alignWord :: forall (n :: * -> *).
MonadThrow n =>
WBuilderState a -> n (WBuilderState a)
alignWord = WordXX a -> WordXX a -> WBuilderState a -> n (WBuilderState a)
forall (n :: * -> *).
MonadThrow n =>
WordXX a -> WordXX a -> WBuilderState a -> n (WBuilderState a)
align WordXX a
0 (WordXX a -> WBuilderState a -> n (WBuilderState a))
-> WordXX a -> WBuilderState a -> n (WBuilderState a)
forall a b. (a -> b) -> a -> b
$ ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
wordSize (ElfClass -> WordXX a) -> ElfClass -> WordXX a
forall a b. (a -> b) -> a -> b
$ Sing a -> Demote ElfClass
forall k (a :: k). SingKind k => Sing a -> Demote k
fromSing (Sing a -> Demote ElfClass) -> Sing a -> Demote ElfClass
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). SingI a => Sing a
forall (a :: ElfClass). SingI a => Sing a
sing @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

        lastSectionIsEmpty :: [ElfXX a] -> Bool
        lastSectionIsEmpty :: [ElfXX a] -> Bool
lastSectionIsEmpty [] = Bool
False
        lastSectionIsEmpty [ElfXX a]
l = case [ElfXX a] -> ElfXX a
forall a. [a] -> a
L.last [ElfXX a]
l of
            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 c -> ElfSectionData c
esLink :: forall (c :: ElfClass). ElfXX c -> Word32
esInfo :: forall (c :: ElfClass). ElfXX c -> Word32
esN :: forall (c :: ElfClass). ElfXX c -> ElfSectionIndex
esEntSize :: forall (c :: ElfClass). ElfXX c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX c -> WordXX c
esAddr :: forall (c :: ElfClass). ElfXX c -> WordXX c
esFlags :: forall (c :: ElfClass). ElfXX c -> ElfSectionFlag
esType :: forall (c :: ElfClass). ElfXX c -> ElfSectionType
esName :: forall (c :: ElfClass). ElfXX c -> String
..} -> ElfSectionData a -> Bool
forall (c :: ElfClass). ElfSectionData c -> Bool
dataIsEmpty ElfSectionData a
esData
            ElfXX a
_ -> Bool
False

        elf2WBuilder' :: MonadThrow n => ElfXX a -> WBuilderState a -> n (WBuilderState a)
        elf2WBuilder' :: forall (n :: * -> *).
MonadThrow n =>
ElfXX a -> WBuilderState a -> n (WBuilderState a)
elf2WBuilder' ElfHeader{} 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)]
..} =
            WBuilderState a -> n (WBuilderState a)
forall (m :: * -> *) a. Monad m => a -> m a
return WBuilderState
                { wbsDataReversed :: [WBuilderData]
wbsDataReversed = WBuilderData
WBuilderDataHeader WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
: [WBuilderData]
wbsDataReversed
                , wbsOffset :: WordXX a
wbsOffset = WordXX a
wbsOffset WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
headerSize ElfClass
Demote ElfClass
elfClass
                , [Int64]
[(ElfSectionIndex, SectionXX a)]
[SegmentXX a]
ElfSectionIndex
WordXX a
wbsNameIndexes :: [Int64]
wbsShStrNdx :: ElfSectionIndex
wbsShOff :: WordXX a
wbsPhOff :: WordXX a
wbsSegmentsReversed :: [SegmentXX a]
wbsSections :: [(ElfSectionIndex, SectionXX a)]
wbsNameIndexes :: [Int64]
wbsShStrNdx :: ElfSectionIndex
wbsShOff :: WordXX a
wbsPhOff :: WordXX a
wbsSegmentsReversed :: [SegmentXX a]
wbsSections :: [(ElfSectionIndex, SectionXX a)]
..
                }
        elf2WBuilder' ElfXX a
ElfSectionTable WBuilderState a
s = do
            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)]
..} <- WBuilderState a -> n (WBuilderState a)
forall (n :: * -> *).
MonadThrow n =>
WBuilderState a -> n (WBuilderState a)
alignWord WBuilderState a
s
            WBuilderState a -> n (WBuilderState a)
forall (m :: * -> *) a. Monad m => a -> m a
return WBuilderState
                { wbsDataReversed :: [WBuilderData]
wbsDataReversed = WBuilderData
WBuilderDataSectionTable WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
: [WBuilderData]
wbsDataReversed
                , wbsOffset :: WordXX a
wbsOffset = WordXX a
wbsOffset WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ (WordXX a
forall b. Num b => b
sectionN WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
1) WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
* ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
sectionTableEntrySize ElfClass
Demote ElfClass
elfClass
                , wbsShOff :: WordXX a
wbsShOff = WordXX a
wbsOffset
                , [Int64]
[(ElfSectionIndex, SectionXX a)]
[SegmentXX a]
ElfSectionIndex
WordXX a
wbsNameIndexes :: [Int64]
wbsShStrNdx :: ElfSectionIndex
wbsPhOff :: WordXX a
wbsSegmentsReversed :: [SegmentXX a]
wbsSections :: [(ElfSectionIndex, SectionXX a)]
wbsNameIndexes :: [Int64]
wbsShStrNdx :: ElfSectionIndex
wbsPhOff :: WordXX a
wbsSegmentsReversed :: [SegmentXX a]
wbsSections :: [(ElfSectionIndex, SectionXX a)]
..
                }
        elf2WBuilder' ElfXX a
ElfSegmentTable WBuilderState a
s = do
            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)]
..} <- WBuilderState a -> n (WBuilderState a)
forall (n :: * -> *).
MonadThrow n =>
WBuilderState a -> n (WBuilderState a)
alignWord WBuilderState a
s
            WBuilderState a -> n (WBuilderState a)
forall (m :: * -> *) a. Monad m => a -> m a
return WBuilderState
                { wbsDataReversed :: [WBuilderData]
wbsDataReversed = WBuilderData
WBuilderDataSegmentTable WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
: [WBuilderData]
wbsDataReversed
                , wbsOffset :: WordXX a
wbsOffset = WordXX a
wbsOffset WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
forall b. Num b => b
segmentN WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
* ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
segmentTableEntrySize ElfClass
Demote ElfClass
elfClass
                , wbsPhOff :: WordXX a
wbsPhOff = WordXX a
wbsOffset
                , [Int64]
[(ElfSectionIndex, SectionXX a)]
[SegmentXX a]
ElfSectionIndex
WordXX a
wbsNameIndexes :: [Int64]
wbsShStrNdx :: ElfSectionIndex
wbsShOff :: WordXX a
wbsSegmentsReversed :: [SegmentXX a]
wbsSections :: [(ElfSectionIndex, SectionXX a)]
wbsNameIndexes :: [Int64]
wbsShStrNdx :: ElfSectionIndex
wbsShOff :: WordXX a
wbsSegmentsReversed :: [SegmentXX a]
wbsSections :: [(ElfSectionIndex, SectionXX a)]
..
                }
        elf2WBuilder' ElfSection{esFlags :: forall (c :: ElfClass). ElfXX 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 c -> ElfSectionData c
esLink :: forall (c :: ElfClass). ElfXX c -> Word32
esInfo :: forall (c :: ElfClass). ElfXX c -> Word32
esN :: forall (c :: ElfClass). ElfXX c -> ElfSectionIndex
esEntSize :: forall (c :: ElfClass). ElfXX c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX c -> WordXX c
esAddr :: forall (c :: ElfClass). ElfXX c -> WordXX c
esType :: forall (c :: ElfClass). ElfXX c -> ElfSectionType
esName :: forall (c :: ElfClass). ElfXX c -> String
..} WBuilderState a
s = do
            Bool -> n () -> n ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word64
f Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. WordXX a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordXX a -> WordXX a
forall a. Bits a => a -> a
complement (forall a. Bounded a => a
maxBound @(WordXX a))) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0)
                ($Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> n ()
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> n ()) -> String -> n ()
forall a b. (a -> b) -> a -> b
$ String
"section flags at section " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ElfSectionIndex -> String
forall a. Show a => a -> String
show ElfSectionIndex
esN String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"don't fit")
            -- I don't see any sense in aligning NOBITS sections
            -- still gcc does it for .o files
            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)]
..} <- if ElfSectionType
esType ElfSectionType -> ElfSectionType -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSectionType
SHT_NOBITS Bool -> Bool -> Bool
&& (ElfXX a -> ElfType
forall (c :: ElfClass). ElfXX c -> ElfType
ehType ElfXX a
header') ElfType -> ElfType -> Bool
forall a. Eq a => a -> a -> Bool
/= ElfType
ET_REL
                then WBuilderState a -> n (WBuilderState a)
forall (m :: * -> *) a. Monad m => a -> m a
return WBuilderState a
s
                else WordXX a -> WordXX a -> WBuilderState a -> n (WBuilderState a)
forall (n :: * -> *).
MonadThrow n =>
WordXX a -> WordXX a -> WBuilderState a -> n (WBuilderState a)
align WordXX a
0 WordXX a
esAddrAlign WBuilderState a
s
            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
wbsShStrNdx, Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> WordXX a) -> Int64 -> WordXX a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length ByteString
esdData)
                    ElfSectionData a
ElfSectionDataStringTable -> (ByteString
stringTable, ElfSectionIndex
esN, Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> WordXX a) -> Int64 -> WordXX a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length ByteString
stringTable)
                    ElfSectionDataNoBits { WordXX a
esdSize :: WordXX a
esdSize :: forall (c :: ElfClass). ElfSectionData c -> WordXX c
.. } -> (ByteString
BSL.empty, ElfSectionIndex
wbsShStrNdx, WordXX a
esdSize)
                (Int64
n, [Int64]
ns) = case [Int64]
wbsNameIndexes of
                    Int64
n' : [Int64]
ns' -> (Int64
n', [Int64]
ns')
                    [Int64]
_ -> String -> (Int64, [Int64])
forall a. HasCallStack => String -> a
error String
"internal error: different number of sections in two iterations"
                sName :: Word32
sName = Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n                 -- Word32
                sType :: ElfSectionType
sType = ElfSectionType
esType                         -- ElfSectionType
                sFlags :: WordXX a
sFlags = Word64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
f
                sAddr :: WordXX a
sAddr = WordXX a
esAddr                         -- WXX c
                sOffset :: WordXX a
sOffset = WordXX a
wbsOffset                    -- 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
            WBuilderState a -> n (WBuilderState a)
forall (m :: * -> *) a. Monad m => a -> m a
return WBuilderState
                { wbsSections :: [(ElfSectionIndex, SectionXX a)]
wbsSections = (ElfSectionIndex
esN, SectionXX{Word32
ElfSectionType
WordXX a
sEntSize :: WordXX a
sAddrAlign :: WordXX a
sInfo :: Word32
sLink :: Word32
sSize :: WordXX a
sOffset :: WordXX a
sAddr :: WordXX a
sFlags :: WordXX a
sType :: ElfSectionType
sName :: Word32
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
..}) (ElfSectionIndex, SectionXX a)
-> [(ElfSectionIndex, SectionXX a)]
-> [(ElfSectionIndex, SectionXX a)]
forall a. a -> [a] -> [a]
: [(ElfSectionIndex, SectionXX a)]
wbsSections
                , wbsDataReversed :: [WBuilderData]
wbsDataReversed = ByteString -> WBuilderData
WBuilderDataByteStream ByteString
d WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
: [WBuilderData]
wbsDataReversed
                , wbsOffset :: WordXX a
wbsOffset = WordXX a
wbsOffset WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
d)
                , wbsShStrNdx :: ElfSectionIndex
wbsShStrNdx = ElfSectionIndex
shStrNdx
                , wbsNameIndexes :: [Int64]
wbsNameIndexes = [Int64]
ns
                , [SegmentXX a]
WordXX a
wbsShOff :: WordXX a
wbsPhOff :: WordXX a
wbsSegmentsReversed :: [SegmentXX a]
wbsShOff :: WordXX a
wbsPhOff :: WordXX a
wbsSegmentsReversed :: [SegmentXX a]
..
                }
        elf2WBuilder' ElfSegment{[ElfXX a]
ElfSegmentType
ElfSegmentFlag
WordXX a
epData :: [ElfXX a]
epAlign :: WordXX a
epAddMemSize :: WordXX a
epPhysAddr :: WordXX a
epVirtAddr :: WordXX a
epFlags :: ElfSegmentFlag
epType :: ElfSegmentType
epData :: forall (c :: ElfClass). ElfXX c -> [ElfXX c]
epAlign :: forall (c :: ElfClass). ElfXX c -> WordXX c
epAddMemSize :: forall (c :: ElfClass). ElfXX c -> WordXX c
epPhysAddr :: forall (c :: ElfClass). ElfXX c -> WordXX c
epVirtAddr :: forall (c :: ElfClass). ElfXX c -> WordXX c
epFlags :: forall (c :: ElfClass). ElfXX c -> ElfSegmentFlag
epType :: forall (c :: ElfClass). ElfXX c -> ElfSegmentType
..} WBuilderState a
s = do
            WBuilderState a
s' <- WordXX a -> WordXX a -> WBuilderState a -> n (WBuilderState a)
forall (n :: * -> *).
MonadThrow n =>
WordXX a -> WordXX a -> WBuilderState a -> n (WBuilderState a)
align WordXX a
epVirtAddr WordXX a
epAlign WBuilderState a
s
            let
                offset :: WordXX a
offset = WBuilderState a -> WordXX a
forall (a :: ElfClass). WBuilderState a -> WordXX a
wbsOffset WBuilderState a
s'
            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)]
..} <- StateT (WBuilderState a) n [()]
-> WBuilderState a -> n (WBuilderState a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ((ElfXX a -> StateT (WBuilderState a) n ())
-> [ElfXX a] -> StateT (WBuilderState a) n [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ElfXX a -> StateT (WBuilderState a) n ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
ElfXX a -> n ()
elf2WBuilder [ElfXX a]
epData) WBuilderState a
s'
            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 = [ElfXX a] -> Bool
lastSectionIsEmpty [ElfXX a]
epData Bool -> Bool -> Bool
&& WordXX a
offset WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
/= WordXX a
wbsOffset
                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
wbsOffset WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
offset WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ if Bool
add1 then WordXX a
1 else WordXX a
0
                pMemSize :: WordXX a
pMemSize = WordXX a
pFileSize WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
epAddMemSize
                pAlign :: WordXX a
pAlign = WordXX a
epAlign
            WBuilderState a -> n (WBuilderState a)
forall (m :: * -> *) a. Monad m => a -> m a
return WBuilderState
                { wbsSegmentsReversed :: [SegmentXX a]
wbsSegmentsReversed = 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
..} SegmentXX a -> [SegmentXX a] -> [SegmentXX a]
forall a. a -> [a] -> [a]
: [SegmentXX a]
wbsSegmentsReversed
                , wbsDataReversed :: [WBuilderData]
wbsDataReversed = if Bool
add1
                    then ByteString -> WBuilderData
WBuilderDataByteStream (Word8 -> ByteString
BSL.singleton Word8
0) WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
: [WBuilderData]
wbsDataReversed
                    else [WBuilderData]
wbsDataReversed
                , wbsOffset :: WordXX a
wbsOffset = if Bool
add1
                    then WordXX a
wbsOffset WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ WordXX a
1
                    else WordXX a
wbsOffset
                , [Int64]
[(ElfSectionIndex, SectionXX a)]
ElfSectionIndex
WordXX a
wbsNameIndexes :: [Int64]
wbsShStrNdx :: ElfSectionIndex
wbsShOff :: WordXX a
wbsPhOff :: WordXX a
wbsSections :: [(ElfSectionIndex, SectionXX a)]
wbsNameIndexes :: [Int64]
wbsShStrNdx :: ElfSectionIndex
wbsShOff :: WordXX a
wbsPhOff :: WordXX a
wbsSections :: [(ElfSectionIndex, SectionXX a)]
..
                }
        elf2WBuilder' ElfRawData{ByteString
edData :: ByteString
edData :: forall (c :: ElfClass). ElfXX c -> ByteString
..} 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)]
..} =
            WBuilderState a -> n (WBuilderState a)
forall (m :: * -> *) a. Monad m => a -> m a
return WBuilderState
                { wbsDataReversed :: [WBuilderData]
wbsDataReversed = ByteString -> WBuilderData
WBuilderDataByteStream ByteString
edData WBuilderData -> [WBuilderData] -> [WBuilderData]
forall a. a -> [a] -> [a]
: [WBuilderData]
wbsDataReversed
                , wbsOffset :: WordXX a
wbsOffset = WordXX a
wbsOffset WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
+ Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
BSL.length ByteString
edData)
                , [Int64]
[(ElfSectionIndex, SectionXX a)]
[SegmentXX a]
ElfSectionIndex
WordXX a
wbsNameIndexes :: [Int64]
wbsShStrNdx :: ElfSectionIndex
wbsShOff :: WordXX a
wbsPhOff :: WordXX a
wbsSegmentsReversed :: [SegmentXX a]
wbsSections :: [(ElfSectionIndex, SectionXX a)]
wbsNameIndexes :: [Int64]
wbsShStrNdx :: ElfSectionIndex
wbsShOff :: WordXX a
wbsPhOff :: WordXX a
wbsSegmentsReversed :: [SegmentXX a]
wbsSections :: [(ElfSectionIndex, SectionXX a)]
..
                }
        elf2WBuilder' ElfRawAlign{WordXX a
eaAlign :: WordXX a
eaOffset :: WordXX a
eaAlign :: forall (c :: ElfClass). ElfXX c -> WordXX c
eaOffset :: forall (c :: ElfClass). ElfXX c -> WordXX c
..} WBuilderState a
s = WordXX a -> WordXX a -> WBuilderState a -> n (WBuilderState a)
forall (n :: * -> *).
MonadThrow n =>
WordXX a -> WordXX a -> WBuilderState a -> n (WBuilderState a)
align WordXX a
eaOffset WordXX a
eaAlign WBuilderState a
s

        elf2WBuilder :: (MonadThrow n, MonadState (WBuilderState a) n) => ElfXX a -> n ()
        elf2WBuilder :: forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
ElfXX a -> n ()
elf2WBuilder ElfXX a
elf = n (WBuilderState a)
forall s (m :: * -> *). MonadState s m => m s
MS.get n (WBuilderState a)
-> (WBuilderState a -> n (WBuilderState a)) -> n (WBuilderState a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ElfXX a -> WBuilderState a -> n (WBuilderState a)
forall (n :: * -> *).
MonadThrow n =>
ElfXX a -> WBuilderState a -> n (WBuilderState a)
elf2WBuilder' ElfXX a
elf n (WBuilderState a) -> (WBuilderState a -> n ()) -> n ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WBuilderState a -> n ()
forall s (m :: * -> *). MonadState s m => s -> m ()
MS.put

        fixSections :: [(ElfSectionIndex, SectionXX a)] -> m [SectionXX a]
        fixSections :: [(ElfSectionIndex, SectionXX a)] -> m [SectionXX a]
fixSections [(ElfSectionIndex, SectionXX a)]
ss = do
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(ElfSectionIndex, SectionXX a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [(ElfSectionIndex, SectionXX a)]
ss Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall b. Num b => b
sectionN) (String -> m ()
forall a. HasCallStack => String -> a
error String
"internal error: L.length ss /= sectionN")
            let
                f :: (a, b) -> (a, b) -> Ordering
f (a
ln, b
_) (a
rn, b
_) = a
ln a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
rn
                sorted :: [(ElfSectionIndex, SectionXX a)]
sorted = ((ElfSectionIndex, SectionXX a)
 -> (ElfSectionIndex, SectionXX a) -> Ordering)
-> [(ElfSectionIndex, SectionXX a)]
-> [(ElfSectionIndex, SectionXX a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (ElfSectionIndex, SectionXX a)
-> (ElfSectionIndex, SectionXX a) -> Ordering
forall {a} {b} {b}. Ord a => (a, b) -> (a, b) -> Ordering
f [(ElfSectionIndex, SectionXX a)]
ss
                next :: (a, b) -> (a, b) -> Bool
next (a
ln, b
_) (a
rn, b
_) = a
ln a -> a -> a
forall a. Num a => a -> a -> a
+ a
1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
rn
                checkNeibours :: Bool
checkNeibours = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ [(ElfSectionIndex, SectionXX a)]
-> ((ElfSectionIndex, SectionXX a)
    -> (ElfSectionIndex, SectionXX a) -> Bool)
-> [Bool]
forall a b. [a] -> (a -> a -> b) -> [b]
neighbours [(ElfSectionIndex, SectionXX a)]
sorted (ElfSectionIndex, SectionXX a)
-> (ElfSectionIndex, SectionXX a) -> Bool
forall {a} {b} {b}. (Eq a, Num a) => (a, b) -> (a, b) -> Bool
next

            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
checkNeibours ($Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m ()
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"sections are not consistent")
            [SectionXX a] -> m [SectionXX a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SectionXX a] -> m [SectionXX a])
-> [SectionXX a] -> m [SectionXX a]
forall a b. (a -> b) -> a -> b
$ ((ElfSectionIndex, SectionXX a) -> SectionXX a)
-> [(ElfSectionIndex, SectionXX a)] -> [SectionXX a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ElfSectionIndex, SectionXX a) -> SectionXX a
forall a b. (a, b) -> b
snd [(ElfSectionIndex, SectionXX a)]
sorted

        wbState2ByteString :: WBuilderState a -> m BSL.ByteString
        wbState2ByteString :: WBuilderState a -> m ByteString
wbState2ByteString WBuilderState{[Int64]
[(ElfSectionIndex, SectionXX a)]
[SegmentXX a]
[WBuilderData]
ElfSectionIndex
WordXX a
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 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 c -> Word32
ehEntry :: forall (c :: ElfClass). ElfXX c -> WordXX c
ehMachine :: forall (c :: ElfClass). ElfXX c -> ElfMachine
ehType :: forall (c :: ElfClass). ElfXX c -> ElfType
ehABIVersion :: forall (c :: ElfClass). ElfXX c -> Word8
ehOSABI :: forall (c :: ElfClass). ElfXX c -> ElfOSABI
ehData :: forall (c :: ElfClass). ElfXX 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  = ElfClass -> Word16
forall a. Num a => ElfClass -> a
segmentTableEntrySize ElfClass
Demote ElfClass
elfClass
                                hPhNum :: Word16
hPhNum      = Word16
forall b. Num b => b
segmentN
                                hShEntSize :: Word16
hShEntSize  = ElfClass -> Word16
forall a. Num a => ElfClass -> a
sectionTableEntrySize ElfClass
Demote ElfClass
elfClass
                                hShNum :: Word16
hShNum      = if Bool
sectionTable then Word16
forall b. Num b => b
sectionN Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1 else Word16
0
                                hShStrNdx :: ElfSectionIndex
hShStrNdx   = ElfSectionIndex
wbsShStrNdx

                                h :: Header
                                h :: Header
h = forall {k} (a :: k). SingI a => Sing a
forall (a :: ElfClass). SingI a => Sing a
sing @a Sing a -> (TyCon1 HeaderXX @@ a) -> Header
forall s (a :: s ~> *) (fst :: s).
Sing fst -> (a @@ fst) -> Sigma s 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
                                Header -> ByteString
forall a. Binary a => a -> ByteString
encode Header
h
                        ElfXX a
_ -> String -> ByteString
forall a. HasCallStack => String -> a
error String
"this should be ElfHeader" -- FIXME
                f WBuilderDataByteStream {ByteString
wbdData :: ByteString
wbdData :: WBuilderData -> ByteString
..} = ByteString
wbdData
                f WBuilderData
WBuilderDataSectionTable =
                    ElfData -> [SectionXX a] -> ByteString
forall a.
(Binary (Le a), Binary (Be a)) =>
ElfData -> [a] -> ByteString
serializeBList ElfData
hData' ([SectionXX a] -> ByteString) -> [SectionXX a] -> ByteString
forall a b. (a -> b) -> a -> b
$ SectionXX a
forall (a :: ElfClass). IsElfClass a => SectionXX a
zeroSection SectionXX a -> [SectionXX a] -> [SectionXX a]
forall a. a -> [a] -> [a]
: [SectionXX a]
sections
                f WBuilderData
WBuilderDataSegmentTable =
                    ElfData -> [SegmentXX a] -> ByteString
forall a.
(Binary (Le a), Binary (Be a)) =>
ElfData -> [a] -> ByteString
serializeBList ElfData
hData' ([SegmentXX a] -> ByteString) -> [SegmentXX a] -> ByteString
forall a b. (a -> b) -> a -> b
$ [SegmentXX a] -> [SegmentXX a]
forall a. [a] -> [a]
L.reverse [SegmentXX a]
wbsSegmentsReversed

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

    StateT (WBuilderState a) m [()]
-> WBuilderState a -> m (WBuilderState a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ((ElfXX a -> StateT (WBuilderState a) m ())
-> [ElfXX a] -> StateT (WBuilderState a) m [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ElfXX a -> StateT (WBuilderState a) m ()
forall (n :: * -> *).
(MonadThrow n, MonadState (WBuilderState a) n) =>
ElfXX a -> n ()
elf2WBuilder [ElfXX a]
elfs) WBuilderState a
forall (a :: ElfClass). IsElfClass a => WBuilderState a
wbStateInit{ wbsNameIndexes :: [Int64]
wbsNameIndexes = [Int64]
nameIndexes } m (WBuilderState a)
-> (WBuilderState a -> m ByteString) -> m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WBuilderState a -> m ByteString
wbState2ByteString

-- | Serialze ELF file
serializeElf :: MonadThrow m => Elf -> m BSL.ByteString
serializeElf :: forall (m :: * -> *). MonadThrow m => Elf -> m ByteString
serializeElf (Sing fst
classS :&: ElfList [ElfXX fst]
ls) = Sing fst
-> (IsElfClass fst => [ElfXX fst] -> m ByteString)
-> [ElfXX fst]
-> m ByteString
forall (c :: ElfClass) a. Sing c -> (IsElfClass c => a) -> a
withElfClass Sing fst
classS IsElfClass fst => [ElfXX fst] -> m ByteString
forall (a :: ElfClass) (m :: * -> *).
(IsElfClass a, MonadThrow m) =>
[ElfXX a] -> m ByteString
serializeElf' [ElfXX fst]
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 (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
BSL.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offset) ByteString
stringTable

mkElfSymbolTableEntry :: SingI a => BSL.ByteString -> SymbolXX a -> ElfSymbolXX a
mkElfSymbolTableEntry :: forall (a :: ElfClass).
SingI 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 (Word8 -> ElfSymbolBinding) -> Word8 -> ElfSymbolBinding
forall a b. (a -> b) -> a -> b
$ Word8
stInfo Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
        steType :: ElfSymbolType
steType  = Word8 -> ElfSymbolType
ElfSymbolType (Word8 -> ElfSymbolType) -> Word8 -> ElfSymbolType
forall a b. (a -> b) -> a -> b
$ Word8
stInfo Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0f
        steShNdx :: ElfSectionIndex
steShNdx = ElfSectionIndex
stShNdx
        steValue :: WordXX a
steValue = WordXX a
stValue
        steSize :: WordXX a
steSize  = WordXX a
stSize
    in
        ElfSymbolXX{String
ElfSymbolType
ElfSymbolBinding
ElfSectionIndex
WordXX a
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, SingI a)
                 => ElfData           -- ^ Endianness of the ELF file
                 -> ElfXX a           -- ^ Parsed section such that @`sectionIsSymbolTable` . `sType`@ is true.
                 -> [ElfXX a]         -- ^ Structured ELF data
                 -> m [ElfSymbolXX a] -- ^ Symbol table
parseSymbolTable :: forall (m :: * -> *) (a :: ElfClass).
(MonadThrow m, SingI a) =>
ElfData -> ElfXX a -> [ElfXX a] -> m [ElfSymbolXX a]
parseSymbolTable ElfData
d ElfSection{ esData :: forall (c :: ElfClass). ElfXX c -> ElfSectionData c
esData = ElfSectionData ByteString
symbolTable, String
Word32
ElfSectionType
ElfSectionFlag
ElfSectionIndex
WordXX a
esLink :: Word32
esInfo :: Word32
esN :: ElfSectionIndex
esEntSize :: WordXX a
esAddrAlign :: WordXX a
esAddr :: WordXX a
esFlags :: ElfSectionFlag
esType :: ElfSectionType
esName :: String
esLink :: forall (c :: ElfClass). ElfXX c -> Word32
esInfo :: forall (c :: ElfClass). ElfXX c -> Word32
esN :: forall (c :: ElfClass). ElfXX c -> ElfSectionIndex
esEntSize :: forall (c :: ElfClass). ElfXX c -> WordXX c
esAddrAlign :: forall (c :: ElfClass). ElfXX c -> WordXX c
esAddr :: forall (c :: ElfClass). ElfXX c -> WordXX c
esFlags :: forall (c :: ElfClass). ElfXX c -> ElfSectionFlag
esType :: forall (c :: ElfClass). ElfXX c -> ElfSectionType
esName :: forall (c :: ElfClass). ElfXX c -> String
..} [ElfXX a]
elfs = do
    ElfXX a
section <- [ElfXX a] -> Word32 -> m (ElfXX a)
forall (a :: ElfClass) (m :: * -> *) b.
(SingI a, MonadThrow m, Integral b, Show b) =>
[ElfXX a] -> b -> m (ElfXX a)
elfFindSection [ElfXX a]
elfs Word32
esLink
    case ElfXX a
section of
        ElfSection{ esData :: forall (c :: ElfClass). ElfXX c -> ElfSectionData c
esData = ElfSectionData ByteString
stringTable } -> do
            [SymbolXX a]
st <- ElfData -> ByteString -> m [SymbolXX a]
forall (m :: * -> *) a.
(MonadThrow m, Binary (Le a), Binary (Be a)) =>
ElfData -> ByteString -> m [a]
parseBList ElfData
d ByteString
symbolTable
            [ElfSymbolXX a] -> m [ElfSymbolXX a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> SymbolXX a -> ElfSymbolXX a
forall (a :: ElfClass).
SingI a =>
ByteString -> SymbolXX a -> ElfSymbolXX a
mkElfSymbolTableEntry ByteString
stringTable (SymbolXX a -> ElfSymbolXX a) -> [SymbolXX a] -> [ElfSymbolXX a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SymbolXX a]
st)
        ElfXX a
_ -> $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [ElfSymbolXX a]
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"not a section" -- FIXME
parseSymbolTable ElfData
_ ElfXX a
_ [ElfXX a]
_ = $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
Loc -> String -> m [ElfSymbolXX a]
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError String
"incorrect args to parseSymbolTable" -- FIXME

mkSymbolTableEntry :: SingI a => Word32 -> ElfSymbolXX a -> SymbolXX a
mkSymbolTableEntry :: forall (a :: ElfClass).
SingI a =>
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 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shift` Int
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
t
        stOther :: Word8
stOther = Word8
0
        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, SingI 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, SingI a) =>
ElfData -> [ElfSymbolXX a] -> m (ByteString, ByteString)
serializeSymbolTable ElfData
d [ElfSymbolXX a]
ss = do

    let
        (ByteString
stringTable, [Int64]
stringIndexes) = [String] -> (ByteString, [Int64])
mkStringTable ([String] -> (ByteString, [Int64]))
-> [String] -> (ByteString, [Int64])
forall a b. (a -> b) -> a -> b
$ (ElfSymbolXX a -> String) -> [ElfSymbolXX a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElfSymbolXX a -> String
forall (c :: ElfClass). ElfSymbolXX c -> String
steName [ElfSymbolXX a]
ss
        ssWithNameIndexes :: [(ElfSymbolXX a, Int64)]
ssWithNameIndexes = [ElfSymbolXX a] -> [Int64] -> [(ElfSymbolXX a, Int64)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [ElfSymbolXX a]
ss [Int64]
stringIndexes

        f :: SingI a => (ElfSymbolXX a, Int64) -> SymbolXX a
        f :: forall (a :: ElfClass).
SingI a =>
(ElfSymbolXX a, Int64) -> SymbolXX a
f (ElfSymbolXX a
s, Int64
n) = Word32 -> ElfSymbolXX a -> SymbolXX a
forall (a :: ElfClass).
SingI a =>
Word32 -> ElfSymbolXX a -> SymbolXX a
mkSymbolTableEntry (Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) ElfSymbolXX a
s

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

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