Adjust stack size based on local variables

lib/Language/Elna/Backend/Allocator.hs

@@ -15,8 +15,9 @@ import Language.Elna.Backend.Intermediate
     )
 import Language.Elna.Location (Identifier(..))
 import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT)
-import Control.Monad.Trans.State (State, runState)
+import Control.Monad.Trans.State (State, runState, modify')
 import GHC.Records (HasField(..))
+import Control.Monad.Trans.Class (MonadTrans(lift))
 
 data Store r
     = RegisterStore r
@@ -26,8 +27,12 @@ newtype MachineConfiguration r = MachineConfiguration
     { temporaryRegisters :: [r]
     }
 
+newtype MachineState = MachineState
+    { stackSize :: Word32
+    } deriving (Eq, Show)
+
 newtype Allocator r a = Allocator
-    { runAllocator :: ReaderT (MachineConfiguration r) (State Word32) a
+    { runAllocator :: ReaderT (MachineConfiguration r) (State MachineState) a
     }
 
 instance forall r. Functor (Allocator r)
@@ -51,14 +56,16 @@ allocate
 allocate machineConfiguration = fmap function
   where
     function :: Vector (Quadruple Variable) -> ProcedureQuadruples (Store r)
-    function quadruples' = ProcedureQuadruples
+    function quadruples' =
-        { quadruples = fst
+        let (result, lastState)
-            $ flip runState 0
+                = flip runState (MachineState{ stackSize = 0 })
-            $ flip runReaderT machineConfiguration
+                $ flip runReaderT machineConfiguration
-            $ runAllocator
+                $ runAllocator
-            $ mapM quadruple quadruples'
+                $ mapM quadruple quadruples'
-        , stackSize = 0
+         in ProcedureQuadruples
-        }
+            { quadruples = result
+            , stackSize = getField @"stackSize" lastState
+            }
 
 quadruple :: Quadruple Variable -> Allocator r (Quadruple (Store r))
 quadruple = \case
@@ -129,5 +136,6 @@ storeVariable (TempVariable index) = do
         $ temporaryRegisters' !! fromIntegral index
 storeVariable (LocalVariable index) = do
     temporaryRegisters' <- Allocator $ asks $ getField @"temporaryRegisters"
-    pure $ RegisterStore
+    Allocator $ lift $ modify' $ MachineState . (+ 4) . getField @"stackSize"
+    pure $ StackStore (index * 4)
         $ temporaryRegisters' !! pred (length temporaryRegisters' - fromIntegral index)

lib/Language/Elna/Glue.hs

@@ -102,7 +102,7 @@ statement localTable (AST.CallStatement (AST.Identifier callName) arguments) = d
         $ Vector.snoc (argumentStatements <> parameterStatements)
         $ CallQuadruple callName
         $ fromIntegral
-        $ Vector.length argumentStatements
+        $ length arguments
 statement localTable (AST.CompoundStatement statements) =
     fold <$> traverse (statement localTable) statements
 statement localTable (AST.IfStatement ifCondition ifStatement elseStatement) = do

lib/Language/Elna/RiscV/CodeGenerator.hs

@@ -91,39 +91,45 @@ generateRiscV = flip evalState 0
     . foldlM go Vector.empty
     . HashMap.toList
   where
-    go accumulator (Identifier key, ProcedureQuadruples{ quadruples = value }) =
+    go accumulator (Identifier key, ProcedureQuadruples{ stackSize, quadruples = value }) =
         let code = Vector.cons (JumpLabel key [GlobalDirective, FunctionDirective])
-                . fold <$> mapM quadruple value
+                . fold <$> mapM (quadruple stackSize) value
          in (accumulator <>) <$> code
 
-quadruple :: RiscVQuadruple -> RiscVGenerator (Vector Statement)
+quadruple :: Word32 -> RiscVQuadruple -> RiscVGenerator (Vector Statement)
-quadruple StartQuadruple = pure $ Vector.fromList
+quadruple stackSize StartQuadruple =
-    [ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP (negate 4))
+    let totalStackSize = stackSize + 4
-    , Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 0 RiscV.SW RiscV.SP RiscV.S0)
+     in pure $ Vector.fromList
-    , Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 4 RiscV.SW RiscV.SP RiscV.RA)
+        [ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP (negate totalStackSize))
-    , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.S0 RiscV.ADDI RiscV.SP 4)
+        , Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 0 RiscV.SW RiscV.SP RiscV.S0)
-    ]
+        , Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 4 RiscV.SW RiscV.SP RiscV.RA)
-quadruple (ParameterQuadruple operand1) =
+        , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.S0 RiscV.ADDI RiscV.SP totalStackSize)
+        ]
+quadruple stackSize StopQuadruple =
+    let totalStackSize = stackSize + 4
+     in pure $ Vector.fromList
+        [ Instruction (RiscV.BaseInstruction RiscV.Load $ RiscV.I RiscV.S0 RiscV.LW RiscV.SP 0)
+        , Instruction (RiscV.BaseInstruction RiscV.Load $ RiscV.I RiscV.RA RiscV.LW RiscV.SP 4)
+        , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP totalStackSize)
+        , Instruction (RiscV.BaseInstruction RiscV.Jalr $ RiscV.I RiscV.RA RiscV.JALR RiscV.Zero 0)
+        ]
+quadruple _ (ParameterQuadruple operand1) =
     let (operandRegister, statements) = loadImmediateOrRegister operand1 RiscV.A0
      in pure $ 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 operandRegister)
         ]
