diff options
| author | Eugen Wissner <belka@caraus.de> | 2024-10-22 01:21:02 +0200 |
|---|---|---|
| committer | Eugen Wissner <belka@caraus.de> | 2024-10-22 01:21:02 +0200 |
| commit | 57436f664e7d138bd915fb30f486e4bb802d74b6 (patch) | |
| tree | 3acdc41c0166cc0d515b37169420e429ad8878df /lib/Language/Elna/Object/Elf.hs | |
| parent | bf5ec1f3e2325e28154b9796532d37ee84753349 (diff) | |
| download | elna-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.hs | 103 |
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 |
