Encode labels as untyped local symbols in ELF

This commit is contained in:
Eugen Wissner 2024-10-27 14:00:54 +01:00
parent 57436f664e
commit 6b92e5059c
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
5 changed files with 239 additions and 177 deletions

4
TODO
View File

@ -9,10 +9,6 @@
- Don't ignore relocations where the symbol is not defined in the symbol table. - Don't ignore relocations where the symbol is not defined in the symbol table.
Report an error about an undefined symbol. Report an error about an undefined symbol.
- JumpLabels inside functions are encoded as functions. Distinguish between
labels (e.g. .A0 or .L0) and global functions. Lables are NOTYPE LOCAL.
- Sort the symbols so that local symbols come first. Some table header had a
number specifiying the index of the first non-local symbol. Adjust that number.
# Name analysis # Name analysis

View File

@ -140,7 +140,7 @@ createLabel = do
pure $ Label pure $ Label
$ Text.Lazy.toStrict $ Text.Lazy.toStrict
$ Text.Builder.toLazyText $ Text.Builder.toLazyText
$ "L" <> Text.Builder.decimal currentCounter $ ".L" <> Text.Builder.decimal currentCounter
where where
modifier generator = generator modifier generator = generator
{ labelCounter = getField @"labelCounter" generator + 1 { labelCounter = getField @"labelCounter" generator + 1

View File

@ -3,20 +3,26 @@ module Language.Elna.Object.ElfCoder
( ElfEnvironment(..) ( ElfEnvironment(..)
, ElfWriter(..) , ElfWriter(..)
, ElfHeaderResult(..) , ElfHeaderResult(..)
, elfHeaderSize , UnresolvedRelocation(..)
, UnresolvedRelocations(..)
, addHeaderToResult
, addSectionHeader , addSectionHeader
, elfHeaderSize
, elfObject , elfObject
, elfSectionsSize , elfSectionsSize
, putSectionHeader , putSectionHeader
, partitionSymbols
, module Language.Elna.Object.Elf , module Language.Elna.Object.Elf
) where ) where
import Control.Exception (throwIO) import Control.Exception (throwIO)
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.State (StateT, runStateT, modify', gets) import Control.Monad.Trans.State (StateT, runStateT, modify', gets)
import Data.Bits (Bits(..))
import Data.ByteString (StrictByteString) import Data.ByteString (StrictByteString)
import qualified Data.ByteString as ByteString import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as ByteString.Builder import qualified Data.ByteString.Builder as ByteString.Builder
import Data.Word (Word8)
import Data.Vector (Vector) import Data.Vector (Vector)
import qualified Data.Vector as Vector import qualified Data.Vector as Vector
import System.IO (Handle, IOMode(..), SeekMode(..), hSeek, withFile) import System.IO (Handle, IOMode(..), SeekMode(..), hSeek, withFile)
@ -26,6 +32,10 @@ import Language.Elna.Object.StringTable (StringTable)
import qualified Language.Elna.Object.StringTable as StringTable import qualified Language.Elna.Object.StringTable as StringTable
import GHC.Records (HasField(..)) import GHC.Records (HasField(..))
data UnresolvedRelocation = UnresolvedRelocation StrictByteString Elf32_Addr Word8
data UnresolvedRelocations =
UnresolvedRelocations (Vector UnresolvedRelocation) (ElfHeaderResult Elf32_Sym) Elf32_Word
data ElfEnvironment = ElfEnvironment data ElfEnvironment = ElfEnvironment
{ objectHeaders :: ElfHeaderResult Elf32_Shdr { objectHeaders :: ElfHeaderResult Elf32_Shdr
, objectHandle :: Handle , objectHandle :: Handle
@ -57,6 +67,11 @@ instance MonadIO ElfWriter
where where
liftIO = ElfWriter . liftIO liftIO = ElfWriter . liftIO
partitionSymbols :: ElfHeaderResult Elf32_Sym -> (Vector Elf32_Sym, Vector Elf32_Sym)
partitionSymbols = Vector.partition go . getField @"sectionHeaders"
where
go Elf32_Sym{ st_info } = (st_info .&. 0xf0) == 0
-- | ELF header size. -- | ELF header size.
elfHeaderSize :: Elf32_Off elfHeaderSize :: Elf32_Off
elfHeaderSize = 52 elfHeaderSize = 52
@ -67,17 +82,18 @@ elfSectionsSize :: Vector Elf32_Shdr -> Elf32_Off
elfSectionsSize = (elfHeaderSize +) elfSectionsSize = (elfHeaderSize +)
. Vector.foldr ((+) . sh_size) 0 . Vector.foldr ((+) . sh_size) 0
addHeaderToResult :: StrictByteString -> a -> ElfHeaderResult a -> ElfHeaderResult a
addHeaderToResult name newHeader accumulator@ElfHeaderResult{..} = accumulator
{ sectionHeaders = Vector.snoc sectionHeaders newHeader
, sectionNames = StringTable.append name sectionNames
}
addSectionHeader :: StrictByteString -> Elf32_Shdr -> ElfWriter () addSectionHeader :: StrictByteString -> Elf32_Shdr -> ElfWriter ()
addSectionHeader name newHeader = ElfWriter $ modify' modifier addSectionHeader name newHeader = ElfWriter $ modify' modifier
where where
modifier elfEnvironment@ElfEnvironment{ objectHeaders } = modifier elfEnvironment@ElfEnvironment{ objectHeaders } = elfEnvironment
let ElfHeaderResult{..} = objectHeaders { objectHeaders = addHeaderToResult name newHeader objectHeaders
in elfEnvironment }
{ objectHeaders = ElfHeaderResult
{ sectionHeaders = Vector.snoc sectionHeaders newHeader
, sectionNames = StringTable.append name sectionNames
}
}
putSectionHeader :: StrictByteString -> Elf32_Shdr -> StrictByteString -> ElfWriter () putSectionHeader :: StrictByteString -> Elf32_Shdr -> StrictByteString -> ElfWriter ()
putSectionHeader name newHeader encoded = do putSectionHeader name newHeader encoded = do

View File

@ -1,5 +1,6 @@
module Language.Elna.RiscV.CodeGenerator module Language.Elna.RiscV.CodeGenerator
( Statement(..) ( Directive(..)
, Statement(..)
, generateRiscV , generateRiscV
, riscVConfiguration , riscVConfiguration
) where ) where

View File

@ -3,16 +3,15 @@ module Language.Elna.RiscV.ElfWriter
( riscv32Elf ( riscv32Elf
) where ) where
import Data.Word (Word8)
import Data.ByteString (StrictByteString) import Data.ByteString (StrictByteString)
import qualified Data.ByteString as ByteString import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as ByteString.Builder import qualified Data.ByteString.Builder as ByteString.Builder
import Data.ByteString.Lazy (LazyByteString)
import qualified Data.ByteString.Lazy as LazyByteString import qualified Data.ByteString.Lazy as LazyByteString
import Data.Vector (Vector) import Data.Vector (Vector)
import qualified Data.Vector as Vector import qualified Data.Vector as Vector
import Language.Elna.Object.ElfCoder import Language.Elna.Object.ElfCoder
( ByteOrder(..) ( ByteOrder(..)
, Elf32_Addr
, Elf32_Ehdr(..) , Elf32_Ehdr(..)
, Elf32_Half , Elf32_Half
, Elf32_Word , Elf32_Word
@ -31,6 +30,10 @@ import Language.Elna.Object.ElfCoder
, ElfWriter(..) , ElfWriter(..)
, ElfHeaderResult(..) , ElfHeaderResult(..)
, ElfEnvironment(..) , ElfEnvironment(..)
, UnresolvedRelocation(..)
, UnresolvedRelocations(..)
, addHeaderToResult
, addSectionHeader
, elf32Sym , elf32Sym
, elfHeaderSize , elfHeaderSize
, elfSectionsSize , elfSectionsSize
@ -38,53 +41,35 @@ import Language.Elna.Object.ElfCoder
, rInfo , rInfo
, elf32Rel , elf32Rel
, shfInfoLink , shfInfoLink
, addSectionHeader , partitionSymbols
, putSectionHeader , putSectionHeader
) )
import qualified Language.Elna.Architecture.RiscV as RiscV import qualified Language.Elna.Architecture.RiscV as RiscV
import qualified Data.Text.Encoding as Text import qualified Data.Text.Encoding as Text
import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.State (get, gets) import Control.Monad.Trans.State (get, gets)
import Language.Elna.RiscV.CodeGenerator (Statement(..)) import Language.Elna.RiscV.CodeGenerator (Directive(..), Statement(..))
import Language.Elna.Object.StringTable (StringTable)
import qualified Language.Elna.Object.StringTable as StringTable import qualified Language.Elna.Object.StringTable as StringTable
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet import qualified Data.HashSet as HashSet
import GHC.Records (HasField(..)) import GHC.Records (HasField(..))
data UnresolvedRelocation = UnresolvedRelocation StrictByteString Elf32_Addr Word8 data TextAccumulator = TextAccumulator
data UnresolvedRelocations = UnresolvedRelocations (Vector UnresolvedRelocation) Elf32_Word { encodedAccumulator :: LazyByteString
, relocationAccumulator :: Vector UnresolvedRelocation
, symbolAccumulator :: ElfHeaderResult Elf32_Sym
, definitionAccumulator :: HashSet StrictByteString
}
riscv32Elf :: Vector Statement -> ElfWriter Elf32_Ehdr riscv32Elf :: Vector Statement -> ElfWriter Elf32_Ehdr
riscv32Elf code = text riscv32Elf code = text code
>>= symtab
>>= uncurry symrel >>= uncurry symrel
>>= strtab >>= strtab
>> shstrtab >> shstrtab
>>= riscv32Header >>= riscv32Header
where where
shstrtab :: ElfWriter Elf32_Half
shstrtab = do
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
let stringTable = ".shstrtab"
currentNamesSize = StringTable.size sectionNames
nextHeader = Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = currentNamesSize -- Adding trailing null character.
+ fromIntegral (succ $ ByteString.length stringTable)
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = currentNamesSize
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 1
, sh_addr = 0
}
addSectionHeader stringTable nextHeader
ElfEnvironment{..} <- ElfWriter get
liftIO $ ByteString.hPut objectHandle
$ StringTable.encode
$ getField @"sectionNames" objectHeaders
pure $ fromIntegral $ Vector.length sectionHeaders
riscv32Header :: Elf32_Half -> ElfWriter Elf32_Ehdr riscv32Header :: Elf32_Half -> ElfWriter Elf32_Ehdr
riscv32Header shstrndx = do riscv32Header shstrndx = do
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
@ -104,110 +89,50 @@ riscv32Elf code = text
, e_entry = 0 , e_entry = 0
, e_ehsize = fromIntegral elfHeaderSize , e_ehsize = fromIntegral elfHeaderSize
} }
takeStringZ stringTable Elf32_Sym{ st_name }
= StringTable.index st_name stringTable
resolveRelocation (ElfHeaderResult stringTable entries) unresolvedRelocation
| UnresolvedRelocation symbolName offset type' <- unresolvedRelocation
, Just entry <- Vector.findIndex ((== symbolName) . takeStringZ stringTable) entries =
Right $ Elf32_Rel
{ r_offset = offset
, r_info = rInfo (fromIntegral entry) type'
}
| otherwise = Left unresolvedRelocation
symtab entries = do
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
let encodedSymbols = LazyByteString.toStrict
$ ByteString.Builder.toLazyByteString
$ foldMap (elf32Sym LSB) entries
symHeader = Elf32_Shdr
{ sh_type = SHT_SYMTAB
, sh_size = fromIntegral $ ByteString.length encodedSymbols
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = StringTable.size sectionNames
, sh_link = fromIntegral $ Vector.length sectionHeaders + 2
, sh_info = 1
, sh_flags = 0
, sh_entsize = 16
, sh_addralign = 4
, sh_addr = 0
}
putSectionHeader ".symtab" symHeader encodedSymbols
pure $ fromIntegral $ Vector.length sectionHeaders
symrel symbols relocations = do
let UnresolvedRelocations relocationList index = relocations
ElfHeaderResult stringTable entries = symbols
sectionHeadersLength <- symtab entries text :: Vector Statement -> ElfWriter UnresolvedRelocations
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" text code = do
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
let encodedRelocations = LazyByteString.toStrict let textTabIndex = fromIntegral $ Vector.length sectionHeaders
$ ByteString.Builder.toLazyByteString initialHeaders = ElfHeaderResult mempty
$ Vector.foldMap (either (const mempty) (elf32Rel LSB)) $ Vector.singleton
$ resolveRelocation symbols <$> relocationList $ Elf32_Sym
relHeader = Elf32_Shdr { st_value = 0
{ sh_type = SHT_REL , st_size = 0
, sh_size = fromIntegral $ ByteString.length encodedRelocations , st_shndx = 0
, sh_offset = elfSectionsSize sectionHeaders , st_other = 0
, sh_name = StringTable.size sectionNames , st_name = 0
, sh_link = sectionHeadersLength , st_info = 0
, sh_info = index
, sh_flags = shfInfoLink
, sh_entsize = 8
, sh_addralign = 4
, sh_addr = 0
} }
putSectionHeader ".rel.text" relHeader encodedRelocations TextAccumulator{..} = encodeFunctions textTabIndex code
pure stringTable $ TextAccumulator
strtab stringTable = do { encodedAccumulator = mempty
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" , relocationAccumulator = Vector.empty
let strHeader = Elf32_Shdr , symbolAccumulator = initialHeaders
{ sh_type = SHT_STRTAB , definitionAccumulator = HashSet.empty
, sh_size = StringTable.size stringTable
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = StringTable.size sectionNames
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 1
, sh_addr = 0
} }
putSectionHeader ".strtab" strHeader $ StringTable.encode stringTable size = fromIntegral $ LazyByteString.length encodedAccumulator
text = do newHeader = Elf32_Shdr
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" { sh_type = SHT_PROGBITS
let textTabIndex = fromIntegral $ Vector.length sectionHeaders , sh_size = size
initialHeaders = ElfHeaderResult mempty , sh_offset = elfSectionsSize sectionHeaders
$ Vector.singleton , sh_name = StringTable.size sectionNames
$ Elf32_Sym , sh_link = 0
{ st_value = 0 , sh_info = 0
, st_size = 0 , sh_flags = 0b110
, st_shndx = 0 , sh_entsize = 0
, st_other = 0 , sh_addralign = 4
, st_name = 0 , sh_addr = 0
, st_info = 0 }
} putSectionHeader ".text" newHeader $ LazyByteString.toStrict encodedAccumulator
(encoded, updatedRelocations, symbols, definitions) = let filterPredicate :: StrictByteString -> Bool
encodeFunctions textTabIndex (mempty, Vector.empty, initialHeaders, HashSet.empty) code filterPredicate = not
size = fromIntegral $ LazyByteString.length encoded . (`StringTable.elem` getField @"sectionNames" symbolAccumulator)
newHeader = Elf32_Shdr symbolResult = HashSet.foldl' encodeEmptyDefinitions symbolAccumulator
{ sh_type = SHT_PROGBITS $ HashSet.filter filterPredicate definitionAccumulator
, sh_size = size pure $ UnresolvedRelocations relocationAccumulator symbolResult
, sh_offset = elfSectionsSize sectionHeaders $ fromIntegral $ Vector.length sectionHeaders
, sh_name = StringTable.size sectionNames where
, sh_link = 0
, sh_info = 0
, sh_flags = 0b110
, sh_entsize = 0
, sh_addralign = 4
, sh_addr = 0
}
putSectionHeader ".text" newHeader $ LazyByteString.toStrict encoded
let filterPredicate :: StrictByteString -> Bool
filterPredicate = not
. (`StringTable.elem` getField @"sectionNames" symbols)
symbolResult = HashSet.foldl' encodeEmptyDefinitions symbols
$ HashSet.filter filterPredicate definitions
pure (symbolResult, UnresolvedRelocations updatedRelocations $ fromIntegral $ Vector.length sectionHeaders)
encodeEmptyDefinitions (ElfHeaderResult names entries) definition = encodeEmptyDefinitions (ElfHeaderResult names entries) definition =
let nextEntry = Elf32_Sym let nextEntry = Elf32_Sym
{ st_value = 0 { st_value = 0
@ -219,34 +144,38 @@ riscv32Elf code = text
} }
in ElfHeaderResult (StringTable.append definition names) in ElfHeaderResult (StringTable.append definition names)
$ Vector.snoc entries nextEntry $ Vector.snoc entries nextEntry
encodeFunctions shndx (encoded, relocations, ElfHeaderResult names symbols, definitions) instructions encodeFunctions shndx instructions textAccumulator
| Just (instruction, rest) <- Vector.uncons instructions = | Just (instruction, rest) <- Vector.uncons instructions =
case instruction of case instruction of
Instruction _ -> Instruction _ ->
let (encoded', relocations', rest', definitions') = let (textAccumulator', rest') = encodeInstructions shndx (textAccumulator, instructions)
encodeInstructions (encoded, relocations, instructions, definitions) in encodeFunctions shndx rest' textAccumulator'
in encodeFunctions shndx (encoded', relocations', ElfHeaderResult names symbols, definitions') rest' JumpLabel labelName directives ->
JumpLabel labelName _ -> let (TextAccumulator{..}, rest') =
let (encoded', relocations', rest', definitions') = encodeInstructions shndx (textAccumulator, rest)
encodeInstructions (encoded, relocations, rest, definitions)
newEntry = Elf32_Sym newEntry = Elf32_Sym
{ st_value = fromIntegral $ LazyByteString.length encoded { st_value = fromIntegral
, st_size = fromIntegral $ LazyByteString.length encoded' $ LazyByteString.length
$ getField @"encodedAccumulator" textAccumulator
, st_size = fromIntegral $ LazyByteString.length encodedAccumulator
, st_shndx = shndx , st_shndx = shndx
, st_other = 0 , st_other = 0
, st_name = StringTable.size names , st_name = StringTable.size $ getField @"sectionNames" symbolAccumulator
, st_info = stInfo STB_GLOBAL STT_FUNC , st_info = stInfo (directivesBinding directives) STT_FUNC
} }
result = in encodeFunctions shndx rest'
( encoded' $ TextAccumulator
, relocations' { encodedAccumulator = encodedAccumulator
, ElfHeaderResult (StringTable.append (Text.encodeUtf8 labelName) names) , relocationAccumulator = relocationAccumulator
$ Vector.snoc symbols newEntry , symbolAccumulator =
, definitions' addHeaderToResult (Text.encodeUtf8 labelName) newEntry symbolAccumulator
) , definitionAccumulator = definitionAccumulator
in encodeFunctions shndx result rest' }
| otherwise = (encoded, relocations, ElfHeaderResult names symbols, definitions) | otherwise = textAccumulator
encodeInstructions (encoded, relocations, instructions, definitions) directivesBinding directives
| GlobalDirective `elem` directives = STB_GLOBAL
| otherwise = STB_LOCAL
encodeInstructions shndx (TextAccumulator encoded relocations symbolResult definitions, instructions)
| Just (Instruction instruction, rest) <- Vector.uncons instructions = | Just (Instruction instruction, rest) <- Vector.uncons instructions =
let offset = fromIntegral $ LazyByteString.length encoded let offset = fromIntegral $ LazyByteString.length encoded
unresolvedRelocation = case instruction of unresolvedRelocation = case instruction of
@ -272,14 +201,134 @@ riscv32Elf code = text
RiscV.BaseInstruction _ _ -> Nothing RiscV.BaseInstruction _ _ -> Nothing
chunk = ByteString.Builder.toLazyByteString chunk = ByteString.Builder.toLazyByteString
$ RiscV.instruction instruction $ RiscV.instruction instruction
result = result = TextAccumulator
( encoded <> chunk (encoded <> chunk)
, maybe relocations (Vector.snoc relocations) unresolvedRelocation (maybe relocations (Vector.snoc relocations) unresolvedRelocation)
, rest symbolResult
, addDefinition unresolvedRelocation definitions (addDefinition unresolvedRelocation definitions)
) in encodeInstructions shndx (result, rest)
in encodeInstructions result | Just (JumpLabel labelName directives , rest) <- Vector.uncons instructions
| otherwise = (encoded, relocations, instructions, definitions) , FunctionDirective `notElem` directives =
let newEntry = Elf32_Sym
{ st_value = fromIntegral $ LazyByteString.length encoded
, st_size = 0
, st_shndx = shndx
, st_other = 0
, st_name = StringTable.size $ getField @"sectionNames" symbolResult
, st_info = stInfo (directivesBinding directives) STT_NOTYPE
}
result = TextAccumulator
encoded
relocations
(addHeaderToResult (Text.encodeUtf8 labelName) newEntry symbolResult)
definitions
in encodeInstructions shndx (result, rest)
| otherwise = (TextAccumulator encoded relocations symbolResult definitions, instructions)
addDefinition (Just (UnresolvedRelocation symbolName _ _)) = addDefinition (Just (UnresolvedRelocation symbolName _ _)) =
HashSet.insert symbolName HashSet.insert symbolName
addDefinition Nothing = id addDefinition Nothing = id
shstrtab :: ElfWriter Elf32_Half
shstrtab = do
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
let stringTable = ".shstrtab"
currentNamesSize = StringTable.size sectionNames
nextHeader = Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = currentNamesSize -- Adding trailing null character.
+ fromIntegral (succ $ ByteString.length stringTable)
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = currentNamesSize
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 1
, sh_addr = 0
}
addSectionHeader stringTable nextHeader
ElfEnvironment{..} <- ElfWriter get
liftIO $ ByteString.hPut objectHandle
$ StringTable.encode
$ getField @"sectionNames" objectHeaders
pure $ fromIntegral $ Vector.length sectionHeaders
symtab :: UnresolvedRelocations -> ElfWriter (Elf32_Word, UnresolvedRelocations)
symtab (UnresolvedRelocations relocationList symbolResult index) = do
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
let (localSymbols, globalSymbols) = partitionSymbols symbolResult
sortedSymbols = localSymbols <> globalSymbols
sortedResult = symbolResult{ sectionHeaders = sortedSymbols }
encodedSymbols = LazyByteString.toStrict
$ ByteString.Builder.toLazyByteString
$ foldMap (elf32Sym LSB) sortedSymbols
symHeader = Elf32_Shdr
{ sh_type = SHT_SYMTAB
, sh_size = fromIntegral $ ByteString.length encodedSymbols
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = StringTable.size sectionNames
, sh_link = fromIntegral $ Vector.length sectionHeaders + 2
, sh_info = fromIntegral $ Vector.length localSymbols
, sh_flags = 0
, sh_entsize = 16
, sh_addralign = 4
, sh_addr = 0
}
putSectionHeader ".symtab" symHeader encodedSymbols
pure
( fromIntegral $ Vector.length sectionHeaders
, UnresolvedRelocations relocationList sortedResult index
)
symrel :: Elf32_Word -> UnresolvedRelocations -> ElfWriter StringTable
symrel sectionHeadersLength relocations = do
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
let UnresolvedRelocations relocationList symbols index = relocations
encodedRelocations = LazyByteString.toStrict
$ ByteString.Builder.toLazyByteString
$ Vector.foldMap (either (const mempty) (elf32Rel LSB))
$ resolveRelocation symbols <$> relocationList
relHeader = Elf32_Shdr
{ sh_type = SHT_REL
, sh_size = fromIntegral $ ByteString.length encodedRelocations
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = StringTable.size sectionNames
, sh_link = sectionHeadersLength
, sh_info = index
, sh_flags = shfInfoLink
, sh_entsize = 8
, sh_addralign = 4
, sh_addr = 0
}
putSectionHeader ".rel.text" relHeader encodedRelocations
pure $ getField @"sectionNames" symbols
where
takeStringZ stringTable Elf32_Sym{ st_name }
= StringTable.index st_name stringTable
resolveRelocation (ElfHeaderResult stringTable entries) unresolvedRelocation
| UnresolvedRelocation symbolName offset type' <- unresolvedRelocation
, Just entry <- Vector.findIndex ((== symbolName) . takeStringZ stringTable) entries =
Right $ Elf32_Rel
{ r_offset = offset
, r_info = rInfo (fromIntegral entry) type'
}
| otherwise = Left unresolvedRelocation
strtab :: StringTable -> ElfWriter ()
strtab stringTable = do
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
let strHeader = Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = StringTable.size stringTable
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = StringTable.size sectionNames
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 1
, sh_addr = 0
}
putSectionHeader ".strtab" strHeader $ StringTable.encode stringTable