-quadruple (CallQuadruple callName numberOfArguments) = pure $ Vector.fromList
+quadruple _ (CallQuadruple callName numberOfArguments) =
-    [ Instruction (RiscV.CallInstruction callName)
+    let restoreStackSize = numberOfArguments * 4
-    , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP (numberOfArguments * 4))
+     in pure $ Vector.fromList
-    ]
+        [ Instruction (RiscV.CallInstruction callName)
-quadruple StopQuadruple = pure $ Vector.fromList
+        , Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP restoreStackSize)
-    [ Instruction (RiscV.BaseInstruction RiscV.Load $ RiscV.I RiscV.S0 RiscV.LW RiscV.SP 0)
+        ]
-    , Instruction (RiscV.BaseInstruction RiscV.Load $ RiscV.I RiscV.RA RiscV.LW RiscV.SP 4)
+quadruple _ (AddQuadruple operand1 operand2 store) =
-    , 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) =
     commutativeBinary (+) RiscV.ADD (RiscV.Funct7 0b0000000) (operand1, operand2) store
-quadruple (ProductQuadruple operand1 operand2 store) =
+quadruple _ (ProductQuadruple operand1 operand2 store) =
     commutativeBinary (*) RiscV.MUL (RiscV.Funct7 0b0000001) (operand1, operand2) store
-quadruple (SubtractionQuadruple operand1 operand2 store)
+quadruple _ (SubtractionQuadruple operand1 operand2 store)
     | IntOperand immediateOperand1 <- operand1
     , IntOperand immediateOperand2 <- operand2 =
         let (storeRegister, storeStatements) = storeToStore store
@@ -158,7 +164,7 @@ quadruple (SubtractionQuadruple operand1 operand2 store)
                 $ RiscV.R storeRegister RiscV.ADD storeRegister operandRegister1
                 $ RiscV.Funct7 0b0000000
          in pure $ statements1 <> statements2 <> Vector.cons instruction storeStatements
-quadruple (NegationQuadruple operand1 store)
+quadruple _ (NegationQuadruple operand1 store)
     | IntOperand immediateOperand1 <- operand1 =
         let (storeRegister, storeStatements) = storeToStore store
          in pure $ lui (negate immediateOperand1) storeRegister <> storeStatements
