diff options
Diffstat (limited to 'lib/Language/Elna/RiscV/CodeGenerator.hs')
| -rw-r--r-- | lib/Language/Elna/RiscV/CodeGenerator.hs | 453 |
1 files changed, 203 insertions, 250 deletions
diff --git a/lib/Language/Elna/RiscV/CodeGenerator.hs b/lib/Language/Elna/RiscV/CodeGenerator.hs index c082812..a2ff71e 100644 --- a/lib/Language/Elna/RiscV/CodeGenerator.hs +++ b/lib/Language/Elna/RiscV/CodeGenerator.hs @@ -14,7 +14,12 @@ 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(..), Quadruple(..)) +import Language.Elna.Backend.Intermediate + ( Label(..) + , Operand(..) + , ProcedureQuadruples(..) + , Quadruple(..) + ) import Language.Elna.Location (Identifier(..)) import Data.Bits (Bits(..)) import Data.Foldable (Foldable(..), foldlM) @@ -80,13 +85,13 @@ createLabel = do $ Text.Builder.toLazyText $ Text.Builder.decimal currentCounter -generateRiscV :: HashMap Identifier (Vector RiscVQuadruple) -> Vector Statement +generateRiscV :: HashMap Identifier (ProcedureQuadruples RiscVStore) -> Vector Statement generateRiscV = flip evalState 0 . runRiscVGenerator . foldlM go Vector.empty . HashMap.toList where - go accumulator (Identifier key, value) = + go accumulator (Identifier key, ProcedureQuadruples{ quadruples = value }) = let code = Vector.cons (JumpLabel key [GlobalDirective, FunctionDirective]) . fold <$> mapM quadruple value in (accumulator <>) <$> code @@ -114,198 +119,228 @@ quadruple StopQuadruple = pure $ Vector.fromList , 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)) +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 = - pure $ lui (immediateOperand1 + immediateOperand2) register + let (storeRegister, storeStatements) = storeToStore store + in pure $ lui (immediateOperand1 - immediateOperand2) storeRegister <> storeStatements | 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)) - | 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.SUB operandRegister1 operandRegister2 - $ RiscV.Funct7 0b0100000 + 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 statements1 = lui immediateOperand1 register - Store operandRegister2 = variableOperand2 - in pure $ Vector.snoc statements1 - $ Instruction - $ RiscV.BaseInstruction RiscV.Op - $ RiscV.R register RiscV.SUB register operandRegister2 - $ RiscV.Funct7 0b0100000 + 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 statements2 = lui (negate immediateOperand2) register - Store operandRegister1 = variableOperand1 - 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)) + 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 = - pure $ lui (negate immediateOperand1) register + let (storeRegister, storeStatements) = storeToStore store + in pure $ lui (negate immediateOperand1) storeRegister <> storeStatements | VariableOperand variableOperand1 <- operand1 = - let Store operandRegister1 = variableOperand1 - in pure $ 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 = - 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)) + 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 pure $ lui (quot immediateOperand1 immediateOperand2) register + else + let (storeRegister, storeStatements) = storeToStore store + in pure $ lui (quot immediateOperand1 immediateOperand2) storeRegister <> storeStatements | VariableOperand variableOperand1 <- operand1 , VariableOperand variableOperand2 <- operand2 = do - let Store operandRegister1 = variableOperand1 - Store operandRegister2 = variableOperand2 + let (storeRegister, storeStatements) = storeToStore store + (operandRegister1, statements1) = loadFromStore variableOperand1 + (operandRegister2, statements2) = loadFromStore variableOperand2 divisionInstruction = Instruction $ RiscV.BaseInstruction RiscV.Op - $ RiscV.R register RiscV.DIV operandRegister1 operandRegister2 (RiscV.Funct7 0b0000001) + $ 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 $ Vector.fromList + pure $ statements1 <> statements2 <> Vector.fromList [ branchInstruction , Instruction (RiscV.CallInstruction "_divide_by_zero_error") , JumpLabel branchLabel [] , divisionInstruction - ] + ] <> storeStatements | VariableOperand variableOperand1 <- operand1 , IntOperand immediateOperand2 <- operand2 = - let statements2 = lui immediateOperand2 register - Store operandRegister1 = variableOperand1 + 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 register RiscV.DIV operandRegister1 register + $ RiscV.R storeRegister RiscV.DIV operandRegister1 storeRegister $ RiscV.Funct7 0b0000001 - in pure $ Vector.snoc statements2 - $ Instruction operationInstruction + in pure $ statements1 <> statements2 + <> Vector.cons (Instruction operationInstruction) storeStatements | IntOperand immediateOperand1 <- operand1 , VariableOperand variableOperand2 <- operand2 = do - let statements1 = lui immediateOperand1 register - Store operandRegister2 = variableOperand2 + let (storeRegister, storeStatements) = storeToStore store + statements1 = lui immediateOperand1 storeRegister + (operandRegister2, statements2) = loadFromStore variableOperand2 divisionInstruction = Instruction $ RiscV.BaseInstruction RiscV.Op - $ RiscV.R register RiscV.DIV register operandRegister2 (RiscV.Funct7 0b0000001) + $ 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 $ mappend statements1 $ Vector.fromList + 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) +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 = - if immediateOperand1 == immediateOperand2 - then pure $ Vector.singleton $ unconditionalJal goToLabel - else pure Vector.empty + let (storeRegister, storeStatements) = storeToStore store + immediateOperation' = immediateOperation immediateOperand1 immediateOperand2 + in pure $ lui immediateOperation' storeRegister <> storeStatements | 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.BEQ operandRegister1 operandRegister2 + , 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 = - compareImmediateRegister variableOperand1 immediateOperand2 + commutativeImmediateRegister variableOperand1 immediateOperand2 | IntOperand immediateOperand1 <- operand1 , VariableOperand variableOperand2 <- operand2 = - compareImmediateRegister variableOperand2 immediateOperand1 + commutativeImmediateRegister 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) + 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 immediateOperand1 /= immediateOperand2 + 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 + let (operandRegister1, statements1) = loadFromStore variableOperand1 + (operandRegister2, statements2) = loadFromStore variableOperand2 Label goToLabel' = goToLabel - pure $ Vector.singleton + pure $ Vector.snoc (statements1 <> statements2) $ Instruction $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BNE operandRegister1 operandRegister2 + $ RiscV.RBranch goToLabel' funct3 operandRegister1 operandRegister2 | VariableOperand variableOperand1 <- operand1 , IntOperand immediateOperand2 <- operand2 = compareImmediateRegister variableOperand1 immediateOperand2 @@ -314,14 +349,16 @@ quadruple (NonEqualQuadruple operand1 operand2 goToLabel) compareImmediateRegister variableOperand2 immediateOperand1 where compareImmediateRegister variableOperand immediateOperand = - let statements = lui immediateOperand immediateRegister - Store operandRegister = variableOperand + let immediateStatements = lui immediateOperand immediateRegister + (operandRegister, registerStatements) = loadFromStore variableOperand Label goToLabel' = goToLabel - in pure $ Vector.snoc statements + in pure $ Vector.snoc (immediateStatements <> registerStatements) $ Instruction $ RiscV.RelocatableInstruction RiscV.Branch - $ RiscV.RBranch goToLabel' RiscV.BNE operandRegister immediateRegister -quadruple (LessQuadruple operand1 operand2 goToLabel) + $ 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 @@ -329,65 +366,34 @@ quadruple (LessQuadruple operand1 operand2 goToLabel) else pure Vector.empty | VariableOperand variableOperand1 <- operand1 , VariableOperand variableOperand2 <- operand2 = do - let Store operandRegister1 = variableOperand1 - Store operandRegister2 = variableOperand2 + let (operandRegister1, statements1) = loadFromStore variableOperand1 + (operandRegister2, statements2) = loadFromStore variableOperand2 Label goToLabel' = goToLabel - pure $ Vector.singleton + 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 - Store operandRegister1 = variableOperand1 + (operandRegister1, statements1) = loadFromStore variableOperand1 Label goToLabel' = goToLabel - in pure $ Vector.snoc statements2 + 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 - Store operandRegister2 = variableOperand2 + (operandRegister2, statements2) = loadFromStore variableOperand2 Label goToLabel' = goToLabel - in pure $ Vector.snoc statements1 + in pure $ Vector.snoc (statements1 <> statements2) $ 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) + +lessOrEqualThan :: (Operand RiscVStore, Operand RiscVStore) -> Label -> RiscVGenerator (Vector Statement) +lessOrEqualThan (operand1, operand2) goToLabel | IntOperand immediateOperand1 <- operand1 , IntOperand immediateOperand2 <- operand2 = if immediateOperand1 <= immediateOperand2 @@ -395,97 +401,44 @@ quadruple (LessOrEqualQuadruple operand1 operand2 goToLabel) else pure Vector.empty | VariableOperand variableOperand1 <- operand1 , VariableOperand variableOperand2 <- operand2 = do - let Store operandRegister1 = variableOperand1 - Store operandRegister2 = variableOperand2 + let (operandRegister1, statements1) = loadFromStore variableOperand1 + (operandRegister2, statements2) = loadFromStore variableOperand2 Label goToLabel' = goToLabel - pure $ Vector.singleton + 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 - Store operandRegister1 = variableOperand1 + (operandRegister1, statements1) = loadFromStore variableOperand1 Label goToLabel' = goToLabel - in pure $ Vector.snoc statements2 + 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 - Store operandRegister2 = variableOperand2 + (operandRegister2, statements2) = loadFromStore variableOperand2 Label goToLabel' = goToLabel - in pure $ Vector.snoc statements1 + in pure $ Vector.snoc (statements1 <> statements2) $ 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)) - | IntOperand immediateOperand1 <- operand1 = pure - $ lui immediateOperand1 register - | VariableOperand variableOperand1 <- operand1 = - let Store operandRegister1 = variableOperand1 - in pure $ Vector.singleton - $ Instruction - $ RiscV.BaseInstruction RiscV.OpImm - $ RiscV.I register RiscV.ADDI operandRegister1 0 -unconditionalJal :: Label -> Statement -unconditionalJal (Label goToLabel) = Instruction - $ RiscV.RelocatableInstruction RiscV.Jal - $ RiscV.RJal RiscV.Zero goToLabel +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.SP offset + in (register, Vector.singleton loadInstruction) -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 +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.SP register + in (register, Vector.singleton storeInstruction) |