summaryrefslogtreecommitdiff
path: root/lib/Language/Elna/Object/Elf.hs
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2024-10-22 01:21:02 +0200
committerEugen Wissner <belka@caraus.de>2024-10-22 01:21:02 +0200
commit57436f664e7d138bd915fb30f486e4bb802d74b6 (patch)
tree3acdc41c0166cc0d515b37169420e429ad8878df /lib/Language/Elna/Object/Elf.hs
parentbf5ec1f3e2325e28154b9796532d37ee84753349 (diff)
downloadelna-57436f664e7d138bd915fb30f486e4bb802d74b6.tar.gz
Abstract the string table into a newtype
Diffstat (limited to 'lib/Language/Elna/Object/Elf.hs')
-rw-r--r--lib/Language/Elna/Object/Elf.hs103
1 files changed, 2 insertions, 101 deletions
diff --git a/lib/Language/Elna/Object/Elf.hs b/lib/Language/Elna/Object/Elf.hs
index 982d638..8d56dd6 100644
--- a/lib/Language/Elna/Object/Elf.hs
+++ b/lib/Language/Elna/Object/Elf.hs
@@ -20,9 +20,7 @@ module Language.Elna.Object.Elf
, ElfSectionType(..)
, ElfSymbolBinding(..)
, ElfSymbolType(..)
- , ElfWriter(..)
- , ElfHeaderResult(..)
- , addSectionHeader
+ , byteOrder
, elf32Addr
, elf32Half
, elf32Off
@@ -33,10 +31,7 @@ module Language.Elna.Object.Elf
, elf32Rel
, elf32Rela
, elf32Sym
- , elfHeaderSize
, elfIdentification
- , elfObject
- , elfSectionsSize
, rInfo
, shfWrite
, shfAlloc
@@ -46,19 +41,12 @@ module Language.Elna.Object.Elf
, stInfo
) where
-import Control.Exception (Exception(..), throwIO)
+import Control.Exception (Exception(..))
import Data.Bits (Bits(..))
import qualified Data.ByteString.Builder as ByteString.Builder
import Data.Int (Int32)
import Data.Word (Word8, Word16, Word32)
import qualified Data.ByteString as ByteString
-import Data.Vector (Vector)
-import qualified Data.Vector as Vector
-import System.IO (Handle, IOMode(..), SeekMode(..), hSeek, withFile)
-import Data.Foldable (traverse_)
-import Control.Monad.Trans.State (StateT, runStateT, modify')
-import Control.Monad.IO.Class (MonadIO(..))
-import Data.ByteString (ByteString)
-- * Data types.
@@ -498,90 +486,3 @@ instance Exception ElfEncodingError
fromIntegralEnum :: (Enum a, Num b) => a -> b
fromIntegralEnum = fromIntegral . fromEnum
-
--- * Object file generation.
-
-newtype ElfWriter a = ElfWriter
- { runElfWriter :: StateT (ElfHeaderResult Elf32_Shdr) IO a
- }
-
-data ElfHeaderResult a = ElfHeaderResult
- { sectionNames :: ByteString
- , sectionHeaders :: Vector a
- } deriving Eq
-
-instance Functor ElfWriter
- where
- fmap f (ElfWriter x) = ElfWriter $ f <$> x
-
-instance Applicative ElfWriter
- where
- pure = ElfWriter . pure
- (ElfWriter f) <*> (ElfWriter x) = ElfWriter $ f <*> x
-
-instance Monad ElfWriter
- where
- (ElfWriter x) >>= f = ElfWriter $ x >>= (runElfWriter . f)
-
-instance MonadIO ElfWriter
- where
- liftIO = ElfWriter . liftIO
-
--- | ELF header size.
-elfHeaderSize :: Elf32_Off
-elfHeaderSize = 52
-
--- | Calculates the size of all sections based on the 'sh_size' in the given
--- headers and adds 'elfHeaderSize' to it.
-elfSectionsSize :: Vector Elf32_Shdr -> Elf32_Off
-elfSectionsSize = (elfHeaderSize +)
- . Vector.foldr ((+) . sh_size) 0
-
-addSectionHeader :: ByteString -> Elf32_Shdr -> ElfWriter ()
-addSectionHeader name newHeader = ElfWriter $ modify' modifier
- where
- modifier ElfHeaderResult{..} =
- ElfHeaderResult
- { sectionHeaders = Vector.snoc sectionHeaders newHeader
- , sectionNames = sectionNames <> name <> "\0"
- }
-
--- 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
- >>= uncurry (afterContents objectHandle)
- putContents' objectHandle
- = flip runStateT initialState
- $ runElfWriter
- $ putContents objectHandle
- zeroHeader = Elf32_Shdr
- { sh_type = SHT_NULL
- , sh_size = 0
- , sh_offset = 0
- , sh_name = 0
- , sh_link = 0
- , sh_info = 0
- , sh_flags = 0
- , sh_entsize = 0
- , sh_addralign = 0
- , sh_addr = 0
- }
- initialState = ElfHeaderResult
- { sectionHeaders = Vector.singleton zeroHeader
- , sectionNames = "\0"
- }
- 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