diff --git a/TODO b/TODO index 3731f6e..43c037b 100644 --- a/TODO +++ b/TODO @@ -9,6 +9,9 @@ - Don't ignore relocations where the symbol is not defined in the symbol table. Report an error about an undefined symbol. +- JumpLabels inside functions are encoded as functions. Distinguish between + labels (e.g. .A0 or .L0) and global functions. + # Name analysis @@ -28,4 +31,4 @@ # Other - Type analysis. -- Generate call a to _divide_by_zero_error on RiscV. +- Generate a call to _divide_by_zero_error on RiscV. diff --git a/lib/Language/Elna/Architecture/RiscV.hs b/lib/Language/Elna/Architecture/RiscV.hs index 808e19e..03895a3 100644 --- a/lib/Language/Elna/Architecture/RiscV.hs +++ b/lib/Language/Elna/Architecture/RiscV.hs @@ -142,9 +142,10 @@ data Type deriving Eq data RelocationType - = Lower12I XRegister Funct3 XRegister Text - | Lower12S Text Funct3 XRegister XRegister - | Higher20 XRegister Text -- Type U. + = RLower12I XRegister Funct3 XRegister Text + | RLower12S Text Funct3 XRegister XRegister + | RHigher20 XRegister Text -- Type U. + | RBranch Text Funct3 XRegister XRegister -- Type B. deriving Eq data Instruction @@ -299,9 +300,10 @@ type' (Type rd funct3' rs1 funct12') .|. (fromIntegral (funct12 funct12') `shiftL` 20); relocationType :: RelocationType -> Word32 -relocationType (Lower12I rd funct3' rs1 _) = type' $ I rd funct3' rs1 0 -relocationType (Lower12S _ funct3' rs1 rs2) = type' $ S 0 funct3' rs1 rs2 -relocationType (Higher20 rd _) = type' $ U rd 0 +relocationType (RLower12I rd funct3' rs1 _) = type' $ I rd funct3' rs1 0 +relocationType (RLower12S _ funct3' rs1 rs2) = type' $ S 0 funct3' rs1 rs2 +relocationType (RHigher20 rd _) = type' $ U rd 0 +relocationType (RBranch _ funct3' rs1 rs2) = type' $ B 0 funct3' rs1 rs2 instruction :: Instruction -> ByteString.Builder.Builder instruction = \case diff --git a/lib/Language/Elna/Glue.hs b/lib/Language/Elna/Glue.hs index 31c31e0..9fc8a1c 100644 --- a/lib/Language/Elna/Glue.hs +++ b/lib/Language/Elna/Glue.hs @@ -2,7 +2,7 @@ module Language.Elna.Glue ( glue ) where -import Control.Monad.Trans.State (State, get, modify', runState) +import Control.Monad.Trans.State (State, gets, modify', runState) import Data.Bifunctor (Bifunctor(..)) import Data.Foldable (Foldable(..)) import Data.HashMap.Strict (HashMap) @@ -13,10 +13,15 @@ import qualified Data.Vector as Vector import Data.Word (Word32) import qualified Language.Elna.Frontend.AST as AST import Language.Elna.Backend.Intermediate (Operand(..), Quadruple(..), Variable(..)) -import Language.Elna.Frontend.SymbolTable (SymbolTable{-, Info(..) -}) +import Language.Elna.Frontend.SymbolTable (SymbolTable) +import GHC.Records (HasField(..)) + +newtype Paste = Paste + { temporaryCounter :: Word32 + } newtype Glue a = Glue - { runGlue :: State Word32 a } + { runGlue :: State Paste a } instance Functor Glue where @@ -34,7 +39,7 @@ instance Monad Glue glue :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector (Quadruple Variable)) glue globalTable = fst - . flip runState 0 + . flip runState Paste{ temporaryCounter = 0 } . runGlue . program globalTable @@ -111,17 +116,17 @@ statement localTable (AST.WhileStatement whileCondition whileStatement) = do createTemporary :: Glue Variable createTemporary = do - currentCounter <- Glue get - Glue $ modify' (+ 1) + currentCounter <- Glue $ gets $ getField @"temporaryCounter" + Glue $ modify' modifier pure $ TempVariable currentCounter + where + modifier generator = generator + { temporaryCounter = getField @"temporaryCounter" generator + 1 + } {- import Language.Elna.Types (Type(..)) import qualified Language.Elna.SymbolTable as SymbolTable -import GHC.Records (HasField(..)) -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 newtype Label = Label Text deriving Eq @@ -130,20 +135,6 @@ instance Show Label where show (Label label) = '.' : Text.unpack label -createLabel :: Glue Label -createLabel = do - currentCounter <- Glue $ gets labelCounter - Glue $ modify' modifier - pure - $ Label - $ Text.Lazy.toStrict - $ Text.Builder.toLazyText - $ Text.Builder.decimal currentCounter - where - modifier generator = generator - { labelCounter = getField @"labelCounter" generator + 1 - } - condition :: SymbolTable -> AST.Condition 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 -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 +newtype RiscVGenerator a = RiscVGenerator + { runRiscVGenerator :: State Word32 a } -quadruple :: RiscVQuadruple -> Vector Statement -quadruple StartQuadruple = Vector.fromList +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 = flip evalState 0 + . runRiscVGenerator + . foldlM go Vector.empty + . HashMap.toList + where + go accumulator (Identifier key, value) = + let code = Vector.cons (JumpLabel key [GlobalDirective, FunctionDirective]) + . fold <$> mapM quadruple value + in (accumulator <>) <$> code + +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 diff --git a/lib/Language/Elna/RiscV/ElfWriter.hs b/lib/Language/Elna/RiscV/ElfWriter.hs index a83aca3..d3b0e94 100644 --- a/lib/Language/Elna/RiscV/ElfWriter.hs +++ b/lib/Language/Elna/RiscV/ElfWriter.hs @@ -41,7 +41,7 @@ import Language.Elna.Object.Elf ) import System.IO (Handle) import qualified Language.Elna.Architecture.RiscV as RiscV -import qualified Data.Text.Encoding as Text.Encoding +import qualified Data.Text.Encoding as Text import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.State (get) import Language.Elna.RiscV.CodeGenerator (Statement(..)) @@ -238,7 +238,7 @@ riscv32Elf code objectHandle = text result = ( encoded <> encoded' , relocations <> relocations' - , ElfHeaderResult (names <> labelName <> "\0") (Vector.snoc symbols newEntry) + , ElfHeaderResult (names <> Text.encodeUtf8 labelName <> "\0") (Vector.snoc symbols newEntry) , definitions' ) in encodeAsm shndx result rest' @@ -248,18 +248,21 @@ riscv32Elf code objectHandle = text let offset = fromIntegral $ LazyByteString.length encoded unresolvedRelocation = case instruction of RiscV.RelocatableInstruction _ instructionType - | RiscV.Higher20 _ symbolName <- instructionType + | RiscV.RHigher20 _ symbolName <- instructionType -> Just -- R_RISCV_HI20 - $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 26 - | RiscV.Lower12I _ _ _ symbolName <- instructionType + $ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 26 + | RiscV.RLower12I _ _ _ symbolName <- instructionType -> Just -- R_RISCV_LO12_I - $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 27 - | RiscV.Lower12S symbolName _ _ _ <- instructionType + $ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 27 + | RiscV.RLower12S symbolName _ _ _ <- instructionType -> Just -- R_RISCV_LO12_S - $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 28 + $ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 28 + | RiscV.RBranch symbolName _ _ _ <- instructionType + -> Just -- R_RISCV_BRANCH + $ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 16 RiscV.CallInstruction symbolName -> Just -- R_RISCV_CALL_PLT - $ UnresolvedRelocation (Text.Encoding.encodeUtf8 symbolName) offset 19 + $ UnresolvedRelocation (Text.encodeUtf8 symbolName) offset 19 RiscV.BaseInstruction _ _ -> Nothing chunk = ByteString.Builder.toLazyByteString $ RiscV.instruction instruction @@ -270,7 +273,7 @@ riscv32Elf code objectHandle = text , addDefinition unresolvedRelocation definitions ) in encodeInstructions result - | otherwise = (encoded, relocations, Vector.drop 1 instructions, definitions) + | otherwise = (encoded, relocations, instructions, definitions) addDefinition (Just (UnresolvedRelocation symbolName _ _)) = HashSet.insert symbolName addDefinition Nothing = id