From c2c923276f7ecde1f71e53309dc5d1cc53cd3ff2 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 29 Sep 2024 19:50:55 +0200 Subject: [PATCH] Implement addition and subtraction --- TODO | 8 ++- lib/Language/Elna/AST.hs | 10 ++-- lib/Language/Elna/CodeGenerator.hs | 62 ++++++++++++++++-------- lib/Language/Elna/Intermediate.hs | 56 ++++++++++----------- lib/Language/Elna/NameAnalysis.hs | 8 +-- lib/Language/Elna/Parser.hs | 56 ++++++++++----------- tests/expectations/print_subtraction.txt | 1 + tests/expectations/print_sum.txt | 1 + tests/vm/print_subtraction.elna | 3 ++ tests/vm/print_sum.elna | 3 ++ tools/builtin.s | 12 ++++- 11 files changed, 131 insertions(+), 89 deletions(-) create mode 100644 tests/expectations/print_subtraction.txt create mode 100644 tests/expectations/print_sum.txt create mode 100644 tests/vm/print_subtraction.elna create mode 100644 tests/vm/print_sum.elna diff --git a/TODO b/TODO index 2710951..c1c909f 100644 --- a/TODO +++ b/TODO @@ -17,6 +17,12 @@ # Built-in -Printi should print a sign for negative numbers. +- Implement printc (with int argument). +- Implement exit() as standalone function. + +# Register allocation + +- Temporary variables always use the same register, t0. Allocate registers for + temporaries. # Type analysis diff --git a/lib/Language/Elna/AST.hs b/lib/Language/Elna/AST.hs index 087c2fd..4861318 100644 --- a/lib/Language/Elna/AST.hs +++ b/lib/Language/Elna/AST.hs @@ -115,12 +115,12 @@ instance Show VariableDeclaration show (VariableDeclaration identifier typeExpression) = concat ["var ", show identifier, ": " <> show typeExpression, ";"] -newtype Expression +data Expression = LiteralExpression Literal -{- | VariableExpression VariableAccess - | NegationExpression Expression | SumExpression Expression Expression | SubtractionExpression Expression Expression +{- | VariableExpression VariableAccess + | NegationExpression Expression | ProductExpression Expression Expression | DivisionExpression Expression Expression -} deriving Eq @@ -128,10 +128,10 @@ newtype Expression instance Show Expression where show (LiteralExpression literal) = show literal - {- show (VariableExpression variable) = show variable - show (NegationExpression negation) = '-' : show negation show (SumExpression lhs rhs) = concat [show lhs, " + ", show rhs] show (SubtractionExpression lhs rhs) = concat [show lhs, " - ", show rhs] + {- show (VariableExpression variable) = show variable + show (NegationExpression negation) = '-' : show negation show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs] show (DivisionExpression lhs rhs) = concat [show lhs, " / ", show rhs] -} {- diff --git a/lib/Language/Elna/CodeGenerator.hs b/lib/Language/Elna/CodeGenerator.hs index 1a9151a..2e9b7a4 100644 --- a/lib/Language/Elna/CodeGenerator.hs +++ b/lib/Language/Elna/CodeGenerator.hs @@ -6,11 +6,12 @@ module Language.Elna.CodeGenerator import Data.ByteString (ByteString) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap +import Data.Int (Int32) import Data.Vector (Vector) import qualified Data.Vector as Vector import qualified Data.Text.Encoding as Text.Encoding import Language.Elna.Location (Identifier(..)) -import Language.Elna.Intermediate (Operand(..), Quadruple(..)) +import Language.Elna.Intermediate (Operand(..), Quadruple(..), Variable(..)) import qualified Language.Elna.Architecture.RiscV as RiscV import Language.Elna.SymbolTable (SymbolTable) import Data.Bits (Bits(..)) @@ -40,27 +41,12 @@ quadruple StartQuadruple = Vector.fromList , Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 4 RiscV.SW RiscV.SP RiscV.RA) , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.S0 RiscV.ADDI RiscV.SP 4) ] -quadruple (ParameterQuadruple (IntOperand intValue)) - = mappend go - $ Vector.fromList +quadruple (ParameterQuadruple operand1) = + let (operandRegister, statements) = loadImmediateOrRegister operand1 RiscV.A0 + in mappend statements $ Vector.fromList [ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP (negate 4)) - , Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 0 RiscV.SW RiscV.SP RiscV.A0) + , Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 0 RiscV.SW RiscV.SP operandRegister) ] - where - hi = intValue `shiftR` 12 - lo = intValue - go - | intValue >= -2048 - , intValue <= 2047 = Vector.singleton - $ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.A0 RiscV.ADDI RiscV.A0 $ fromIntegral lo) - | intValue .&. 0x800 /= 0 = Vector.fromList - [ Instruction (RiscV.BaseInstruction RiscV.Lui $ RiscV.U RiscV.A0 $ fromIntegral $ succ hi) - , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.A0 RiscV.ADDI RiscV.A0 $ fromIntegral lo) - ] - | otherwise = Vector.fromList - [ Instruction (RiscV.BaseInstruction RiscV.Lui $ RiscV.U RiscV.A0 $ fromIntegral hi) - , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.A0 RiscV.ADDI RiscV.A0 $ fromIntegral lo) - ] quadruple (CallQuadruple callName numberOfArguments) = Vector.fromList [ Instruction (RiscV.CallInstruction callName) , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP (numberOfArguments * 4)) @@ -71,3 +57,39 @@ quadruple StopQuadruple = Vector.fromList , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP 4) , Instruction (RiscV.BaseInstruction RiscV.Jalr $ RiscV.I RiscV.RA RiscV.JALR RiscV.Zero 0) ] +quadruple (AddQuadruple operand1 operand2 (TempVariable _)) = + let (operandRegister1, statements1) = loadImmediateOrRegister operand1 RiscV.A0 + (operandRegister2, statements2) = loadImmediateOrRegister operand2 RiscV.A1 + in Vector.snoc (statements1 <> statements2) + $ Instruction + $ RiscV.BaseInstruction RiscV.Op + $ RiscV.R RiscV.T0 RiscV.ADD operandRegister1 operandRegister2 (RiscV.Funct7 0b0000000) +quadruple (SubtractionQuadruple operand1 operand2 (TempVariable _)) = + let (operandRegister1, statements1) = loadImmediateOrRegister operand1 RiscV.A0 + (operandRegister2, statements2) = loadImmediateOrRegister operand2 RiscV.A1 + in Vector.snoc (statements1 <> statements2) + $ Instruction + $ RiscV.BaseInstruction RiscV.Op + $ RiscV.R RiscV.T0 RiscV.SUB operandRegister1 operandRegister2 (RiscV.Funct7 0b0100000) + +loadImmediateOrRegister :: Operand -> RiscV.XRegister -> (RiscV.XRegister, Vector Statement) +loadImmediateOrRegister (IntOperand intValue) targetRegister = + (targetRegister, lui intValue targetRegister) +loadImmediateOrRegister (VariableOperand _) _ = (RiscV.T0, Vector.empty) + +lui :: Int32 -> RiscV.XRegister -> Vector Statement +lui intValue targetRegister + | intValue >= -2048 + , intValue <= 2047 = Vector.singleton + $ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I targetRegister RiscV.ADDI RiscV.Zero lo) + | intValue .&. 0x800 /= 0 = Vector.fromList + [ Instruction (RiscV.BaseInstruction RiscV.Lui $ RiscV.U targetRegister $ fromIntegral $ succ hi) + , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I targetRegister RiscV.ADDI targetRegister lo) + ] + | otherwise = Vector.fromList + [ Instruction (RiscV.BaseInstruction RiscV.Lui $ RiscV.U targetRegister $ fromIntegral hi) + , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I targetRegister RiscV.ADDI targetRegister lo) + ] + where + hi = intValue `shiftR` 12 + lo = fromIntegral intValue diff --git a/lib/Language/Elna/Intermediate.hs b/lib/Language/Elna/Intermediate.hs index 35f5ad2..d535b6a 100644 --- a/lib/Language/Elna/Intermediate.hs +++ b/lib/Language/Elna/Intermediate.hs @@ -1,8 +1,8 @@ module Language.Elna.Intermediate ( Operand(..) , Quadruple(..) - {- , Label(..) - , Variable(..) -} + {- , Label(..) -} + , Variable(..) , intermediate ) where @@ -17,12 +17,20 @@ import Data.Text (Text) import qualified Language.Elna.AST as AST import Language.Elna.SymbolTable (SymbolTable{-, Info(..) -}) import Data.Foldable (Foldable(..)) -import Control.Monad.Trans.State (State, runState) +import Control.Monad.Trans.State (State, get, modify', runState) import Data.Maybe (catMaybes) -newtype Operand +newtype Variable = TempVariable Word32 -- | Variable Text + deriving Eq + +instance Show Variable + where + -- show (Variable variable) = '$' : Text.unpack variable + show (TempVariable variable) = '$' : show variable + +data Operand = IntOperand Int32 - -- | VariableOperand Variable + | VariableOperand Variable deriving (Eq, Show) data Quadruple @@ -30,12 +38,12 @@ data Quadruple | StopQuadruple | ParameterQuadruple Operand | CallQuadruple Text Word32 + | AddQuadruple Operand Operand Variable + | SubtractionQuadruple Operand Operand Variable {-| GoToQuadruple Label | AssignQuadruple Operand Variable | ArrayQuadruple Variable Operand Variable | ArrayAssignQuadruple Operand Operand Variable - | AddQuadruple Operand Operand Variable - | SubtractionQuadruple Operand Operand Variable | ProductQuadruple Operand Operand Variable | DivisionQuadruple Operand Operand Variable | NegationQuadruple Operand Variable @@ -142,6 +150,12 @@ statement localTable (AST.WhileStatement whileCondition whileStatement) = do statement localTable (AST.CompoundStatement statements) = fold <$> traverse (statement localTable) statements -} +createTemporary :: Intermediate Variable +createTemporary = do + currentCounter <- Intermediate get + Intermediate $ modify' (+ 1) + pure $ TempVariable currentCounter + {- import Language.Elna.Types (Type(..)) import qualified Language.Elna.SymbolTable as SymbolTable @@ -171,16 +185,6 @@ createLabel = do { labelCounter = getField @"labelCounter" generator + 1 } -createTemporary :: Intermediate Variable -createTemporary = do - currentCounter <- Intermediate $ gets temporaryCounter - Intermediate $ modify' modifier - pure $ TempVariable currentCounter - where - modifier generator = generator - { temporaryCounter = getField @"temporaryCounter" generator + 1 - } - condition :: SymbolTable -> AST.Condition @@ -257,8 +261,11 @@ variableType (AST.ArrayAccess arrayAccess' _) symbolTable = variableType arrayAccess' symbolTable -} expression :: SymbolTable -> AST.Expression -> Intermediate (Operand, Vector Quadruple) -expression _localTable = \case +expression localTable = \case (AST.LiteralExpression literal') -> pure (literal literal', mempty) + (AST.SumExpression lhs rhs) -> binaryExpression AddQuadruple lhs rhs + (AST.SubtractionExpression lhs rhs) -> + binaryExpression SubtractionQuadruple lhs rhs {- (AST.VariableExpression variableExpression) -> do let variableType' = variableType variableExpression localTable variableAccess' <- variableAccess localTable variableExpression Nothing variableType' mempty @@ -280,13 +287,10 @@ expression _localTable = \case ( VariableOperand tempVariable , Vector.snoc statements negationQuadruple ) - (AST.SumExpression lhs rhs) -> binaryExpression AddQuadruple lhs rhs - (AST.SubtractionExpression lhs rhs) -> - binaryExpression SubtractionQuadruple lhs rhs (AST.ProductExpression lhs rhs) -> binaryExpression ProductQuadruple lhs rhs (AST.DivisionExpression lhs rhs) -> - binaryExpression DivisionQuadruple lhs rhs + binaryExpression DivisionQuadruple lhs rhs -} where binaryExpression f lhs rhs = do (lhsOperand, lhsStatements) <- expression localTable lhs @@ -298,14 +302,6 @@ expression _localTable = \case , Vector.snoc (lhsStatements <> rhsStatements) newQuadruple ) -data Variable = Variable Text | TempVariable Int32 - deriving Eq - -instance Show Variable - where - show (Variable variable) = '$' : Text.unpack variable - show (TempVariable variable) = '$' : show variable --} literal :: AST.Literal -> Operand literal (AST.IntegerLiteral integer) = IntOperand integer {-literal (AST.HexadecimalLiteral integer) = IntOperand integer diff --git a/lib/Language/Elna/NameAnalysis.hs b/lib/Language/Elna/NameAnalysis.hs index 6cb2f5c..10045e9 100644 --- a/lib/Language/Elna/NameAnalysis.hs +++ b/lib/Language/Elna/NameAnalysis.hs @@ -136,16 +136,16 @@ checkSymbol globalTable identifier expression :: SymbolTable -> AST.Expression -> NameAnalysis () expression _ (AST.LiteralExpression _) = pure () -{- expression globalTable (AST.VariableExpression variableExpression) = - variableAccess globalTable variableExpression -expression globalTable (AST.NegationExpression negation) = - expression globalTable negation expression globalTable (AST.SumExpression lhs rhs) = expression globalTable lhs >> expression globalTable rhs expression globalTable (AST.SubtractionExpression lhs rhs) = expression globalTable lhs >> expression globalTable rhs +{- expression globalTable (AST.VariableExpression variableExpression) = + variableAccess globalTable variableExpression +expression globalTable (AST.NegationExpression negation) = + expression globalTable negation expression globalTable (AST.ProductExpression lhs rhs) = expression globalTable lhs >> expression globalTable rhs diff --git a/lib/Language/Elna/Parser.hs b/lib/Language/Elna/Parser.hs index 5583601..3c98fff 100644 --- a/lib/Language/Elna/Parser.hs +++ b/lib/Language/Elna/Parser.hs @@ -4,7 +4,7 @@ module Language.Elna.Parser ) where import Control.Monad (void) -import Control.Monad.Combinators.Expr ({-Operator(..), -} makeExprParser) +import Control.Monad.Combinators.Expr (Operator(..), makeExprParser) import Data.Text (Text) import qualified Data.Text as Text import Data.Void (Void) @@ -69,6 +69,31 @@ termP = choice , LiteralExpression <$> literalP -- , VariableExpression <$> variableAccessP ] + +operatorTable :: [[Operator Parser Expression]] +operatorTable = + [{- unaryOperator + , factorOperator + ,-} termOperator + ] + where + {- unaryOperator = + [ prefix "-" NegationExpression + , prefix "+" id + ] + factorOperator = + [ binary "*" ProductExpression + , binary "/" DivisionExpression + ] -} + termOperator = + [ binary "+" SumExpression + , binary "-" SubtractionExpression + ] + -- prefix name f = Prefix (f <$ symbol name) + binary name f = InfixL (f <$ symbol name) + +expressionP :: Parser Expression +expressionP = makeExprParser termP operatorTable {- variableAccessP :: Parser VariableAccess variableAccessP = do @@ -76,31 +101,6 @@ variableAccessP = do indices <- many $ bracketsP expressionP pure $ foldr (flip ArrayAccess) (VariableAccess identifier) indices -operatorTable :: [[Operator Parser Expression]] -operatorTable = - [ unaryOperator - , factorOperator - , termOperator - ] - where - unaryOperator = - [ prefix "-" NegationExpression - , prefix "+" id - ] - factorOperator = - [ binary "*" ProductExpression - , binary "/" DivisionExpression - ] - termOperator = - [ binary "+" SumExpression - , binary "-" SubtractionExpression - ] - prefix name f = Prefix (f <$ symbol name) - binary name f = InfixL (f <$ symbol name) --} -expressionP :: Parser Expression -expressionP = makeExprParser termP [] -- operatorTable -{- conditionP :: Parser Condition conditionP = do lhs <- expressionP @@ -204,8 +204,8 @@ statementP <$> variableAccessP <* symbol ":=" <*> expressionP - <* semicolonP --} + <* semicolonP -} + variableDeclarationP :: Parser VariableDeclaration variableDeclarationP = VariableDeclaration <$> (symbol "var" *> identifierP) diff --git a/tests/expectations/print_subtraction.txt b/tests/expectations/print_subtraction.txt new file mode 100644 index 0000000..de71f88 --- /dev/null +++ b/tests/expectations/print_subtraction.txt @@ -0,0 +1 @@ +-8 diff --git a/tests/expectations/print_sum.txt b/tests/expectations/print_sum.txt new file mode 100644 index 0000000..3c03207 --- /dev/null +++ b/tests/expectations/print_sum.txt @@ -0,0 +1 @@ +18 diff --git a/tests/vm/print_subtraction.elna b/tests/vm/print_subtraction.elna new file mode 100644 index 0000000..c5b09a2 --- /dev/null +++ b/tests/vm/print_subtraction.elna @@ -0,0 +1,3 @@ +proc main() { + printi(5 - 13); +} diff --git a/tests/vm/print_sum.elna b/tests/vm/print_sum.elna new file mode 100644 index 0000000..8ad98d6 --- /dev/null +++ b/tests/vm/print_sum.elna @@ -0,0 +1,3 @@ +proc main() { + printi(5 + 13); +} diff --git a/tools/builtin.s b/tools/builtin.s index 7b14d95..ecea15b 100644 --- a/tools/builtin.s +++ b/tools/builtin.s @@ -18,10 +18,16 @@ printi: # t1 - Constant 10. # a1 - Local buffer. # t2 - Current character. + # t3 - Whether the number is negative. lw t0, 0(s0) addi t1, zero, 10 addi a1, s0, -2 + addi t3, zero, 0 + bge t0, zero, .digit10 + addi t3, zero, 1 + sub t0, zero, t0 + .digit10: rem t2, t0, t1 addi t2, t2, '0' @@ -30,8 +36,12 @@ printi: addi a1, a1, -1 bne zero, t0, .digit10 - ecall + beq zero, t3, .write_call + addi t2, zero, '-' + sb t2, 0(a1) + addi a1, a1, -1 +.write_call: addi a0, zero, 1 addi a1, a1, 1 sub a2, s0, a1