Parse call statements

1 files changed, 30 insertions, 18 deletions

diff --git a/lib/Language/Elna/PrinterWriter.hs b/lib/Language/Elna/PrinterWriter.hs
index 8ab1aed..40b60de 100644
--- a/lib/Language/Elna/PrinterWriter.hs
+++ b/lib/Language/Elna/PrinterWriter.hs
@@ -44,12 +44,14 @@ import qualified Language.Elna.Architecture.RiscV as RiscV
 import qualified Data.Text.Encoding as Text.Encoding
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Trans.State (get)
-import Language.Elna.CodeGenerator (Asm(..))
+import Language.Elna.CodeGenerator (Statement(..))
+import qualified Data.HashSet as HashSet
+import GHC.Records (HasField(..))
 
 data UnresolvedRelocation = UnresolvedRelocation ByteString Elf32_Addr Word8
 data UnresolvedRelocations = UnresolvedRelocations (Vector UnresolvedRelocation) Elf32_Word
 
-riscv32Elf :: Vector Asm -> Handle -> ElfWriter Elf32_Ehdr
+riscv32Elf :: Vector Statement -> Handle -> ElfWriter Elf32_Ehdr
 riscv32Elf code objectHandle = text
     >>= uncurry symrel
     >>= strtab
@@ -180,9 +182,14 @@ riscv32Elf code objectHandle = text
                     , st_name = 0
                     , st_info = 0
                     }
-            (encoded, updatedRelocations, symbols) = 
-                encodeAsm textTabIndex (mempty, Vector.empty, initialHeaders) code
-            symbolResult = encodeEmptyDefinitions symbols
+            (encoded, updatedRelocations, symbols, definitions) = 
+                encodeAsm textTabIndex (mempty, Vector.empty, initialHeaders, HashSet.empty) code
+
+            filterPredicate = not
+                . (`ByteString.isInfixOf` getField @"sectionNames" symbols)
+                . ("\0" <>) . (<> "\0")
+            symbolResult = HashSet.foldl' encodeEmptyDefinitions symbols
+                $ HashSet.filter filterPredicate definitions
             size = fromIntegral $ LazyByteString.length encoded
             newHeader = Elf32_Shdr
                 { sh_type = SHT_PROGBITS
@@ -199,8 +206,8 @@ riscv32Elf code objectHandle = text
         liftIO $ ByteString.hPut objectHandle $ LazyByteString.toStrict encoded
         addSectionHeader ".text" newHeader
         pure (symbolResult, UnresolvedRelocations updatedRelocations $ fromIntegral $ Vector.length sectionHeaders)
-    encodeEmptyDefinitions (ElfHeaderResult names entries) =
-        let printEntry = Elf32_Sym
+    encodeEmptyDefinitions (ElfHeaderResult names entries) definition =
+        let nextEntry = Elf32_Sym
                 { st_value = 0
                 , st_size = 0
                 , st_shndx = 0
@@ -208,18 +215,18 @@ riscv32Elf code objectHandle = text
                 , st_name = fromIntegral (ByteString.length names)
                 , st_info = stInfo STB_GLOBAL STT_FUNC
                 }
-         in ElfHeaderResult (names <> "printi\0")
-            $ Vector.snoc entries printEntry 
-    encodeAsm shndx (encoded, relocations, ElfHeaderResult names symbols) instructions
+         in ElfHeaderResult (names <> definition <> "\0")
+            $ Vector.snoc entries nextEntry
+    encodeAsm shndx (encoded, relocations, ElfHeaderResult names symbols, definitions) 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'
+                    let (encoded', relocations', rest', definitions') =
+                            encodeInstructions (encoded, relocations, instructions, definitions)
+                     in encodeAsm shndx (encoded', relocations', ElfHeaderResult names symbols, definitions') rest'
                 JumpLabel labelName _ ->
-                    let (encoded', relocations', rest') =
-                            encodeInstructions (encoded, relocations, rest)
+                    let (encoded', relocations', rest', definitions') =
+                            encodeInstructions (encoded, relocations, rest, definitions)
                         newEntry = Elf32_Sym
                             { st_value = fromIntegral $ LazyByteString.length encoded
                             , st_size = fromIntegral $ LazyByteString.length encoded'
@@ -232,10 +239,11 @@ riscv32Elf code objectHandle = text
                             ( encoded <> encoded'
                             , relocations <> relocations'
                             , ElfHeaderResult (names <> labelName <> "\0") (Vector.snoc symbols newEntry)
+                            , definitions'
                             )
                      in encodeAsm shndx result rest'
-        | otherwise = (encoded, relocations, ElfHeaderResult names symbols)
-    encodeInstructions (encoded, relocations, instructions)
+        | otherwise = (encoded, relocations, ElfHeaderResult names symbols, definitions)
+    encodeInstructions (encoded, relocations, instructions, definitions)
         | Just (Instruction instruction, rest) <- Vector.uncons instructions =
             let offset = fromIntegral $ LazyByteString.length encoded
                 unresolvedRelocation = case instruction of
@@ -259,6 +267,10 @@ riscv32Elf code objectHandle = text
                     ( encoded <> chunk
                     , maybe relocations (Vector.snoc relocations) unresolvedRelocation
                     , rest
+                    , addDefinition unresolvedRelocation definitions
                     )
              in encodeInstructions result
-        | otherwise = (encoded, relocations, Vector.drop 1 instructions)
+        | otherwise = (encoded, relocations, Vector.drop 1 instructions, definitions)
+    addDefinition (Just (UnresolvedRelocation symbolName _ _)) =
+        HashSet.insert symbolName
+    addDefinition Nothing = id