From c9ff4f0a2a2cfa31964a307c08f9baa349565bbd Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 15 Sep 2024 23:03:25 +0200 Subject: [PATCH] Add call pseudo instruction --- TODO | 1 + lib/Language/Elna/AST.hs | 169 +++++++++++---------- lib/Language/Elna/Architecture/RiscV.hs | 5 + lib/Language/Elna/CodeGenerator.hs | 3 +- lib/Language/Elna/Parser.hs | 193 ++++++++++++------------ lib/Language/Elna/PrinterWriter.hs | 15 +- rakelib/tester.rake | 27 +++- tests/expectations/empty.txt | 1 + tests/vm/empty.elna | 2 + tools/builtin.s | 29 ++++ tools/init.c | 1 - 11 files changed, 255 insertions(+), 191 deletions(-) create mode 100644 tools/builtin.s 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(..) + ( Declaration(..) + , Identifier(..) + , Parameter(..) + , Program(..) + , Statement(..) + , TypeExpression(..) + , VariableDeclaration(..) {-, VariableAccess(..) , Condition(..) - , Declaration(..) , Expression(..) - , Identifier(..) - , Literal(..) - , Parameter(..) - , Statement(..) - , VariableDeclaration(..) - , TypeExpression(..)-} + , 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 -} - ) -{- import Text.Megaparsec.Char - ( alphaNumChar - , char - , letterChar - , space1 - , string + --, choice ) 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 -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");