Add call pseudo instruction

TODO

@@ -8,3 +8,4 @@
 
 - Don't ignore relocations where the symbol is not defined in the symbol table.
   Report an error about an undefined symbol.
+- Don't hardcode symbols in symbolEntry.

lib/Language/Elna/AST.hs

@@ -1,25 +1,56 @@
 module Language.Elna.AST
-    ( Program(..)
+    ( Declaration(..)
+    , Identifier(..)
+    , Parameter(..)
+    , Program(..)
+    , Statement(..)
+    , TypeExpression(..)
+    , VariableDeclaration(..)
     {-, VariableAccess(..)
     , Condition(..)
-    , Declaration(..)
     , Expression(..)
-    , Identifier(..)
+    , Literal(..)-}
-    , Literal(..)
-    , Parameter(..)
-    , Statement(..)
-    , VariableDeclaration(..)
-    , TypeExpression(..)-}
     ) where
 
-data Program = Program
-{-
-import Data.Int (Int32)
 import Data.List (intercalate)
-import Data.Word (Word16, Word32)
+import Data.Word ({-Word16, -}Word32)
-import Data.Char (chr)
 import Language.Elna.Location (Identifier(..), showArrayType)
-import Numeric (showHex)
+
+newtype Program = Program [Declaration]
+    deriving Eq
+
+instance Show Program
+  where
+    show (Program declarations) = unlines (show <$> declarations)
+
+data Declaration
+    = ProcedureDeclaration Identifier [Parameter] [VariableDeclaration] [Statement]
+    -- | TypeDefinition Identifier TypeExpression
+    deriving Eq
+
+instance Show Declaration
+  where
+    {- show (TypeDefinition identifier typeExpression) =
+        concat ["type ", show identifier, " = ", show typeExpression, ";"] -}
+    show (ProcedureDeclaration procedureName parameters variables body)
+        = "proc " <> show procedureName <> showParameters parameters <> " {\n"
+        <> unlines (("  " <>) . show <$> variables)
+        <> unlines (("  " <>) . show <$> body)
+        <> "}"
+
+data Parameter = Parameter Identifier TypeExpression Bool
+    deriving Eq
+
+instance Show Parameter
+  where
+    show (Parameter identifier typeName ref) = concat
+        [ if ref then "ref " else ""
+        , show identifier, ": ", show typeName
+        ]
+
+showParameters :: [Parameter] -> String
+showParameters parameters =
+    "(" <> intercalate ", " (show <$> parameters) <> ")"
 
 data TypeExpression
     = NamedType Identifier
@@ -31,6 +62,45 @@ instance Show TypeExpression
     show (NamedType typeName) = show typeName
     show (ArrayType elementCount typeName) = showArrayType elementCount typeName
 
+data Statement
+    = EmptyStatement
+    {-| AssignmentStatement VariableAccess Expression
+    | IfStatement Condition Statement (Maybe Statement)
+    | WhileStatement Condition Statement
+    | CompoundStatement [Statement]
+    | CallStatement Identifier [Expression]-}
+    deriving Eq
+
+instance Show Statement
+  where
+    show EmptyStatement = ";"
+    {-show (AssignmentStatement lhs rhs) =
+        concat [show lhs, " := ", show rhs, ";"]
+    show (IfStatement condition if' else') = concat
+        [ "if (", show condition, ") "
+        , show if'
+        , maybe "" ((<> " else ") . show) else'
+        ]
+    show (WhileStatement expression statement) =
+        concat ["while (", show expression, ") ", show statement, ";"]
+    show (CompoundStatement statements) =
+        concat ["{\n", unlines (show <$> statements), " }"]
+    show (CallStatement name parameters) = show name <> "("
+        <> intercalate ", " (show <$> parameters) <> ")"-}
+
+data VariableDeclaration =
+    VariableDeclaration Identifier TypeExpression
+    deriving Eq
+
+instance Show VariableDeclaration
+  where
+    show (VariableDeclaration identifier typeExpression) =
+        concat ["var ", show identifier, ": " <> show typeExpression, ";"]
+{-
+import Data.Int (Int32)
+import Data.Char (chr)
+import Numeric (showHex)
+
 data Literal
     = IntegerLiteral Int32
     | HexadecimalLiteral Int32
@@ -96,75 +166,4 @@ instance Show Condition
     show (GreaterCondition lhs rhs) = concat [show lhs, " > ", show rhs]
     show (LessOrEqualCondition lhs rhs) = concat [show lhs, " <= ", show rhs]
     show (GreaterOrEqualCondition lhs rhs) = concat [show lhs, " >= ", show rhs]
-
-data Statement
-    = EmptyStatement
-    | AssignmentStatement VariableAccess Expression
-    | IfStatement Condition Statement (Maybe Statement)
-    | WhileStatement Condition Statement
-    | CompoundStatement [Statement]
-    | CallStatement Identifier [Expression]
-    deriving Eq
-
-instance Show Statement
-  where
-    show EmptyStatement = ";"
-    show (AssignmentStatement lhs rhs) =
-        concat [show lhs, " := ", show rhs, ";"]
-    show (IfStatement condition if' else') = concat
-        [ "if (", show condition, ") "
-        , show if'
-        , maybe "" ((<> " else ") . show) else'
-        ]
-    show (WhileStatement expression statement) =
-        concat ["while (", show expression, ") ", show statement, ";"]
-    show (CompoundStatement statements) =
-        concat ["{\n", unlines (show <$> statements), " }"]
-    show (CallStatement name parameters) = show name <> "("
-        <> intercalate ", " (show <$> parameters) <> ")"
-
-data Parameter = Parameter Identifier TypeExpression Bool
-    deriving Eq
-
-instance Show Parameter
-  where
-    show (Parameter identifier typeName ref) = concat
-        [ if ref then "ref " else ""
-        , show identifier, ": ", show typeName
-        ]
-
-data VariableDeclaration =
-    VariableDeclaration Identifier TypeExpression
-    deriving Eq
-
-instance Show VariableDeclaration
-  where
-    show (VariableDeclaration identifier typeExpression) =
-        concat ["var ", show identifier, ": " <> show typeExpression, ";"]
-
-data Declaration
-    = TypeDefinition Identifier TypeExpression
-    | ProcedureDefinition Identifier [Parameter] [VariableDeclaration] [Statement]
-    deriving Eq
-
-instance Show Declaration
-  where
-    show (TypeDefinition identifier typeExpression) =
-        concat ["type ", show identifier, " = ", show typeExpression, ";"]
-    show (ProcedureDefinition procedureName parameters variables body)
-        = "proc " <> show procedureName <> showParameters parameters <> " {\n"
-        <> unlines (("  " <>) . show <$> variables)
-        <> unlines (("  " <>) . show <$> body)
-        <> "}"
-
-newtype Program = Program [Declaration]
-    deriving Eq
-
-instance Show Program
-  where
-    show (Program declarations) = unlines (show <$> declarations)
-
-showParameters :: [Parameter] -> String
-showParameters parameters =
-    "(" <> intercalate ", " (show <$> parameters) <> ")"
 -}

lib/Language/Elna/Architecture/RiscV.hs

@@ -150,6 +150,7 @@ data RelocationType
 data Instruction
     = Instruction BaseOpcode Type
     | RelocatableInstruction BaseOpcode RelocationType
+    | CallInstruction Text
     deriving Eq
 
 xRegister :: XRegister -> Word8
@@ -306,6 +307,10 @@ instruction :: Instruction -> ByteString.Builder.Builder
 instruction = \case
     (Instruction base instructionType) -> go base $ type' instructionType
     (RelocatableInstruction base instructionType) -> go base $ relocationType instructionType
+    (CallInstruction _) -> foldMap instruction
+        [ Instruction Auipc $ U RA 0
+        , Instruction Jalr $ I RA JALR RA 0
+        ]
   where
     go base instructionType
         = ByteString.Builder.word32LE

lib/Language/Elna/CodeGenerator.hs

@@ -10,7 +10,8 @@ import Language.Elna.SymbolTable (SymbolTable)
 
 generateCode :: SymbolTable -> Vector Quadruple -> Vector RiscV.Instruction
 generateCode _ _ = Vector.fromList
-    [ RiscV.Instruction RiscV.OpImm $ RiscV.I RiscV.A0 RiscV.ADDI RiscV.Zero 0
+    [ RiscV.CallInstruction "printi"
+    , RiscV.Instruction RiscV.OpImm $ RiscV.I RiscV.A0 RiscV.ADDI RiscV.Zero 0
     , RiscV.Instruction RiscV.OpImm $ RiscV.I RiscV.A7 RiscV.ADDI RiscV.Zero 93
     , RiscV.Instruction RiscV.System $ RiscV.Type RiscV.Zero RiscV.PRIV RiscV.Zero RiscV.ECALL
     ]

lib/Language/Elna/Parser.hs

@@ -3,89 +3,48 @@ module Language.Elna.Parser
     , programP
     ) where
 
--- import Control.Monad (void)
+import Control.Monad (void)
 -- import Control.Monad.Combinators.Expr (Operator(..), makeExprParser)
 import Data.Text (Text)
--- import qualified Data.Text as Text
+import qualified Data.Text as Text
 import Data.Void (Void)
 import Language.Elna.AST
-    ( Program(..)
+    ( Declaration(..)
-    {-, VariableAccess(..)
-    , Condition(..)
-    , Declaration(..)
-    , Expression(..)
     , Identifier(..)
-    , Literal(..)
     , Parameter(..)
+    , Program(..)
     , Statement(..)
     , TypeExpression(..)
-    , VariableDeclaration(..)-}
+    , VariableDeclaration(..)
+    {-, VariableAccess(..)
+    , Condition(..)
+    , Expression(..)
+    , Literal(..)-}
     )
 import Text.Megaparsec
     ( Parsec
-    {-, MonadParsec(..)
     , (<?>)
+    --, MonadParsec(..)
+    , eof
     , optional
     , between
     , sepBy
-    , choice -}
+    --, choice
-    )
-{- import Text.Megaparsec.Char
-    ( alphaNumChar
-    , char
-    , letterChar
-    , space1
-    , string
     )
 import qualified Text.Megaparsec.Char.Lexer as Lexer
+import Text.Megaparsec.Char
+    ( alphaNumChar
+--    , char
+    , letterChar
+    , space1
+--    , string
+    )
 import Control.Applicative (Alternative(..))
 import Data.Maybe (isJust)
-import Data.Functor (($>))
+-- import Data.Functor (($>))
--}
+
 type Parser = Parsec Void Text
 {-
-space :: Parser ()
-space = Lexer.space space1 (Lexer.skipLineComment "//")
-    $ Lexer.skipBlockComment "/*" "*/"
-
-lexeme :: forall a. Parser a -> Parser a
-lexeme = Lexer.lexeme space
-
-symbol :: Text -> Parser Text
-symbol = Lexer.symbol space
-
-blockP :: forall a. Parser a -> Parser a
-blockP = between (symbol "{") (symbol "}")
-
-procedureP :: Parser ()
-procedureP = void $ symbol "proc"
-
-parensP :: forall a. Parser a -> Parser a
-parensP = between (symbol "(")  (symbol ")")
-
-bracketsP :: forall a. Parser a -> Parser a
-bracketsP = between (symbol "[") (symbol "]")
-
-colonP :: Parser ()
-colonP = void $ symbol ":"
-
-semicolonP :: Parser ()
-semicolonP = void $ symbol ";"
-
-identifierP :: Parser Identifier
-identifierP =
-    let wordParser = (:) <$> letterChar <*> many alphaNumChar <?> "identifier"
-     in fmap Identifier $ lexeme $ Text.pack <$> wordParser
-
-typeExpressionP :: Parser TypeExpression
-typeExpressionP = arrayTypeExpression
-    <|> NamedType <$> identifierP
-    <?> "type expression"
-  where
-    arrayTypeExpression = ArrayType
-        <$> (symbol "array" *> bracketsP (lexeme Lexer.decimal))
-        <*> (symbol "of" *> typeExpressionP)
-
 typeDefinitionP :: Parser Declaration
 typeDefinitionP = TypeDefinition
     <$> (symbol "type" *> identifierP)
@@ -93,24 +52,6 @@ typeDefinitionP = TypeDefinition
     <* semicolonP
     <?> "type definition"
 
-variableDeclarationP :: Parser VariableDeclaration
-variableDeclarationP = VariableDeclaration
-    <$> (symbol "var" *> identifierP)
-    <*> (colonP *> typeExpressionP)
-    <* semicolonP
-    <?> "variable declaration"
-
-parameterP :: Parser Parameter
-parameterP = paramCons
-    <$> optional (symbol "ref")
-    <*> identifierP
-    <*> (colonP *> typeExpressionP)
-  where
-    paramCons ref name typeName = Parameter name typeName (isJust ref)
-
-commaP :: Parser ()
-commaP = void $ symbol ","
-
 literalP :: Parser Literal
 literalP
     = HexadecimalLiteral <$> (string "0x" *> lexeme Lexer.hexadecimal)
@@ -174,17 +115,80 @@ conditionP = do
         , symbol "=" >> pure EqualCondition
         , symbol "#" >> pure NonEqualCondition
         ]
+-}
+symbol :: Text -> Parser Text
+symbol = Lexer.symbol space
+
+space :: Parser ()
+space = Lexer.space space1 (Lexer.skipLineComment "//")
+    $ Lexer.skipBlockComment "/*" "*/"
+
+lexeme :: forall a. Parser a -> Parser a
+lexeme = Lexer.lexeme space
+
+blockP :: forall a. Parser a -> Parser a
+blockP = between (symbol "{") (symbol "}")
+
+parensP :: forall a. Parser a -> Parser a
+parensP = between (symbol "(")  (symbol ")")
+
+bracketsP :: forall a. Parser a -> Parser a
+bracketsP = between (symbol "[") (symbol "]")
+
+colonP :: Parser ()
+colonP = void $ symbol ":"
+
+commaP :: Parser ()
+commaP = void $ symbol ","
+
+semicolonP :: Parser ()
+semicolonP = void $ symbol ";"
+
+identifierP :: Parser Identifier
+identifierP =
+    let wordParser = (:) <$> letterChar <*> many alphaNumChar <?> "identifier"
+     in fmap Identifier $ lexeme $ Text.pack <$> wordParser
+
+procedureP :: Parser ()
+procedureP = void $ symbol "proc"
+
+parameterP :: Parser Parameter
+parameterP = paramCons
+    <$> optional (symbol "ref")
+    <*> identifierP
+    <*> (colonP *> typeExpressionP)
+  where
+    paramCons ref name typeName = Parameter name typeName (isJust ref)
+
+typeExpressionP :: Parser TypeExpression
+typeExpressionP = arrayTypeExpression
+    <|> NamedType <$> identifierP
+    <?> "type expression"
+  where
+    arrayTypeExpression = ArrayType
+        <$> (symbol "array" *> bracketsP (lexeme Lexer.decimal))
+        <*> (symbol "of" *> typeExpressionP)
+
+procedureDeclarationP :: Parser Declaration
+procedureDeclarationP = procedureCons
+    <$> (procedureP *> identifierP)
+    <*> parensP (sepBy parameterP commaP)
+    <*> blockP ((,) <$> many variableDeclarationP <*> many statementP)
+    <?> "procedure definition"
+  where
+    procedureCons procedureName parameters (variables, body) =
+        ProcedureDeclaration procedureName parameters variables body
 
 statementP :: Parser Statement
 statementP
     = EmptyStatement <$ semicolonP
-    <|> CompoundStatement <$> blockP (many statementP)
+    {-<|> CompoundStatement <$> blockP (many statementP)
     <|> try assignmentP
     <|> try ifElseP
     <|> try whileP
-    <|> try callP
+    <|> try callP -}
     <?> "statement"
-  where
+  {-where
     ifElseP = IfStatement
         <$> (symbol "if" *> parensP conditionP)
         <*> statementP
@@ -201,19 +205,16 @@ statementP
         <* symbol ":="
         <*> expressionP
         <* semicolonP
-
+-}
-procedureDefinitionP :: Parser Declaration
+variableDeclarationP :: Parser VariableDeclaration
-procedureDefinitionP = procedureCons
+variableDeclarationP = VariableDeclaration
-    <$> (procedureP *> identifierP)
+    <$> (symbol "var" *> identifierP)
-    <*> parensP (sepBy parameterP commaP)
+    <*> (colonP *> typeExpressionP)
-    <*> blockP ((,) <$> many variableDeclarationP <*> many statementP)
+    <* semicolonP
-    <?> "procedure definition"
+    <?> "variable declaration"
-  where
-    procedureCons procedureName parameters (variables, body) =
-        ProcedureDefinition procedureName parameters variables body
 
 declarationP :: Parser Declaration
-declarationP = typeDefinitionP <|> procedureDefinitionP
+declarationP = procedureDeclarationP -- <|> typeDefinitionP
--}
+
 programP :: Parser Program
