diff options
| -rw-r--r-- | lib/Language/Elna/CodeGenerator.hs | 4 | ||||
| -rw-r--r-- | lib/Language/Elna/PrinterWriter.hs | 114 |
2 files changed, 66 insertions, 52 deletions
diff --git a/lib/Language/Elna/CodeGenerator.hs b/lib/Language/Elna/CodeGenerator.hs index 1ddfb21..e61e274 100644 --- a/lib/Language/Elna/CodeGenerator.hs +++ b/lib/Language/Elna/CodeGenerator.hs @@ -3,7 +3,7 @@ module Language.Elna.CodeGenerator , generateCode ) where -import Data.Text (Text) +import Data.ByteString (ByteString) import Data.Vector (Vector) import qualified Data.Vector as Vector import Language.Elna.Intermediate (Quadruple(..)) @@ -17,7 +17,7 @@ data Directive data Asm = Instruction RiscV.Instruction - | JumpLabel Text [Directive] + | JumpLabel ByteString [Directive] deriving Eq generateCode :: SymbolTable -> Vector Quadruple -> Vector Asm diff --git a/lib/Language/Elna/PrinterWriter.hs b/lib/Language/Elna/PrinterWriter.hs index ed5cbf0..8ab1aed 100644 --- a/lib/Language/Elna/PrinterWriter.hs +++ b/lib/Language/Elna/PrinterWriter.hs @@ -180,9 +180,11 @@ riscv32Elf code objectHandle = text , st_name = 0 , st_info = 0 } - (symbolResult, size, relocations) <- symbolEntry textTabIndex code - (initialHeaders, 0, mempty) - let newHeader = Elf32_Shdr + (encoded, updatedRelocations, symbols) = + encodeAsm textTabIndex (mempty, Vector.empty, initialHeaders) code + symbolResult = encodeEmptyDefinitions symbols + size = fromIntegral $ LazyByteString.length encoded + newHeader = Elf32_Shdr { sh_type = SHT_PROGBITS , sh_size = size , sh_offset = elfSectionsSize sectionHeaders @@ -194,57 +196,69 @@ riscv32Elf code objectHandle = text , sh_addralign = 4 , sh_addr = 0 } + liftIO $ ByteString.hPut objectHandle $ LazyByteString.toStrict encoded addSectionHeader ".text" newHeader - pure (symbolResult, UnresolvedRelocations relocations $ fromIntegral $ Vector.length sectionHeaders) - symbolEntry - :: Elf32_Half - -> Vector Asm - -> (ElfHeaderResult Elf32_Sym, Elf32_Addr, Vector UnresolvedRelocation) - -> ElfWriter (ElfHeaderResult Elf32_Sym, Elf32_Addr, Vector UnresolvedRelocation) - symbolEntry shndx instructions (ElfHeaderResult names entries, offset, relocations) = do - let (encoded, size, updatedRelocations) = - Vector.foldl' encodeInstruction (mempty, offset, relocations) instructions - newEntry = Elf32_Sym - { st_value = offset - , st_size = fromIntegral size - , st_shndx = shndx - , st_other = 0 - , st_name = fromIntegral $ ByteString.length names - , st_info = stInfo STB_GLOBAL STT_FUNC - } - printEntry = Elf32_Sym + pure (symbolResult, UnresolvedRelocations updatedRelocations $ fromIntegral $ Vector.length sectionHeaders) + encodeEmptyDefinitions (ElfHeaderResult names entries) = + let printEntry = Elf32_Sym { st_value = 0 , st_size = 0 , st_shndx = 0 , st_other = 0 - , st_name = fromIntegral (ByteString.length names) + 5 + , st_name = fromIntegral (ByteString.length names) , st_info = stInfo STB_GLOBAL STT_FUNC } - liftIO $ ByteString.hPut objectHandle $ LazyByteString.toStrict encoded - let newResult = ElfHeaderResult (names <> "main\0printi\0") - $ Vector.snoc (Vector.snoc entries newEntry) printEntry - pure (newResult, size, updatedRelocations) - encodeInstruction (instructions, offset, relocations) (Instruction instruction) = - let unresolvedRelocation = case instruction of - RiscV.RelocatableInstruction _ instructionType - | RiscV.Higher20 _ symbolName <- instructionType - -> Just -- R_RISCV_HI20 - $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 26 - | RiscV.Lower12I _ _ _ symbolName <- instructionType - -> Just -- R_RISCV_LO12_I - $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 27 - | RiscV.Lower12S symbolName _ _ _ <- instructionType - -> Just -- R_RISCV_LO12_S - $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 28 - RiscV.CallInstruction symbolName - -> Just -- R_RISCV_CALL_PLT - $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 19 - RiscV.BaseInstruction _ _ -> Nothing - encoded = ByteString.Builder.toLazyByteString - $ RiscV.instruction instruction - in - ( instructions <> encoded - , offset + fromIntegral (LazyByteString.length encoded) - , maybe relocations (Vector.snoc relocations) unresolvedRelocation - ) - encodeInstruction accumulator (JumpLabel _ _) = accumulator + in ElfHeaderResult (names <> "printi\0") + $ Vector.snoc entries printEntry + encodeAsm shndx (encoded, relocations, ElfHeaderResult names symbols) instructions + | Just (instruction, rest) <- Vector.uncons instructions = + case instruction of + Instruction _ -> + let (encoded', relocations', rest') = + encodeInstructions (encoded, relocations, instructions) + in encodeAsm shndx (encoded', relocations', ElfHeaderResult names symbols) rest' + JumpLabel labelName _ -> + let (encoded', relocations', rest') = + encodeInstructions (encoded, relocations, rest) + newEntry = Elf32_Sym + { st_value = fromIntegral $ LazyByteString.length encoded + , st_size = fromIntegral $ LazyByteString.length encoded' + , st_shndx = shndx + , st_other = 0 + , st_name = fromIntegral $ ByteString.length names + , st_info = stInfo STB_GLOBAL STT_FUNC + } + result = + ( encoded <> encoded' + , relocations <> relocations' + , ElfHeaderResult (names <> labelName <> "\0") (Vector.snoc symbols newEntry) + ) + in encodeAsm shndx result rest' + | otherwise = (encoded, relocations, ElfHeaderResult names symbols) + encodeInstructions (encoded, relocations, instructions) + | Just (Instruction instruction, rest) <- Vector.uncons instructions = + let offset = fromIntegral $ LazyByteString.length encoded + unresolvedRelocation = case instruction of + RiscV.RelocatableInstruction _ instructionType + | RiscV.Higher20 _ symbolName <- instructionType + -> Just -- R_RISCV_HI20 + $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 26 + | RiscV.Lower12I _ _ _ symbolName <- instructionType + -> Just -- R_RISCV_LO12_I + $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 27 + | RiscV.Lower12S symbolName _ _ _ <- instructionType + -> Just -- R_RISCV_LO12_S + $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 28 + RiscV.CallInstruction symbolName + -> Just -- R_RISCV_CALL_PLT + $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 19 + RiscV.BaseInstruction _ _ -> Nothing + chunk = ByteString.Builder.toLazyByteString + $ RiscV.instruction instruction + result = + ( encoded <> chunk + , maybe relocations (Vector.snoc relocations) unresolvedRelocation + , rest + ) + in encodeInstructions result + | otherwise = (encoded, relocations, Vector.drop 1 instructions) |