Take function name from the generated asm
This commit is contained in:
parent
daec506ed3
commit
e66ccf46f4
@ -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
|
||||||
|
@ -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)
|
||||||
|
Loading…
Reference in New Issue
Block a user