-programP = pure Program -- <$> many declarationP
+programP = Program <$> many declarationP <* eof

lib/Language/Elna/PrinterWriter.hs

@@ -211,9 +211,17 @@ riscv32Elf code objectHandle = text
                 , st_name = fromIntegral $ ByteString.length names
                 , st_info = stInfo STB_GLOBAL STT_FUNC
                 }
+            printEntry = Elf32_Sym
+                { st_value = 0
+                , st_size = 0
+                , st_shndx = 0
+                , st_other = 0
+                , st_name = fromIntegral (ByteString.length names) + 7
+                , st_info = stInfo STB_GLOBAL STT_FUNC
+                }
         liftIO $ ByteString.hPut objectHandle $ LazyByteString.toStrict encoded
-        let newResult = ElfHeaderResult (names <> "_start\0")
+        let newResult = ElfHeaderResult (names <> "_start\0printi\0")
-                $ Vector.snoc entries newEntry
+                $ Vector.snoc (Vector.snoc entries newEntry) printEntry
         pure (newResult, size, updatedRelocations)
     encodeInstruction (instructions, offset, relocations) instruction =
         let unresolvedRelocation = case instruction of
@@ -227,6 +235,9 @@ riscv32Elf code objectHandle = text
                     | 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.Instruction _ _ -> Nothing
             encoded = ByteString.Builder.toLazyByteString
                 $ RiscV.instruction instruction

