[Git][ghc/ghc][wip/supersven/riscv64-ncg] 7 commits: Cleanup
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sat Apr 6 15:46:36 UTC 2024
Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC
Commits:
707f61fb by Sven Tennie at 2024-04-06T10:37:45+02:00
Cleanup
Delete dead code, useless/obsolete comments ...
- - - - -
3f002026 by Sven Tennie at 2024-04-06T10:39:52+02:00
Remove unused constructors
Aarch64 and RISCV64 are just too different...
- - - - -
4e654b45 by Sven Tennie at 2024-04-06T10:45:20+02:00
Remove more dead code
- - - - -
0eaa6163 by Sven Tennie at 2024-04-06T11:43:59+02:00
Replace duplicated source Note by reference
- - - - -
41b2d605 by Sven Tennie at 2024-04-06T11:44:30+02:00
Delete commented out code
- - - - -
0a5accfd by Sven Tennie at 2024-04-06T11:44:54+02:00
TLabel was unused / unsupported
- - - - -
36471c3e by Sven Tennie at 2024-04-06T17:45:50+02:00
Cleanup immediate pretty printing
- - - - -
3 changed files:
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Instr.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -10,18 +10,20 @@ module GHC.CmmToAsm.RV64.CodeGen (
where
--- NCG stuff:
-import GHC.Prelude hiding (EQ)
-
+import Control.Monad (mapAndUnzipM)
+import Data.Maybe
import Data.Word
-
-import GHC.Platform.Regs
-import GHC.CmmToAsm.RV64.Instr
-import GHC.CmmToAsm.RV64.Regs
-import GHC.CmmToAsm.RV64.Cond
-
-import GHC.CmmToAsm.CPrim
+import GHC.Cmm
+import GHC.Cmm.BlockId
+import GHC.Cmm.CLabel
+import GHC.Cmm.Dataflow.Block
+import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.DebugBlock
+import GHC.Cmm.Switch
+import GHC.Cmm.Utils
+import GHC.CmmToAsm.CPrim
+import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Monad
( NatM,
getConfig,
@@ -32,72 +34,28 @@ import GHC.CmmToAsm.Monad
getPicBaseMaybeNat,
getPlatform,
)
-
--- import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.PIC
-import GHC.CmmToAsm.Format
-import GHC.CmmToAsm.Config
+import GHC.CmmToAsm.RV64.Cond
+import GHC.CmmToAsm.RV64.Instr
+import GHC.CmmToAsm.RV64.Regs
import GHC.CmmToAsm.Types
-import GHC.Platform.Reg
-import GHC.Platform
-
--- Our intermediate code:
-import GHC.Cmm.BlockId
-import GHC.Cmm
-import GHC.Cmm.Utils
-import GHC.Cmm.Switch
-import GHC.Cmm.CLabel
-import GHC.Cmm.Dataflow.Block
-import GHC.Cmm.Dataflow.Graph
-import GHC.Types.Tickish ( GenTickish(..) )
-import GHC.Types.SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
-
--- The rest:
+import GHC.Data.FastString
import GHC.Data.OrdList
-import GHC.Utils.Outputable
-
-import Control.Monad ( mapAndUnzipM, foldM )
-import Data.Maybe
import GHC.Float
-
+import GHC.Platform
+import GHC.Platform.Reg
+import GHC.Platform.Regs
+import GHC.Prelude hiding (EQ)
import GHC.Types.Basic
import GHC.Types.ForeignCall
-import GHC.Data.FastString
+import GHC.Types.SrcLoc (srcSpanFile, srcSpanStartCol, srcSpanStartLine)
+import GHC.Types.Tickish (GenTickish (..))
+import GHC.Utils.Constants (debugIsOn)
import GHC.Utils.Misc
+import GHC.Utils.Outputable
import GHC.Utils.Panic
-import GHC.Utils.Constants (debugIsOn)
--- Note [General layout of an NCG]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- @cmmTopCodeGen@ will be our main entry point to code gen. Here we'll get
--- @RawCmmDecl@; see GHC.Cmm
---
--- RawCmmDecl = GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
---
--- GenCmmDecl d h g = CmmProc h CLabel [GlobalReg] g
--- | CmmData Section d
---
--- As a result we want to transform this to a list of @NatCmmDecl@, which is
--- defined @GHC.CmmToAsm.Instr@ as
---
--- type NatCmmDecl statics instr
--- = GenCmmDecl statics (LabelMap RawCmmStatics) (ListGraph instr)
---
--- Thus well' turn
--- GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph
--- into
--- [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) (ListGraph Instr)]
---
--- where @CmmGraph@ is
---
--- type CmmGraph = GenCmmGraph CmmNode
--- data GenCmmGraph n = CmmGraph { g_entry :: BlockId, g_graph :: Graph n C C }
--- type CmmBlock = Block CmmNode C C
---
--- and @ListGraph Instr@ is
---
--- newtype ListGraph i = ListGraph [GenBasicBlock i]
--- data GenBasicBlock i = BasicBlock BlockId [i]
+-- For an overview of an NCG's structure, see Note [General layout of an NCG]
cmmTopCodeGen
:: RawCmmDecl
@@ -379,12 +337,6 @@ getRegisterReg platform (CmmGlobal mid)
-- ones which map to a real machine register on this
-- platform. Hence if it's not mapped to a registers something
-- went wrong earlier in the pipeline.
--- | Convert a BlockId to some CmmStatic data
--- TODO: Add JumpTable Logic, see Ticket 19912
--- jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic
--- jumpTableEntry config Nothing = CmmStaticLit (CmmInt 0 (ncgWordWidth config))
--- jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
--- where blockLabel = blockLbl blockid
-- -----------------------------------------------------------------------------
-- General things for putting together code sequences
@@ -861,6 +813,7 @@ getRegister' config plat expr =
-- TODO: Handle sub-word case
MO_Sub w -> intOp False w (\d x y -> unitOL $ annExpr expr (SUB d x y))
+ -- TODO: Check if this comment is correct
-- Note [CSET]
-- ~~~~~~~~~~~
-- Setting conditional flags: the architecture internally knows the
@@ -937,11 +890,6 @@ getRegister' config plat expr =
MO_F_Eq w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y EQ))
MO_F_Ne w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y NE))
- -- careful with the floating point operations.
- -- SLE is effectively LE or unordered (NaN)
- -- SLT is the same. ULE, and ULT will not return true for NaN.
- -- This is a bit counter-intuitive. Don't let yourself be fooled by
- -- the S/U prefix for floats, it's only meaningful for integers.
MO_F_Ge w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y FGE))
MO_F_Le w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y FLE)) -- x <= y <=> y > x
MO_F_Gt w -> floatCond w (\d x y -> unitOL $ annExpr expr (CSET d x y FGT))
@@ -1706,14 +1654,6 @@ genCCall target dest_regs arg_regs bid = do
let cconv = ForeignConvention CCallConv [NoHint] [NoHint] CmmMayReturn
genCCall (ForeignTarget target cconv) dest_regs arg_regs bid
- -- TODO: Optimize using paired stores and loads (STP, LDP). It is
- -- automatically done by the allocator for us. However it's not optimal,
- -- as we'd rather want to have control over
- -- all spill/load registers, so we can optimize with instructions like
- -- STP xA, xB, [sp, #-16]!
- -- and
- -- LDP xA, xB, sp, #16
- --
passArguments :: Bool -> [Reg] -> [Reg] -> [(Reg, Format, ForeignHint, InstrBlock)] -> Int -> [Reg] -> InstrBlock -> NatM (Int, [Reg], InstrBlock)
passArguments _packStack _ _ [] stackSpace accumRegs accumCode = return (stackSpace, accumRegs, accumCode)
-- passArguments _ _ [] accumCode stackSpace | isEven stackSpace = return $ SUM (OpReg W64 x31) (OpReg W64 x31) OpImm (ImmInt (-8 * stackSpace))
=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -87,8 +87,6 @@ regUsageOfInstr platform instr = case instr of
-- 1. Arithmetic Instructions ------------------------------------------------
ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
- -- CMN l r -> usage (regOp l ++ regOp r, [])
- -- CMP l r -> usage (regOp l ++ regOp r, [])
MUL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
NEG dst src -> usage (regOp src, regOp dst)
SMULH dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
@@ -99,15 +97,10 @@ regUsageOfInstr platform instr = case instr of
DIVU dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
-- 2. Bit Manipulation Instructions ------------------------------------------
- SBFM dst src _ _ -> usage (regOp src, regOp dst)
- UBFM dst src _ _ -> usage (regOp src, regOp dst)
- UBFX dst src _ _ -> usage (regOp src, regOp dst)
-- 3. Logical and Move Instructions ------------------------------------------
AND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
OR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
ASR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
- BIC dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
- BICS dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
XOR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
LSL dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
LSR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst)
@@ -132,10 +125,6 @@ regUsageOfInstr platform instr = case instr of
-- STLR _ src dst L -> usage (regOp src ++ regOp dst, [])
LDR _ dst src -> usage (regOp src, regOp dst)
LDRU _ dst src -> usage (regOp src, regOp dst)
- -- LDAR _ dst src -> usage (regOp src, regOp dst)
- -- TODO is this right? see STR, which I'm only partial about being right?
- -- STP _ src1 src2 dst -> usage (regOp src1 ++ regOp src2 ++ regOp dst, [])
- -- LDP _ dst1 dst2 src -> usage (regOp src, regOp dst1 ++ regOp dst2)
-- 8. Synchronization Instructions -------------------------------------------
DMBSY _ _ -> usage ([], [])
@@ -164,7 +153,6 @@ regUsageOfInstr platform instr = case instr of
regOp (OpImm _) = []
regTarget :: Target -> [Reg]
regTarget (TBlock _) = []
- regTarget (TLabel _) = []
regTarget (TReg r1) = [r1]
-- Is this register interesting for the register allocator?
@@ -216,8 +204,6 @@ patchRegsOfInstr instr env = case instr of
DELTA{} -> instr
-- 1. Arithmetic Instructions ----------------------------------------------
ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3)
- -- CMN o1 o2 -> CMN (patchOp o1) (patchOp o2)
- -- CMP o1 o2 -> CMP (patchOp o1) (patchOp o2)
MUL o1 o2 o3 -> MUL (patchOp o1) (patchOp o2) (patchOp o3)
NEG o1 o2 -> NEG (patchOp o1) (patchOp o2)
SMULH o1 o2 o3 -> SMULH (patchOp o1) (patchOp o2) (patchOp o3)
@@ -228,17 +214,11 @@ patchRegsOfInstr instr env = case instr of
DIVU o1 o2 o3 -> DIVU (patchOp o1) (patchOp o2) (patchOp o3)
-- 2. Bit Manipulation Instructions ----------------------------------------
- SBFM o1 o2 o3 o4 -> SBFM (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4)
- UBFM o1 o2 o3 o4 -> UBFM (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4)
- UBFX o1 o2 o3 o4 -> UBFX (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4)
-- 3. Logical and Move Instructions ----------------------------------------
AND o1 o2 o3 -> AND (patchOp o1) (patchOp o2) (patchOp o3)
OR o1 o2 o3 -> OR (patchOp o1) (patchOp o2) (patchOp o3)
- -- ANDS o1 o2 o3 -> ANDS (patchOp o1) (patchOp o2) (patchOp o3)
ASR o1 o2 o3 -> ASR (patchOp o1) (patchOp o2) (patchOp o3)
- BIC o1 o2 o3 -> BIC (patchOp o1) (patchOp o2) (patchOp o3)
- BICS o1 o2 o3 -> BICS (patchOp o1) (patchOp o2) (patchOp o3)
XOR o1 o2 o3 -> XOR (patchOp o1) (patchOp o2) (patchOp o3)
LSL o1 o2 o3 -> LSL (patchOp o1) (patchOp o2) (patchOp o3)
LSR o1 o2 o3 -> LSR (patchOp o1) (patchOp o2) (patchOp o3)
@@ -264,9 +244,6 @@ patchRegsOfInstr instr env = case instr of
-- STLR f o1 o2 -> STLR f (patchOp o1) (patchOp o2)
LDR f o1 o2 -> LDR f (patchOp o1) (patchOp o2)
LDRU f o1 o2 -> LDRU f (patchOp o1) (patchOp o2)
- -- LDAR f o1 o2 -> LDAR f (patchOp o1) (patchOp o2)
- -- STP f o1 o2 o3 -> STP f (patchOp o1) (patchOp o2) (patchOp o3)
- -- LDP f o1 o2 o3 -> LDP f (patchOp o1) (patchOp o2) (patchOp o3)
-- 8. Synchronization Instructions -----------------------------------------
DMBSY o1 o2 -> DMBSY o1 o2
@@ -310,7 +287,7 @@ isJumpishInstr instr = case instr of
jumpDestsOfInstr :: Instr -> [BlockId]
jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i
jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
-jumpDestsOfInstr (J_TBL ids _mbLbl _r) = [id | Just id <- ids]
+jumpDestsOfInstr (J_TBL ids _mbLbl _r) = catMaybes ids
jumpDestsOfInstr (B t) = [id | TBlock id <- [t]]
jumpDestsOfInstr (B_FAR t) = [t]
jumpDestsOfInstr (BL t _ _) = [id | TBlock id <- [t]]
@@ -532,9 +509,6 @@ allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do
-- We have a few common "instructions" (nearly all the pseudo-ops) but
-- mostly all of 'Instr' is machine-specific.
--- Some additional (potential future) instructions are commented out. They are
--- not needed yet for the backend but could be used in the future.
-
-- RV64 reference card: https://cs61c.org/sp23/pdfs/resources/reference-card.pdf
-- RV64 pseudo instructions: https://github.com/riscv-non-isa/riscv-asm-manual/blob/master/riscv-asm.md#-a-listing-of-standard-risc-v-pseudoinstructions
-- We will target: RV64G(C). That is G = I+A+F+S+D
@@ -573,8 +547,6 @@ data Instr
| DELTA Int
-- 0. Pseudo Instructions --------------------------------------------------
- -- | SXTW Operand Operand
- -- | SXTX Operand Operand
| PUSH_STACK_FRAME
| POP_STACK_FRAME
@@ -590,10 +562,7 @@ data Instr
-- | XOR Operand Operand Operand -- rd = rs1 ^ rs2
| LSL {- SLL -} Operand Operand Operand -- rd = rs1 << rs2 (zero ext)
| LSR {- SRL -} Operand Operand Operand -- rd = rs1 >> rs2 (zero ext)
- -- | ASL {- SLA -} Operand Operand Operand -- rd = rs1 << rs2 (sign ext)
| ASR {- SRA -} Operand Operand Operand -- rd = rs1 >> rs2 (sign ext)
- -- | SLT Operand Operand Operand -- rd = rs1 < rs2 ? 1 : 0 (signed)
- -- | SLTU Operand Operand Operand -- rd = rs1 < rs2 ? 1 : 0 (unsigned)
-- 2. Memory Load/Store Instructions ---------------------------------------
-- Unlike arm, we don't have register shorthands for size.
@@ -609,16 +578,10 @@ data Instr
-- powerful.
-- JAL / JARL are effectively the BL instruction from AArch64.
-
- -- | CMN Operand Operand -- rd + op2
- -- | CMP Operand Operand -- rd - op2
-
| MUL Operand Operand Operand -- rd = rn × rm
-- Pseudo/synthesized:
- -- NEG = SUB x, 0, y
- -- NOT = XOR -1, x
| NEG Operand Operand -- rd = -op2
| DIV Operand Operand Operand -- rd = rn ÷ rm
@@ -630,19 +593,11 @@ data Instr
| DIVU Operand Operand Operand -- rd = rn ÷ rm
-- 2. Bit Manipulation Instructions ----------------------------------------
- | SBFM Operand Operand Operand Operand -- rd = rn[i,j]
- | UBFM Operand Operand Operand Operand -- rd = rn[i,j]
- -- Signed/Unsigned bitfield extract
- | UBFX Operand Operand Operand Operand -- rd = rn[i,j]
-- 3. Logical and Move Instructions ----------------------------------------
-- | AND Operand Operand Operand -- rd = rn & op2
-- | ANDS Operand Operand Operand -- rd = rn & op2
-- | ASR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits
- -- TODO: unused
- | BIC Operand Operand Operand -- rd = rn & ~op2
- -- TODO: unused
- | BICS Operand Operand Operand -- rd = rn & ~op2
| XOR Operand Operand Operand -- rd = rn ⊕ op2
-- | LSL Operand Operand Operand -- rd = rn ≪ rm or rd = rn ≪ #i, i is 6 bits
-- | LSR Operand Operand Operand -- rd = rn ≫ rm or rd = rn ≫ #i, i is 6 bits
@@ -650,13 +605,6 @@ data Instr
| ORI Operand Operand Operand -- rd = rn | op2
| XORI Operand Operand Operand -- rd = rn `xor` imm
-- Load and stores.
- -- TODO STR/LDR might want to change to STP/LDP with XZR for the second register.
- -- | STR Format Operand Operand -- str Xn, address-mode // Xn -> *addr
- -- | STLR Format Operand Operand -- stlr Xn, address-mode // Xn -> *addr
- -- | LDR Format Operand Operand -- ldr Xn, address-mode // Xn <- *addr
- -- | LDAR Format Operand Operand -- ldar Xn, address-mode // Xn <- *addr
- -- | STP Format Operand Operand Operand -- stp Xn, Xm, address-mode // Xn -> *addr, Xm -> *(addr + 8)
- -- | LDP Format Operand Operand Operand -- stp Xn, Xm, address-mode // Xn <- *addr, Xm <- *(addr + 8)
-- Conditional instructions
-- This is a synthetic operation.
@@ -711,13 +659,8 @@ instrCon i =
SMULH{} -> "SMULH"
SUB{} -> "SUB"
DIVU{} -> "DIVU"
- SBFM{} -> "SBFM"
- UBFM{} -> "UBFM"
- UBFX{} -> "UBFX"
AND{} -> "AND"
ASR{} -> "ASR"
- BIC{} -> "BIC"
- BICS{} -> "BICS"
XOR{} -> "XOR"
LSL{} -> "LSL"
LSR{} -> "LSR"
@@ -741,17 +684,18 @@ instrCon i =
FCVTZS{} -> "FCVTZS"
FABS{} -> "FABS"
--- TODO: We don't need TLabel.
data Target
= TBlock BlockId
- | TLabel CLabel
| TReg Reg
data Operand
- = OpReg Width Reg -- register
- | OpImm Imm -- immediate value
- | OpAddr AddrMode -- memory reference
- deriving (Eq, Show)
+ = -- | register
+ OpReg Width Reg
+ | -- | immediate value
+ OpImm Imm
+ | -- | memory reference
+ OpAddr AddrMode
+ deriving (Eq, Show)
operandFromReg :: Reg -> Operand
operandFromReg = OpReg W64
=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -231,10 +231,10 @@ pprDataItem config lit
imm = litToImm lit
- ppr_item II8 _ = [text "\t.byte\t" <> pprImm platform imm]
- ppr_item II16 _ = [text "\t.short\t" <> pprImm platform imm]
- ppr_item II32 _ = [text "\t.long\t" <> pprImm platform imm]
- ppr_item II64 _ = [text "\t.quad\t" <> pprImm platform imm]
+ ppr_item II8 _ = [text "\t.byte\t" <> pprDataImm platform imm]
+ ppr_item II16 _ = [text "\t.short\t" <> pprDataImm platform imm]
+ ppr_item II32 _ = [text "\t.long\t" <> pprDataImm platform imm]
+ ppr_item II64 _ = [text "\t.quad\t" <> pprDataImm platform imm]
ppr_item FF32 (CmmFloat r _)
= let bs = floatToBytes (fromRational r)
@@ -246,23 +246,23 @@ pprDataItem config lit
ppr_item _ _ = pprPanic "pprDataItem:ppr_item" (text $ show lit)
-pprImm :: IsLine doc => Platform -> Imm -> doc
-pprImm _ (ImmInt i) = int i
-pprImm _ (ImmInteger i) = integer i
-pprImm p (ImmCLbl l) = pprAsmLabel p l
-pprImm p (ImmIndex l i) = pprAsmLabel p l <> char '+' <> int i
-pprImm _ (ImmLit s) = ftext s
-
--- TODO: See pprIm below for why this is a bad idea!
-pprImm _ (ImmFloat f) = float (fromRational f)
-pprImm _ (ImmDouble d) = double (fromRational d)
-
-pprImm p (ImmConstantSum a b) = pprImm p a <> char '+' <> pprImm p b
-pprImm p (ImmConstantDiff a b) = pprImm p a <> char '-'
- <> lparen <> pprImm p b <> rparen
-
+-- | Pretty print an immediate value in the @data@ section
+--
+-- This does not include any checks. We rely on the Assembler to check for
+-- errors. Use `pprOpImm` for immediates in instructions (operands.)
+pprDataImm :: IsLine doc => Platform -> Imm -> doc
+pprDataImm _ (ImmInt i) = int i
+pprDataImm _ (ImmInteger i) = integer i
+pprDataImm p (ImmCLbl l) = pprAsmLabel p l
+pprDataImm p (ImmIndex l i) = pprAsmLabel p l <> char '+' <> int i
+pprDataImm _ (ImmLit s) = ftext s
+pprDataImm _ (ImmFloat f) = float (fromRational f)
+pprDataImm _ (ImmDouble d) = double (fromRational d)
+
+pprDataImm p (ImmConstantSum a b) = pprDataImm p a <> char '+' <> pprDataImm p b
+pprDataImm p (ImmConstantDiff a b) = pprDataImm p a <> char '-'
+ <> lparen <> pprDataImm p b <> rparen
--- aarch64 GNU as uses // for comments.
asmComment :: SDoc -> SDoc
asmComment c = text "#" <+> c
@@ -272,32 +272,18 @@ asmDoubleslashComment c = text "//" <+> c
asmMultilineComment :: SDoc -> SDoc
asmMultilineComment c = text "/*" $+$ c $+$ text "*/"
-pprIm :: IsLine doc => Platform -> Imm -> doc
-pprIm platform im = case im of
- ImmInt i -> int i
+-- | Pretty print an immediate operand of an instruction
+--
+-- The kinds of immediates we can use here is pretty limited: RISCV doesn't
+-- support index expressions (as e.g. Aarch64 does.) Floating points need to
+-- fit in range. As we don't need them, forbit them to save us from future
+-- troubles.
+pprOpImm :: (IsLine doc) => Platform -> Imm -> doc
+pprOpImm platform im = case im of
+ ImmInt i -> int i
ImmInteger i -> integer i
-
- -- FIXME: This is AArch64 commentry, not necesarily correct for RISCV!
- -- TODO: This will only work for
- -- The floating point value must be expressible as ±n ÷ 16 × 2^r,
- -- where n and r are integers such that 16 ≤ n ≤ 31 and -3 ≤ r ≤ 4.
- -- and 0 needs to be encoded as wzr/xzr.
- --
- -- Except for 0, we might want to either split it up into enough
- -- ADD operations into an Integer register and then just bit copy it into
- -- the double register? See the toBytes + fromRational above for data items.
- -- This is something the x86 backend does.
- --
- -- We could also just turn them into statics :-/ Which is what the
- -- PowerPC backend does.
- ImmFloat f | f == 0 -> text "zero"
- ImmFloat f -> char '#' <> float (fromRational f)
- ImmDouble d | d == 0 -> text "zero"
- ImmDouble d -> char '#' <> double (fromRational d)
- -- =<lbl> pseudo instruction!
- ImmCLbl l -> char '=' <> pprAsmLabel platform l
- ImmIndex l o -> text "[=" <> pprAsmLabel platform l <> comma <+> char '#' <> int o <> char ']'
- _ -> panic "AArch64.pprIm"
+ ImmCLbl l -> char '=' <> pprAsmLabel platform l
+ _ -> pprPanic "RV64.Ppr.pprOpImm" (text "Unsupported immediate for instruction operands" <> colon <+> (text . show) im)
negOp :: Operand -> Operand
negOp (OpImm (ImmInt i)) = OpImm (ImmInt (negate i))
@@ -307,8 +293,8 @@ negOp op = pprPanic "RV64.negOp" (text $ show op)
pprOp :: IsLine doc => Platform -> Operand -> doc
pprOp plat op = case op of
OpReg w r -> pprReg w r
- OpImm im -> pprIm plat im
- OpAddr (AddrRegImm r1 im) -> pprImm plat im <> char '(' <> pprReg W64 r1 <> char ')'
+ OpImm im -> pprOpImm plat im
+ OpAddr (AddrRegImm r1 im) -> pprOpImm plat im <> char '(' <> pprReg W64 r1 <> char ')'
OpAddr (AddrReg r1) -> text "0(" <+> pprReg W64 r1 <+> char ')'
pprReg :: forall doc. IsLine doc => Width -> Reg -> doc
@@ -416,12 +402,10 @@ isImmZero _ = False
isLabel :: Target -> Bool
isLabel (TBlock _) = True
-isLabel (TLabel _) = True
isLabel _ = False
getLabel :: IsLine doc => Platform -> Target -> doc
getLabel platform (TBlock bid) = pprBlockId platform bid
-getLabel platform (TLabel lbl) = pprAsmLabel platform lbl
getLabel _platform _other = panic "Cannot turn this into a label"
pprBlockId :: IsLine doc => Platform -> BlockId -> doc
@@ -459,11 +443,6 @@ pprInstr platform instr = case instr of
-- This case is used for sign extension: SEXT.W op
| OpReg W64 _ <- o1 , OpReg W32 _ <- o2, isImmOp o3 -> op3 (text "\taddiw") o1 o2 o3
| otherwise -> op3 (text "\tadd") o1 o2 o3
- -- TODO: Delete commented out code.
- -- CMN o1 o2 -> op2 (text "\tcmn") o1 o2
- -- CMP o1 o2
- -- | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfcmp") o1 o2
- -- | otherwise -> op2 (text "\tcmp") o1 o2
MUL o1 o2 o3
| isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfmul." <> if isSingleOp o1 then text "s" else text "d") o1 o2 o3
| otherwise -> op3 (text "\tmul") o1 o2 o3
@@ -487,22 +466,12 @@ pprInstr platform instr = case instr of
DIVU o1 o2 o3 -> op3 (text "\tdivu") o1 o2 o3
-- 2. Bit Manipulation Instructions ------------------------------------------
- -- TODO: Non-existant in RISCV - delete
- SBFM o1 o2 o3 o4 -> op4 (text "\tsbfm") o1 o2 o3 o4
- -- TODO: Non-existant in RISCV - delete
- UBFM o1 o2 o3 o4 -> op4 (text "\tubfm") o1 o2 o3 o4
- -- signed and unsigned bitfield extract
- -- TODO: Non-existant in RISCV - delete
- UBFX o1 o2 o3 o4 -> op4 (text "\tubfx") o1 o2 o3 o4
-- 3. Logical and Move Instructions ------------------------------------------
AND o1 o2 o3 -> op3 (text "\tand") o1 o2 o3
OR o1 o2 o3 -> op3 (text "\tor") o1 o2 o3
- -- ANDS o1 o2 o3 -> op3 (text "\tands") o1 o2 o3
ASR o1 o2 o3 | isImmOp o3 -> op3 (text "\tsrai") o1 o2 o3
ASR o1 o2 o3 -> op3 (text "\tsra") o1 o2 o3
- BIC o1 o2 o3 -> op3 (text "\tbic") o1 o2 o3
- BICS o1 o2 o3 -> op3 (text "\tbics") o1 o2 o3
XOR o1 o2 o3 -> op3 (text "\txor") o1 o2 o3
LSL o1 o2 o3 -> op3 (text "\tsll") o1 o2 o3
LSR o1 o2 o3 -> op3 (text "\tsrl") o1 o2 o3
@@ -652,10 +621,6 @@ pprInstr platform instr = case instr of
LDRU FF64 o1 o2@(OpAddr (AddrReg _)) -> op2 (text "\tfld") o1 o2
LDRU FF64 o1 o2@(OpAddr (AddrRegImm _ _)) -> op2 (text "\tfld") o1 o2
LDRU f o1 o2 -> pprPanic "Unsupported unsigned load" ((text.show) f <+> pprOp platform o1 <+> pprOp platform o2)
- -- LDAR _f o1 o2 -> op2 (text "\tldar") o1 o2
-
- -- STP _f o1 o2 o3 -> op3 (text "\tstp") o1 o2 o3
- -- LDP _f o1 o2 o3 -> op3 (text "\tldp") o1 o2 o3
-- 8. Synchronization Instructions -------------------------------------------
DMBSY r w -> line $ text "\tfence" <+> pprDmbType r <> char ',' <+> pprDmbType w
@@ -685,11 +650,6 @@ pprInstr platform instr = case instr of
instr -> panic $ "RV64.pprInstr - Unknown instruction: " ++ instrCon instr
where op2 op o1 o2 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2
op3 op o1 o2 o3 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
- op4 op o1 o2 o3 o4 = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
- -- TODO: Delete commented out code.
- -- op_ldr o1 rest = line $ text "\tld" <+> pprOp platform o1 <> comma <+> rest <+> text "(" <> pprOp platform o1 <> text ")"
- -- op_adrp o1 rest = line $ text "\tauipc" <+> pprOp platform o1 <> comma <+> rest
- -- op_add o1 rest = line $ text "\taddi" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> rest
pprDmbType DmbRead = text "r"
pprDmbType DmbWrite = text "w"
pprDmbType DmbReadWrite = text "rw"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/61f8c7e4a06349df7fe31863ac9791abee2741db...36471c3ebe3b8824dc31c33825a0f2eced92f63f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/61f8c7e4a06349df7fe31863ac9791abee2741db...36471c3ebe3b8824dc31c33825a0f2eced92f63f
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240406/fe7c3955/attachment-0001.html>
More information about the ghc-commits
mailing list