From fdf56ce9d0de459dc5bd65537847ded7b02ad5c2 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Wed, 2 Oct 2024 22:56:15 +0200 Subject: Negate integral expressions --- lib/Language/Elna/RiscV/CodeGenerator.hs | 156 +++++++++++++++++++++++++++++++ 1 file changed, 156 insertions(+) create mode 100644 lib/Language/Elna/RiscV/CodeGenerator.hs (limited to 'lib/Language/Elna/RiscV/CodeGenerator.hs') diff --git a/lib/Language/Elna/RiscV/CodeGenerator.hs b/lib/Language/Elna/RiscV/CodeGenerator.hs new file mode 100644 index 0000000..d20488c --- /dev/null +++ b/lib/Language/Elna/RiscV/CodeGenerator.hs @@ -0,0 +1,156 @@ +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 + { temporaryRegister = RiscV.T0 + } + +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 + +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 -- cgit v1.2.3