rakelib/tester.rake

@@ -5,32 +5,47 @@ require_relative 'shared'
 CLEAN.include(TMP + 'riscv')
 
 LINKER = 'build/rootfs/riscv32-unknown-linux-gnu/bin/ld'
+AS = 'build/rootfs/riscv32-unknown-linux-gnu/bin/as'
 
 namespace :test do
-  test_sources = FileList['tests/vm/*.elna']
+  test_sources = FileList['tests/vm/*.elna', 'tests/vm/*.s']
   compiler = `cabal list-bin elna`.strip
   object_directory = TMP + 'riscv/tests'
   root_directory = TMP + 'riscv/root'
   executable_directory = root_directory + 'tests'
   expectation_directory = root_directory + 'expectations'
   init = TMP + 'riscv/root/init'
+  builtin = TMP + 'riscv/builtin.o'
 
   directory root_directory
   directory object_directory
   directory executable_directory
   directory expectation_directory
 
+  file builtin => ['tools/builtin.s', object_directory] do |task|
+    sh AS, '-o', task.name, task.prerequisites.first
+  end
+
   test_files = test_sources.flat_map do |test_source|
-    test_basename = File.basename(test_source, '.elna')
+    test_basename = File.basename(test_source, '.*')
     test_object = object_directory + test_basename.ext('.o')
 
