Pass relocation base table

lib/Language/Elna/Object/Elf.hs

@@ -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