451 lines
22 KiB
Haskell
451 lines
22 KiB
Haskell
module Language.Elna.RiscV.CodeGenerator
|
|
( Directive(..)
|
|
, Statement(..)
|
|
, generateRiscV
|
|
, riscVConfiguration
|
|
) where
|
|
|
|
import Control.Monad.Trans.State (State, get, evalState, modify')
|
|
import Data.HashMap.Strict (HashMap)
|
|
import qualified Data.HashMap.Strict as HashMap
|
|
import Data.Int (Int32)
|
|
import Data.Word (Word32)
|
|
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(..)
|
|
, ProcedureQuadruples(..)
|
|
, Quadruple(..)
|
|
)
|
|
import Language.Elna.Location (Identifier(..))
|
|
import Data.Bits (Bits(..))
|
|
import Data.Foldable (Foldable(..), foldlM)
|
|
import Data.Text (Text)
|
|
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
|
|
import qualified Data.Text.Lazy.Builder as Text.Builder
|
|
import qualified Data.Text.Lazy as Text.Lazy
|
|
|
|
data Directive
|
|
= GlobalDirective
|
|
| FunctionDirective
|
|
deriving (Eq, Show)
|
|
|
|
data Statement
|
|
= Instruction RiscV.Instruction
|
|
| JumpLabel Text [Directive]
|
|
deriving Eq
|
|
|
|
riscVConfiguration :: MachineConfiguration RiscV.XRegister
|
|
riscVConfiguration = MachineConfiguration
|
|
{ temporaryRegisters =
|
|
[ RiscV.T0
|
|
, RiscV.T1
|
|
, RiscV.T2
|
|
, RiscV.T3
|
|
, RiscV.T4
|
|
, RiscV.T5
|
|
, RiscV.T6
|
|
]
|
|
}
|
|
|
|
-- | Reserved register used for calculations to save an immediate temporary.
|
|
immediateRegister :: RiscV.XRegister
|
|
immediateRegister = RiscV.A7
|
|
|
|
type RiscVStore = Store RiscV.XRegister
|
|
type RiscVQuadruple = Quadruple RiscVStore
|
|
type RiscVOperand = Operand RiscVStore
|
|
|
|
newtype RiscVGenerator a = RiscVGenerator
|
|
{ runRiscVGenerator :: State Word32 a }
|
|
|
|
instance Functor RiscVGenerator
|
|
where
|
|
fmap f (RiscVGenerator x) = RiscVGenerator $ f <$> x
|
|
|
|
instance Applicative RiscVGenerator
|
|
where
|
|
pure = RiscVGenerator . pure
|
|
(RiscVGenerator f) <*> (RiscVGenerator x) = RiscVGenerator $ f <*> x
|
|
|
|
instance Monad RiscVGenerator
|
|
where
|
|
(RiscVGenerator x) >>= f = RiscVGenerator $ x >>= (runRiscVGenerator . f)
|
|
|
|
createLabel :: RiscVGenerator Text
|
|
createLabel = do
|
|
currentCounter <- RiscVGenerator get
|
|
RiscVGenerator $ modify' (+ 1)
|
|
pure
|
|
$ mappend ".A"
|
|
$ Text.Lazy.toStrict
|
|
$ Text.Builder.toLazyText
|
|
$ Text.Builder.decimal currentCounter
|
|
|
|
generateRiscV :: HashMap Identifier (ProcedureQuadruples RiscVStore) -> Vector Statement
|
|
generateRiscV = flip evalState 0
|
|
. runRiscVGenerator
|
|
. foldlM go Vector.empty
|
|
. HashMap.toList
|
|
where
|
|
go accumulator (Identifier key, ProcedureQuadruples{ stackSize, quadruples = value }) =
|
|
let code = Vector.cons (JumpLabel key [GlobalDirective, FunctionDirective])
|
|
. fold <$> mapM (quadruple stackSize) value
|
|
in (accumulator <>) <$> code
|
|
|
|
quadruple :: Word32 -> RiscVQuadruple -> RiscVGenerator (Vector Statement)
|
|
quadruple stackSize StartQuadruple =
|
|
let totalStackSize = stackSize + 4
|
|
in pure $ Vector.fromList
|
|
[ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP (negate totalStackSize))
|
|
, Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 0 RiscV.SW RiscV.SP RiscV.S0)
|
|
, Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 4 RiscV.SW RiscV.SP RiscV.RA)
|
|
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.S0 RiscV.ADDI RiscV.SP totalStackSize)
|
|
]
|
|
quadruple stackSize StopQuadruple =
|
|
let totalStackSize = stackSize + 4
|
|
in pure $ Vector.fromList
|
|
[ Instruction (RiscV.BaseInstruction RiscV.Load $ RiscV.I RiscV.S0 RiscV.LW RiscV.SP 0)
|
|
, Instruction (RiscV.BaseInstruction RiscV.Load $ RiscV.I RiscV.RA RiscV.LW RiscV.SP 4)
|
|
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP totalStackSize)
|
|
, Instruction (RiscV.BaseInstruction RiscV.Jalr $ RiscV.I RiscV.RA RiscV.JALR RiscV.Zero 0)
|
|
]
|
|
quadruple _ (ParameterQuadruple operand1) =
|
|
let (operandRegister, statements) = loadImmediateOrRegister operand1 RiscV.A0
|
|
in pure $ mappend statements $ Vector.fromList
|
|
[ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP (negate 4))
|
|
, Instruction (RiscV.BaseInstruction RiscV.Store $ RiscV.S 0 RiscV.SW RiscV.SP operandRegister)
|
|
]
|
|
quadruple _ (CallQuadruple callName numberOfArguments) =
|
|
let restoreStackSize = numberOfArguments * 4
|
|
in pure $ Vector.fromList
|
|
[ Instruction (RiscV.CallInstruction callName)
|
|
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP restoreStackSize)
|
|
]
|
|
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 =
|
|
let (storeRegister, storeStatements) = storeToStore store
|
|
in pure $ lui (immediateOperand1 - immediateOperand2) storeRegister <> storeStatements
|
|
| VariableOperand variableOperand1 <- operand1
|
|
, VariableOperand variableOperand2 <- operand2 =
|
|
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 =
|
|
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 (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 =
|
|
let (storeRegister, storeStatements) = storeToStore store
|
|
in pure $ lui (negate immediateOperand1) storeRegister <> storeStatements
|
|
| VariableOperand variableOperand1 <- operand1 =
|
|
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
|
|
let (storeRegister, storeStatements) = storeToStore store
|
|
in pure $ lui (quot immediateOperand1 immediateOperand2) storeRegister <> storeStatements
|
|
| VariableOperand variableOperand1 <- operand1
|
|
, VariableOperand variableOperand2 <- operand2 = do
|
|
let (storeRegister, storeStatements) = storeToStore store
|
|
(operandRegister1, statements1) = loadFromStore variableOperand1
|
|
(operandRegister2, statements2) = loadFromStore variableOperand2
|
|
divisionInstruction = Instruction
|
|
$ RiscV.BaseInstruction RiscV.Op
|
|
$ 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 $ statements1 <> statements2 <> Vector.fromList
|
|
[ branchInstruction
|
|
, Instruction (RiscV.CallInstruction "_divide_by_zero_error")
|
|
, JumpLabel branchLabel []
|
|
, divisionInstruction
|
|
] <> storeStatements
|
|
| VariableOperand variableOperand1 <- operand1
|
|
, IntOperand immediateOperand2 <- operand2 =
|
|
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 storeRegister RiscV.DIV operandRegister1 storeRegister
|
|
$ RiscV.Funct7 0b0000001
|
|
in pure $ statements1 <> statements2
|
|
<> Vector.cons (Instruction operationInstruction) storeStatements
|
|
| IntOperand immediateOperand1 <- operand1
|
|
, VariableOperand variableOperand2 <- operand2 = do
|
|
let (storeRegister, storeStatements) = storeToStore store
|
|
statements1 = lui immediateOperand1 storeRegister
|
|
(operandRegister2, statements2) = loadFromStore variableOperand2
|
|
divisionInstruction = Instruction
|
|
$ RiscV.BaseInstruction RiscV.Op
|
|
$ 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 $ 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) =
|
|
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 (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
|
|
$ RiscV.RelocatableInstruction RiscV.Jal
|
|
$ RiscV.RJal RiscV.Zero goToLabel
|
|
|
|
loadImmediateOrRegister :: RiscVOperand -> RiscV.XRegister -> (RiscV.XRegister, Vector Statement)
|
|
loadImmediateOrRegister (IntOperand intValue) targetRegister =
|
|
(targetRegister, lui intValue targetRegister)
|
|
loadImmediateOrRegister (VariableOperand store) _ = loadFromStore store
|
|
|
|
lui :: Int32 -> RiscV.XRegister -> Vector Statement
|
|
lui intValue targetRegister
|
|
| intValue >= -2048
|
|
, intValue <= 2047 = Vector.singleton
|
|
$ Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I targetRegister RiscV.ADDI RiscV.Zero lo)
|
|
| intValue .&. 0x800 /= 0 = Vector.fromList
|
|
[ Instruction (RiscV.BaseInstruction RiscV.Lui $ RiscV.U targetRegister $ fromIntegral $ succ hi)
|
|
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I targetRegister RiscV.ADDI targetRegister lo)
|
|
]
|
|
| otherwise = Vector.fromList
|
|
[ Instruction (RiscV.BaseInstruction RiscV.Lui $ RiscV.U targetRegister $ fromIntegral hi)
|
|
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I targetRegister RiscV.ADDI targetRegister lo)
|
|
]
|
|
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.S0 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.S0 register
|
|
in (register, Vector.singleton storeInstruction)
|