Map local variables in IR to their original names

This commit is contained in:
Eugen Wissner 2024-11-14 19:55:30 +01:00
parent 060496fc6e
commit 1ec3467830
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
7 changed files with 376 additions and 386 deletions

4
TODO
View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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,354 +119,140 @@ 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))
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)
| IntOperand immediateOperand1 <- operand1
, IntOperand immediateOperand2 <- operand2 =
pure $ lui (immediateOperand1 + immediateOperand2) register
let (storeRegister, storeStatements) = storeToStore store
in pure $ lui (immediateOperand1 - immediateOperand2) storeRegister <> storeStatements
| 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
let (storeRegister, storeStatements) = storeToStore store
(operandRegister1, statements1) = loadFromStore variableOperand1
(operandRegister2, statements2) = loadFromStore variableOperand2
instruction = Instruction
$ RiscV.BaseInstruction RiscV.Op
$ RiscV.R storeRegister RiscV.SUB operandRegister1 operandRegister2
$ RiscV.Funct7 0b0100000
in pure $ statements1 <> statements2 <> Vector.cons instruction storeStatements
| 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 (SubtractionQuadruple 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.SUB operandRegister1 operandRegister2
$ RiscV.Funct7 0b0100000
| IntOperand immediateOperand1 <- operand1
, VariableOperand variableOperand2 <- operand2 =
let statements1 = lui immediateOperand1 register
Store operandRegister2 = variableOperand2
in pure $ Vector.snoc statements1
$ Instruction
$ RiscV.BaseInstruction RiscV.Op
$ RiscV.R register RiscV.SUB register operandRegister2
$ RiscV.Funct7 0b0100000
let (storeRegister, storeStatements) = storeToStore store
statements1 = lui immediateOperand1 storeRegister
(operandRegister2, statements2) = loadFromStore variableOperand2
instruction = Instruction
$ RiscV.BaseInstruction RiscV.Op
$ RiscV.R storeRegister RiscV.SUB storeRegister operandRegister2
$ RiscV.Funct7 0b0100000
in pure $ statements1 <> statements2 <> Vector.cons instruction storeStatements
| VariableOperand variableOperand1 <- operand1
, IntOperand immediateOperand2 <- operand2 =
let statements2 = lui (negate immediateOperand2) register
Store operandRegister1 = variableOperand1
in pure $ Vector.snoc statements2
$ Instruction
$ RiscV.BaseInstruction RiscV.Op
$ RiscV.R register RiscV.ADD register operandRegister1
$ RiscV.Funct7 0b0000000
quadruple (NegationQuadruple operand1 (Store register))
let (storeRegister, storeStatements) = storeToStore store
statements2 = lui (negate immediateOperand2) storeRegister
(operandRegister1, statements1) = loadFromStore variableOperand1
instruction = Instruction
$ RiscV.BaseInstruction RiscV.Op
$ RiscV.R storeRegister RiscV.ADD storeRegister operandRegister1
$ RiscV.Funct7 0b0000000
in pure $ statements1 <> statements2 <> Vector.cons instruction storeStatements
quadruple (NegationQuadruple operand1 store)
| IntOperand immediateOperand1 <- operand1 =
pure $ lui (negate immediateOperand1) register
let (storeRegister, storeStatements) = storeToStore store
in pure $ lui (negate immediateOperand1) storeRegister <> storeStatements
| VariableOperand variableOperand1 <- operand1 =
let Store operandRegister1 = variableOperand1
in pure $ Vector.singleton
$ Instruction
$ 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))
let (storeRegister, storeStatements) = storeToStore store
(operandRegister1, statements1) = loadFromStore variableOperand1
instruction = Instruction
$ RiscV.BaseInstruction RiscV.Op
$ RiscV.R storeRegister RiscV.SUB RiscV.Zero operandRegister1
$ RiscV.Funct7 0b0100000
in pure $ statements1 <> Vector.cons instruction storeStatements
quadruple (DivisionQuadruple operand1 operand2 store)
| IntOperand immediateOperand1 <- operand1
, IntOperand immediateOperand2 <- operand2 =
if immediateOperand2 == 0
then pure $ Vector.singleton
$ Instruction (RiscV.CallInstruction "_divide_by_zero_error")
else pure $ lui (quot immediateOperand1 immediateOperand2) register
else
let (storeRegister, storeStatements) = storeToStore store
in pure $ lui (quot immediateOperand1 immediateOperand2) storeRegister <> storeStatements
| VariableOperand variableOperand1 <- operand1
, VariableOperand variableOperand2 <- operand2 = do
let Store operandRegister1 = variableOperand1
Store operandRegister2 = variableOperand2
let (storeRegister, storeStatements) = storeToStore store
(operandRegister1, statements1) = loadFromStore variableOperand1
(operandRegister2, statements2) = loadFromStore variableOperand2
divisionInstruction = Instruction
$ RiscV.BaseInstruction RiscV.Op
$ RiscV.R register RiscV.DIV operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001)
$ RiscV.R storeRegister RiscV.DIV operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001)
branchLabel <- createLabel
let branchInstruction = Instruction
$ RiscV.RelocatableInstruction RiscV.Branch
$ RiscV.RBranch branchLabel RiscV.BNE RiscV.Zero operandRegister2
pure $ Vector.fromList
pure $ statements1 <> statements2 <> Vector.fromList
[ branchInstruction
, Instruction (RiscV.CallInstruction "_divide_by_zero_error")
, JumpLabel branchLabel []
, divisionInstruction
]
] <> storeStatements
| VariableOperand variableOperand1 <- operand1
, IntOperand immediateOperand2 <- operand2 =
let statements2 = lui immediateOperand2 register
Store operandRegister1 = variableOperand1
let (storeRegister, storeStatements) = storeToStore store
statements2 = lui immediateOperand2 storeRegister
(operandRegister1, statements1) = loadFromStore variableOperand1
operationInstruction
| immediateOperand2 == 0 =
RiscV.CallInstruction "_divide_by_zero_error"
| otherwise = RiscV.BaseInstruction RiscV.Op
$ RiscV.R register RiscV.DIV operandRegister1 register
$ RiscV.R storeRegister RiscV.DIV operandRegister1 storeRegister
$ RiscV.Funct7 0b0000001
in pure $ Vector.snoc statements2
$ Instruction operationInstruction
in pure $ statements1 <> statements2
<> Vector.cons (Instruction operationInstruction) storeStatements
| IntOperand immediateOperand1 <- operand1
, VariableOperand variableOperand2 <- operand2 = do
let statements1 = lui immediateOperand1 register
Store operandRegister2 = variableOperand2
let (storeRegister, storeStatements) = storeToStore store
statements1 = lui immediateOperand1 storeRegister
(operandRegister2, statements2) = loadFromStore variableOperand2
divisionInstruction = Instruction
$ RiscV.BaseInstruction RiscV.Op
$ RiscV.R register RiscV.DIV register operandRegister2 (RiscV.Funct7 0b0000001)
$ RiscV.R storeRegister RiscV.DIV storeRegister operandRegister2 (RiscV.Funct7 0b0000001)
branchLabel <- createLabel
let branchInstruction = Instruction
$ RiscV.RelocatableInstruction RiscV.Branch
$ RiscV.RBranch branchLabel RiscV.BNE RiscV.Zero operandRegister2
pure $ mappend statements1 $ Vector.fromList
pure $ statements1 <> statements2 <> Vector.fromList
[ branchInstruction
, Instruction (RiscV.CallInstruction "_divide_by_zero_error")
, JumpLabel branchLabel []
, divisionInstruction
]
] <> storeStatements
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 (AssignQuadruple operand1 (Store register))
| IntOperand immediateOperand1 <- operand1 = pure
$ lui immediateOperand1 register
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)
| IntOperand immediateOperand1 <- operand1 =
let (storeRegister, storeStatements) = storeToStore store
in pure $ lui immediateOperand1 storeRegister <> storeStatements
| VariableOperand variableOperand1 <- operand1 =
let Store operandRegister1 = variableOperand1
in pure $ Vector.singleton
$ Instruction
$ RiscV.BaseInstruction RiscV.OpImm
$ RiscV.I register RiscV.ADDI operandRegister1 0
let (operandRegister1, statements1) = loadFromStore variableOperand1
(storeRegister, storeStatements) = storeToStore store
instruction = Instruction
$ RiscV.BaseInstruction RiscV.OpImm
$ RiscV.I storeRegister RiscV.ADDI operandRegister1 0
in pure $ statements1 <> Vector.cons instruction storeStatements
unconditionalJal :: Label -> Statement
unconditionalJal (Label goToLabel) = Instruction
@ -471,7 +262,7 @@ unconditionalJal (Label goToLabel) = Instruction
loadImmediateOrRegister :: RiscVOperand -> RiscV.XRegister -> (RiscV.XRegister, Vector Statement)
loadImmediateOrRegister (IntOperand intValue) targetRegister =
(targetRegister, lui intValue targetRegister)
loadImmediateOrRegister (VariableOperand (Store register)) _ = (register, Vector.empty)
loadImmediateOrRegister (VariableOperand store) _ = loadFromStore store
lui :: Int32 -> RiscV.XRegister -> Vector Statement
lui intValue targetRegister
@ -489,3 +280,165 @@ 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
| IntOperand immediateOperand1 <- operand1
, IntOperand immediateOperand2 <- operand2 =
let (storeRegister, storeStatements) = storeToStore store
immediateOperation' = immediateOperation immediateOperand1 immediateOperand2
in pure $ lui immediateOperation' storeRegister <> storeStatements
| VariableOperand variableOperand1 <- operand1
, VariableOperand variableOperand2 <- operand2 =
let (operandRegister1, statements1) = loadFromStore variableOperand1
(operandRegister2, statements2) = loadFromStore variableOperand2
(storeRegister, storeStatements) = storeToStore store
instruction = Instruction $ RiscV.BaseInstruction RiscV.Op
$ RiscV.R storeRegister funct3 operandRegister1 operandRegister2 funct7
in pure $ statements1 <> statements2
<> Vector.cons instruction storeStatements
| VariableOperand variableOperand1 <- operand1
, IntOperand immediateOperand2 <- operand2 =
commutativeImmediateRegister variableOperand1 immediateOperand2
| IntOperand immediateOperand1 <- operand1
, VariableOperand variableOperand2 <- operand2 =
commutativeImmediateRegister variableOperand2 immediateOperand1
where
commutativeImmediateRegister variableOperand immediateOperand =
let (storeRegister, storeStatements) = storeToStore store
immediateStatements = lui immediateOperand storeRegister
(operandRegister, registerStatements) = loadFromStore variableOperand
instruction = Instruction
$ RiscV.BaseInstruction RiscV.Op
$ RiscV.R storeRegister funct3 storeRegister operandRegister funct7
in pure $ immediateStatements <> registerStatements
<> Vector.cons instruction storeStatements
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 (operandRegister1, statements1) = loadFromStore variableOperand1
(operandRegister2, statements2) = loadFromStore variableOperand2
Label goToLabel' = goToLabel
pure $ Vector.snoc (statements1 <> statements2)
$ 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 immediateStatements = lui immediateOperand immediateRegister
(operandRegister, registerStatements) = loadFromStore variableOperand
Label goToLabel' = goToLabel
in pure $ Vector.snoc (immediateStatements <> registerStatements)
$ 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 (operandRegister1, statements1) = loadFromStore variableOperand1
(operandRegister2, statements2) = loadFromStore variableOperand2
Label goToLabel' = goToLabel
pure $ Vector.snoc (statements1 <> statements2)
$ Instruction
$ RiscV.RelocatableInstruction RiscV.Branch
$ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 operandRegister2
| VariableOperand variableOperand1 <- operand1
, IntOperand immediateOperand2 <- operand2 =
let statements2 = lui immediateOperand2 immediateRegister
(operandRegister1, statements1) = loadFromStore variableOperand1
Label goToLabel' = goToLabel
in pure $ Vector.snoc (statements1 <> statements2)
$ Instruction
$ RiscV.RelocatableInstruction RiscV.Branch
$ RiscV.RBranch goToLabel' RiscV.BLT operandRegister1 immediateRegister
| IntOperand immediateOperand1 <- operand1
, VariableOperand variableOperand2 <- operand2 =
let statements1 = lui immediateOperand1 immediateRegister
(operandRegister2, statements2) = loadFromStore variableOperand2
Label goToLabel' = goToLabel
in pure $ Vector.snoc (statements1 <> statements2)
$ 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 (operandRegister1, statements1) = loadFromStore variableOperand1
(operandRegister2, statements2) = loadFromStore variableOperand2
Label goToLabel' = goToLabel
pure $ Vector.snoc (statements1 <> statements2)
$ Instruction
$ RiscV.RelocatableInstruction RiscV.Branch
$ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 operandRegister1
| VariableOperand variableOperand1 <- operand1
, IntOperand immediateOperand2 <- operand2 =
let statements2 = lui immediateOperand2 immediateRegister
(operandRegister1, statements1) = loadFromStore variableOperand1
Label goToLabel' = goToLabel
in pure $ Vector.snoc (statements1 <> statements2)
$ Instruction
$ RiscV.RelocatableInstruction RiscV.Branch
$ RiscV.RBranch goToLabel' RiscV.BGE immediateRegister operandRegister1
| IntOperand immediateOperand1 <- operand1
, VariableOperand variableOperand2 <- operand2 =
let statements1 = lui immediateOperand1 immediateRegister
(operandRegister2, statements2) = loadFromStore variableOperand2
Label goToLabel' = goToLabel
in pure $ Vector.snoc (statements1 <> statements2)
$ Instruction
$ RiscV.RelocatableInstruction RiscV.Branch
$ RiscV.RBranch goToLabel' RiscV.BGE operandRegister2 immediateRegister
loadFromStore :: RiscVStore -> (RiscV.XRegister, Vector Statement)
loadFromStore (RegisterStore register) = (register, mempty)
loadFromStore (StackStore offset register) =
let loadInstruction = Instruction
$ RiscV.BaseInstruction RiscV.Load
$ RiscV.I register RiscV.LW RiscV.SP offset
in (register, Vector.singleton loadInstruction)
storeToStore :: RiscVStore -> (RiscV.XRegister, Vector Statement)
storeToStore (RegisterStore register) = (register, mempty)
storeToStore (StackStore offset register) =
let storeInstruction = Instruction
$ RiscV.BaseInstruction RiscV.Store
$ RiscV.S offset RiscV.SW RiscV.SP register
in (register, Vector.singleton storeInstruction)

View File

@ -0,0 +1 @@
58

View File

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