@@ -170,7 +176,7 @@ quadruple (NegationQuadruple operand1 store)
                 $ RiscV.R storeRegister RiscV.SUB RiscV.Zero operandRegister1
                 $ RiscV.Funct7 0b0100000
          in pure $ statements1 <> Vector.cons instruction storeStatements
-quadruple (DivisionQuadruple operand1 operand2 store)
+quadruple _ (DivisionQuadruple operand1 operand2 store)
     | IntOperand immediateOperand1 <- operand1
     , IntOperand immediateOperand2 <- operand2 =
         if immediateOperand2 == 0
@@ -228,21 +234,21 @@ quadruple (DivisionQuadruple operand1 operand2 store)
             , JumpLabel branchLabel []
             , divisionInstruction
             ] <> storeStatements
-quadruple (LabelQuadruple (Label label)) = pure $ Vector.singleton $ JumpLabel label mempty
+quadruple _ (LabelQuadruple (Label label)) = pure $ Vector.singleton $ JumpLabel label mempty
-quadruple (GoToQuadruple label) = pure $ Vector.singleton $ unconditionalJal label
+quadruple _ (GoToQuadruple label) = pure $ Vector.singleton $ unconditionalJal label
-quadruple (EqualQuadruple operand1 operand2 goToLabel) =
+quadruple _ (EqualQuadruple operand1 operand2 goToLabel) =
     commutativeComparison (==) RiscV.BEQ (operand1, operand2) goToLabel
-quadruple (NonEqualQuadruple operand1 operand2 goToLabel) =
+quadruple _ (NonEqualQuadruple operand1 operand2 goToLabel) =
     commutativeComparison (/=) RiscV.BNE (operand1, operand2) goToLabel
-quadruple (LessQuadruple operand1 operand2 goToLabel) =
+quadruple _ (LessQuadruple operand1 operand2 goToLabel) =
     lessThan (operand1, operand2) goToLabel
-quadruple (GreaterQuadruple operand1 operand2 goToLabel) =
+quadruple _ (GreaterQuadruple operand1 operand2 goToLabel) =
     lessThan (operand2, operand1) goToLabel
-quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) =
+quadruple _ (LessOrEqualQuadruple operand1 operand2 goToLabel) =
     lessOrEqualThan (operand1, operand2) goToLabel
-quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) =
+quadruple _ (GreaterOrEqualQuadruple operand1 operand2 goToLabel) =
     lessOrEqualThan (operand2, operand1) goToLabel
-quadruple (AssignQuadruple operand1 store)
+quadruple _ (AssignQuadruple operand1 store)
     | IntOperand immediateOperand1 <- operand1 =
         let (storeRegister, storeStatements) = storeToStore store
          in pure $ lui immediateOperand1 storeRegister <> storeStatements
@@ -432,7 +438,7 @@ loadFromStore (RegisterStore register) = (register, mempty)
 loadFromStore (StackStore offset register) =
     let loadInstruction = Instruction
             $ RiscV.BaseInstruction RiscV.Load
-            $ RiscV.I register RiscV.LW RiscV.SP offset
+            $ RiscV.I register RiscV.LW RiscV.S0 offset
      in (register, Vector.singleton loadInstruction)
 
 storeToStore :: RiscVStore -> (RiscV.XRegister, Vector Statement)
@@ -440,5 +446,5 @@ storeToStore (RegisterStore register) = (register, mempty)
 storeToStore (StackStore offset register) =
     let storeInstruction = Instruction
             $ RiscV.BaseInstruction RiscV.Store
-            $ RiscV.S offset RiscV.SW RiscV.SP register
+            $ RiscV.S offset RiscV.SW RiscV.S0 register
      in (register, Vector.singleton storeInstruction)

tests/expectations/two_variables.txt

@@ -0,0 +1,2 @@
+58
+28

tests/vm/two_variables.elna

@@ -0,0 +1,10 @@
+proc main() {
+  var i: int;
+  var j: int;
+
+  i := 58;
+  j := 28;
+
+  printi(i);
+  printi(j);
+}