Encode labels as untyped local symbols in ELF
This commit is contained in:
parent
57436f664e
commit
6b92e5059c
4
TODO
4
TODO
@ -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
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -1,5 +1,6 @@
|
|||||||
module Language.Elna.RiscV.CodeGenerator
|
module Language.Elna.RiscV.CodeGenerator
|
||||||
( Statement(..)
|
( Directive(..)
|
||||||
|
, Statement(..)
|
||||||
, generateRiscV
|
, generateRiscV
|
||||||
, riscVConfiguration
|
, riscVConfiguration
|
||||||
) where
|
) where
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user