diff --git a/TODO b/TODO index 40d6de1..2063e28 100644 --- a/TODO +++ b/TODO @@ -9,10 +9,7 @@ - Don't ignore relocations where the symbol is not defined in the symbol table. Report an error about an undefined symbol. -- JumpLabels inside functions are encoded as functions. Distinguish between - labels (e.g. .A0 or .L0) and global functions. Lables are NOTYPE LOCAL. -- Sort the symbols so that local symbols come first. Some table header had a - number specifiying the index of the first non-local symbol. Adjust that number. +- Labels should start with a dot, ".L", not just "L0" or "L1". # Name analysis diff --git a/lib/Language/Elna/Object/ElfCoder.hs b/lib/Language/Elna/Object/ElfCoder.hs index c3d58a1..b01045a 100644 --- a/lib/Language/Elna/Object/ElfCoder.hs +++ b/lib/Language/Elna/Object/ElfCoder.hs @@ -3,20 +3,26 @@ module Language.Elna.Object.ElfCoder ( ElfEnvironment(..) , ElfWriter(..) , ElfHeaderResult(..) - , elfHeaderSize + , UnresolvedRelocation(..) + , UnresolvedRelocations(..) + , addHeaderToResult , addSectionHeader + , elfHeaderSize , elfObject , elfSectionsSize , putSectionHeader + , partitionSymbols , module Language.Elna.Object.Elf ) where import Control.Exception (throwIO) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.State (StateT, runStateT, modify', gets) +import Data.Bits (Bits(..)) import Data.ByteString (StrictByteString) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Builder as ByteString.Builder +import Data.Word (Word8) import Data.Vector (Vector) import qualified Data.Vector as Vector import System.IO (Handle, IOMode(..), SeekMode(..), hSeek, withFile) @@ -26,6 +32,10 @@ import Language.Elna.Object.StringTable (StringTable) import qualified Language.Elna.Object.StringTable as StringTable import GHC.Records (HasField(..)) +data UnresolvedRelocation = UnresolvedRelocation StrictByteString Elf32_Addr Word8 +data UnresolvedRelocations = + UnresolvedRelocations (Vector UnresolvedRelocation) (ElfHeaderResult Elf32_Sym) Elf32_Word + data ElfEnvironment = ElfEnvironment { objectHeaders :: ElfHeaderResult Elf32_Shdr , objectHandle :: Handle @@ -57,6 +67,11 @@ instance MonadIO ElfWriter where liftIO = ElfWriter . liftIO +partitionSymbols :: ElfHeaderResult Elf32_Sym -> (Vector Elf32_Sym, Vector Elf32_Sym) +partitionSymbols = Vector.partition go . getField @"sectionHeaders" + where + go Elf32_Sym{ st_info } = (st_info .&. 0xf0) == 0 + -- | ELF header size. elfHeaderSize :: Elf32_Off elfHeaderSize = 52 @@ -67,17 +82,18 @@ elfSectionsSize :: Vector Elf32_Shdr -> Elf32_Off elfSectionsSize = (elfHeaderSize +) . Vector.foldr ((+) . sh_size) 0 +addHeaderToResult :: StrictByteString -> a -> ElfHeaderResult a -> ElfHeaderResult a +addHeaderToResult name newHeader accumulator@ElfHeaderResult{..} = accumulator + { sectionHeaders = Vector.snoc sectionHeaders newHeader + , sectionNames = StringTable.append name sectionNames + } + addSectionHeader :: StrictByteString -> Elf32_Shdr -> ElfWriter () addSectionHeader name newHeader = ElfWriter $ modify' modifier where - modifier elfEnvironment@ElfEnvironment{ objectHeaders } = - let ElfHeaderResult{..} = objectHeaders - in elfEnvironment - { objectHeaders = ElfHeaderResult - { sectionHeaders = Vector.snoc sectionHeaders newHeader - , sectionNames = StringTable.append name sectionNames - } - } + modifier elfEnvironment@ElfEnvironment{ objectHeaders } = elfEnvironment + { objectHeaders = addHeaderToResult name newHeader objectHeaders + } putSectionHeader :: StrictByteString -> Elf32_Shdr -> StrictByteString -> ElfWriter () putSectionHeader name newHeader encoded = do diff --git a/lib/Language/Elna/RiscV/CodeGenerator.hs b/lib/Language/Elna/RiscV/CodeGenerator.hs index c364ae6..6e5a92f 100644 --- a/lib/Language/Elna/RiscV/CodeGenerator.hs +++ b/lib/Language/Elna/RiscV/CodeGenerator.hs @@ -1,5 +1,6 @@ module Language.Elna.RiscV.CodeGenerator - ( Statement(..) + ( Directive(..) + , Statement(..) , generateRiscV , riscVConfiguration ) where diff --git a/lib/Language/Elna/RiscV/ElfWriter.hs b/lib/Language/Elna/RiscV/ElfWriter.hs index d7723d3..d174202 100644 --- a/lib/Language/Elna/RiscV/ElfWriter.hs +++ b/lib/Language/Elna/RiscV/ElfWriter.hs @@ -3,7 +3,6 @@ module Language.Elna.RiscV.ElfWriter ( riscv32Elf ) where -import Data.Word (Word8) import Data.ByteString (StrictByteString) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Builder as ByteString.Builder @@ -12,7 +11,6 @@ import Data.Vector (Vector) import qualified Data.Vector as Vector import Language.Elna.Object.ElfCoder ( ByteOrder(..) - , Elf32_Addr , Elf32_Ehdr(..) , Elf32_Half , Elf32_Word @@ -31,6 +29,10 @@ import Language.Elna.Object.ElfCoder , ElfWriter(..) , ElfHeaderResult(..) , ElfEnvironment(..) + , UnresolvedRelocation(..) + , UnresolvedRelocations(..) + , addHeaderToResult + , addSectionHeader , elf32Sym , elfHeaderSize , elfSectionsSize @@ -38,53 +40,27 @@ import Language.Elna.Object.ElfCoder , rInfo , elf32Rel , shfInfoLink - , addSectionHeader + , partitionSymbols , putSectionHeader ) import qualified Language.Elna.Architecture.RiscV as RiscV import qualified Data.Text.Encoding as Text import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.State (get, gets) -import Language.Elna.RiscV.CodeGenerator (Statement(..)) +import Language.Elna.RiscV.CodeGenerator (Directive(..), Statement(..)) +import Language.Elna.Object.StringTable (StringTable) import qualified Language.Elna.Object.StringTable as StringTable import qualified Data.HashSet as HashSet import GHC.Records (HasField(..)) -data UnresolvedRelocation = UnresolvedRelocation StrictByteString Elf32_Addr Word8 -data UnresolvedRelocations = UnresolvedRelocations (Vector UnresolvedRelocation) Elf32_Word - riscv32Elf :: Vector Statement -> ElfWriter Elf32_Ehdr -riscv32Elf code = text +riscv32Elf code = text code + >>= symtab >>= uncurry symrel >>= strtab >> shstrtab >>= riscv32Header where - shstrtab :: ElfWriter Elf32_Half - shstrtab = do - ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" - let stringTable = ".shstrtab" - currentNamesSize = StringTable.size sectionNames - nextHeader = Elf32_Shdr - { sh_type = SHT_STRTAB - , sh_size = currentNamesSize -- Adding trailing null character. - + fromIntegral (succ $ ByteString.length stringTable) - , sh_offset = elfSectionsSize sectionHeaders - , sh_name = currentNamesSize - , sh_link = 0 - , sh_info = 0 - , sh_flags = 0 - , sh_entsize = 0 - , sh_addralign = 1 - , sh_addr = 0 - } - addSectionHeader stringTable nextHeader - - ElfEnvironment{..} <- ElfWriter get - liftIO $ ByteString.hPut objectHandle - $ StringTable.encode - $ getField @"sectionNames" objectHeaders - pure $ fromIntegral $ Vector.length sectionHeaders riscv32Header :: Elf32_Half -> ElfWriter Elf32_Ehdr riscv32Header shstrndx = do ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" @@ -104,110 +80,45 @@ riscv32Elf code = text , e_entry = 0 , e_ehsize = fromIntegral elfHeaderSize } - takeStringZ stringTable Elf32_Sym{ st_name } - = StringTable.index st_name stringTable - resolveRelocation (ElfHeaderResult stringTable entries) unresolvedRelocation - | UnresolvedRelocation symbolName offset type' <- unresolvedRelocation - , Just entry <- Vector.findIndex ((== symbolName) . takeStringZ stringTable) entries = - Right $ Elf32_Rel - { r_offset = offset - , r_info = rInfo (fromIntegral entry) type' - } - | otherwise = Left unresolvedRelocation - symtab entries = do - ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" - let encodedSymbols = LazyByteString.toStrict - $ ByteString.Builder.toLazyByteString - $ foldMap (elf32Sym LSB) entries - symHeader = Elf32_Shdr - { sh_type = SHT_SYMTAB - , sh_size = fromIntegral $ ByteString.length encodedSymbols - , sh_offset = elfSectionsSize sectionHeaders - , sh_name = StringTable.size sectionNames - , sh_link = fromIntegral $ Vector.length sectionHeaders + 2 - , sh_info = 1 - , sh_flags = 0 - , sh_entsize = 16 - , sh_addralign = 4 - , sh_addr = 0 - } - putSectionHeader ".symtab" symHeader encodedSymbols - pure $ fromIntegral $ Vector.length sectionHeaders - symrel symbols relocations = do - let UnresolvedRelocations relocationList index = relocations - ElfHeaderResult stringTable entries = symbols - sectionHeadersLength <- symtab entries - ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" - - let encodedRelocations = LazyByteString.toStrict - $ ByteString.Builder.toLazyByteString - $ 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 sectionHeaders - , sh_name = StringTable.size sectionNames - , sh_link = sectionHeadersLength - , sh_info = index - , sh_flags = shfInfoLink - , sh_entsize = 8 - , sh_addralign = 4 - , sh_addr = 0 +text :: Vector Statement -> ElfWriter UnresolvedRelocations +text code = do + ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" + let textTabIndex = fromIntegral $ Vector.length sectionHeaders + initialHeaders = ElfHeaderResult mempty + $ Vector.singleton + $ Elf32_Sym + { st_value = 0 + , st_size = 0 + , st_shndx = 0 + , st_other = 0 + , st_name = 0 + , st_info = 0 } - putSectionHeader ".rel.text" relHeader encodedRelocations - pure stringTable - strtab stringTable = do - ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" - let strHeader = Elf32_Shdr - { sh_type = SHT_STRTAB - , sh_size = StringTable.size stringTable - , sh_offset = elfSectionsSize sectionHeaders - , sh_name = StringTable.size sectionNames - , sh_link = 0 - , sh_info = 0 - , sh_flags = 0 - , sh_entsize = 0 - , sh_addralign = 1 - , sh_addr = 0 - } - putSectionHeader ".strtab" strHeader $ StringTable.encode stringTable - text = do - ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" - let textTabIndex = fromIntegral $ Vector.length sectionHeaders - initialHeaders = ElfHeaderResult mempty - $ Vector.singleton - $ Elf32_Sym - { st_value = 0 - , st_size = 0 - , st_shndx = 0 - , st_other = 0 - , st_name = 0 - , st_info = 0 - } - (encoded, updatedRelocations, symbols, definitions) = - encodeFunctions textTabIndex (mempty, Vector.empty, initialHeaders, HashSet.empty) code - size = fromIntegral $ LazyByteString.length encoded - newHeader = Elf32_Shdr - { sh_type = SHT_PROGBITS - , sh_size = size - , sh_offset = elfSectionsSize sectionHeaders - , sh_name = StringTable.size sectionNames - , sh_link = 0 - , sh_info = 0 - , sh_flags = 0b110 - , sh_entsize = 0 - , sh_addralign = 4 - , sh_addr = 0 - } - putSectionHeader ".text" newHeader $ LazyByteString.toStrict encoded - let filterPredicate :: StrictByteString -> Bool - filterPredicate = not - . (`StringTable.elem` getField @"sectionNames" symbols) - symbolResult = HashSet.foldl' encodeEmptyDefinitions symbols - $ HashSet.filter filterPredicate definitions - pure (symbolResult, UnresolvedRelocations updatedRelocations $ fromIntegral $ Vector.length sectionHeaders) + (encoded, updatedRelocations, symbols, definitions) = + encodeFunctions textTabIndex (mempty, Vector.empty, initialHeaders, HashSet.empty) code + size = fromIntegral $ LazyByteString.length encoded + newHeader = Elf32_Shdr + { sh_type = SHT_PROGBITS + , sh_size = size + , sh_offset = elfSectionsSize sectionHeaders + , sh_name = StringTable.size sectionNames + , sh_link = 0 + , sh_info = 0 + , sh_flags = 0b110 + , sh_entsize = 0 + , sh_addralign = 4 + , sh_addr = 0 + } + putSectionHeader ".text" newHeader $ LazyByteString.toStrict encoded + let filterPredicate :: StrictByteString -> Bool + filterPredicate = not + . (`StringTable.elem` getField @"sectionNames" symbols) + symbolResult = HashSet.foldl' encodeEmptyDefinitions symbols + $ HashSet.filter filterPredicate definitions + pure $ UnresolvedRelocations updatedRelocations symbolResult + $ fromIntegral $ Vector.length sectionHeaders + where encodeEmptyDefinitions (ElfHeaderResult names entries) definition = let nextEntry = Elf32_Sym { st_value = 0 @@ -219,34 +130,36 @@ riscv32Elf code = text } in ElfHeaderResult (StringTable.append definition names) $ Vector.snoc entries nextEntry - encodeFunctions shndx (encoded, relocations, ElfHeaderResult names symbols, definitions) instructions + encodeFunctions shndx (encoded, relocations, symbolResult, definitions) instructions | Just (instruction, rest) <- Vector.uncons instructions = case instruction of Instruction _ -> - let (encoded', relocations', rest', definitions') = - encodeInstructions (encoded, relocations, instructions, definitions) - in encodeFunctions shndx (encoded', relocations', ElfHeaderResult names symbols, definitions') rest' - JumpLabel labelName _ -> - let (encoded', relocations', rest', definitions') = - encodeInstructions (encoded, relocations, rest, definitions) + let (encoded', relocations', symbolResult', definitions', rest') = + encodeInstructions shndx (encoded, relocations, symbolResult, definitions, instructions) + in encodeFunctions shndx (encoded', relocations', symbolResult', definitions') rest' + JumpLabel labelName directives -> + let (encoded', relocations', ElfHeaderResult _names _symbols, definitions', rest') = + encodeInstructions shndx (encoded, relocations, symbolResult, definitions, rest) + isGlobal = GlobalDirective `elem` directives newEntry = Elf32_Sym { st_value = fromIntegral $ LazyByteString.length encoded - , st_size = fromIntegral $ LazyByteString.length encoded' + , st_size = if isGlobal then fromIntegral $ LazyByteString.length encoded' else 0 , st_shndx = shndx , st_other = 0 - , st_name = StringTable.size names - , st_info = stInfo STB_GLOBAL STT_FUNC + , st_name = StringTable.size _names + , st_info = stInfo (if isGlobal then STB_GLOBAL else STB_LOCAL) + $ if FunctionDirective `elem` directives then STT_FUNC else STT_NOTYPE } result = ( encoded' , relocations' - , ElfHeaderResult (StringTable.append (Text.encodeUtf8 labelName) names) - $ Vector.snoc symbols newEntry + , ElfHeaderResult (StringTable.append (Text.encodeUtf8 labelName) _names) + $ Vector.snoc _symbols newEntry , definitions' ) in encodeFunctions shndx result rest' - | otherwise = (encoded, relocations, ElfHeaderResult names symbols, definitions) - encodeInstructions (encoded, relocations, instructions, definitions) + | otherwise = (encoded, relocations, symbolResult, definitions) + encodeInstructions shndx (encoded, relocations, ElfHeaderResult names symbols, definitions, instructions) | Just (Instruction instruction, rest) <- Vector.uncons instructions = let offset = fromIntegral $ LazyByteString.length encoded unresolvedRelocation = case instruction of @@ -275,11 +188,136 @@ riscv32Elf code = text result = ( encoded <> chunk , maybe relocations (Vector.snoc relocations) unresolvedRelocation - , rest + , ElfHeaderResult names symbols , addDefinition unresolvedRelocation definitions + , rest ) - in encodeInstructions result - | otherwise = (encoded, relocations, instructions, definitions) + in encodeInstructions shndx result + | Just (JumpLabel labelName directives , rest) <- Vector.uncons instructions + , FunctionDirective `notElem` directives = + let newEntry = Elf32_Sym + { st_value = fromIntegral $ LazyByteString.length encoded + , st_size = 0 + , st_shndx = shndx + , st_other = 0 + , st_name = StringTable.size names + , st_info = stInfo (if GlobalDirective `elem` directives then STB_GLOBAL else STB_LOCAL) STT_NOTYPE + } + result = + ( encoded + , relocations + , ElfHeaderResult (StringTable.append (Text.encodeUtf8 labelName) names) + $ Vector.snoc symbols newEntry + , definitions + , rest + ) + in encodeInstructions shndx result + | otherwise = (encoded, relocations, ElfHeaderResult names symbols, definitions, instructions) addDefinition (Just (UnresolvedRelocation symbolName _ _)) = HashSet.insert symbolName addDefinition Nothing = id + +shstrtab :: ElfWriter Elf32_Half +shstrtab = do + ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" + let stringTable = ".shstrtab" + currentNamesSize = StringTable.size sectionNames + nextHeader = Elf32_Shdr + { sh_type = SHT_STRTAB + , sh_size = currentNamesSize -- Adding trailing null character. + + fromIntegral (succ $ ByteString.length stringTable) + , sh_offset = elfSectionsSize sectionHeaders + , sh_name = currentNamesSize + , sh_link = 0 + , sh_info = 0 + , sh_flags = 0 + , sh_entsize = 0 + , sh_addralign = 1 + , sh_addr = 0 + } + addSectionHeader stringTable nextHeader + + ElfEnvironment{..} <- ElfWriter get + liftIO $ ByteString.hPut objectHandle + $ StringTable.encode + $ getField @"sectionNames" objectHeaders + pure $ fromIntegral $ Vector.length sectionHeaders + +symtab :: UnresolvedRelocations -> ElfWriter (Elf32_Word, UnresolvedRelocations) +symtab (UnresolvedRelocations relocationList symbolResult index) = do + ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" + let (localSymbols, globalSymbols) = partitionSymbols symbolResult + sortedSymbols = localSymbols <> globalSymbols + sortedResult = symbolResult{ sectionHeaders = sortedSymbols } + encodedSymbols = LazyByteString.toStrict + $ ByteString.Builder.toLazyByteString + $ foldMap (elf32Sym LSB) sortedSymbols + symHeader = Elf32_Shdr + { sh_type = SHT_SYMTAB + , sh_size = fromIntegral $ ByteString.length encodedSymbols + , sh_offset = elfSectionsSize sectionHeaders + , sh_name = StringTable.size sectionNames + , sh_link = fromIntegral $ Vector.length sectionHeaders + 2 + , sh_info = fromIntegral $ Vector.length localSymbols + , sh_flags = 0 + , sh_entsize = 16 + , sh_addralign = 4 + , sh_addr = 0 + } + putSectionHeader ".symtab" symHeader encodedSymbols + pure + ( fromIntegral $ Vector.length sectionHeaders + , UnresolvedRelocations relocationList sortedResult index + ) + +symrel :: Elf32_Word -> UnresolvedRelocations -> ElfWriter StringTable +symrel sectionHeadersLength relocations = do + ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" + + let UnresolvedRelocations relocationList symbols index = relocations + encodedRelocations = LazyByteString.toStrict + $ ByteString.Builder.toLazyByteString + $ 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 sectionHeaders + , sh_name = StringTable.size sectionNames + , sh_link = sectionHeadersLength + , sh_info = index + , sh_flags = shfInfoLink + , sh_entsize = 8 + , sh_addralign = 4 + , sh_addr = 0 + } + putSectionHeader ".rel.text" relHeader encodedRelocations + pure $ getField @"sectionNames" symbols + where + takeStringZ stringTable Elf32_Sym{ st_name } + = StringTable.index st_name stringTable + resolveRelocation (ElfHeaderResult stringTable entries) unresolvedRelocation + | UnresolvedRelocation symbolName offset type' <- unresolvedRelocation + , Just entry <- Vector.findIndex ((== symbolName) . takeStringZ stringTable) entries = + Right $ Elf32_Rel + { r_offset = offset + , r_info = rInfo (fromIntegral entry) type' + } + | otherwise = Left unresolvedRelocation + +strtab :: StringTable -> ElfWriter () +strtab stringTable = do + ElfHeaderResult{..} <- ElfWriter $ gets $ getField @"objectHeaders" + let strHeader = Elf32_Shdr + { sh_type = SHT_STRTAB + , sh_size = StringTable.size stringTable + , sh_offset = elfSectionsSize sectionHeaders + , sh_name = StringTable.size sectionNames + , sh_link = 0 + , sh_info = 0 + , sh_flags = 0 + , sh_entsize = 0 + , sh_addralign = 1 + , sh_addr = 0 + } + putSectionHeader ".strtab" strHeader $ StringTable.encode stringTable