summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2024-09-15 23:03:25 +0200
committerEugen Wissner <belka@caraus.de>2024-09-15 23:03:25 +0200
commitc9ff4f0a2a2cfa31964a307c08f9baa349565bbd (patch)
tree780fd5b416c9c8a54b0d7933a70a2d49e4c8d549
parentd29012d30e158edc28d4467b69a95b5a3c68f04d (diff)
downloadelna-c9ff4f0a2a2cfa31964a307c08f9baa349565bbd.tar.gz
Add call pseudo instruction
-rw-r--r--TODO1
-rw-r--r--lib/Language/Elna/AST.hs167
-rw-r--r--lib/Language/Elna/Architecture/RiscV.hs5
-rw-r--r--lib/Language/Elna/CodeGenerator.hs3
-rw-r--r--lib/Language/Elna/Parser.hs187
-rw-r--r--lib/Language/Elna/PrinterWriter.hs15
-rw-r--r--rakelib/tester.rake27
-rw-r--r--tests/expectations/empty.txt1
-rw-r--r--tests/vm/empty.elna2
-rw-r--r--tools/builtin.s29
-rw-r--r--tools/init.c1
11 files changed, 251 insertions, 187 deletions
diff --git a/TODO b/TODO
index 09b4a59..41aee95 100644
--- a/TODO
+++ b/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.
diff --git a/lib/Language/Elna/AST.hs b/lib/Language/Elna/AST.hs
index a13798c..8f66bdc 100644
--- a/lib/Language/Elna/AST.hs
+++ b/lib/Language/Elna/AST.hs
@@ -1,25 +1,56 @@
module Language.Elna.AST
- ( Program(..)
- {-, VariableAccess(..)
- , Condition(..)
- , Declaration(..)
- , Expression(..)
+ ( Declaration(..)
, Identifier(..)
- , Literal(..)
, Parameter(..)
+ , Program(..)
, Statement(..)
+ , TypeExpression(..)
, VariableDeclaration(..)
- , TypeExpression(..)-}
+ {-, VariableAccess(..)
+ , Condition(..)
+ , Expression(..)
+ , Literal(..)-}
) where
-data Program = Program
-{-
-import Data.Int (Int32)
import Data.List (intercalate)
-import Data.Word (Word16, Word32)
-import Data.Char (chr)
+import Data.Word ({-Word16, -}Word32)
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) <> ")"
-}
diff --git a/lib/Language/Elna/Architecture/RiscV.hs b/lib/Language/Elna/Architecture/RiscV.hs
index 9964911..4ee516d 100644
--- a/lib/Language/Elna/Architecture/RiscV.hs
+++ b/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
diff --git a/lib/Language/Elna/CodeGenerator.hs b/lib/Language/Elna/CodeGenerator.hs
index 6097843..704f625 100644
--- a/lib/Language/Elna/CodeGenerator.hs
+++ b/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
]
diff --git a/lib/Language/Elna/Parser.hs b/lib/Language/Elna/Parser.hs
index 4828bf5..57ebb1b 100644
--- a/lib/Language/Elna/Parser.hs
+++ b/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(..)
- {-, VariableAccess(..)
- , Condition(..)
- , Declaration(..)
- , Expression(..)
+ ( Declaration(..)
, 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
+import qualified Text.Megaparsec.Char.Lexer as Lexer
+import Text.Megaparsec.Char
( alphaNumChar
- , char
+-- , char
, letterChar
, space1
- , string
+-- , string
)
-import qualified Text.Megaparsec.Char.Lexer as Lexer
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
-procedureDefinitionP = procedureCons
- <$> (procedureP *> identifierP)
- <*> parensP (sepBy parameterP commaP)
- <*> blockP ((,) <$> many variableDeclarationP <*> many statementP)
- <?> "procedure definition"
- where
- procedureCons procedureName parameters (variables, body) =
- ProcedureDefinition procedureName parameters variables body
+-}
+variableDeclarationP :: Parser VariableDeclaration
+variableDeclarationP = VariableDeclaration
+ <$> (symbol "var" *> identifierP)
+ <*> (colonP *> typeExpressionP)
+ <* semicolonP
+ <?> "variable declaration"
declarationP :: Parser Declaration
-declarationP = typeDefinitionP <|> procedureDefinitionP
--}
+declarationP = procedureDeclarationP -- <|> typeDefinitionP
+
programP :: Parser Program
-programP = pure Program -- <$> many declarationP
+programP = Program <$> many declarationP <* eof
diff --git a/lib/Language/Elna/PrinterWriter.hs b/lib/Language/Elna/PrinterWriter.hs
index d0c1fe3..ff8b9aa 100644
--- a/lib/Language/Elna/PrinterWriter.hs
+++ b/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")
- $ Vector.snoc entries newEntry
+ let newResult = ElfHeaderResult (names <> "_start\0printi\0")
+ $ 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
diff --git a/rakelib/tester.rake b/rakelib/tester.rake
index c348303..d164c2a 100644
--- a/rakelib/tester.rake
+++ b/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
- sh compiler, '--output', test_object.to_path, test_source
+ file test_object => [test_source, object_directory] do |task|
+ 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
- sh LINKER, '-o', test_executable.to_path, test_object.to_path
+ file test_executable => [test_object, executable_directory, builtin] do |task|
+ 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}"
diff --git a/tests/expectations/empty.txt b/tests/expectations/empty.txt
index e69de29..573541a 100644
--- a/tests/expectations/empty.txt
+++ b/tests/expectations/empty.txt
@@ -0,0 +1 @@
+0
diff --git a/tests/vm/empty.elna b/tests/vm/empty.elna
index e69de29..fffe51f 100644
--- a/tests/vm/empty.elna
+++ b/tests/vm/empty.elna
@@ -0,0 +1,2 @@
+proc main() {
+}
diff --git a/tools/builtin.s b/tools/builtin.s
new file mode 100644
index 0000000..6fc43f6
--- /dev/null
+++ b/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
diff --git a/tools/init.c b/tools/init.c
index cb646bd..f463bcd 100644
--- a/tools/init.c
+++ b/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");