Map local variables in IR to their original names
This commit is contained in:
@ -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)
|
||||
|
||||
Reference in New Issue
Block a user