From 1ec34678308709f7f6103bd4d67347ad859479c8 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Thu, 14 Nov 2024 19:55:30 +0100 Subject: Map local variables in IR to their original names --- lib/Language/Elna/Backend/Allocator.hs | 111 ++++++++++++++++-------------- lib/Language/Elna/Backend/Intermediate.hs | 9 ++- 2 files changed, 66 insertions(+), 54 deletions(-) (limited to 'lib/Language/Elna/Backend') diff --git a/lib/Language/Elna/Backend/Allocator.hs b/lib/Language/Elna/Backend/Allocator.hs index 0c3e5c3..ac54c78 100644 --- a/lib/Language/Elna/Backend/Allocator.hs +++ b/lib/Language/Elna/Backend/Allocator.hs @@ -5,11 +5,19 @@ module Language.Elna.Backend.Allocator ) where import Data.HashMap.Strict (HashMap) +import Data.Word (Word32) 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 +data Store r + = RegisterStore r + | StackStore Word32 r newtype MachineConfiguration r = MachineConfiguration { temporaryRegisters :: [r] @@ -19,60 +27,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) = RegisterStore $ 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) = RegisterStore + $ 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 -- cgit v1.2.3