Pass relocation base table

1 files changed, 80 insertions, 48 deletions

diff --git a/lib/Language/Elna/PrinterWriter.hs b/lib/Language/Elna/PrinterWriter.hs
index 5575e16..d0c1fe3 100644
--- a/lib/Language/Elna/PrinterWriter.hs
+++ b/lib/Language/Elna/PrinterWriter.hs
@@ -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
-    }