{-# 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
headerInterval :: forall a . IsElfClass a => HeaderXX a -> Interval (WordXX a)
HeaderXX a
_ = WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
0 (WordXX a -> Interval (WordXX a))
-> WordXX a -> Interval (WordXX a)
forall a b. (a -> b) -> a -> b
$ ElfClass -> WordXX a
forall a. Num a => ElfClass -> a
headerSize (ElfClass -> WordXX a) -> ElfClass -> WordXX a
forall a b. (a -> b) -> a -> b
$ 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
data RBuilder c
=
{ :: HeaderXX c
}
| RBuilderSectionTable
{ :: HeaderXX c
}
| RBuilderSegmentTable
{ :: HeaderXX c
}
| RBuilderSection
{ :: SectionXX c
, forall (c :: ElfClass). RBuilder c -> ElfSectionIndex
rbsN :: ElfSectionIndex
, forall (c :: ElfClass). RBuilder c -> String
rbsName :: String
}
| RBuilderSegment
{ :: SegmentXX c
, forall (c :: ElfClass). RBuilder c -> Word16
rbpN :: Word16
, forall (c :: ElfClass). RBuilder c -> [RBuilder c]
rbpData :: [RBuilder c]
}
| RBuilderRawData
{ forall (c :: ElfClass). RBuilder c -> Interval (WordXX c)
rbrdInterval :: Interval (WordXX c)
}
| RBuilderRawAlign
{ forall (c :: ElfClass). RBuilder c -> WordXX c
rbraOffset :: WordXX c
, forall (c :: ElfClass). RBuilder c -> WordXX c
rbraAlign :: WordXX c
}
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
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"
showRBuilder' RBuilderRawAlign{} = String
"alignment"
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
")"
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 =
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
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 =
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
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
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
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
$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
$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
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
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
$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
newtype ElfList c = ElfList [ElfXX c]
type Elf = Sigma ElfClass (TyCon1 ElfList)
data ElfSectionData c
= ElfSectionData
{ forall (c :: ElfClass). ElfSectionData c -> ByteString
esdData :: BSL.ByteString
}
| ElfSectionDataStringTable
| ElfSectionDataNoBits
{ forall (c :: ElfClass). ElfSectionData c -> WordXX c
esdSize :: WordXX c
}
data ElfXX c
=
{ forall (c :: ElfClass). ElfXX c -> ElfData
ehData :: ElfData
, forall (c :: ElfClass). ElfXX c -> ElfOSABI
ehOSABI :: ElfOSABI
, forall (c :: ElfClass). ElfXX c -> Word8
ehABIVersion :: Word8
, forall (c :: ElfClass). ElfXX c -> ElfType
ehType :: ElfType
, forall (c :: ElfClass). ElfXX c -> ElfMachine
ehMachine :: ElfMachine
, forall (c :: ElfClass). ElfXX c -> WordXX c
ehEntry :: WordXX c
, forall (c :: ElfClass). ElfXX c -> Word32
ehFlags :: Word32
}
| ElfSectionTable
| ElfSegmentTable
| ElfSection
{ forall (c :: ElfClass). ElfXX c -> String
esName :: String
, forall (c :: ElfClass). ElfXX c -> ElfSectionType
esType :: ElfSectionType
, forall (c :: ElfClass). ElfXX c -> ElfSectionFlag
esFlags :: ElfSectionFlag
, forall (c :: ElfClass). ElfXX c -> WordXX c
esAddr :: WordXX c
, forall (c :: ElfClass). ElfXX c -> WordXX c
esAddrAlign :: WordXX c
, forall (c :: ElfClass). ElfXX c -> WordXX c
esEntSize :: WordXX c
, forall (c :: ElfClass). ElfXX c -> ElfSectionIndex
esN :: ElfSectionIndex
, forall (c :: ElfClass). ElfXX c -> Word32
esInfo :: Word32
, forall (c :: ElfClass). ElfXX c -> Word32
esLink :: Word32
, forall (c :: ElfClass). ElfXX c -> ElfSectionData c
esData :: ElfSectionData c
}
| ElfSegment
{ forall (c :: ElfClass). ElfXX c -> ElfSegmentType
epType :: ElfSegmentType
, forall (c :: ElfClass). ElfXX c -> ElfSegmentFlag
epFlags :: ElfSegmentFlag
, forall (c :: ElfClass). ElfXX c -> WordXX c
epVirtAddr :: WordXX c
, forall (c :: ElfClass). ElfXX c -> WordXX c
epPhysAddr :: WordXX c
, forall (c :: ElfClass). ElfXX c -> WordXX c
epAddMemSize :: WordXX c
, forall (c :: ElfClass). ElfXX c -> WordXX c
epAlign :: WordXX c
, forall (c :: ElfClass). ElfXX c -> [ElfXX c]
epData :: [ElfXX c]
}
| ElfRawData
{ forall (c :: ElfClass). ElfXX c -> ByteString
edData :: BSL.ByteString
}
| ElfRawAlign
{ forall (c :: ElfClass). ElfXX c -> WordXX c
eaOffset :: WordXX c
, forall (c :: ElfClass). ElfXX c -> WordXX c
eaAlign :: WordXX c
}
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)
elfFindSection :: forall a m b . (SingI a, MonadThrow m, Integral b, Show b)
=> [ElfXX a]
-> b
-> m (ElfXX a)
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
elfFindSectionByName :: forall a m . (SingI a, MonadThrow m)
=> [ElfXX a]
-> String
-> m (ElfXX a)
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
elfFindHeader :: forall a m . (SingI a, MonadThrow m)
=> [ElfXX a]
-> m (ElfXX a)
[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
getString :: BSL.ByteString
-> Int64
-> 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
getSectionData :: IsElfClass a
=> BSL.ByteString
-> SectionXX a
-> BSL.ByteString
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
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
addRaw :: WordXX a -> WordXX a -> [RBuilder a] -> [RBuilder a]
addRaw :: WordXX a -> WordXX a -> [RBuilder a] -> [RBuilder a]
addRaw WordXX a
b WordXX a
ee [RBuilder a]
rbs' =
if WordXX a
b WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
ee
then
if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ WordXX a -> WordXX a -> Bool
allEmpty WordXX a
b WordXX a
s
then
Interval (WordXX a) -> RBuilder a
forall (c :: ElfClass). Interval (WordXX c) -> RBuilder c
RBuilderRawData (WordXX a -> WordXX a -> Interval (WordXX a)
forall a. a -> a -> Interval a
I WordXX a
b WordXX a
s) RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'
else
if WordXX a
e' WordXX a -> WordXX a -> Bool
forall a. Ord a => a -> a -> Bool
< WordXX a
ee Bool -> Bool -> Bool
&& WordXX a
e'' WordXX a -> WordXX a -> Bool
forall a. Eq a => a -> a -> Bool
== WordXX a
ee
then
WordXX a -> WordXX a -> RBuilder a
forall (c :: ElfClass). WordXX c -> WordXX c -> RBuilder c
RBuilderRawAlign WordXX a
ee WordXX a
alignHint RBuilder a -> [RBuilder a] -> [RBuilder a]
forall a. a -> [a] -> [a]
: [RBuilder a]
rbs'
else
[RBuilder a]
rbs'
else
[RBuilder a]
rbs'
where
s :: WordXX a
s = WordXX a
ee WordXX a -> WordXX a -> WordXX a
forall a. Num a => a -> a -> a
- WordXX a
b
eAddr :: WordXX a
eAddr = case [RBuilder a]
rbs' of
(RBuilderSegment{rbpHeader :: forall (c :: ElfClass). RBuilder c -> SegmentXX c
rbpHeader = SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX a
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' :: 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
parseRBuilder :: (IsElfClass a, MonadCatch m)
=> HeaderXX a
-> [SectionXX a]
-> [SegmentXX a]
-> BSL.ByteString
-> 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
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
=
| 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
mkStringTable :: [String] -> (BSL.ByteString, [Int64])
mkStringTable :: [String] -> (ByteString, [Int64])
mkStringTable [String]
sectionNames = (ByteString
stringTable, [Int64]
os)
where
([(Word32, String)]
ins0, [(Word32, String)]
ins) = ((Word32, String) -> Bool)
-> [(Word32, String)] -> ([(Word32, String)], [(Word32, String)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.break ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") (String -> Bool)
-> ((Word32, String) -> String) -> (Word32, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32, String) -> String
forall a b. (a, b) -> b
snd) ([(Word32, String)] -> ([(Word32, String)], [(Word32, String)]))
-> [(Word32, String)] -> ([(Word32, String)], [(Word32, String)])
forall a b. (a -> b) -> a -> b
$ ((Word32, String) -> Int)
-> [(Word32, String)] -> [(Word32, String)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (String -> Int
forall (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
f :: (ByteString, [(a, Int64)], [(a, String)])
-> (ByteString, [(a, Int64)], [(a, String)])
f x :: (ByteString, [(a, Int64)], [(a, String)])
x@(ByteString
_, [(a, Int64)]
_, []) = (ByteString, [(a, Int64)], [(a, String)])
x
f (ByteString
st, [(a, Int64)]
iosf, (a
i, String
n) : [(a, String)]
insf) = (ByteString, [(a, Int64)], [(a, String)])
-> (ByteString, [(a, Int64)], [(a, String)])
f (ByteString
st', [(a, Int64)]
iosf'', [(a, String)]
insf')
where
st' :: ByteString
st' = ByteString
st ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
BSL8.pack String
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BSL.singleton Word8
0
o :: Int64
o = ByteString -> Int64
BSL.length ByteString
st
iosf'' :: [(a, Int64)]
iosf'' = (a
i, Int64
o) (a, Int64) -> [(a, Int64)] -> [(a, Int64)]
forall a. a -> [a] -> [a]
: [(a, Int64)]
iosf' [(a, Int64)] -> [(a, Int64)] -> [(a, Int64)]
forall a. [a] -> [a] -> [a]
++ [(a, Int64)]
iosf
([(a, Int64)]
iosf', [(a, String)]
insf') = [(a, String)] -> ([(a, Int64)], [(a, String)])
ff [(a, String)]
insf
ff :: [(a, String)] -> ([(a, Int64)], [(a, String)])
ff = ((a, String)
-> ([(a, Int64)], [(a, String)]) -> ([(a, Int64)], [(a, String)]))
-> ([(a, Int64)], [(a, String)])
-> [(a, String)]
-> ([(a, Int64)], [(a, String)])
forall (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)
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"
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")
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
sType :: ElfSectionType
sType = ElfSectionType
esType
sFlags :: WordXX a
sFlags = Word64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
f
sAddr :: WordXX a
sAddr = WordXX a
esAddr
sOffset :: WordXX a
sOffset = WordXX a
wbsOffset
sSize :: WordXX a
sSize = WordXX a
sz
sLink :: Word32
sLink = Word32
esLink
sInfo :: Word32
sInfo = Word32
esInfo
sAddrAlign :: WordXX a
sAddrAlign = WordXX a
esAddrAlign
sEntSize :: WordXX a
sEntSize = WordXX a
esEntSize
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
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"
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
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
data ElfSymbolXX c =
ElfSymbolXX
{ forall (c :: ElfClass). ElfSymbolXX c -> String
steName :: String
, forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolBinding
steBind :: ElfSymbolBinding
, forall (c :: ElfClass). ElfSymbolXX c -> ElfSymbolType
steType :: ElfSymbolType
, forall (c :: ElfClass). ElfSymbolXX c -> ElfSectionIndex
steShNdx :: ElfSectionIndex
, forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steValue :: WordXX c
, forall (c :: ElfClass). ElfSymbolXX c -> WordXX c
steSize :: WordXX c
}
getStringFromData :: BSL.ByteString -> Word32 -> String
getStringFromData :: ByteString -> Word32 -> String
getStringFromData ByteString
stringTable Word32
offset = ByteString -> String
BSL8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
BSL.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop (Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offset) ByteString
stringTable
mkElfSymbolTableEntry :: 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
..}
parseSymbolTable :: (MonadThrow m, SingI a)
=> ElfData
-> ElfXX a
-> [ElfXX a]
-> m [ElfSymbolXX a]
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"
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"
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
..}
serializeSymbolTable :: (MonadThrow m, SingI a)
=> ElfData
-> [ElfSymbolXX a]
-> m (BSL.ByteString, BSL.ByteString)
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)