Pass relocation base table

This commit is contained in:
Eugen Wissner 2024-09-12 02:21:48 +02:00
parent 8a0751dfb0
commit d29012d30e
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
4 changed files with 128 additions and 124 deletions

8
TODO
View File

@ -8,11 +8,3 @@
- Don't ignore relocations where the symbol is not defined in the symbol table.
Report an error about an undefined symbol.
- elfObject always uses LSB. It should decide the byte order based on the ELF
header.
- Relocation section header relates to another section (e.g. .rel.text). The
index of that section should be passed together with collected relocations.
- symstrtab creates 3 section headers and does some math to calculate the
offsets and names. Introducing the state monad can help to get rid of magic
numbers.
- The final reutrn value of the state monad should be the Elf header.

View File

@ -92,7 +92,7 @@ instance Enum ElfClass
-- | Data encoding.
data ElfData
= ELFDATANONE
= ELFDATANONE
| ELFDATA2LSB
| ELFDATA2MSB
deriving Eq
@ -238,7 +238,7 @@ data Elf32_Sym = Elf32_Sym
, st_size :: Elf32_Word
, st_info :: Word8
, st_other :: Word8
, st_shndx :: Elf32_Half
, st_shndx :: Elf32_Half
} deriving Eq
data ElfSymbolBinding
@ -412,7 +412,7 @@ elfIdentification (ElfIdentification elfClass elfData)
<> ByteString.Builder.byteString (ByteString.replicate 9 0)
elf32Ehdr :: Elf32_Ehdr -> Either ElfEncodingError ByteString.Builder.Builder
elf32Ehdr Elf32_Ehdr{..} = encode <$> byteOrder
elf32Ehdr Elf32_Ehdr{..} = encode <$> byteOrder e_ident
where
encode byteOrder'
= elfIdentification e_ident
@ -429,45 +429,46 @@ elf32Ehdr Elf32_Ehdr{..} = encode <$> byteOrder
<> elf32Half byteOrder' e_shentsize
<> elf32Half byteOrder' e_shnum
<> elf32Half byteOrder' e_shstrndx
byteOrder
| ElfIdentification class' _ <- e_ident
, class' /= ELFCLASS32 = Left $ ElfUnsupportedClassError class'
| ElfIdentification _ ELFDATA2MSB <- e_ident = Right MSB
| ElfIdentification _ ELFDATA2LSB <- e_ident = Right LSB
| ElfIdentification _ ELFDATANONE <- e_ident = Left ElfInvalidByteOrderError
byteOrder :: ElfIdentification -> Either ElfEncodingError ByteOrder
byteOrder (ElfIdentification class' _)
| class' /= ELFCLASS32 = Left $ ElfUnsupportedClassError class'
byteOrder (ElfIdentification _ ELFDATA2MSB) = Right MSB
byteOrder (ElfIdentification _ ELFDATA2LSB) = Right LSB
byteOrder (ElfIdentification _ ELFDATANONE) = Left ElfInvalidByteOrderError
elf32Shdr :: ByteOrder -> Elf32_Shdr -> ByteString.Builder.Builder
elf32Shdr byteOrder Elf32_Shdr{..}
= elf32Word byteOrder sh_name
<> elf32Word byteOrder (fromIntegralEnum sh_type)
<> elf32Word byteOrder sh_flags
<> elf32Addr byteOrder sh_addr
<> elf32Off byteOrder sh_offset
<> elf32Word byteOrder sh_size
<> elf32Word byteOrder sh_link
<> elf32Word byteOrder sh_info
<> elf32Word byteOrder sh_addralign
<> elf32Word byteOrder sh_entsize
elf32Shdr byteOrder' Elf32_Shdr{..}
= elf32Word byteOrder' sh_name
<> elf32Word byteOrder' (fromIntegralEnum sh_type)
<> elf32Word byteOrder' sh_flags
<> elf32Addr byteOrder' sh_addr
<> elf32Off byteOrder' sh_offset
<> elf32Word byteOrder' sh_size
<> elf32Word byteOrder' sh_link
<> elf32Word byteOrder' sh_info
<> elf32Word byteOrder' sh_addralign
<> elf32Word byteOrder' sh_entsize
elf32Sym :: ByteOrder -> Elf32_Sym -> ByteString.Builder.Builder
elf32Sym byteOrder Elf32_Sym{..}
= elf32Word byteOrder st_name
<> elf32Addr byteOrder st_value
<> elf32Word byteOrder st_size
elf32Sym byteOrder' Elf32_Sym{..}
= elf32Word byteOrder' st_name
<> elf32Addr byteOrder' st_value
<> elf32Word byteOrder' st_size
<> ByteString.Builder.word8 st_info
<> ByteString.Builder.word8 st_other
<> elf32Half byteOrder st_shndx
<> elf32Half byteOrder' st_shndx
elf32Rel :: ByteOrder -> Elf32_Rel -> ByteString.Builder.Builder
elf32Rel byteOrder Elf32_Rel{..}
= elf32Addr byteOrder r_offset
<> elf32Word byteOrder r_info
elf32Rel byteOrder' Elf32_Rel{..}
= elf32Addr byteOrder' r_offset
<> elf32Word byteOrder' r_info
elf32Rela :: ByteOrder -> Elf32_Rela -> ByteString.Builder.Builder
elf32Rela byteOrder Elf32_Rela{..}
= elf32Addr byteOrder r_offset
<> elf32Word byteOrder r_info
<> elf32Sword byteOrder r_addend
elf32Rela byteOrder' Elf32_Rela{..}
= elf32Addr byteOrder' r_offset
<> elf32Word byteOrder' r_info
<> elf32Sword byteOrder' r_addend
stInfo :: ElfSymbolBinding -> ElfSymbolType -> Word8
stInfo binding type' = fromIntegralEnum binding `shiftL` 4
@ -545,21 +546,17 @@ addSectionHeader name newHeader = ElfWriter $ modify' modifier
, sectionNames = sectionNames <> name <> "\0"
}
-- Writes an ELF object with the given header to the provided file path.
-- The callback writes the sections and returns headers for those sections.
--
-- It updates some of the header header according to the given headers and
-- expects .shstrtab be the last header in the list.
elfObject :: FilePath -> Elf32_Ehdr -> (Handle -> ElfWriter ()) -> IO ()
elfObject outFile header putContents = withFile outFile WriteMode withObjectFile
-- Writes an ELF object to the provided file path. The callback writes the
-- sections, collects headers for those sections and returns the ELF header.
elfObject :: FilePath -> (Handle -> ElfWriter Elf32_Ehdr) -> IO ()
elfObject outFile putContents = withFile outFile WriteMode withObjectFile
where
withObjectFile objectHandle
= hSeek objectHandle AbsoluteSeek (fromIntegral elfHeaderSize)
>> putContents' objectHandle
>>= afterContents objectHandle
>>= uncurry (afterContents objectHandle)
putContents' objectHandle
= fmap snd
$ flip runStateT initialState
= flip runStateT initialState
$ runElfWriter
$ putContents objectHandle
zeroHeader = Elf32_Shdr
@ -578,30 +575,13 @@ elfObject outFile header putContents = withFile outFile WriteMode withObjectFile
{ sectionHeaders = Vector.singleton zeroHeader
, sectionNames = "\0"
}
afterContents objectHandle ElfHeaderResult{..} =
let stringTable = sectionNames <> ".shstrtab\0"
nextHeader = Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = fromIntegral $ ByteString.length stringTable
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = fromIntegral $ ByteString.length sectionNames
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 0
, sh_addr = 0
}
headers = Vector.snoc sectionHeaders nextHeader
headerEncodingResult = elf32Ehdr
$ header
{ e_shoff = elfSectionsSize headers
, e_shnum = fromIntegral $ Vector.length headers
, e_shstrndx = fromIntegral (Vector.length headers) - 1
}
in ByteString.hPut objectHandle stringTable
>> traverse_ (ByteString.Builder.hPutBuilder objectHandle . elf32Shdr LSB) headers
>> either throwIO (putHeaders objectHandle) headerEncodingResult
afterContents objectHandle header ElfHeaderResult{..} =
let hPutBuilder = ByteString.Builder.hPutBuilder objectHandle
writeSectionHeaders byteOrder' =
traverse_ (hPutBuilder . elf32Shdr byteOrder') sectionHeaders
in either throwIO pure (byteOrder (e_ident header))
>>= writeSectionHeaders
>> either throwIO (putHeaders objectHandle) (elf32Ehdr header)
putHeaders objectHandle encodedHeader
= hSeek objectHandle AbsoluteSeek 0
>> ByteString.Builder.hPutBuilder objectHandle encodedHeader

View File

@ -1,7 +1,6 @@
-- | Writer assembler to an object file.
module Language.Elna.PrinterWriter
( riscv32Elf
, riscv32Header
) where
import Data.Word (Word8)
@ -16,6 +15,7 @@ import Language.Elna.Object.Elf
, Elf32_Addr
, Elf32_Ehdr(..)
, Elf32_Half
, Elf32_Word
, Elf32_Sym(..)
, ElfMachine(..)
, ElfType(..)
@ -27,7 +27,9 @@ import Language.Elna.Object.Elf
, ElfSectionType(..)
, ElfSymbolBinding(..)
, ElfSymbolType(..)
, Elf32_Rel (..)
, Elf32_Rel(..)
, ElfWriter(..)
, ElfHeaderResult(..)
, elf32Sym
, elfHeaderSize
, elfSectionsSize
@ -35,8 +37,6 @@ import Language.Elna.Object.Elf
, rInfo
, elf32Rel
, shfInfoLink
, ElfWriter(..)
, ElfHeaderResult(..)
, addSectionHeader
)
import System.IO (Handle)
@ -46,11 +46,53 @@ import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.State (get)
data UnresolvedRelocation = UnresolvedRelocation ByteString Elf32_Addr Word8
data UnresolvedRelocations = UnresolvedRelocations (Vector UnresolvedRelocation) Elf32_Word
riscv32Elf :: Vector RiscV.Instruction -> Handle -> ElfWriter ()
riscv32Elf :: Vector RiscV.Instruction -> Handle -> ElfWriter Elf32_Ehdr
riscv32Elf code objectHandle = text
>>= symstrtab
>>= uncurry symrel
>>= strtab
>> shstrtab
>>= riscv32Header
where
shstrtab :: ElfWriter Elf32_Half
shstrtab = do
ElfHeaderResult{..} <- ElfWriter get
let stringTable = sectionNames <> ".shstrtab\0"
nextHeader = Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = fromIntegral $ ByteString.length stringTable
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = fromIntegral $ ByteString.length sectionNames
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 1
, sh_addr = 0
}
liftIO $ ByteString.hPut objectHandle stringTable
addSectionHeader ".shstrtab" nextHeader
pure $ fromIntegral $ Vector.length sectionHeaders
riscv32Header :: Elf32_Half -> ElfWriter Elf32_Ehdr
riscv32Header shstrndx = do
ElfHeaderResult{..} <- ElfWriter get
pure $ Elf32_Ehdr
{ e_version = EV_CURRENT
, e_type = ET_REL
, e_shstrndx = shstrndx
, e_shoff = elfSectionsSize sectionHeaders
, e_shnum = fromIntegral (Vector.length sectionHeaders)
, e_shentsize = 40
, e_phoff = 0
, e_phnum = 0
, e_phentsize = 32
, e_machine = EM_RISCV
, e_ident = ElfIdentification ELFCLASS32 ELFDATA2LSB
, e_flags = 0x4 -- EF_RISCV_FLOAT_ABI_DOUBLE
, e_entry = 0
, e_ehsize = fromIntegral elfHeaderSize
}
takeStringZ stringTable Elf32_Sym{ st_name }
= ByteString.takeWhile (/= 0)
$ ByteString.drop (fromIntegral st_name) stringTable
@ -62,59 +104,67 @@ riscv32Elf code objectHandle = text
, r_info = rInfo (fromIntegral entry) type'
}
| otherwise = Left unresolvedRelocation
symstrtab (symbols@(ElfHeaderResult stringTable entries), relocations) = do
symtab entries = do
ElfHeaderResult{..} <- ElfWriter get
let encodedSymbols = LazyByteString.toStrict
$ ByteString.Builder.toLazyByteString
$ foldMap (elf32Sym LSB) entries
namesLength = fromIntegral $ ByteString.length sectionNames
symHeader = Elf32_Shdr
{ sh_type = SHT_SYMTAB
, sh_size = fromIntegral $ ByteString.length encodedSymbols
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = namesLength
, sh_name = fromIntegral $ ByteString.length sectionNames
, sh_link = fromIntegral $ Vector.length sectionHeaders + 2
, sh_info = 1
, sh_flags = 0
, sh_entsize = 16
, sh_addralign = 0
, sh_addralign = 4
, sh_addr = 0
}
liftIO $ ByteString.hPut objectHandle encodedSymbols
let headers1 = Vector.snoc sectionHeaders symHeader
let y = resolveRelocation symbols <$> relocations
encodedRelocations = LazyByteString.toStrict
addSectionHeader ".symtab" symHeader
pure $ fromIntegral $ Vector.length sectionHeaders
symrel symbols relocations = do
let UnresolvedRelocations relocationList index = relocations
ElfHeaderResult stringTable entries = symbols
sectionHeadersLength <- symtab entries
ElfHeaderResult{..} <- ElfWriter get
let encodedRelocations = LazyByteString.toStrict
$ ByteString.Builder.toLazyByteString
$ Vector.foldMap (either (const mempty) (elf32Rel LSB)) y
$ 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 headers1
, sh_name = namesLength + 8
, sh_link = fromIntegral $ Vector.length sectionHeaders
, sh_info = 1
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = fromIntegral $ ByteString.length sectionNames
, sh_link = sectionHeadersLength
, sh_info = index
, sh_flags = shfInfoLink
, sh_entsize = 8
, sh_addralign = 0
, sh_addralign = 4
, sh_addr = 0
}
liftIO $ ByteString.hPut objectHandle encodedRelocations
let headers2 = Vector.snoc headers1 relHeader
addSectionHeader ".rel.text" relHeader
pure stringTable
strtab stringTable = do
ElfHeaderResult{..} <- ElfWriter get
let strHeader = Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = fromIntegral $ ByteString.length stringTable
, sh_offset = elfSectionsSize headers2
, sh_name = namesLength + 18
, sh_offset = elfSectionsSize sectionHeaders
, sh_name = fromIntegral $ ByteString.length sectionNames
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 0
, sh_addralign = 1
, sh_addr = 0
}
liftIO $ ByteString.hPut objectHandle stringTable
addSectionHeader ".symtab" symHeader
addSectionHeader ".rel.text" relHeader
addSectionHeader ".strtab" strHeader
text = do
ElfHeaderResult{..} <- ElfWriter get
@ -140,11 +190,11 @@ riscv32Elf code objectHandle = text
, sh_info = 0
, sh_flags = 0b110
, sh_entsize = 0
, sh_addralign = 0
, sh_addralign = 4
, sh_addr = 0
}
addSectionHeader ".text" newHeader
pure (symbolResult, relocations)
pure (symbolResult, UnresolvedRelocations relocations $ fromIntegral $ Vector.length sectionHeaders)
symbolEntry
:: Elf32_Half
-> Vector RiscV.Instruction
@ -169,13 +219,13 @@ riscv32Elf code objectHandle = text
let unresolvedRelocation = case instruction of
RiscV.RelocatableInstruction _ instructionType
| RiscV.Higher20 _ symbolName <- instructionType
-> Just
-> Just -- R_RISCV_HI20
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 26
| RiscV.Lower12I _ _ _ symbolName <- instructionType
-> Just
-> Just -- R_RISCV_LO12_I
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 27
| RiscV.Lower12S symbolName _ _ _ <- instructionType
-> Just
-> Just -- R_RISCV_LO12_S
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 28
RiscV.Instruction _ _ -> Nothing
encoded = ByteString.Builder.toLazyByteString
@ -185,21 +235,3 @@ riscv32Elf code objectHandle = text
, offset + fromIntegral (LazyByteString.length encoded)
, maybe relocations (Vector.snoc relocations) unresolvedRelocation
)
riscv32Header :: Elf32_Ehdr
riscv32Header = Elf32_Ehdr
{ e_version = EV_CURRENT
, e_type = ET_REL
, e_shstrndx = 2 -- String table. SHN_UNDEF
, e_shoff = 0
, e_shnum = 0
, e_shentsize = 40
, e_phoff = 0
, e_phnum = 0
, e_phentsize = 32
, e_machine = EM_RISCV
, e_ident = ElfIdentification ELFCLASS32 ELFDATA2LSB
, e_flags = 0x4 -- EF_RISCV_FLOAT_ABI_DOUBLE
, e_entry = 0
, e_ehsize = fromIntegral elfHeaderSize
}

View File

@ -3,7 +3,7 @@ module Main
) where
import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser)
import Language.Elna.PrinterWriter (riscv32Elf, riscv32Header)
import Language.Elna.PrinterWriter (riscv32Elf)
import Language.Elna.Object.Elf (elfObject)
import Language.Elna.Parser (programP)
import Language.Elna.NameAnalysis (nameAnalysis)
@ -28,7 +28,7 @@ main = execParser commandLine >>= withCommandLine
let symbolTable = nameAnalysis program
_ = typeAnalysis symbolTable program
intermediate' = intermediate symbolTable program
in elfObject output riscv32Header
in elfObject output
$ riscv32Elf
$ generateCode symbolTable intermediate'
withParsedInput _ (Left errorBundle) = putStrLn