Map local variables in IR to their original names
This commit is contained in:
parent
060496fc6e
commit
e9a22addcc
4
TODO
4
TODO
@ -3,10 +3,6 @@
|
|||||||
- To access named parameters inside a procedure, IR should be able to reference
|
- To access named parameters inside a procedure, IR should be able to reference
|
||||||
them. During the generation the needed information (e.g. offsets or registers)
|
them. During the generation the needed information (e.g. offsets or registers)
|
||||||
can be extracted from the symbol table and saved in the operands.
|
can be extracted from the symbol table and saved in the operands.
|
||||||
- Glue always generates the same intermediate variable (LocalVariable 0) for
|
|
||||||
local variables. (LocalVariable 0) is handled the same as temporary variables
|
|
||||||
that are currently saved only in registers. There space on the stack allocated
|
|
||||||
for local variables.
|
|
||||||
|
|
||||||
# ELF generation
|
# ELF generation
|
||||||
|
|
||||||
|
@ -4,10 +4,13 @@ module Language.Elna.Backend.Allocator
|
|||||||
, allocate
|
, allocate
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.HashMap.Strict (HashMap)
|
|
||||||
import Data.Vector (Vector)
|
import Data.Vector (Vector)
|
||||||
import Language.Elna.Backend.Intermediate (Operand(..), Quadruple(..), Variable(..))
|
import Language.Elna.Backend.Intermediate
|
||||||
import Language.Elna.Location (Identifier(..))
|
( ProcedureQuadruples(..)
|
||||||
|
, Operand(..)
|
||||||
|
, Quadruple(..)
|
||||||
|
, Variable(..)
|
||||||
|
)
|
||||||
|
|
||||||
newtype Store r = Store r
|
newtype Store r = Store r
|
||||||
|
|
||||||
@ -18,9 +21,10 @@ newtype MachineConfiguration r = MachineConfiguration
|
|||||||
allocate
|
allocate
|
||||||
:: forall r
|
:: forall r
|
||||||
. MachineConfiguration r
|
. MachineConfiguration r
|
||||||
-> HashMap Identifier (Vector (Quadruple Variable))
|
-> ProcedureQuadruples Variable
|
||||||
-> HashMap Identifier (Vector (Quadruple (Store r)))
|
-> ProcedureQuadruples (Store r)
|
||||||
allocate MachineConfiguration{..} = fmap function
|
allocate MachineConfiguration{..} (ProcedureQuadruples quadruples) =
|
||||||
|
ProcedureQuadruples $ function <$> quadruples
|
||||||
where
|
where
|
||||||
function :: Vector (Quadruple Variable) -> Vector (Quadruple (Store r))
|
function :: Vector (Quadruple Variable) -> Vector (Quadruple (Store r))
|
||||||
function = fmap quadruple
|
function = fmap quadruple
|
||||||
|
@ -1,14 +1,18 @@
|
|||||||
module Language.Elna.Backend.Intermediate
|
module Language.Elna.Backend.Intermediate
|
||||||
( Operand(..)
|
( ProcedureQuadruples(..)
|
||||||
|
, Operand(..)
|
||||||
, Quadruple(..)
|
, Quadruple(..)
|
||||||
, Label(..)
|
, Label(..)
|
||||||
, Variable(..)
|
, Variable(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Int (Int32)
|
import Data.Int (Int32)
|
||||||
|
import Data.HashMap.Strict (HashMap)
|
||||||
|
import Data.Vector (Vector)
|
||||||
import Data.Word (Word32)
|
import Data.Word (Word32)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
|
import Language.Elna.Location (Identifier(..))
|
||||||
|
|
||||||
newtype Label = Label { unLabel :: Text }
|
newtype Label = Label { unLabel :: Text }
|
||||||
deriving Eq
|
deriving Eq
|
||||||
@ -30,6 +34,10 @@ data Operand v
|
|||||||
| VariableOperand v
|
| VariableOperand v
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
newtype ProcedureQuadruples v =
|
||||||
|
ProcedureQuadruples (HashMap Identifier (Vector (Quadruple v)))
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data Quadruple v
|
data Quadruple v
|
||||||
= StartQuadruple
|
= StartQuadruple
|
||||||
| StopQuadruple
|
| StopQuadruple
|
||||||
|
@ -4,7 +4,7 @@ module Language.Elna.Glue
|
|||||||
|
|
||||||
import Control.Monad.Trans.State (State, gets, modify', runState)
|
import Control.Monad.Trans.State (State, gets, modify', runState)
|
||||||
import Data.Bifunctor (Bifunctor(..))
|
import Data.Bifunctor (Bifunctor(..))
|
||||||
import Data.Foldable (Foldable(..))
|
import Data.Foldable (Foldable(..), traverse_)
|
||||||
import Data.HashMap.Strict (HashMap)
|
import Data.HashMap.Strict (HashMap)
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
import qualified Data.HashMap.Strict as HashMap
|
||||||
import Data.Maybe (catMaybes)
|
import Data.Maybe (catMaybes)
|
||||||
@ -18,6 +18,7 @@ import qualified Language.Elna.Frontend.AST as AST
|
|||||||
import Language.Elna.Frontend.Types (Type(..))
|
import Language.Elna.Frontend.Types (Type(..))
|
||||||
import Language.Elna.Backend.Intermediate
|
import Language.Elna.Backend.Intermediate
|
||||||
( Label(..)
|
( Label(..)
|
||||||
|
, ProcedureQuadruples(..)
|
||||||
, Operand(..)
|
, Operand(..)
|
||||||
, Quadruple(..)
|
, Quadruple(..)
|
||||||
, Variable(..)
|
, Variable(..)
|
||||||
@ -25,10 +26,12 @@ import Language.Elna.Backend.Intermediate
|
|||||||
import Language.Elna.Frontend.SymbolTable (Info(..), SymbolTable)
|
import Language.Elna.Frontend.SymbolTable (Info(..), SymbolTable)
|
||||||
import qualified Language.Elna.Frontend.SymbolTable as SymbolTable
|
import qualified Language.Elna.Frontend.SymbolTable as SymbolTable
|
||||||
import GHC.Records (HasField(..))
|
import GHC.Records (HasField(..))
|
||||||
|
import Language.Elna.Frontend.AST (Identifier(..))
|
||||||
|
|
||||||
data Paste = Paste
|
data Paste = Paste
|
||||||
{ temporaryCounter :: Word32
|
{ temporaryCounter :: Word32
|
||||||
, labelCounter :: Word32
|
, labelCounter :: Word32
|
||||||
|
, localMap :: HashMap Identifier Variable
|
||||||
}
|
}
|
||||||
|
|
||||||
newtype Glue a = Glue
|
newtype Glue a = Glue
|
||||||
@ -47,31 +50,45 @@ instance Monad Glue
|
|||||||
where
|
where
|
||||||
(Glue x) >>= f = Glue $ x >>= (runGlue . f)
|
(Glue x) >>= f = Glue $ x >>= (runGlue . f)
|
||||||
|
|
||||||
glue :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector (Quadruple Variable))
|
glue :: SymbolTable -> AST.Program -> ProcedureQuadruples Variable
|
||||||
glue globalTable
|
glue globalTable
|
||||||
= fst
|
= fst
|
||||||
. flip runState Paste{ temporaryCounter = 0, labelCounter = 0 }
|
. flip runState emptyPaste
|
||||||
. runGlue
|
. runGlue
|
||||||
. program globalTable
|
. program globalTable
|
||||||
|
where
|
||||||
|
emptyPaste = Paste
|
||||||
|
{ temporaryCounter = 0
|
||||||
|
, labelCounter = 0
|
||||||
|
, localMap = mempty
|
||||||
|
}
|
||||||
|
|
||||||
program
|
program :: SymbolTable -> AST.Program -> Glue (ProcedureQuadruples Variable)
|
||||||
:: SymbolTable
|
program globalTable (AST.Program declarations)
|
||||||
-> AST.Program
|
= ProcedureQuadruples . HashMap.fromList . catMaybes
|
||||||
-> Glue (HashMap AST.Identifier (Vector (Quadruple Variable)))
|
|
||||||
program globalTable (AST.Program declarations) = HashMap.fromList . catMaybes
|
|
||||||
<$> traverse (declaration globalTable) declarations
|
<$> traverse (declaration globalTable) declarations
|
||||||
|
|
||||||
declaration
|
declaration
|
||||||
:: SymbolTable
|
:: SymbolTable
|
||||||
-> AST.Declaration
|
-> AST.Declaration
|
||||||
-> Glue (Maybe (AST.Identifier, Vector (Quadruple Variable)))
|
-> Glue (Maybe (AST.Identifier, Vector (Quadruple Variable)))
|
||||||
declaration globalTable (AST.ProcedureDeclaration procedureName _ _ statements)
|
declaration globalTable (AST.ProcedureDeclaration procedureName _ variableDeclarations statements)
|
||||||
= Just
|
= traverse_ registerVariable variableDeclarations
|
||||||
. (procedureName,)
|
>> statements' <$> traverse (statement globalTable) statements
|
||||||
. Vector.cons StartQuadruple
|
where
|
||||||
. flip Vector.snoc StopQuadruple
|
registerVariable (AST.VariableDeclaration identifier _) = do
|
||||||
. fold
|
currentCounter <- fmap (fromIntegral . HashMap.size)
|
||||||
<$> traverse (statement globalTable) statements
|
$ Glue $ gets $ getField @"localMap"
|
||||||
|
Glue $ modify' $ modifier identifier $ LocalVariable currentCounter
|
||||||
|
modifier identifier currentCounter generator = generator
|
||||||
|
{ localMap = HashMap.insert identifier currentCounter
|
||||||
|
$ getField @"localMap" generator
|
||||||
|
}
|
||||||
|
statements' = Just
|
||||||
|
. (procedureName,)
|
||||||
|
. Vector.cons StartQuadruple
|
||||||
|
. flip Vector.snoc StopQuadruple
|
||||||
|
. fold
|
||||||
declaration _ (AST.TypeDefinition _ _) = pure Nothing
|
declaration _ (AST.TypeDefinition _ _) = pure Nothing
|
||||||
|
|
||||||
statement :: SymbolTable -> AST.Statement -> Glue (Vector (Quadruple Variable))
|
statement :: SymbolTable -> AST.Statement -> Glue (Vector (Quadruple Variable))
|
||||||
@ -104,15 +121,16 @@ statement localTable (AST.AssignmentStatement variableAccess' assignee) = do
|
|||||||
(rhsOperand, rhsStatements) <- expression localTable assignee
|
(rhsOperand, rhsStatements) <- expression localTable assignee
|
||||||
let variableType' = variableType variableAccess' localTable
|
let variableType' = variableType variableAccess' localTable
|
||||||
accessResult <- variableAccess localTable variableAccess' Nothing variableType' mempty
|
accessResult <- variableAccess localTable variableAccess' Nothing variableType' mempty
|
||||||
pure $ rhsStatements <> case accessResult of
|
lhsStatements <- case accessResult of
|
||||||
{-(AST.Identifier identifier, Just accumulatedIndex, accumulatedStatements) ->
|
{-(AST.Identifier identifier, Just accumulatedIndex, accumulatedStatements) ->
|
||||||
Vector.snoc accumulatedStatements
|
Vector.snoc accumulatedStatements
|
||||||
$ ArrayAssignQuadruple rhsOperand accumulatedIndex
|
$ ArrayAssignQuadruple rhsOperand accumulatedIndex
|
||||||
$ LocalVariable identifier -}
|
$ LocalVariable identifier -}
|
||||||
(AST.Identifier identifier, Nothing, accumulatedStatements) ->
|
(identifier, _Nothing, accumulatedStatements)
|
||||||
Vector.snoc accumulatedStatements
|
-> Vector.snoc accumulatedStatements
|
||||||
$ AssignQuadruple rhsOperand
|
. AssignQuadruple rhsOperand
|
||||||
$ LocalVariable 0
|
<$> lookupLocal identifier
|
||||||
|
pure $ rhsStatements <> lhsStatements
|
||||||
{- statement localTable (AST.WhileStatement whileCondition whileStatement) = do
|
{- statement localTable (AST.WhileStatement whileCondition whileStatement) = do
|
||||||
(conditionStatements, jumpConstructor) <- condition localTable whileCondition
|
(conditionStatements, jumpConstructor) <- condition localTable whileCondition
|
||||||
startLabel <- createLabel
|
startLabel <- createLabel
|
||||||
@ -135,6 +153,10 @@ createTemporary = do
|
|||||||
{ temporaryCounter = getField @"temporaryCounter" generator + 1
|
{ temporaryCounter = getField @"temporaryCounter" generator + 1
|
||||||
}
|
}
|
||||||
|
|
||||||
|
lookupLocal :: Identifier -> Glue Variable
|
||||||
|
lookupLocal identifier =
|
||||||
|
fmap (HashMap.! identifier) $ Glue $ gets $ getField @"localMap"
|
||||||
|
|
||||||
createLabel :: Glue Label
|
createLabel :: Glue Label
|
||||||
createLabel = do
|
createLabel = do
|
||||||
currentCounter <- Glue $ gets $ getField @"labelCounter"
|
currentCounter <- Glue $ gets $ getField @"labelCounter"
|
||||||
@ -242,13 +264,13 @@ expression localTable = \case
|
|||||||
(AST.DivisionExpression lhs rhs) ->
|
(AST.DivisionExpression lhs rhs) ->
|
||||||
binaryExpression DivisionQuadruple lhs rhs
|
binaryExpression DivisionQuadruple lhs rhs
|
||||||
(AST.VariableExpression variableExpression) -> do
|
(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
|
variableAccess' <- variableAccess localTable variableExpression Nothing variableType' mempty
|
||||||
case variableAccess' of
|
case variableAccess' of
|
||||||
(AST.Identifier identifier, Nothing, statements) ->
|
(identifier, _Nothing, statements)
|
||||||
pure (VariableOperand (Variable identifier), statements)
|
-> (, statements) . VariableOperand
|
||||||
(AST.Identifier identifier, Just operand, statements) -> do
|
<$> lookupLocal identifier
|
||||||
|
{-(AST.Identifier identifier, Just operand, statements) -> do
|
||||||
arrayAddress <- createTemporary
|
arrayAddress <- createTemporary
|
||||||
let arrayStatement = ArrayQuadruple (Variable identifier) operand arrayAddress
|
let arrayStatement = ArrayQuadruple (Variable identifier) operand arrayAddress
|
||||||
pure
|
pure
|
||||||
|
@ -6,7 +6,6 @@ module Language.Elna.RiscV.CodeGenerator
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (State, get, evalState, modify')
|
import Control.Monad.Trans.State (State, get, evalState, modify')
|
||||||
import Data.HashMap.Strict (HashMap)
|
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
import qualified Data.HashMap.Strict as HashMap
|
||||||
import Data.Int (Int32)
|
import Data.Int (Int32)
|
||||||
import Data.Word (Word32)
|
import Data.Word (Word32)
|
||||||
@ -14,7 +13,12 @@ import Data.Vector (Vector)
|
|||||||
import qualified Data.Vector as Vector
|
import qualified Data.Vector as Vector
|
||||||
import qualified Language.Elna.Architecture.RiscV as RiscV
|
import qualified Language.Elna.Architecture.RiscV as RiscV
|
||||||
import Language.Elna.Backend.Allocator (MachineConfiguration(..), Store(..))
|
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 Language.Elna.Location (Identifier(..))
|
||||||
import Data.Bits (Bits(..))
|
import Data.Bits (Bits(..))
|
||||||
import Data.Foldable (Foldable(..), foldlM)
|
import Data.Foldable (Foldable(..), foldlM)
|
||||||
@ -80,11 +84,11 @@ createLabel = do
|
|||||||
$ Text.Builder.toLazyText
|
$ Text.Builder.toLazyText
|
||||||
$ Text.Builder.decimal currentCounter
|
$ Text.Builder.decimal currentCounter
|
||||||
|
|
||||||
generateRiscV :: HashMap Identifier (Vector RiscVQuadruple) -> Vector Statement
|
generateRiscV :: ProcedureQuadruples RiscVStore -> Vector Statement
|
||||||
generateRiscV = flip evalState 0
|
generateRiscV (ProcedureQuadruples quadruples) = flip evalState 0
|
||||||
. runRiscVGenerator
|
$ runRiscVGenerator
|
||||||
. foldlM go Vector.empty
|
$ foldlM go Vector.empty
|
||||||
. HashMap.toList
|
$ HashMap.toList quadruples
|
||||||
where
|
where
|
||||||
go accumulator (Identifier key, value) =
|
go accumulator (Identifier key, value) =
|
||||||
let code = Vector.cons (JumpLabel key [GlobalDirective, FunctionDirective])
|
let code = Vector.cons (JumpLabel key [GlobalDirective, FunctionDirective])
|
||||||
@ -114,32 +118,10 @@ quadruple StopQuadruple = pure $ Vector.fromList
|
|||||||
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP 4)
|
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP 4)
|
||||||
, Instruction (RiscV.BaseInstruction RiscV.Jalr $ RiscV.I RiscV.RA RiscV.JALR RiscV.Zero 0)
|
, 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) =
|
||||||
| IntOperand immediateOperand1 <- operand1
|
commutativeBinary (+) RiscV.ADD (RiscV.Funct7 0b0000000) (operand1, operand2) store
|
||||||
, IntOperand immediateOperand2 <- operand2 =
|
quadruple (ProductQuadruple operand1 operand2 store) =
|
||||||
pure $ lui (immediateOperand1 + immediateOperand2) register
|
commutativeBinary (*) RiscV.MUL (RiscV.Funct7 0b0000001) (operand1, operand2) store
|
||||||
| 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
|
|
||||||
| 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))
|
quadruple (SubtractionQuadruple operand1 operand2 (Store register))
|
||||||
| IntOperand immediateOperand1 <- operand1
|
| IntOperand immediateOperand1 <- operand1
|
||||||
, IntOperand immediateOperand2 <- operand2 =
|
, IntOperand immediateOperand2 <- operand2 =
|
||||||
@ -180,32 +162,6 @@ quadruple (NegationQuadruple operand1 (Store register))
|
|||||||
$ RiscV.BaseInstruction RiscV.Op
|
$ RiscV.BaseInstruction RiscV.Op
|
||||||
$ RiscV.R register RiscV.SUB RiscV.Zero operandRegister1
|
$ RiscV.R register RiscV.SUB RiscV.Zero operandRegister1
|
||||||
$ RiscV.Funct7 0b0100000
|
$ 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))
|
quadruple (DivisionQuadruple operand1 operand2 (Store register))
|
||||||
| IntOperand immediateOperand1 <- operand1
|
| IntOperand immediateOperand1 <- operand1
|
||||||
, IntOperand immediateOperand2 <- operand2 =
|
, IntOperand immediateOperand2 <- operand2 =
|
||||||
@ -261,198 +217,18 @@ quadruple (DivisionQuadruple operand1 operand2 (Store register))
|
|||||||
]
|
]
|
||||||
quadruple (LabelQuadruple (Label label)) = pure $ Vector.singleton $ JumpLabel label mempty
|
quadruple (LabelQuadruple (Label label)) = pure $ Vector.singleton $ JumpLabel label mempty
|
||||||
quadruple (GoToQuadruple label) = pure $ Vector.singleton $ unconditionalJal label
|
quadruple (GoToQuadruple label) = pure $ Vector.singleton $ unconditionalJal label
|
||||||
quadruple (EqualQuadruple operand1 operand2 goToLabel)
|
quadruple (EqualQuadruple operand1 operand2 goToLabel) =
|
||||||
| IntOperand immediateOperand1 <- operand1
|
commutativeComparison (==) RiscV.BEQ (operand1, operand2) goToLabel
|
||||||
, IntOperand immediateOperand2 <- operand2 =
|
quadruple (NonEqualQuadruple operand1 operand2 goToLabel) =
|
||||||
if immediateOperand1 == immediateOperand2
|
commutativeComparison (/=) RiscV.BNE (operand1, operand2) goToLabel
|
||||||
then pure $ Vector.singleton $ unconditionalJal goToLabel
|
quadruple (LessQuadruple operand1 operand2 goToLabel) =
|
||||||
else pure Vector.empty
|
lessThan (operand1, operand2) goToLabel
|
||||||
| VariableOperand variableOperand1 <- operand1
|
quadruple (GreaterQuadruple operand1 operand2 goToLabel) =
|
||||||
, VariableOperand variableOperand2 <- operand2 = do
|
lessThan (operand2, operand1) goToLabel
|
||||||
let Store operandRegister1 = variableOperand1
|
quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) =
|
||||||
Store operandRegister2 = variableOperand2
|
lessOrEqualThan (operand1, operand2) goToLabel
|
||||||
Label goToLabel' = goToLabel
|
quadruple (GreaterOrEqualQuadruple operand1 operand2 goToLabel) =
|
||||||
pure $ Vector.singleton
|
lessOrEqualThan (operand2, operand1) goToLabel
|
||||||
$ 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))
|
quadruple (AssignQuadruple operand1 (Store register))
|
||||||
| IntOperand immediateOperand1 <- operand1 = pure
|
| IntOperand immediateOperand1 <- operand1 = pure
|
||||||
$ lui immediateOperand1 register
|
$ lui immediateOperand1 register
|
||||||
@ -489,3 +265,143 @@ lui intValue targetRegister
|
|||||||
where
|
where
|
||||||
hi = intValue `shiftR` 12
|
hi = intValue `shiftR` 12
|
||||||
lo = fromIntegral intValue
|
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 register)
|
||||||
|
| IntOperand immediateOperand1 <- operand1
|
||||||
|
, IntOperand immediateOperand2 <- operand2 = pure
|
||||||
|
$ lui (immediateOperation 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 funct3 operandRegister1 operandRegister2 funct7
|
||||||
|
| VariableOperand variableOperand1 <- operand1
|
||||||
|
, IntOperand immediateOperand2 <- operand2 =
|
||||||
|
commutativeImmediateRegister variableOperand1 immediateOperand2
|
||||||
|
| IntOperand immediateOperand1 <- operand1
|
||||||
|
, VariableOperand variableOperand2 <- operand2 =
|
||||||
|
commutativeImmediateRegister variableOperand2 immediateOperand1
|
||||||
|
where
|
||||||
|
commutativeImmediateRegister variableOperand immediateOperand =
|
||||||
|
let statements = lui immediateOperand register
|
||||||
|
Store operandRegister = variableOperand
|
||||||
|
in pure $ Vector.snoc statements
|
||||||
|
$ Instruction
|
||||||
|
$ RiscV.BaseInstruction RiscV.Op
|
||||||
|
$ RiscV.R register funct3 register operandRegister funct7
|
||||||
|
|
||||||
|
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 Store operandRegister1 = variableOperand1
|
||||||
|
Store operandRegister2 = variableOperand2
|
||||||
|
Label goToLabel' = goToLabel
|
||||||
|
pure $ Vector.singleton
|
||||||
|
$ 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 statements = lui immediateOperand immediateRegister
|
||||||
|
Store operandRegister = variableOperand
|
||||||
|
Label goToLabel' = goToLabel
|
||||||
|
in pure $ Vector.snoc statements
|
||||||
|
$ 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 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
|
||||||
|
|
||||||
|
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 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
|
||||||
|
Loading…
Reference in New Issue
Block a user