belka/elna
1
0
Fork 0
Code Issues 4 Pull Requests Releases Activity

Take function name from the generated asm

Browse Source
This commit is contained in:
Eugen Wissner 2024-09-22 23:45:59 +02:00
parent daec506ed3
commit e66ccf46f4
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
2 changed files with 66 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lib/Language/Elna/CodeGenerator.hs
View File

@ -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

114
lib/Language/Elna/PrinterWriter.hs
View File

@ -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)