-    file test_object => [test_source, object_directory] do
+    file test_object => [test_source, object_directory] do |task|
-      sh compiler, '--output', test_object.to_path, test_source
+      case File.extname(task.prerequisites.first)
+      when '.s'
+        sh AS, '-mno-relax', '-o', task.name, task.prerequisites.first
+      when '.elna'
+        sh compiler, '--output', task.name, task.prerequisites.first
+      else
+        raise "Unknown source file extension #{task.prerequisites.first}"
+      end
     end
     test_executable = executable_directory + test_basename
 
-    file test_executable => [test_object, executable_directory] do
+    file test_executable => [test_object, executable_directory, builtin] do |task|
-      sh LINKER, '-o', test_executable.to_path, test_object.to_path
+      objects = task.prerequisites.filter { |prerequisite| File.file? prerequisite }
+
+      sh LINKER, '-o', test_executable.to_path, *objects
     end
     expectation_name = test_basename.ext '.txt'
     source_expectation = "tests/expectations/#{expectation_name}"

tests/expectations/empty.txt

@@ -0,0 +1 @@
+0

tests/vm/empty.elna

@@ -0,0 +1,2 @@
+proc main() {
+}

tools/builtin.s

@@ -0,0 +1,29 @@
+.global printi
+.type printi, @function
+
+.text
+printi:
+    addi sp, sp, -8
+    sw s0, 0(sp)
+    sw ra, 4(sp)
+    addi s0, sp, 8
+
+    addi t0, a0, 0
+    addi a0, a0, '0'
+    sw a0, 0(s0)
+    addi a0, x0, 1
+    addi a1, s0, 0
+    addi a2, x0, 1
+    addi a7, x0, 64
+    ecall
+
+    addi t1, x0, '\n'
+    sw t1, 0(s0)
+    ecall
+
+    addi a0, t0, 0
+
+    lw s0, 0(sp)
+    lw ra, 4(sp)
+    addi sp, sp, 8
+    ret

tools/init.c

@@ -118,7 +118,6 @@ enum status run_test(const char *file_entry_name)
         close(pipe_ends[0]);
 
         int wait_status = 0;
-        wait(&wait_status);
 
         make_path(filename, "./expectations/", file_entry_name, ".txt");