belka/elna
1
0
Fork 0
Code Issues 5 Pull Requests Releases Activity

Abstract the string table into a newtype

Browse Source
This commit is contained in:
Eugen Wissner
2024-10-18 23:20:04 +02:00
parent bf5ec1f3e2
commit 6bbb4e36c6
6 changed files with 186 additions and 128 deletions
Download Patch File Download Diff File Expand all files Collapse all files

53
lib/Language/Elna/RiscV/ElfWriter.hs
View File

@ -4,13 +4,13 @@ module Language.Elna.RiscV.ElfWriter
) where
import Data.Word (Word8)
import Data.ByteString (ByteString)
import Data.ByteString (StrictByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as ByteString.Builder
import qualified Data.ByteString.Lazy as LazyByteString
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Language.Elna.Object.Elf
import Language.Elna.Object.ElfCoder
( ByteOrder(..)
, Elf32_Addr
, Elf32_Ehdr(..)
@ -43,12 +43,13 @@ import System.IO (Handle)
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)
import Control.Monad.Trans.State (get, gets)
import Language.Elna.RiscV.CodeGenerator (Statement(..))
import qualified Language.Elna.Object.StringTable as StringTable
import qualified Data.HashSet as HashSet
import GHC.Records (HasField(..))
data UnresolvedRelocation = UnresolvedRelocation ByteString Elf32_Addr Word8
data UnresolvedRelocation = UnresolvedRelocation StrictByteString Elf32_Addr Word8
data UnresolvedRelocations = UnresolvedRelocations (Vector UnresolvedRelocation) Elf32_Word
riscv32Elf :: Vector Statement -> Handle -> ElfWriter Elf32_Ehdr
@ -61,12 +62,14 @@ riscv32Elf code objectHandle = text
shstrtab :: ElfWriter Elf32_Half
shstrtab = do
ElfHeaderResult{..} <- ElfWriter get
let stringTable = sectionNames <> ".shstrtab\0"
let stringTable = ".shstrtab"
currentNamesSize = StringTable.size sectionNames
nextHeader = Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = fromIntegral $ ByteString.length stringTable
, sh_size = currentNamesSize -- Adding trailing null character.
+ fromIntegral (succ $ ByteString.length stringTable)
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = fromIntegral $ ByteString.length sectionNames
, sh_name = currentNamesSize
, sh_link = 0
, sh_info = 0
, sh_flags = 0
@ -74,8 +77,10 @@ riscv32Elf code objectHandle = text
, sh_addralign = 1
, sh_addr = 0
}
liftIO $ ByteString.hPut objectHandle stringTable
addSectionHeader ".shstrtab" nextHeader
addSectionHeader stringTable nextHeader
updatedSectionNames <- ElfWriter $ gets (StringTable.encode . getField @"sectionNames")
liftIO $ ByteString.hPut objectHandle updatedSectionNames
pure $ fromIntegral $ Vector.length sectionHeaders
riscv32Header :: Elf32_Half -> ElfWriter Elf32_Ehdr
riscv32Header shstrndx = do
@ -97,8 +102,7 @@ riscv32Elf code objectHandle = text
, e_ehsize = fromIntegral elfHeaderSize
}
takeStringZ stringTable Elf32_Sym{ st_name }
= ByteString.takeWhile (/= 0)
$ ByteString.drop (fromIntegral st_name) stringTable
= StringTable.index st_name stringTable
resolveRelocation (ElfHeaderResult stringTable entries) unresolvedRelocation
| UnresolvedRelocation symbolName offset type' <- unresolvedRelocation
, Just entry <- Vector.findIndex ((== symbolName) . takeStringZ stringTable) entries =
@ -116,7 +120,7 @@ riscv32Elf code objectHandle = text
{ sh_type = SHT_SYMTAB
, sh_size = fromIntegral $ ByteString.length encodedSymbols
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = fromIntegral $ ByteString.length sectionNames
, sh_name = StringTable.size sectionNames
, sh_link = fromIntegral $ Vector.length sectionHeaders + 2
, sh_info = 1
, sh_flags = 0
@ -142,7 +146,7 @@ riscv32Elf code objectHandle = text
{ sh_type = SHT_REL
, sh_size = fromIntegral $ ByteString.length encodedRelocations
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = fromIntegral $ ByteString.length sectionNames
, sh_name = StringTable.size sectionNames
, sh_link = sectionHeadersLength
, sh_info = index
, sh_flags = shfInfoLink
@ -157,9 +161,9 @@ riscv32Elf code objectHandle = text
ElfHeaderResult{..} <- ElfWriter get
let strHeader = Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = fromIntegral $ ByteString.length stringTable
, sh_size = StringTable.size stringTable
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = fromIntegral $ ByteString.length sectionNames
, sh_name = StringTable.size sectionNames
, sh_link = 0
, sh_info = 0
, sh_flags = 0
@ -167,12 +171,12 @@ riscv32Elf code objectHandle = text
, sh_addralign = 1
, sh_addr = 0
}
liftIO $ ByteString.hPut objectHandle stringTable
liftIO $ ByteString.hPut objectHandle $ StringTable.encode stringTable
addSectionHeader ".strtab" strHeader
text = do
ElfHeaderResult{..} <- ElfWriter get
let textTabIndex = fromIntegral $ Vector.length sectionHeaders
initialHeaders = ElfHeaderResult "\0"
initialHeaders = ElfHeaderResult mempty
$ Vector.singleton
$ Elf32_Sym
{ st_value = 0
@ -185,9 +189,9 @@ riscv32Elf code objectHandle = text
(encoded, updatedRelocations, symbols, definitions) =
encodeAsm textTabIndex (mempty, Vector.empty, initialHeaders, HashSet.empty) code
filterPredicate :: StrictByteString -> Bool
filterPredicate = not
. (`ByteString.isInfixOf` getField @"sectionNames" symbols)
. ("\0" <>) . (<> "\0")
. (`StringTable.elem` getField @"sectionNames" symbols)
symbolResult = HashSet.foldl' encodeEmptyDefinitions symbols
$ HashSet.filter filterPredicate definitions
size = fromIntegral $ LazyByteString.length encoded
@ -195,7 +199,7 @@ riscv32Elf code objectHandle = text
{ sh_type = SHT_PROGBITS
, sh_size = size
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = fromIntegral $ ByteString.length sectionNames
, sh_name = StringTable.size sectionNames
, sh_link = 0
, sh_info = 0
, sh_flags = 0b110
@ -212,10 +216,10 @@ riscv32Elf code objectHandle = text
, st_size = 0
, st_shndx = 0
, st_other = 0
, st_name = fromIntegral (ByteString.length names)
, st_name = StringTable.size names
, st_info = stInfo STB_GLOBAL STT_FUNC
}
in ElfHeaderResult (names <> definition <> "\0")
in ElfHeaderResult (StringTable.append definition names)
$ Vector.snoc entries nextEntry
encodeAsm shndx (encoded, relocations, ElfHeaderResult names symbols, definitions) instructions
| Just (instruction, rest) <- Vector.uncons instructions =
@ -232,13 +236,14 @@ riscv32Elf code objectHandle = text
, st_size = fromIntegral $ LazyByteString.length encoded'
, st_shndx = shndx
, st_other = 0
, st_name = fromIntegral $ ByteString.length names
, st_name = StringTable.size names
, st_info = stInfo STB_GLOBAL STT_FUNC
}
result =
( encoded'
, relocations'
, ElfHeaderResult (names <> Text.encodeUtf8 labelName <> "\0") (Vector.snoc symbols newEntry)
, ElfHeaderResult (StringTable.append (Text.encodeUtf8 labelName) names)
$ Vector.snoc symbols newEntry
, definitions'
)
in encodeAsm shndx result rest'