Create empty relocations section

This commit is contained in:
Eugen Wissner 2024-09-08 22:53:07 +02:00
parent 1cbbef19af
commit bb33423c31
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
4 changed files with 172 additions and 55 deletions

14
TODO
View File

@ -3,3 +3,17 @@
- Put symbol table in the reader monad and it to the stack - Put symbol table in the reader monad and it to the stack
or use the state monad for everything. or use the state monad for everything.
- Add errors handling to the monad stack. - Add errors handling to the monad stack.
# ELF generation
- Don't ignore relocations where the symbol is not defined in the symbol table.
Report an error about an undefined symbol.
- Since every function adds a section header use a state monad
in the generator and put the headers into the state to reduce the number of
returned values in the tuples.
- 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

@ -1,5 +1,6 @@
module Language.Elna.Architecture.RiscV module Language.Elna.Architecture.RiscV
( BaseOpcode(..) ( BaseOpcode(..)
, RelocationType(..)
, Funct3(..) , Funct3(..)
, Funct7(..) , Funct7(..)
, Funct12(..) , Funct12(..)
@ -15,6 +16,7 @@ module Language.Elna.Architecture.RiscV
import qualified Data.ByteString.Builder as ByteString.Builder import qualified Data.ByteString.Builder as ByteString.Builder
import Data.Bits (Bits(..)) import Data.Bits (Bits(..))
import Data.Text (Text)
import Data.Word (Word8, Word32) import Data.Word (Word8, Word32)
data XRegister data XRegister
@ -137,8 +139,18 @@ data Type
| U XRegister Word32 | U XRegister Word32
| J XRegister Word32 | J XRegister Word32
| Type XRegister Funct3 XRegister Funct12 -- Privileged. | Type XRegister Funct3 XRegister Funct12 -- Privileged.
deriving Eq
data Instruction = Instruction BaseOpcode Type data RelocationType
= Lower12I XRegister Funct3 XRegister Text
| Lower12S Text Funct3 XRegister XRegister
| Higher20 XRegister Text -- Type U.
deriving Eq
data Instruction
= Instruction BaseOpcode Type
| RelocatableInstruction BaseOpcode RelocationType
deriving Eq
xRegister :: XRegister -> Word8 xRegister :: XRegister -> Word8
xRegister Zero = 0 xRegister Zero = 0
@ -285,8 +297,17 @@ type' (Type rd funct3' rs1 funct12')
.|. (fromIntegral (xRegister rs1) `shiftL` 15) .|. (fromIntegral (xRegister rs1) `shiftL` 15)
.|. (fromIntegral (funct12 funct12') `shiftL` 20); .|. (fromIntegral (funct12 funct12') `shiftL` 20);
relocationType :: RelocationType -> Word32
relocationType (Lower12I rd funct3' rs1 _) = type' $ I rd funct3' rs1 0
relocationType (Lower12S _ funct3' rs1 rs2) = type' $ S 0 funct3' rs1 rs2
relocationType (Higher20 rd _) = type' $ U rd 0
instruction :: Instruction -> ByteString.Builder.Builder instruction :: Instruction -> ByteString.Builder.Builder
instruction (Instruction base instructionType) instruction = \case
(Instruction base instructionType) -> go base $ type' instructionType
(RelocatableInstruction base instructionType) -> go base $ relocationType instructionType
where
go base instructionType
= ByteString.Builder.word32LE = ByteString.Builder.word32LE
$ fromIntegral (baseOpcode base) $ fromIntegral (baseOpcode base)
.|. type' instructionType .|. instructionType

View File

@ -35,6 +35,11 @@ module Language.Elna.Object.Elf
, elfObject , elfObject
, elfSectionsSize , elfSectionsSize
, rInfo , rInfo
, shfWrite
, shfAlloc
, shfExecinstr
, shfMascproc
, shfInfoLink
, stInfo , stInfo
) where ) where
@ -352,6 +357,23 @@ instance Enum ElfSectionType
fromEnum SHT_HIUSER = 0xffffffff fromEnum SHT_HIUSER = 0xffffffff
fromEnum (ElfSectionType x) = fromIntegral x fromEnum (ElfSectionType x) = fromIntegral x
-- * Constants.
shfWrite :: Elf32_Word
shfWrite = 0x1
shfAlloc :: Elf32_Word
shfAlloc = 0x2
shfExecinstr:: Elf32_Word
shfExecinstr = 0x4
shfMascproc :: Elf32_Word
shfMascproc = 0xf0000000
shfInfoLink :: Elf32_Word
shfInfoLink = 0x40
-- * Encoding functions. -- * Encoding functions.
elf32Addr :: ByteOrder -> Elf32_Addr -> ByteString.Builder.Builder elf32Addr :: ByteOrder -> Elf32_Addr -> ByteString.Builder.Builder

View File

@ -4,6 +4,7 @@ module Language.Elna.PrinterWriter
, riscv32Header , riscv32Header
) where ) where
import Data.Word (Word8)
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
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
@ -12,6 +13,7 @@ import Data.Vector (Vector)
import qualified Data.Vector as Vector import qualified Data.Vector as Vector
import Language.Elna.Object.Elf import Language.Elna.Object.Elf
( ByteOrder(..) ( ByteOrder(..)
, Elf32_Addr
, Elf32_Ehdr(..) , Elf32_Ehdr(..)
, Elf32_Half , Elf32_Half
, Elf32_Sym(..) , Elf32_Sym(..)
@ -25,15 +27,21 @@ import Language.Elna.Object.Elf
, ElfSectionType(..) , ElfSectionType(..)
, ElfSymbolBinding(..) , ElfSymbolBinding(..)
, ElfSymbolType(..) , ElfSymbolType(..)
, Elf32_Rel (..)
, elf32Sym , elf32Sym
, elfHeaderSize , elfHeaderSize
, elfSectionsSize , elfSectionsSize
, stInfo , stInfo
, rInfo
, elf32Rel
, shfInfoLink
) )
import System.IO (Handle) import System.IO (Handle)
import qualified Language.Elna.Architecture.RiscV as RiscV import qualified Language.Elna.Architecture.RiscV as RiscV
import qualified Data.Text.Encoding as Text.Encoding
data ElfHeaderResult a = ElfHeaderResult ByteString (Vector a) data ElfHeaderResult a = ElfHeaderResult ByteString (Vector a)
data UnresolvedRelocation = UnresolvedRelocation ByteString Elf32_Addr Word8
riscv32Elf :: Vector RiscV.Instruction -> Handle -> IO (Vector Elf32_Shdr) riscv32Elf :: Vector RiscV.Instruction -> Handle -> IO (Vector Elf32_Shdr)
riscv32Elf code objectHandle = riscv32Elf code objectHandle =
@ -50,6 +58,7 @@ riscv32Elf code objectHandle =
, sh_addr = 0 , sh_addr = 0
} }
in text (ElfHeaderResult "\0" $ Vector.singleton zeroHeader) in text (ElfHeaderResult "\0" $ Vector.singleton zeroHeader)
>>= symstrtab
>>= shstrtab >>= shstrtab
>>= finalize >>= finalize
where where
@ -71,12 +80,59 @@ riscv32Elf code objectHandle =
ByteString.hPut objectHandle stringTable ByteString.hPut objectHandle stringTable
pure $ ElfHeaderResult stringTable pure $ ElfHeaderResult stringTable
$ Vector.snoc headers nextHeader $ Vector.snoc headers nextHeader
strtab stringTable (ElfHeaderResult names headers) = do takeStringZ stringTable Elf32_Sym{ st_name }
let newHeader = Elf32_Shdr = ByteString.takeWhile (/= 0)
$ ByteString.drop (fromIntegral 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
symstrtab (symbols@(ElfHeaderResult stringTable entries), ElfHeaderResult names headers, relocations) = do
let encodedSymbols = LazyByteString.toStrict
$ ByteString.Builder.toLazyByteString
$ foldMap (elf32Sym LSB) entries
namesLength = fromIntegral $ ByteString.length names
symHeader = Elf32_Shdr
{ sh_type = SHT_SYMTAB
, sh_size = fromIntegral $ ByteString.length encodedSymbols
, sh_offset = elfSectionsSize headers
, sh_name = namesLength
, sh_link = fromIntegral $ Vector.length headers + 2
, sh_info = 1
, sh_flags = 0
, sh_entsize = 16
, sh_addralign = 0
, sh_addr = 0
}
ByteString.hPut objectHandle encodedSymbols
let headers1 = Vector.snoc headers symHeader
let y = resolveRelocation symbols <$> relocations
encodedRelocations = LazyByteString.toStrict
$ ByteString.Builder.toLazyByteString
$ Vector.foldMap (either (const mempty) (elf32Rel LSB)) y
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 headers
, sh_info = 1
, sh_flags = shfInfoLink
, sh_entsize = 8
, sh_addralign = 0
, sh_addr = 0
}
ByteString.hPut objectHandle encodedRelocations
let headers2 = Vector.snoc headers1 relHeader
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 headers , sh_offset = elfSectionsSize headers2
, sh_name = fromIntegral $ ByteString.length names , sh_name = namesLength + 18
, sh_link = 0 , sh_link = 0
, sh_info = 0 , sh_info = 0
, sh_flags = 0 , sh_flags = 0
@ -85,32 +141,11 @@ riscv32Elf code objectHandle =
, sh_addr = 0 , sh_addr = 0
} }
ByteString.hPut objectHandle stringTable ByteString.hPut objectHandle stringTable
pure $ ElfHeaderResult (names <> ".strtab\0") pure $ ElfHeaderResult (names <> ".symtab\0.rel.text\0.strtab\0")
$ Vector.snoc headers newHeader $ Vector.snoc headers2 strHeader
symtab strtabIndex entries (ElfHeaderResult names headers) = do
let encoded = LazyByteString.toStrict
$ ByteString.Builder.toLazyByteString
$ foldMap (elf32Sym LSB) entries
newHeader = Elf32_Shdr
{ sh_type = SHT_SYMTAB
, sh_size = fromIntegral $ ByteString.length encoded
, sh_offset = elfSectionsSize headers
, sh_name = fromIntegral $ ByteString.length names
, sh_link = strtabIndex
, sh_info = 1
, sh_flags = 0
, sh_entsize = 16
, sh_addralign = 0
, sh_addr = 0
}
ByteString.hPut objectHandle encoded
pure $ ElfHeaderResult (names <> ".symtab\0")
$ Vector.snoc headers newHeader
text (ElfHeaderResult names headers) = do text (ElfHeaderResult names headers) = do
let textTabIndex = fromIntegral $ Vector.length headers let textTabIndex = fromIntegral $ Vector.length headers
strtabIndex = fromIntegral $ textTabIndex + 2 initialHeaders = ElfHeaderResult "\0"
ElfHeaderResult stringTable entries <- symbolEntry textTabIndex code
$ ElfHeaderResult "\0"
$ Vector.singleton $ Vector.singleton
$ Elf32_Sym $ Elf32_Sym
{ st_value = 0 { st_value = 0
@ -120,9 +155,11 @@ riscv32Elf code objectHandle =
, st_name = 0 , st_name = 0
, st_info = 0 , st_info = 0
} }
(symbolResult, size, relocations) <- symbolEntry textTabIndex code
(initialHeaders, 0, mempty)
let newHeader = Elf32_Shdr let newHeader = Elf32_Shdr
{ sh_type = SHT_PROGBITS { sh_type = SHT_PROGBITS
, sh_size = fromIntegral $ foldr ((+) . st_size) 0 entries , sh_size = size
, sh_offset = elfSectionsSize headers , sh_offset = elfSectionsSize headers
, sh_name = fromIntegral $ ByteString.length names , sh_name = fromIntegral $ ByteString.length names
, sh_link = 0 , sh_link = 0
@ -134,24 +171,47 @@ riscv32Elf code objectHandle =
} }
newResult = ElfHeaderResult (names <> ".text\0") newResult = ElfHeaderResult (names <> ".text\0")
$ Vector.snoc headers newHeader $ Vector.snoc headers newHeader
symtab strtabIndex entries newResult pure (symbolResult, newResult, relocations)
>>= strtab stringTable symbolEntry
symbolEntry :: Elf32_Half -> Vector RiscV.Instruction -> ElfHeaderResult Elf32_Sym -> IO (ElfHeaderResult Elf32_Sym) :: Elf32_Half
symbolEntry shndx instructions (ElfHeaderResult names entries) = do -> Vector RiscV.Instruction
let encoded = LazyByteString.toStrict -> (ElfHeaderResult Elf32_Sym, Elf32_Addr, Vector UnresolvedRelocation)
$ ByteString.Builder.toLazyByteString -> IO (ElfHeaderResult Elf32_Sym, Elf32_Addr, Vector UnresolvedRelocation)
$ foldMap RiscV.instruction instructions symbolEntry shndx instructions (ElfHeaderResult names entries, offset, relocations) = do
let (encoded, size, updatedRelocations) =
Vector.foldl' encodeInstruction (mempty, offset, relocations) instructions
newEntry = Elf32_Sym newEntry = Elf32_Sym
{ st_value = 0 { st_value = offset
, st_size = fromIntegral $ ByteString.length encoded , st_size = fromIntegral size
, st_shndx = shndx , st_shndx = shndx
, st_other = 0 , st_other = 0
, st_name = fromIntegral $ ByteString.length names , st_name = fromIntegral $ ByteString.length names
, st_info = stInfo STB_GLOBAL STT_FUNC , st_info = stInfo STB_GLOBAL STT_FUNC
} }
ByteString.hPut objectHandle encoded ByteString.hPut objectHandle $ LazyByteString.toStrict encoded
pure $ ElfHeaderResult (names <> "_start\0") let newResult = ElfHeaderResult (names <> "_start\0")
$ Vector.snoc entries newEntry $ Vector.snoc entries newEntry
pure (newResult, size, updatedRelocations)
encodeInstruction (instructions, offset, relocations) instruction =
let unresolvedRelocation = case instruction of
RiscV.RelocatableInstruction _ instructionType
| RiscV.Higher20 _ symbolName <- instructionType
-> Just
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 26
| RiscV.Lower12I _ _ _ symbolName <- instructionType
-> Just
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 27
| RiscV.Lower12S symbolName _ _ _ <- instructionType
-> Just
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 28
RiscV.Instruction _ _ -> Nothing
encoded = ByteString.Builder.toLazyByteString
$ RiscV.instruction instruction
in
( instructions <> encoded
, offset + fromIntegral (LazyByteString.length encoded)
, maybe relocations (Vector.snoc relocations) unresolvedRelocation
)
riscv32Header :: Elf32_Ehdr riscv32Header :: Elf32_Ehdr
riscv32Header = Elf32_Ehdr riscv32Header = Elf32_Ehdr