Add branch relocation type

This commit is contained in:
Eugen Wissner 2024-10-08 17:29:08 +02:00
parent 699cc8684b
commit 8bda5fe96d
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
5 changed files with 122 additions and 75 deletions

5
TODO
View File

@ -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.

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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