Take function name from the generated asm

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

View File

@ -3,7 +3,7 @@ module Language.Elna.CodeGenerator
, generateCode , generateCode
) where ) where
import Data.Text (Text) import Data.ByteString (ByteString)
import Data.Vector (Vector) import Data.Vector (Vector)
import qualified Data.Vector as Vector import qualified Data.Vector as Vector
import Language.Elna.Intermediate (Quadruple(..)) import Language.Elna.Intermediate (Quadruple(..))
@ -17,7 +17,7 @@ data Directive
data Asm data Asm
= Instruction RiscV.Instruction = Instruction RiscV.Instruction
| JumpLabel Text [Directive] | JumpLabel ByteString [Directive]
deriving Eq deriving Eq
generateCode :: SymbolTable -> Vector Quadruple -> Vector Asm generateCode :: SymbolTable -> Vector Quadruple -> Vector Asm

View File

@ -180,9 +180,11 @@ riscv32Elf code objectHandle = text
, st_name = 0 , st_name = 0
, st_info = 0 , st_info = 0
} }
(symbolResult, size, relocations) <- symbolEntry textTabIndex code (encoded, updatedRelocations, symbols) =
(initialHeaders, 0, mempty) encodeAsm textTabIndex (mempty, Vector.empty, initialHeaders) code
let newHeader = Elf32_Shdr symbolResult = encodeEmptyDefinitions symbols
size = fromIntegral $ LazyByteString.length encoded
newHeader = Elf32_Shdr
{ sh_type = SHT_PROGBITS { sh_type = SHT_PROGBITS
, sh_size = size , sh_size = size
, sh_offset = elfSectionsSize sectionHeaders , sh_offset = elfSectionsSize sectionHeaders
@ -194,57 +196,69 @@ riscv32Elf code objectHandle = text
, sh_addralign = 4 , sh_addralign = 4
, sh_addr = 0 , sh_addr = 0
} }
liftIO $ ByteString.hPut objectHandle $ LazyByteString.toStrict encoded
addSectionHeader ".text" newHeader addSectionHeader ".text" newHeader
pure (symbolResult, UnresolvedRelocations relocations $ fromIntegral $ Vector.length sectionHeaders) pure (symbolResult, UnresolvedRelocations updatedRelocations $ fromIntegral $ Vector.length sectionHeaders)
symbolEntry encodeEmptyDefinitions (ElfHeaderResult names entries) =
:: Elf32_Half let printEntry = Elf32_Sym
-> 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
{ st_value = 0 { st_value = 0
, st_size = 0 , st_size = 0
, st_shndx = 0 , st_shndx = 0
, st_other = 0 , st_other = 0
, st_name = fromIntegral (ByteString.length names) + 5 , st_name = fromIntegral (ByteString.length names)
, st_info = stInfo STB_GLOBAL STT_FUNC , st_info = stInfo STB_GLOBAL STT_FUNC
} }
liftIO $ ByteString.hPut objectHandle $ LazyByteString.toStrict encoded in ElfHeaderResult (names <> "printi\0")
let newResult = ElfHeaderResult (names <> "main\0printi\0") $ Vector.snoc entries printEntry
$ Vector.snoc (Vector.snoc entries newEntry) printEntry encodeAsm shndx (encoded, relocations, ElfHeaderResult names symbols) instructions
pure (newResult, size, updatedRelocations) | Just (instruction, rest) <- Vector.uncons instructions =
encodeInstruction (instructions, offset, relocations) (Instruction instruction) = case instruction of
let unresolvedRelocation = case instruction of Instruction _ ->
RiscV.RelocatableInstruction _ instructionType let (encoded', relocations', rest') =
| RiscV.Higher20 _ symbolName <- instructionType encodeInstructions (encoded, relocations, instructions)
-> Just -- R_RISCV_HI20 in encodeAsm shndx (encoded', relocations', ElfHeaderResult names symbols) rest'
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 26 JumpLabel labelName _ ->
| RiscV.Lower12I _ _ _ symbolName <- instructionType let (encoded', relocations', rest') =
-> Just -- R_RISCV_LO12_I encodeInstructions (encoded, relocations, rest)
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 27 newEntry = Elf32_Sym
| RiscV.Lower12S symbolName _ _ _ <- instructionType { st_value = fromIntegral $ LazyByteString.length encoded
-> Just -- R_RISCV_LO12_S , st_size = fromIntegral $ LazyByteString.length encoded'
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 28 , st_shndx = shndx
RiscV.CallInstruction symbolName , st_other = 0
-> Just -- R_RISCV_CALL_PLT , st_name = fromIntegral $ ByteString.length names
$ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 19 , st_info = stInfo STB_GLOBAL STT_FUNC
RiscV.BaseInstruction _ _ -> Nothing }
encoded = ByteString.Builder.toLazyByteString result =
$ RiscV.instruction instruction ( encoded <> encoded'
in , relocations <> relocations'
( instructions <> encoded , ElfHeaderResult (names <> labelName <> "\0") (Vector.snoc symbols newEntry)
, offset + fromIntegral (LazyByteString.length encoded) )
, maybe relocations (Vector.snoc relocations) unresolvedRelocation in encodeAsm shndx result rest'
) | otherwise = (encoded, relocations, ElfHeaderResult names symbols)
encodeInstruction accumulator (JumpLabel _ _) = accumulator 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)