220 lines
10 KiB
Haskell
220 lines
10 KiB
Haskell
module Language.Elna.RiscV.CodeGenerator
|
|
( Statement(..)
|
|
, generateRiscV
|
|
, riscVConfiguration
|
|
) where
|
|
|
|
import Data.ByteString (ByteString)
|
|
import Data.HashMap.Strict (HashMap)
|
|
import qualified Data.HashMap.Strict as HashMap
|
|
import Data.Int (Int32)
|
|
import Data.Vector (Vector)
|
|
import qualified Data.Vector as Vector
|
|
import qualified Data.Text.Encoding as Text.Encoding
|
|
import qualified Language.Elna.Architecture.RiscV as RiscV
|
|
import Language.Elna.Backend.Allocator (MachineConfiguration(..), Store(..))
|
|
import Language.Elna.Backend.Intermediate (Operand(..), Quadruple(..))
|
|
import Language.Elna.Location (Identifier(..))
|
|
import Data.Bits (Bits(..))
|
|
|
|
data Directive
|
|
= GlobalDirective
|
|
| FunctionDirective
|
|
deriving (Eq, Show)
|
|
|
|
data Statement
|
|
= Instruction RiscV.Instruction
|
|
| JumpLabel ByteString [Directive]
|
|
deriving Eq
|
|
|
|
riscVConfiguration :: MachineConfiguration RiscV.XRegister
|
|
riscVConfiguration = MachineConfiguration
|
|
{ temporaryRegisters =
|
|
[ RiscV.T0
|
|
, RiscV.T1
|
|
, RiscV.T2
|
|
, RiscV.T3
|
|
, RiscV.T4
|
|
, RiscV.T5
|
|
, RiscV.T6
|
|
]
|
|
}
|
|
|
|
type RiscVStore = Store RiscV.XRegister
|
|
type RiscVQuadruple = Quadruple RiscVStore
|
|
type RiscVOperand = Operand RiscVStore
|
|
|
|
generateRiscV :: HashMap Identifier (Vector RiscVQuadruple) -> Vector Statement
|
|
generateRiscV = HashMap.foldlWithKey' go Vector.empty
|
|
where
|
|
go accumulator (Identifier key) value =
|
|
let code = Vector.cons (JumpLabel (Text.Encoding.encodeUtf8 key) [GlobalDirective, FunctionDirective])
|
|
$ Vector.foldMap quadruple value
|
|
in accumulator <> code
|
|
|
|
quadruple :: RiscVQuadruple -> Vector Statement
|
|
quadruple StartQuadruple = 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 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 4)
|
|
]
|
|
quadruple (ParameterQuadruple operand1) =
|
|
let (operandRegister, statements) = loadImmediateOrRegister operand1 RiscV.A0
|
|
in 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) = Vector.fromList
|
|
[ Instruction (RiscV.CallInstruction callName)
|
|
, Instruction (RiscV.BaseInstruction RiscV.OpImm $ RiscV.I RiscV.SP RiscV.ADDI RiscV.SP (numberOfArguments * 4))
|
|
]
|
|
quadruple StopQuadruple = 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 4)
|
|
, Instruction (RiscV.BaseInstruction RiscV.Jalr $ RiscV.I RiscV.RA RiscV.JALR RiscV.Zero 0)
|
|
]
|
|
quadruple (AddQuadruple operand1 operand2 (Store register))
|
|
| IntOperand immediateOperand1 <- operand1
|
|
, IntOperand immediateOperand2 <- operand2 =
|
|
lui (immediateOperand1 + immediateOperand2) register
|
|
| VariableOperand variableOperand1 <- operand1
|
|
, VariableOperand variableOperand2 <- operand2 =
|
|
let Store operandRegister1 = variableOperand1
|
|
Store operandRegister2 = variableOperand2
|
|
in pure $ 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 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 =
|
|
lui (immediateOperand1 - immediateOperand2) register
|
|
| VariableOperand variableOperand1 <- operand1
|
|
, VariableOperand variableOperand2 <- operand2 =
|
|
let Store operandRegister1 = variableOperand1
|
|
Store operandRegister2 = variableOperand2
|
|
in pure $ 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 Vector.snoc statements1
|
|
$ Instruction
|
|
$ RiscV.BaseInstruction RiscV.Op
|
|
$ RiscV.R register RiscV.SUB register operandRegister2
|
|
$ RiscV.Funct7 0b0100000
|
|
| VariableOperand variableOperand1 <- operand1
|
|
, IntOperand immediateOperand2 <- operand2 =
|
|
let statements2 = lui (negate immediateOperand2) register
|
|
Store operandRegister1 = variableOperand1
|
|
in Vector.snoc statements2
|
|
$ Instruction
|
|
$ RiscV.BaseInstruction RiscV.Op
|
|
$ RiscV.R register RiscV.ADD register operandRegister1
|
|
$ RiscV.Funct7 0b0000000
|
|
quadruple (NegationQuadruple operand1 (Store register))
|
|
| IntOperand immediateOperand1 <- operand1 = lui (negate immediateOperand1) register
|
|
| VariableOperand variableOperand1 <- operand1 =
|
|
let Store operandRegister1 = variableOperand1
|
|
in 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 =
|
|
lui (immediateOperand1 * immediateOperand2) register
|
|
| VariableOperand variableOperand1 <- operand1
|
|
, VariableOperand variableOperand2 <- operand2 =
|
|
let Store operandRegister1 = variableOperand1
|
|
Store operandRegister2 = variableOperand2
|
|
in pure $ 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 Vector.snoc statements
|
|
$ Instruction
|
|
$ RiscV.BaseInstruction RiscV.Op
|
|
$ RiscV.R register RiscV.MUL register operandRegister
|
|
$ RiscV.Funct7 0b0000001
|
|
quadruple (DivisionQuadruple operand1 operand2 (Store register))
|
|
| IntOperand immediateOperand1 <- operand1
|
|
, IntOperand immediateOperand2 <- operand2 =
|
|
lui (quot immediateOperand1 immediateOperand2) register
|
|
| VariableOperand variableOperand1 <- operand1
|
|
, VariableOperand variableOperand2 <- operand2 =
|
|
let Store operandRegister1 = variableOperand1
|
|
Store operandRegister2 = variableOperand2
|
|
in pure $ Instruction
|
|
$ RiscV.BaseInstruction RiscV.Op
|
|
$ RiscV.R register RiscV.DIV operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001)
|
|
| VariableOperand variableOperand1 <- operand1
|
|
, IntOperand immediateOperand2 <- operand2 =
|
|
let statements2 = lui immediateOperand2 register
|
|
Store operandRegister1 = variableOperand1
|
|
in Vector.snoc statements2
|
|
$ Instruction
|
|
$ RiscV.BaseInstruction RiscV.Op
|
|
$ RiscV.R register RiscV.DIV operandRegister1 register
|
|
$ RiscV.Funct7 0b0000001
|
|
| IntOperand immediateOperand1 <- operand1
|
|
, VariableOperand variableOperand2 <- operand2 =
|
|
let statements1 = lui immediateOperand1 register
|
|
Store operandRegister2 = variableOperand2
|
|
in Vector.snoc statements1
|
|
$ Instruction
|
|
$ RiscV.BaseInstruction RiscV.Op
|
|
$ RiscV.R register RiscV.DIV register operandRegister2
|
|
$ RiscV.Funct7 0b0000001
|
|
|
|
loadImmediateOrRegister :: RiscVOperand -> RiscV.XRegister -> (RiscV.XRegister, Vector Statement)
|
|
loadImmediateOrRegister (IntOperand intValue) targetRegister =
|
|
(targetRegister, lui intValue targetRegister)
|
|
loadImmediateOrRegister (VariableOperand (Store register)) _ = (register, Vector.empty)
|
|
|
|
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
|