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

View File

@ -1,7 +1,6 @@
-- | Writer assembler to an object file. -- | Writer assembler to an object file.
module Language.Elna.PrinterWriter module Language.Elna.PrinterWriter
( riscv32Elf ( riscv32Elf
, riscv32Header
) where ) where
import Data.Word (Word8) import Data.Word (Word8)
@ -16,6 +15,7 @@ import Language.Elna.Object.Elf
, Elf32_Addr , Elf32_Addr
, Elf32_Ehdr(..) , Elf32_Ehdr(..)
, Elf32_Half , Elf32_Half
, Elf32_Word
, Elf32_Sym(..) , Elf32_Sym(..)
, ElfMachine(..) , ElfMachine(..)
, ElfType(..) , ElfType(..)
@ -27,7 +27,9 @@ import Language.Elna.Object.Elf
, ElfSectionType(..) , ElfSectionType(..)
, ElfSymbolBinding(..) , ElfSymbolBinding(..)
, ElfSymbolType(..) , ElfSymbolType(..)
, Elf32_Rel (..) , Elf32_Rel(..)
, ElfWriter(..)
, ElfHeaderResult(..)
, elf32Sym , elf32Sym
, elfHeaderSize , elfHeaderSize
, elfSectionsSize , elfSectionsSize
@ -35,8 +37,6 @@ import Language.Elna.Object.Elf
, rInfo , rInfo
, elf32Rel , elf32Rel
, shfInfoLink , shfInfoLink
, ElfWriter(..)
, ElfHeaderResult(..)
, addSectionHeader , addSectionHeader
) )
import System.IO (Handle) import System.IO (Handle)
@ -46,11 +46,53 @@ import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.State (get) import Control.Monad.Trans.State (get)
data UnresolvedRelocation = UnresolvedRelocation ByteString Elf32_Addr Word8 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 riscv32Elf code objectHandle = text
>>= symstrtab >>= uncurry symrel
>>= strtab
>> shstrtab
>>= riscv32Header
where 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 } takeStringZ stringTable Elf32_Sym{ st_name }
= ByteString.takeWhile (/= 0) = ByteString.takeWhile (/= 0)
$ ByteString.drop (fromIntegral st_name) stringTable $ ByteString.drop (fromIntegral st_name) stringTable
@ -62,59 +104,67 @@ riscv32Elf code objectHandle = text
, r_info = rInfo (fromIntegral entry) type' , r_info = rInfo (fromIntegral entry) type'
} }
| otherwise = Left unresolvedRelocation | otherwise = Left unresolvedRelocation
symstrtab (symbols@(ElfHeaderResult stringTable entries), relocations) = do symtab entries = do
ElfHeaderResult{..} <- ElfWriter get ElfHeaderResult{..} <- ElfWriter get
let encodedSymbols = LazyByteString.toStrict let encodedSymbols = LazyByteString.toStrict
$ ByteString.Builder.toLazyByteString $ ByteString.Builder.toLazyByteString
$ foldMap (elf32Sym LSB) entries $ foldMap (elf32Sym LSB) entries
namesLength = fromIntegral $ ByteString.length sectionNames
symHeader = Elf32_Shdr symHeader = Elf32_Shdr
{ sh_type = SHT_SYMTAB { sh_type = SHT_SYMTAB
, sh_size = fromIntegral $ ByteString.length encodedSymbols , sh_size = fromIntegral $ ByteString.length encodedSymbols
, sh_offset = elfSectionsSize sectionHeaders , sh_offset = elfSectionsSize sectionHeaders
, sh_name = namesLength , sh_name = fromIntegral $ ByteString.length sectionNames
, sh_link = fromIntegral $ Vector.length sectionHeaders + 2 , sh_link = fromIntegral $ Vector.length sectionHeaders + 2
, sh_info = 1 , sh_info = 1
, sh_flags = 0 , sh_flags = 0
, sh_entsize = 16 , sh_entsize = 16
, sh_addralign = 0 , sh_addralign = 4
, sh_addr = 0 , sh_addr = 0
} }
liftIO $ ByteString.hPut objectHandle encodedSymbols liftIO $ ByteString.hPut objectHandle encodedSymbols
let headers1 = Vector.snoc sectionHeaders symHeader addSectionHeader ".symtab" symHeader
let y = resolveRelocation symbols <$> relocations pure $ fromIntegral $ Vector.length sectionHeaders
encodedRelocations = LazyByteString.toStrict 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 $ ByteString.Builder.toLazyByteString
$ Vector.foldMap (either (const mempty) (elf32Rel LSB)) y $ Vector.foldMap (either (const mempty) (elf32Rel LSB))
$ resolveRelocation symbols <$> relocationList
relHeader = Elf32_Shdr relHeader = Elf32_Shdr
{ sh_type = SHT_REL { sh_type = SHT_REL
, sh_size = fromIntegral $ ByteString.length encodedRelocations , sh_size = fromIntegral $ ByteString.length encodedRelocations
, sh_offset = elfSectionsSize headers1 , sh_offset = elfSectionsSize sectionHeaders
, sh_name = namesLength + 8 , sh_name = fromIntegral $ ByteString.length sectionNames
, sh_link = fromIntegral $ Vector.length sectionHeaders , sh_link = sectionHeadersLength
, sh_info = 1 , sh_info = index
, sh_flags = shfInfoLink , sh_flags = shfInfoLink
, sh_entsize = 8 , sh_entsize = 8
, sh_addralign = 0 , sh_addralign = 4
, sh_addr = 0 , sh_addr = 0
} }
liftIO $ ByteString.hPut objectHandle encodedRelocations 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 let strHeader = Elf32_Shdr
{ sh_type = SHT_STRTAB { sh_type = SHT_STRTAB
, sh_size = fromIntegral $ ByteString.length stringTable , sh_size = fromIntegral $ ByteString.length stringTable
, sh_offset = elfSectionsSize headers2 , sh_offset = elfSectionsSize sectionHeaders
, sh_name = namesLength + 18 , sh_name = fromIntegral $ ByteString.length sectionNames
, sh_link = 0 , sh_link = 0
, sh_info = 0 , sh_info = 0
, sh_flags = 0 , sh_flags = 0
, sh_entsize = 0 , sh_entsize = 0
, sh_addralign = 0 , sh_addralign = 1
, sh_addr = 0 , sh_addr = 0
} }
liftIO $ ByteString.hPut objectHandle stringTable liftIO $ ByteString.hPut objectHandle stringTable
addSectionHeader ".symtab" symHeader
addSectionHeader ".rel.text" relHeader
addSectionHeader ".strtab" strHeader addSectionHeader ".strtab" strHeader
text = do text = do
ElfHeaderResult{..} <- ElfWriter get ElfHeaderResult{..} <- ElfWriter get
@ -140,11 +190,11 @@ riscv32Elf code objectHandle = text
, sh_info = 0 , sh_info = 0
, sh_flags = 0b110 , sh_flags = 0b110
, sh_entsize = 0 , sh_entsize = 0
, sh_addralign = 0 , sh_addralign = 4
, sh_addr = 0 , sh_addr = 0
} }
addSectionHeader ".text" newHeader addSectionHeader ".text" newHeader
pure (symbolResult, relocations) pure (symbolResult, UnresolvedRelocations relocations $ fromIntegral $ Vector.length sectionHeaders)
symbolEntry symbolEntry
:: Elf32_Half :: Elf32_Half
-> Vector RiscV.Instruction -> Vector RiscV.Instruction
@ -169,13 +219,13 @@ riscv32Elf code objectHandle = text
let unresolvedRelocation = case instruction of let unresolvedRelocation = case instruction of
RiscV.RelocatableInstruction _ instructionType RiscV.RelocatableInstruction _ instructionType
| RiscV.Higher20 _ symbolName <- instructionType | RiscV.Higher20 _ symbolName <- instructionType
-> Just -> Just -- R_RISCV_HI20
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 26 $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 26
| RiscV.Lower12I _ _ _ symbolName <- instructionType | RiscV.Lower12I _ _ _ symbolName <- instructionType
-> Just -> Just -- R_RISCV_LO12_I
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 27 $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 27
| RiscV.Lower12S symbolName _ _ _ <- instructionType | RiscV.Lower12S symbolName _ _ _ <- instructionType
-> Just -> Just -- R_RISCV_LO12_S
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 28 $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 28
RiscV.Instruction _ _ -> Nothing RiscV.Instruction _ _ -> Nothing
encoded = ByteString.Builder.toLazyByteString encoded = ByteString.Builder.toLazyByteString
@ -185,21 +235,3 @@ riscv32Elf code objectHandle = text
, offset + fromIntegral (LazyByteString.length encoded) , offset + fromIntegral (LazyByteString.length encoded)
, maybe relocations (Vector.snoc relocations) unresolvedRelocation , 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 ) where
import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser) 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.Object.Elf (elfObject)
import Language.Elna.Parser (programP) import Language.Elna.Parser (programP)
import Language.Elna.NameAnalysis (nameAnalysis) import Language.Elna.NameAnalysis (nameAnalysis)
@ -28,7 +28,7 @@ main = execParser commandLine >>= withCommandLine
let symbolTable = nameAnalysis program let symbolTable = nameAnalysis program
_ = typeAnalysis symbolTable program _ = typeAnalysis symbolTable program
intermediate' = intermediate symbolTable program intermediate' = intermediate symbolTable program
in elfObject output riscv32Header in elfObject output
$ riscv32Elf $ riscv32Elf
$ generateCode symbolTable intermediate' $ generateCode symbolTable intermediate'
withParsedInput _ (Left errorBundle) = putStrLn withParsedInput _ (Left errorBundle) = putStrLn