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.
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

View File

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

View File

@ -3,20 +3,26 @@ module Language.Elna.Object.ElfCoder
( ElfEnvironment(..)
, ElfWriter(..)
, ElfHeaderResult(..)
, elfHeaderSize
, UnresolvedRelocation(..)
, UnresolvedRelocations(..)
, addHeaderToResult
, addSectionHeader
, elfHeaderSize
, elfObject
, elfSectionsSize
, putSectionHeader
, partitionSymbols
, module Language.Elna.Object.Elf
) where
import Control.Exception (throwIO)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.State (StateT, runStateT, modify', gets)
import Data.Bits (Bits(..))
import Data.ByteString (StrictByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as ByteString.Builder
import Data.Word (Word8)
import Data.Vector (Vector)
import qualified Data.Vector as Vector
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 GHC.Records (HasField(..))
data UnresolvedRelocation = UnresolvedRelocation StrictByteString Elf32_Addr Word8
data UnresolvedRelocations =
UnresolvedRelocations (Vector UnresolvedRelocation) (ElfHeaderResult Elf32_Sym) Elf32_Word
data ElfEnvironment = ElfEnvironment
{ objectHeaders :: ElfHeaderResult Elf32_Shdr
, objectHandle :: Handle
@ -57,6 +67,11 @@ instance MonadIO ElfWriter
where
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.
elfHeaderSize :: Elf32_Off
elfHeaderSize = 52
@ -67,16 +82,17 @@ elfSectionsSize :: Vector Elf32_Shdr -> Elf32_Off
elfSectionsSize = (elfHeaderSize +)
. Vector.foldr ((+) . sh_size) 0
addSectionHeader :: StrictByteString -> Elf32_Shdr -> ElfWriter ()
addSectionHeader name newHeader = ElfWriter $ modify' modifier
where
modifier elfEnvironment@ElfEnvironment{ objectHeaders } =
let ElfHeaderResult{..} = objectHeaders
in elfEnvironment
{ objectHeaders = ElfHeaderResult
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 name newHeader = ElfWriter $ modify' modifier
where
modifier elfEnvironment@ElfEnvironment{ objectHeaders } = elfEnvironment
{ objectHeaders = addHeaderToResult name newHeader objectHeaders
}
putSectionHeader :: StrictByteString -> Elf32_Shdr -> StrictByteString -> ElfWriter ()

View File

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

View File

@ -3,16 +3,15 @@ module Language.Elna.RiscV.ElfWriter
( riscv32Elf
) where
import Data.Word (Word8)
import Data.ByteString (StrictByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as ByteString.Builder
import Data.ByteString.Lazy (LazyByteString)
import qualified Data.ByteString.Lazy as LazyByteString
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Language.Elna.Object.ElfCoder
( ByteOrder(..)
, Elf32_Addr
, Elf32_Ehdr(..)
, Elf32_Half
, Elf32_Word
@ -31,6 +30,10 @@ import Language.Elna.Object.ElfCoder
, ElfWriter(..)
, ElfHeaderResult(..)
, ElfEnvironment(..)
, UnresolvedRelocation(..)
, UnresolvedRelocations(..)
, addHeaderToResult
, addSectionHeader
, elf32Sym
, elfHeaderSize
, elfSectionsSize
@ -38,53 +41,35 @@ import Language.Elna.Object.ElfCoder
, rInfo
, elf32Rel
, shfInfoLink
, addSectionHeader
, partitionSymbols
, putSectionHeader
)
import qualified Language.Elna.Architecture.RiscV as RiscV
import qualified Data.Text.Encoding as Text
import Control.Monad.IO.Class (MonadIO(..))
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 Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import GHC.Records (HasField(..))
data UnresolvedRelocation = UnresolvedRelocation StrictByteString Elf32_Addr Word8
data UnresolvedRelocations = UnresolvedRelocations (Vector UnresolvedRelocation) Elf32_Word
data TextAccumulator = TextAccumulator
{ encodedAccumulator :: LazyByteString
, relocationAccumulator :: Vector UnresolvedRelocation
, symbolAccumulator :: ElfHeaderResult Elf32_Sym
, definitionAccumulator :: HashSet StrictByteString
}
riscv32Elf :: Vector Statement -> ElfWriter Elf32_Ehdr
riscv32Elf code = text
riscv32Elf code = text code
>>= symtab
>>= uncurry symrel
>>= strtab
>> shstrtab
>>= riscv32Header
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 shstrndx = do
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
@ -104,76 +89,9 @@ riscv32Elf code = text
, e_entry = 0
, 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
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
let 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 stringTable
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
text = do
text :: Vector Statement -> ElfWriter UnresolvedRelocations
text code = do
ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders"
let textTabIndex = fromIntegral $ Vector.length sectionHeaders
initialHeaders = ElfHeaderResult mempty
@ -186,9 +104,14 @@ riscv32Elf code = text
, st_name = 0
, st_info = 0
}
(encoded, updatedRelocations, symbols, definitions) =
encodeFunctions textTabIndex (mempty, Vector.empty, initialHeaders, HashSet.empty) code
size = fromIntegral $ LazyByteString.length encoded
TextAccumulator{..} = encodeFunctions textTabIndex code
$ TextAccumulator
{ encodedAccumulator = mempty
, relocationAccumulator = Vector.empty
, symbolAccumulator = initialHeaders
, definitionAccumulator = HashSet.empty
}
size = fromIntegral $ LazyByteString.length encodedAccumulator
newHeader = Elf32_Shdr
{ sh_type = SHT_PROGBITS
, sh_size = size
@ -201,13 +124,15 @@ riscv32Elf code = text
, sh_addralign = 4
, sh_addr = 0
}
putSectionHeader ".text" newHeader $ LazyByteString.toStrict encoded
putSectionHeader ".text" newHeader $ LazyByteString.toStrict encodedAccumulator
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)
. (`StringTable.elem` getField @"sectionNames" symbolAccumulator)
symbolResult = HashSet.foldl' encodeEmptyDefinitions symbolAccumulator
$ HashSet.filter filterPredicate definitionAccumulator
pure $ UnresolvedRelocations relocationAccumulator symbolResult
$ fromIntegral $ Vector.length sectionHeaders
where
encodeEmptyDefinitions (ElfHeaderResult names entries) definition =
let nextEntry = Elf32_Sym
{ st_value = 0
@ -219,34 +144,38 @@ riscv32Elf code = text
}
in ElfHeaderResult (StringTable.append definition names)
$ Vector.snoc entries nextEntry
encodeFunctions shndx (encoded, relocations, ElfHeaderResult names symbols, definitions) instructions
encodeFunctions shndx instructions textAccumulator
| Just (instruction, rest) <- Vector.uncons instructions =
case instruction of
Instruction _ ->
let (encoded', relocations', rest', definitions') =
encodeInstructions (encoded, relocations, instructions, definitions)
in encodeFunctions shndx (encoded', relocations', ElfHeaderResult names symbols, definitions') rest'
JumpLabel labelName _ ->
let (encoded', relocations', rest', definitions') =
encodeInstructions (encoded, relocations, rest, definitions)
let (textAccumulator', rest') = encodeInstructions shndx (textAccumulator, instructions)
in encodeFunctions shndx rest' textAccumulator'
JumpLabel labelName directives ->
let (TextAccumulator{..}, rest') =
encodeInstructions shndx (textAccumulator, rest)
newEntry = Elf32_Sym
{ st_value = fromIntegral $ LazyByteString.length encoded
, st_size = fromIntegral $ LazyByteString.length encoded'
{ st_value = fromIntegral
$ LazyByteString.length
$ getField @"encodedAccumulator" textAccumulator
, st_size = fromIntegral $ LazyByteString.length encodedAccumulator
, st_shndx = shndx
, st_other = 0
, st_name = StringTable.size names
, st_info = stInfo STB_GLOBAL STT_FUNC
, st_name = StringTable.size $ getField @"sectionNames" symbolAccumulator
, st_info = stInfo (directivesBinding directives) STT_FUNC
}
result =
( encoded'
, relocations'
, ElfHeaderResult (StringTable.append (Text.encodeUtf8 labelName) names)
$ Vector.snoc symbols newEntry
, definitions'
)
in encodeFunctions shndx result rest'
| otherwise = (encoded, relocations, ElfHeaderResult names symbols, definitions)
encodeInstructions (encoded, relocations, instructions, definitions)
in encodeFunctions shndx rest'
$ TextAccumulator
{ encodedAccumulator = encodedAccumulator
, relocationAccumulator = relocationAccumulator
, symbolAccumulator =
addHeaderToResult (Text.encodeUtf8 labelName) newEntry symbolAccumulator
, definitionAccumulator = definitionAccumulator
}
| otherwise = textAccumulator
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 =
let offset = fromIntegral $ LazyByteString.length encoded
unresolvedRelocation = case instruction of
@ -272,14 +201,134 @@ riscv32Elf code = text
RiscV.BaseInstruction _ _ -> Nothing
chunk = ByteString.Builder.toLazyByteString
$ RiscV.instruction instruction
result =
( encoded <> chunk
, maybe relocations (Vector.snoc relocations) unresolvedRelocation
, rest
, addDefinition unresolvedRelocation definitions
)
in encodeInstructions result
| otherwise = (encoded, relocations, instructions, definitions)
result = TextAccumulator
(encoded <> chunk)
(maybe relocations (Vector.snoc relocations) unresolvedRelocation)
symbolResult
(addDefinition unresolvedRelocation definitions)
in encodeInstructions shndx (result, rest)
| Just (JumpLabel labelName directives , rest) <- Vector.uncons instructions
, 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 _ _)) =
HashSet.insert symbolName
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