diff options
Diffstat (limited to 'lib/Language/Elna/RiscV/CodeGenerator.hs')
| -rw-r--r-- | lib/Language/Elna/RiscV/CodeGenerator.hs | 112 |
1 files changed, 80 insertions, 32 deletions
diff --git a/lib/Language/Elna/RiscV/CodeGenerator.hs b/lib/Language/Elna/RiscV/CodeGenerator.hs index 5bc9228..e3fac72 100644 --- a/lib/Language/Elna/RiscV/CodeGenerator.hs +++ b/lib/Language/Elna/RiscV/CodeGenerator.hs @@ -4,18 +4,23 @@ module Language.Elna.RiscV.CodeGenerator , riscVConfiguration ) where -import Data.ByteString (ByteString) +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 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(..)) +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 @@ -24,7 +29,7 @@ data Directive data Statement = Instruction RiscV.Instruction - | JumpLabel ByteString [Directive] + | JumpLabel Text [Directive] deriving Eq riscVConfiguration :: MachineConfiguration RiscV.XRegister @@ -44,16 +49,45 @@ 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 (Vector RiscVQuadruple) -> Vector Statement -generateRiscV = HashMap.foldlWithKey' go Vector.empty +generateRiscV = flip evalState 0 + . runRiscVGenerator + . foldlM go Vector.empty + . HashMap.toList where - go accumulator (Identifier key) value = - let code = Vector.cons (JumpLabel (Text.Encoding.encodeUtf8 key) [GlobalDirective, FunctionDirective]) - $ Vector.foldMap quadruple value - in accumulator <> code + go accumulator (Identifier key, value) = + let code = Vector.cons (JumpLabel key [GlobalDirective, FunctionDirective]) + . fold <$> mapM quadruple value + in (accumulator <>) <$> code -quadruple :: RiscVQuadruple -> Vector Statement -quadruple StartQuadruple = Vector.fromList +quadruple :: RiscVQuadruple -> RiscVGenerator (Vector Statement) +quadruple StartQuadruple = pure $ 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) @@ -61,15 +95,15 @@ quadruple StartQuadruple = Vector.fromList ] quadruple (ParameterQuadruple operand1) = let (operandRegister, statements) = loadImmediateOrRegister operand1 RiscV.A0 - in mappend statements $ Vector.fromList + 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) = Vector.fromList +quadruple (CallQuadruple callName numberOfArguments) = pure $ 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 +quadruple StopQuadruple = 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 4) @@ -78,12 +112,12 @@ quadruple StopQuadruple = Vector.fromList quadruple (AddQuadruple operand1 operand2 (Store register)) | IntOperand immediateOperand1 <- operand1 , IntOperand immediateOperand2 <- operand2 = - lui (immediateOperand1 + immediateOperand2) register + pure $ lui (immediateOperand1 + immediateOperand2) register | VariableOperand variableOperand1 <- operand1 , VariableOperand variableOperand2 <- operand2 = let Store operandRegister1 = variableOperand1 Store operandRegister2 = variableOperand2 - in pure $ Instruction + in pure $ Vector.singleton $ Instruction $ RiscV.BaseInstruction RiscV.Op $ RiscV.R register RiscV.ADD operandRegister1 operandRegister2 (RiscV.Funct7 0b0000000) | VariableOperand variableOperand1 <- operand1 @@ -96,7 +130,7 @@ quadruple (AddQuadruple operand1 operand2 (Store register)) addImmediateRegister variableOperand immediateOperand = let statements = lui immediateOperand register Store operandRegister = variableOperand - in Vector.snoc statements + in pure $ Vector.snoc statements $ Instruction $ RiscV.BaseInstruction RiscV.Op $ RiscV.R register RiscV.ADD register operandRegister @@ -104,12 +138,12 @@ quadruple (AddQuadruple operand1 operand2 (Store register)) quadruple (SubtractionQuadruple operand1 operand2 (Store register)) | IntOperand immediateOperand1 <- operand1 , IntOperand immediateOperand2 <- operand2 = - lui (immediateOperand1 - immediateOperand2) register + pure $ lui (immediateOperand1 - immediateOperand2) register | VariableOperand variableOperand1 <- operand1 , VariableOperand variableOperand2 <- operand2 = let Store operandRegister1 = variableOperand1 Store operandRegister2 = variableOperand2 - in pure $ Instruction + in pure $ Vector.singleton $ Instruction $ RiscV.BaseInstruction RiscV.Op $ RiscV.R register RiscV.SUB operandRegister1 operandRegister2 $ RiscV.Funct7 0b0100000 @@ -117,7 +151,7 @@ quadruple (SubtractionQuadruple operand1 operand2 (Store register)) , VariableOperand variableOperand2 <- operand2 = let statements1 = lui immediateOperand1 register Store operandRegister2 = variableOperand2 - in Vector.snoc statements1 + in pure $ Vector.snoc statements1 $ Instruction $ RiscV.BaseInstruction RiscV.Op $ RiscV.R register RiscV.SUB register operandRegister2 @@ -126,16 +160,17 @@ quadruple (SubtractionQuadruple operand1 operand2 (Store register)) , IntOperand immediateOperand2 <- operand2 = let statements2 = lui (negate immediateOperand2) register Store operandRegister1 = variableOperand1 - in Vector.snoc statements2 + 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)) - | IntOperand immediateOperand1 <- operand1 = lui (negate immediateOperand1) register + | IntOperand immediateOperand1 <- operand1 = + pure $ lui (negate immediateOperand1) register | VariableOperand variableOperand1 <- operand1 = let Store operandRegister1 = variableOperand1 - in Vector.singleton + in pure $ Vector.singleton $ Instruction $ RiscV.BaseInstruction RiscV.Op $ RiscV.R register RiscV.SUB RiscV.Zero operandRegister1 @@ -143,12 +178,12 @@ quadruple (NegationQuadruple operand1 (Store register)) quadruple (ProductQuadruple operand1 operand2 (Store register)) | IntOperand immediateOperand1 <- operand1 , IntOperand immediateOperand2 <- operand2 = - lui (immediateOperand1 * immediateOperand2) register + pure $ lui (immediateOperand1 * immediateOperand2) register | VariableOperand variableOperand1 <- operand1 , VariableOperand variableOperand2 <- operand2 = let Store operandRegister1 = variableOperand1 Store operandRegister2 = variableOperand2 - in pure $ Instruction + in pure $ Vector.singleton $ Instruction $ RiscV.BaseInstruction RiscV.Op $ RiscV.R register RiscV.MUL operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001) | VariableOperand variableOperand1 <- operand1 @@ -161,7 +196,7 @@ quadruple (ProductQuadruple operand1 operand2 (Store register)) multiplyImmediateRegister variableOperand immediateOperand = let statements = lui immediateOperand register Store operandRegister = variableOperand - in Vector.snoc statements + in pure $ Vector.snoc statements $ Instruction $ RiscV.BaseInstruction RiscV.Op $ RiscV.R register RiscV.MUL register operandRegister @@ -169,19 +204,32 @@ quadruple (ProductQuadruple operand1 operand2 (Store register)) quadruple (DivisionQuadruple operand1 operand2 (Store register)) | IntOperand immediateOperand1 <- operand1 , IntOperand immediateOperand2 <- operand2 = - lui (quot immediateOperand1 immediateOperand2) register + if immediateOperand2 == 0 + then pure $ Vector.singleton + $ Instruction (RiscV.CallInstruction "_divide_by_zero_error") + else pure $ lui (quot immediateOperand1 immediateOperand2) register | VariableOperand variableOperand1 <- operand1 - , VariableOperand variableOperand2 <- operand2 = + , VariableOperand variableOperand2 <- operand2 = do let Store operandRegister1 = variableOperand1 Store operandRegister2 = variableOperand2 - in pure $ Instruction - $ RiscV.BaseInstruction RiscV.Op - $ RiscV.R register RiscV.DIV operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001) + divisionInstruction = Instruction + $ RiscV.BaseInstruction RiscV.Op + $ RiscV.R register 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 + [ branchInstruction + , Instruction (RiscV.CallInstruction "_divide_by_zero_error") + , JumpLabel branchLabel [] + , divisionInstruction + ] | VariableOperand variableOperand1 <- operand1 , IntOperand immediateOperand2 <- operand2 = let statements2 = lui immediateOperand2 register Store operandRegister1 = variableOperand1 - in Vector.snoc statements2 + in pure $ Vector.snoc statements2 $ Instruction $ RiscV.BaseInstruction RiscV.Op $ RiscV.R register RiscV.DIV operandRegister1 register @@ -190,7 +238,7 @@ quadruple (DivisionQuadruple operand1 operand2 (Store register)) , VariableOperand variableOperand2 <- operand2 = let statements1 = lui immediateOperand1 register Store operandRegister2 = variableOperand2 - in Vector.snoc statements1 + in pure $ Vector.snoc statements1 $ Instruction $ RiscV.BaseInstruction RiscV.Op $ RiscV.R register RiscV.DIV register operandRegister2 |