Adjust stack size based on local variables

This commit is contained in:
Eugen Wissner 2024-11-20 17:38:03 +01:00
parent 276d4c963b
commit 0c9799b887
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
5 changed files with 74 additions and 48 deletions
lib/Language/Elna
tests

View File

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

View File

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

View File

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

View File

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

View File

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