belka/elna
1
0
Fork 0
Code Issues 5 Pull Requests Releases Activity

Map local variables in IR to their original names

Browse Source
This commit is contained in:
Eugen Wissner
2024-11-14 19:55:30 +01:00
parent 060496fc6e
commit 1ec3467830
7 changed files with 376 additions and 386 deletions
Download Patch File Download Diff File Expand all files Collapse all files

111
lib/Language/Elna/Backend/Allocator.hs
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)

9
lib/Language/Elna/Backend/Intermediate.hs
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

72
lib/Language/Elna/Glue.hs
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

559
lib/Language/Elna/RiscV/CodeGenerator.hs
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)