diff options
| -rw-r--r-- | TODO | 8 | ||||
| -rw-r--r-- | lib/Language/Elna/Object/Elf.hs | 112 | ||||
| -rw-r--r-- | lib/Language/Elna/PrinterWriter.hs | 128 | ||||
| -rw-r--r-- | src/Main.hs | 4 |
4 files changed, 128 insertions, 124 deletions
@@ -8,11 +8,3 @@ - Don't ignore relocations where the symbol is not defined in the symbol table. Report an error about an undefined symbol. -- elfObject always uses LSB. It should decide the byte order based on the ELF - header. -- 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. diff --git a/lib/Language/Elna/Object/Elf.hs b/lib/Language/Elna/Object/Elf.hs index 4e08abb..982d638 100644 --- a/lib/Language/Elna/Object/Elf.hs +++ b/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 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 - } diff --git a/src/Main.hs b/src/Main.hs index 872cad9..646d967 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -3,7 +3,7 @@ module Main ) where import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser) -import Language.Elna.PrinterWriter (riscv32Elf, riscv32Header) +import Language.Elna.PrinterWriter (riscv32Elf) import Language.Elna.Object.Elf (elfObject) import Language.Elna.Parser (programP) import Language.Elna.NameAnalysis (nameAnalysis) @@ -28,7 +28,7 @@ main = execParser commandLine >>= withCommandLine let symbolTable = nameAnalysis program _ = typeAnalysis symbolTable program intermediate' = intermediate symbolTable program - in elfObject output riscv32Header + in elfObject output $ riscv32Elf $ generateCode symbolTable intermediate' withParsedInput _ (Left errorBundle) = putStrLn |