From 0f527914b501d57f393eff509f22694604fc5d2e Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Tue, 12 Nov 2024 21:06:38 +0100 Subject: [PATCH] Map local variables in IR to their original names --- TODO | 4 - lib/Language/Elna/Backend/Allocator.hs | 106 +++--- lib/Language/Elna/Backend/Intermediate.hs | 9 +- lib/Language/Elna/Glue.hs | 72 ++-- lib/Language/Elna/RiscV/CodeGenerator.hs | 411 +++++++++------------- tests/expectations/add_to_variable.txt | 1 + tests/vm/add_to_variable.elna | 6 + 7 files changed, 280 insertions(+), 329 deletions(-) create mode 100644 tests/expectations/add_to_variable.txt create mode 100644 tests/vm/add_to_variable.elna diff --git a/TODO b/TODO index 5da4303..a0ab264 100644 --- a/TODO +++ b/TODO @@ -3,10 +3,6 @@ - To access named parameters inside a procedure, IR should be able to reference them. During the generation the needed information (e.g. offsets or registers) can be extracted from the symbol table and saved in the operands. -- Glue always generates the same intermediate variable (LocalVariable 0) for - local variables. (LocalVariable 0) is handled the same as temporary variables - that are currently saved only in registers. There space on the stack allocated - for local variables. # ELF generation diff --git a/lib/Language/Elna/Backend/Allocator.hs b/lib/Language/Elna/Backend/Allocator.hs index 0c3e5c3..8b921c4 100644 --- a/lib/Language/Elna/Backend/Allocator.hs +++ b/lib/Language/Elna/Backend/Allocator.hs @@ -6,7 +6,12 @@ module Language.Elna.Backend.Allocator import Data.HashMap.Strict (HashMap) import Data.Vector (Vector) -import Language.Elna.Backend.Intermediate (Operand(..), Quadruple(..), Variable(..)) +import Language.Elna.Backend.Intermediate + ( ProcedureQuadruples(..) + , Operand(..) + , Quadruple(..) + , Variable(..) + ) import Language.Elna.Location (Identifier(..)) newtype Store r = Store r @@ -19,60 +24,57 @@ allocate :: forall r . MachineConfiguration r -> HashMap Identifier (Vector (Quadruple Variable)) - -> HashMap Identifier (Vector (Quadruple (Store r))) + -> HashMap Identifier (ProcedureQuadruples (Store r)) allocate MachineConfiguration{..} = fmap function where - function :: Vector (Quadruple Variable) -> Vector (Quadruple (Store r)) - function = fmap quadruple + function :: Vector (Quadruple Variable) -> ProcedureQuadruples (Store r) + function quadruples' = ProcedureQuadruples + { quadruples = quadruple <$> quadruples' + , stackSize = 0 + } quadruple :: Quadruple Variable -> Quadruple (Store r) - quadruple StartQuadruple = StartQuadruple - quadruple StopQuadruple = StopQuadruple - quadruple (ParameterQuadruple operand1) = - ParameterQuadruple (operand operand1) - quadruple (CallQuadruple name count) = CallQuadruple name count - quadruple (AddQuadruple operand1 operand2 variable) - = AddQuadruple (operand operand1) (operand operand2) - $ storeVariable variable - quadruple (SubtractionQuadruple operand1 operand2 variable) - = SubtractionQuadruple (operand operand1) (operand operand2) - $ storeVariable variable - quadruple (NegationQuadruple operand1 variable) - = NegationQuadruple (operand operand1) - $ storeVariable variable - quadruple (ProductQuadruple operand1 operand2 variable) - = ProductQuadruple (operand operand1) (operand operand2) - $ storeVariable variable - quadruple (DivisionQuadruple operand1 operand2 variable) - = DivisionQuadruple (operand operand1) (operand operand2) - $ storeVariable variable - quadruple (LabelQuadruple label) = LabelQuadruple label - quadruple (GoToQuadruple label) = GoToQuadruple label - quadruple (EqualQuadruple operand1 operand2 goToLabel) = - EqualQuadruple (operand operand1) (operand operand2) goToLabel - quadruple (NonEqualQuadruple operand1 operand2 goToLabel) = - NonEqualQuadruple (operand operand1) (operand operand2) goToLabel - quadruple (LessQuadruple operand1 operand2 goToLabel) = - LessQuadruple (operand operand1) (operand operand2) goToLabel - quadruple (GreaterQuadruple operand1 operand2 goToLabel) = - GreaterQuadruple (operand operand1) (operand operand2) goToLabel - quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) = - LessOrEqualQuadruple (operand operand1) (operand operand2) goToLabel - quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) = - GreaterOrEqualQuadruple (operand operand1) (operand operand2) goToLabel - quadruple (AssignQuadruple operand1 variable) - = AssignQuadruple (operand operand1) - $ storeVariable variable + quadruple = \case + StartQuadruple -> StartQuadruple + StopQuadruple -> StopQuadruple + ParameterQuadruple operand1 -> + ParameterQuadruple (operand operand1) + CallQuadruple name count -> CallQuadruple name count + AddQuadruple operand1 operand2 variable + -> AddQuadruple (operand operand1) (operand operand2) + $ storeVariable variable + SubtractionQuadruple operand1 operand2 variable + -> SubtractionQuadruple (operand operand1) (operand operand2) + $ storeVariable variable + NegationQuadruple operand1 variable + -> NegationQuadruple (operand operand1) + $ storeVariable variable + ProductQuadruple operand1 operand2 variable + -> ProductQuadruple (operand operand1) (operand operand2) + $ storeVariable variable + DivisionQuadruple operand1 operand2 variable + -> DivisionQuadruple (operand operand1) (operand operand2) + $ storeVariable variable + LabelQuadruple label -> LabelQuadruple label + GoToQuadruple label -> GoToQuadruple label + EqualQuadruple operand1 operand2 goToLabel -> + EqualQuadruple (operand operand1) (operand operand2) goToLabel + NonEqualQuadruple operand1 operand2 goToLabel -> + NonEqualQuadruple (operand operand1) (operand operand2) goToLabel + LessQuadruple operand1 operand2 goToLabel -> + LessQuadruple (operand operand1) (operand operand2) goToLabel + GreaterQuadruple operand1 operand2 goToLabel -> + GreaterQuadruple (operand operand1) (operand operand2) goToLabel + LessOrEqualQuadruple operand1 operand2 goToLabel -> + LessOrEqualQuadruple (operand operand1) (operand operand2) goToLabel + GreaterOrEqualQuadruple operand1 operand2 goToLabel -> + GreaterOrEqualQuadruple (operand operand1) (operand operand2) goToLabel + AssignQuadruple operand1 variable -> + AssignQuadruple (operand operand1) $ storeVariable variable operand :: Operand Variable -> Operand (Store r) operand (IntOperand x) = IntOperand x - operand (VariableOperand (TempVariable index)) - = VariableOperand - $ Store + operand (VariableOperand variableOperand) = + VariableOperand $ storeVariable variableOperand + storeVariable (TempVariable index) = Store $ temporaryRegisters !! fromIntegral index - operand (VariableOperand (LocalVariable index)) - = VariableOperand - $ Store - $ temporaryRegisters !! fromIntegral index - storeVariable (TempVariable index) = - Store $ temporaryRegisters !! fromIntegral index - storeVariable (LocalVariable index) = - Store $ temporaryRegisters !! fromIntegral index + storeVariable (LocalVariable index) = Store + $ temporaryRegisters !! pred (length temporaryRegisters - fromIntegral index) diff --git a/lib/Language/Elna/Backend/Intermediate.hs b/lib/Language/Elna/Backend/Intermediate.hs index c4dcf18..624bba8 100644 --- a/lib/Language/Elna/Backend/Intermediate.hs +++ b/lib/Language/Elna/Backend/Intermediate.hs @@ -1,11 +1,13 @@ module Language.Elna.Backend.Intermediate - ( Operand(..) + ( ProcedureQuadruples(..) + , Operand(..) , Quadruple(..) , Label(..) , Variable(..) ) where import Data.Int (Int32) +import Data.Vector (Vector) import Data.Word (Word32) import Data.Text (Text) import qualified Data.Text as Text @@ -30,6 +32,11 @@ data Operand v | VariableOperand v deriving (Eq, Show) +data ProcedureQuadruples v = ProcedureQuadruples + { quadruples :: Vector (Quadruple v) + , stackSize :: Word32 + } deriving (Eq, Show) + data Quadruple v = StartQuadruple | StopQuadruple diff --git a/lib/Language/Elna/Glue.hs b/lib/Language/Elna/Glue.hs index 8f28696..9101ca5 100644 --- a/lib/Language/Elna/Glue.hs +++ b/lib/Language/Elna/Glue.hs @@ -4,7 +4,7 @@ module Language.Elna.Glue import Control.Monad.Trans.State (State, gets, modify', runState) import Data.Bifunctor (Bifunctor(..)) -import Data.Foldable (Foldable(..)) +import Data.Foldable (Foldable(..), traverse_) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Maybe (catMaybes) @@ -25,10 +25,12 @@ import Language.Elna.Backend.Intermediate import Language.Elna.Frontend.SymbolTable (Info(..), SymbolTable) import qualified Language.Elna.Frontend.SymbolTable as SymbolTable import GHC.Records (HasField(..)) +import Language.Elna.Frontend.AST (Identifier(..)) data Paste = Paste { temporaryCounter :: Word32 , labelCounter :: Word32 + , localMap :: HashMap Identifier Variable } newtype Glue a = Glue @@ -47,31 +49,46 @@ instance Monad Glue where (Glue x) >>= f = Glue $ x >>= (runGlue . f) -glue :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector (Quadruple Variable)) +glue :: SymbolTable -> AST.Program -> HashMap Identifier (Vector (Quadruple Variable)) glue globalTable = fst - . flip runState Paste{ temporaryCounter = 0, labelCounter = 0 } + . flip runState emptyPaste . runGlue . program globalTable + where + emptyPaste = Paste + { temporaryCounter = 0 + , labelCounter = 0 + , localMap = mempty + } -program - :: SymbolTable - -> AST.Program - -> Glue (HashMap AST.Identifier (Vector (Quadruple Variable))) -program globalTable (AST.Program declarations) = HashMap.fromList . catMaybes +program :: SymbolTable -> AST.Program -> Glue (HashMap Identifier (Vector (Quadruple Variable))) +program globalTable (AST.Program declarations) + = HashMap.fromList . catMaybes <$> traverse (declaration globalTable) declarations declaration :: SymbolTable -> AST.Declaration -> Glue (Maybe (AST.Identifier, Vector (Quadruple Variable))) -declaration globalTable (AST.ProcedureDeclaration procedureName _ _ statements) - = Just - . (procedureName,) - . Vector.cons StartQuadruple - . flip Vector.snoc StopQuadruple - . fold - <$> traverse (statement globalTable) statements +declaration globalTable (AST.ProcedureDeclaration procedureName _ variableDeclarations statements) + = traverse_ registerVariable variableDeclarations + >> nameQuadruplesTuple <$> traverse (statement globalTable) statements + where + registerVariable (AST.VariableDeclaration identifier _) = do + currentCounter <- fmap (fromIntegral . HashMap.size) + $ Glue $ gets $ getField @"localMap" + Glue $ modify' $ modifier identifier $ LocalVariable currentCounter + modifier identifier currentCounter generator = generator + { localMap = HashMap.insert identifier currentCounter + $ getField @"localMap" generator + } + nameQuadruplesTuple quadrupleList = Just + ( procedureName + , Vector.cons StartQuadruple + $ flip Vector.snoc StopQuadruple + $ fold quadrupleList + ) declaration _ (AST.TypeDefinition _ _) = pure Nothing statement :: SymbolTable -> AST.Statement -> Glue (Vector (Quadruple Variable)) @@ -104,15 +121,16 @@ statement localTable (AST.AssignmentStatement variableAccess' assignee) = do (rhsOperand, rhsStatements) <- expression localTable assignee let variableType' = variableType variableAccess' localTable accessResult <- variableAccess localTable variableAccess' Nothing variableType' mempty - pure $ rhsStatements <> case accessResult of + lhsStatements <- case accessResult of {-(AST.Identifier identifier, Just accumulatedIndex, accumulatedStatements) -> Vector.snoc accumulatedStatements $ ArrayAssignQuadruple rhsOperand accumulatedIndex $ LocalVariable identifier -} - (AST.Identifier identifier, Nothing, accumulatedStatements) -> - Vector.snoc accumulatedStatements - $ AssignQuadruple rhsOperand - $ LocalVariable 0 + (identifier, _Nothing, accumulatedStatements) + -> Vector.snoc accumulatedStatements + . AssignQuadruple rhsOperand + <$> lookupLocal identifier + pure $ rhsStatements <> lhsStatements {- statement localTable (AST.WhileStatement whileCondition whileStatement) = do (conditionStatements, jumpConstructor) <- condition localTable whileCondition startLabel <- createLabel @@ -135,6 +153,10 @@ createTemporary = do { temporaryCounter = getField @"temporaryCounter" generator + 1 } +lookupLocal :: Identifier -> Glue Variable +lookupLocal identifier = + fmap (HashMap.! identifier) $ Glue $ gets $ getField @"localMap" + createLabel :: Glue Label createLabel = do currentCounter <- Glue $ gets $ getField @"labelCounter" @@ -242,13 +264,13 @@ expression localTable = \case (AST.DivisionExpression lhs rhs) -> binaryExpression DivisionQuadruple lhs rhs (AST.VariableExpression variableExpression) -> do - pure (VariableOperand (LocalVariable 0), mempty) - {- let variableType' = variableType variableExpression localTable + let variableType' = variableType variableExpression localTable variableAccess' <- variableAccess localTable variableExpression Nothing variableType' mempty case variableAccess' of - (AST.Identifier identifier, Nothing, statements) -> - pure (VariableOperand (Variable identifier), statements) - (AST.Identifier identifier, Just operand, statements) -> do + (identifier, _Nothing, statements) + -> (, statements) . VariableOperand + <$> lookupLocal identifier + {-(AST.Identifier identifier, Just operand, statements) -> do arrayAddress <- createTemporary let arrayStatement = ArrayQuadruple (Variable identifier) operand arrayAddress pure diff --git a/lib/Language/Elna/RiscV/CodeGenerator.hs b/lib/Language/Elna/RiscV/CodeGenerator.hs index c082812..6a330bd 100644 --- a/lib/Language/Elna/RiscV/CodeGenerator.hs +++ b/lib/Language/Elna/RiscV/CodeGenerator.hs @@ -14,7 +14,12 @@ import Data.Vector (Vector) import qualified Data.Vector as Vector import qualified Language.Elna.Architecture.RiscV as RiscV import Language.Elna.Backend.Allocator (MachineConfiguration(..), Store(..)) -import Language.Elna.Backend.Intermediate (Label(..), Operand(..), Quadruple(..)) +import Language.Elna.Backend.Intermediate + ( Label(..) + , Operand(..) + , ProcedureQuadruples(..) + , Quadruple(..) + ) import Language.Elna.Location (Identifier(..)) import Data.Bits (Bits(..)) import Data.Foldable (Foldable(..), foldlM) @@ -80,13 +85,13 @@ createLabel = do $ Text.Builder.toLazyText $ Text.Builder.decimal currentCounter -generateRiscV :: HashMap Identifier (Vector RiscVQuadruple) -> Vector Statement +generateRiscV :: HashMap Identifier (ProcedureQuadruples RiscVStore) -> Vector Statement generateRiscV = flip evalState 0 . runRiscVGenerator . foldlM go Vector.empty . HashMap.toList where - go accumulator (Identifier key, value) = + go accumulator (Identifier key, ProcedureQuadruples{ quadruples = value }) = let code = Vector.cons (JumpLabel key [GlobalDirective, FunctionDirective]) . fold <$> mapM quadruple value in (accumulator <>) <$> code @@ -114,32 +119,10 @@ quadruple StopQuadruple = pure $ 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 (Store register)) - | IntOperand immediateOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - pure $ lui (immediateOperand1 + immediateOperand2) register - | VariableOperand variableOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = - let Store operandRegister1 = variableOperand1 - Store operandRegister2 = variableOperand2 - in pure $ Vector.singleton $ Instruction - $ RiscV.BaseInstruction RiscV.Op - $ RiscV.R register RiscV.ADD operandRegister1 operandRegister2 (RiscV.Funct7 0b0000000) - | VariableOperand variableOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - addImmediateRegister variableOperand1 immediateOperand2 - | IntOperand immediateOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = - addImmediateRegister variableOperand2 immediateOperand1 - where - addImmediateRegister variableOperand immediateOperand = - let statements = lui immediateOperand register - Store operandRegister = variableOperand - in pure $ Vector.snoc statements - $ Instruction - $ RiscV.BaseInstruction RiscV.Op - $ RiscV.R register RiscV.ADD register operandRegister - $ RiscV.Funct7 0b0000000 +quadruple (AddQuadruple operand1 operand2 store) = + commutativeBinary (+) RiscV.ADD (RiscV.Funct7 0b0000000) (operand1, operand2) store +quadruple (ProductQuadruple operand1 operand2 store) = + commutativeBinary (*) RiscV.MUL (RiscV.Funct7 0b0000001) (operand1, operand2) store quadruple (SubtractionQuadruple operand1 operand2 (Store register)) | IntOperand immediateOperand1 <- operand1 , IntOperand immediateOperand2 <- operand2 = @@ -180,32 +163,6 @@ quadruple (NegationQuadruple operand1 (Store register)) $ RiscV.BaseInstruction RiscV.Op $ RiscV.R register RiscV.SUB RiscV.Zero operandRegister1 $ RiscV.Funct7 0b0100000 -quadruple (ProductQuadruple operand1 operand2 (Store register)) - | IntOperand immediateOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - pure $ lui (immediateOperand1 * immediateOperand2) register - | VariableOperand variableOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = - let Store operandRegister1 = variableOperand1 - Store operandRegister2 = variableOperand2 - in pure $ Vector.singleton $ Instruction - $ RiscV.BaseInstruction RiscV.Op - $ RiscV.R register RiscV.MUL operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001) - | VariableOperand variableOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - multiplyImmediateRegister variableOperand1 immediateOperand2 - | IntOperand immediateOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = - multiplyImmediateRegister variableOperand2 immediateOperand1 - where - multiplyImmediateRegister variableOperand immediateOperand = - let statements = lui immediateOperand register - Store operandRegister = variableOperand - in pure $ Vector.snoc statements - $ Instruction - $ RiscV.BaseInstruction RiscV.Op - $ RiscV.R register RiscV.MUL register operandRegister - $ RiscV.Funct7 0b0000001 quadruple (DivisionQuadruple operand1 operand2 (Store register)) | IntOperand immediateOperand1 <- operand1 , IntOperand immediateOperand2 <- operand2 = @@ -261,198 +218,18 @@ quadruple (DivisionQuadruple operand1 operand2 (Store register)) ] quadruple (LabelQuadruple (Label label)) = pure $ Vector.singleton $ JumpLabel label mempty quadruple (GoToQuadruple label) = pure $ Vector.singleton $ unconditionalJal label -quadruple (EqualQuadruple operand1 operand2 goToLabel) - | IntOperand immediateOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - if immediateOperand1 == immediateOperand2 - then pure $ Vector.singleton $ unconditionalJal goToLabel - else pure Vector.empty - | VariableOperand variableOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = do - let Store operandRegister1 = variableOperand1 - Store operandRegister2 = variableOperand2 - Label goToLabel' = goToLabel - pure $ Vector.singleton - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BEQ operandRegister1 operandRegister2 - | VariableOperand variableOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - compareImmediateRegister variableOperand1 immediateOperand2 - | IntOperand immediateOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = - compareImmediateRegister variableOperand2 immediateOperand1 - where - compareImmediateRegister variableOperand immediateOperand = - let statements = lui immediateOperand immediateRegister - Store operandRegister = variableOperand - Label goToLabel' = goToLabel - in pure $ Vector.snoc statements - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BEQ operandRegister immediateRegister -quadruple (NonEqualQuadruple operand1 operand2 goToLabel) - | IntOperand immediateOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - if immediateOperand1 /= immediateOperand2 - then pure $ Vector.singleton $ unconditionalJal goToLabel - else pure Vector.empty - | VariableOperand variableOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = do - let Store operandRegister1 = variableOperand1 - Store operandRegister2 = variableOperand2 - Label goToLabel' = goToLabel - pure $ Vector.singleton - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BNE operandRegister1 operandRegister2 - | VariableOperand variableOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - compareImmediateRegister variableOperand1 immediateOperand2 - | IntOperand immediateOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = - compareImmediateRegister variableOperand2 immediateOperand1 - where - compareImmediateRegister variableOperand immediateOperand = - let statements = lui immediateOperand immediateRegister - Store operandRegister = variableOperand - Label goToLabel' = goToLabel - in pure $ Vector.snoc statements - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BNE operandRegister immediateRegister -quadruple (LessQuadruple operand1 operand2 goToLabel) - | IntOperand immediateOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - if immediateOperand1 < immediateOperand2 - then pure $ Vector.singleton $ unconditionalJal goToLabel - else pure Vector.empty - | VariableOperand variableOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = do - let Store operandRegister1 = variableOperand1 - Store operandRegister2 = variableOperand2 - Label goToLabel' = goToLabel - pure $ Vector.singleton - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 operandRegister2 - | VariableOperand variableOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - let statements2 = lui immediateOperand2 immediateRegister - Store operandRegister1 = variableOperand1 - Label goToLabel' = goToLabel - in pure $ Vector.snoc statements2 - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 immediateRegister - | IntOperand immediateOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = - let statements1 = lui immediateOperand1 immediateRegister - Store operandRegister2 = variableOperand2 - Label goToLabel' = goToLabel - in pure $ Vector.snoc statements1 - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BLT immediateRegister operandRegister2 -quadruple (GreaterQuadruple operand1 operand2 goToLabel) - | IntOperand immediateOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - if immediateOperand1 > immediateOperand2 - then pure $ Vector.singleton $ unconditionalJal goToLabel - else pure Vector.empty - | VariableOperand variableOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = do - let Store operandRegister1 = variableOperand1 - Store operandRegister2 = variableOperand2 - Label goToLabel' = goToLabel - pure $ Vector.singleton - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister2 operandRegister1 - | VariableOperand variableOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - let statements2 = lui immediateOperand2 immediateRegister - Store operandRegister1 = variableOperand1 - Label goToLabel' = goToLabel - in pure $ Vector.snoc statements2 - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BLT immediateRegister operandRegister1 - | IntOperand immediateOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = - let statements1 = lui immediateOperand1 immediateRegister - Store operandRegister2 = variableOperand2 - Label goToLabel' = goToLabel - in pure $ Vector.snoc statements1 - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister2 immediateRegister -quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) - | IntOperand immediateOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - if immediateOperand1 <= immediateOperand2 - then pure $ Vector.singleton $ unconditionalJal goToLabel - else pure Vector.empty - | VariableOperand variableOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = do - let Store operandRegister1 = variableOperand1 - Store operandRegister2 = variableOperand2 - Label goToLabel' = goToLabel - pure $ Vector.singleton - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 operandRegister1 - | VariableOperand variableOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - let statements2 = lui immediateOperand2 immediateRegister - Store operandRegister1 = variableOperand1 - Label goToLabel' = goToLabel - in pure $ Vector.snoc statements2 - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BGE immediateRegister operandRegister1 - | IntOperand immediateOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = - let statements1 = lui immediateOperand1 immediateRegister - Store operandRegister2 = variableOperand2 - Label goToLabel' = goToLabel - in pure $ Vector.snoc statements1 - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 immediateRegister -quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) - | IntOperand immediateOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - if immediateOperand1 >= immediateOperand2 - then pure $ Vector.singleton $ unconditionalJal goToLabel - else pure Vector.empty - | VariableOperand variableOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = - let Store operandRegister1 = variableOperand1 - Store operandRegister2 = variableOperand2 - Label goToLabel' = goToLabel - in pure $ Vector.singleton - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister1 operandRegister2 - | VariableOperand variableOperand1 <- operand1 - , IntOperand immediateOperand2 <- operand2 = - let statements2 = lui immediateOperand2 immediateRegister - Store operandRegister1 = variableOperand1 - Label goToLabel' = goToLabel - in pure $ Vector.snoc statements2 - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister1 immediateRegister - | IntOperand immediateOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = - let statements1 = lui immediateOperand1 immediateRegister - Store operandRegister2 = variableOperand2 - Label goToLabel' = goToLabel - in pure $ Vector.snoc statements1 - $ Instruction - $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BGE immediateRegister operandRegister2 +quadruple (EqualQuadruple operand1 operand2 goToLabel) = + commutativeComparison (==) RiscV.BEQ (operand1, operand2) goToLabel +quadruple (NonEqualQuadruple operand1 operand2 goToLabel) = + commutativeComparison (/=) RiscV.BNE (operand1, operand2) goToLabel +quadruple (LessQuadruple operand1 operand2 goToLabel) = + lessThan (operand1, operand2) goToLabel +quadruple (GreaterQuadruple operand1 operand2 goToLabel) = + lessThan (operand2, operand1) goToLabel +quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) = + lessOrEqualThan (operand1, operand2) goToLabel +quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) = + lessOrEqualThan (operand2, operand1) goToLabel quadruple (AssignQuadruple operand1 (Store register)) | IntOperand immediateOperand1 <- operand1 = pure $ lui immediateOperand1 register @@ -489,3 +266,143 @@ lui intValue targetRegister where hi = intValue `shiftR` 12 lo = fromIntegral intValue + +commutativeBinary + :: (Int32 -> Int32 -> Int32) + -> RiscV.Funct3 + -> RiscV.Funct7 + -> (Operand RiscVStore, Operand RiscVStore) + -> Store RiscV.XRegister + -> RiscVGenerator (Vector Statement) +commutativeBinary immediateOperation funct3 funct7 (operand1, operand2) (Store register) + | IntOperand immediateOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = pure + $ lui (immediateOperation immediateOperand1 immediateOperand2) register + | VariableOperand variableOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = + let Store operandRegister1 = variableOperand1 + Store operandRegister2 = variableOperand2 + in pure $ Vector.singleton $ Instruction + $ RiscV.BaseInstruction RiscV.Op + $ RiscV.R register funct3 operandRegister1 operandRegister2 funct7 + | VariableOperand variableOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + commutativeImmediateRegister variableOperand1 immediateOperand2 + | IntOperand immediateOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = + commutativeImmediateRegister variableOperand2 immediateOperand1 + where + commutativeImmediateRegister variableOperand immediateOperand = + let statements = lui immediateOperand register + Store operandRegister = variableOperand + in pure $ Vector.snoc statements + $ Instruction + $ RiscV.BaseInstruction RiscV.Op + $ RiscV.R register funct3 register operandRegister funct7 + +commutativeComparison + :: (Int32 -> Int32 -> Bool) + -> RiscV.Funct3 + -> (Operand RiscVStore, Operand RiscVStore) + -> Label + -> RiscVGenerator (Vector Statement) +commutativeComparison immediateOperation funct3 (operand1, operand2) goToLabel + | IntOperand immediateOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + if immediateOperation immediateOperand1 immediateOperand2 + then pure $ Vector.singleton $ unconditionalJal goToLabel + else pure Vector.empty + | VariableOperand variableOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = do + let Store operandRegister1 = variableOperand1 + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + pure $ Vector.singleton + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' funct3 operandRegister1 operandRegister2 + | VariableOperand variableOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + compareImmediateRegister variableOperand1 immediateOperand2 + | IntOperand immediateOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = + compareImmediateRegister variableOperand2 immediateOperand1 + where + compareImmediateRegister variableOperand immediateOperand = + let statements = lui immediateOperand immediateRegister + Store operandRegister = variableOperand + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' funct3 operandRegister immediateRegister + +lessThan :: (Operand RiscVStore, Operand RiscVStore) -> Label -> RiscVGenerator (Vector Statement) +lessThan (operand1, operand2) goToLabel + | IntOperand immediateOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + if immediateOperand1 < immediateOperand2 + then pure $ Vector.singleton $ unconditionalJal goToLabel + else pure Vector.empty + | VariableOperand variableOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = do + let Store operandRegister1 = variableOperand1 + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + pure $ Vector.singleton + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 operandRegister2 + | VariableOperand variableOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + let statements2 = lui immediateOperand2 immediateRegister + Store operandRegister1 = variableOperand1 + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements2 + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 immediateRegister + | IntOperand immediateOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = + let statements1 = lui immediateOperand1 immediateRegister + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements1 + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BLT immediateRegister operandRegister2 + +lessOrEqualThan :: (Operand RiscVStore, Operand RiscVStore) -> Label -> RiscVGenerator (Vector Statement) +lessOrEqualThan (operand1, operand2) goToLabel + | IntOperand immediateOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + if immediateOperand1 <= immediateOperand2 + then pure $ Vector.singleton $ unconditionalJal goToLabel + else pure Vector.empty + | VariableOperand variableOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = do + let Store operandRegister1 = variableOperand1 + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + pure $ Vector.singleton + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 operandRegister1 + | VariableOperand variableOperand1 <- operand1 + , IntOperand immediateOperand2 <- operand2 = + let statements2 = lui immediateOperand2 immediateRegister + Store operandRegister1 = variableOperand1 + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements2 + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BGE immediateRegister operandRegister1 + | IntOperand immediateOperand1 <- operand1 + , VariableOperand variableOperand2 <- operand2 = + let statements1 = lui immediateOperand1 immediateRegister + Store operandRegister2 = variableOperand2 + Label goToLabel' = goToLabel + in pure $ Vector.snoc statements1 + $ Instruction + $ RiscV.RelocatableInstruction RiscV.Branch + $ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 immediateRegister diff --git a/tests/expectations/add_to_variable.txt b/tests/expectations/add_to_variable.txt new file mode 100644 index 0000000..8c61d23 --- /dev/null +++ b/tests/expectations/add_to_variable.txt @@ -0,0 +1 @@ +58 diff --git a/tests/vm/add_to_variable.elna b/tests/vm/add_to_variable.elna new file mode 100644 index 0000000..cbcfc8e --- /dev/null +++ b/tests/vm/add_to_variable.elna @@ -0,0 +1,6 @@ +proc main() { + var i: int; + i := 28; + + printi(i + 30); +}