[Git][ghc/ghc][wip/supersven/riscv64-ncg] 6 commits: Reduce duplication in conditionals
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sun Jan 28 16:51:36 UTC 2024
Sven Tennie pushed to branch wip/supersven/riscv64-ncg at Glasgow Haskell Compiler / GHC
Commits:
fcd6a629 by Sven Tennie at 2024-01-15T17:52:06+01:00
Reduce duplication in conditionals
All non-W64 width had the same code.
- - - - -
5bced457 by Sven Tennie at 2024-01-25T12:13:51+01:00
Add TODOS
- - - - -
eb35e081 by Sven Tennie at 2024-01-27T11:13:15+01:00
Far branches
- - - - -
2031765e by Sven Tennie at 2024-01-28T11:02:46+01:00
Far unconditional jumps / branches
Introduce B_FAR.
- - - - -
c2df499e by Sven Tennie at 2024-01-28T11:03:43+01:00
Fix DWARF labels
Some were missing...
- - - - -
61bcb6d1 by Sven Tennie at 2024-01-28T11:04:17+01:00
Add TODOs
- - - - -
5 changed files:
- compiler/GHC/CmmToAsm/RV64.hs
- compiler/GHC/CmmToAsm/RV64/CodeGen.hs
- compiler/GHC/CmmToAsm/RV64/Cond.hs
- compiler/GHC/CmmToAsm/RV64/Instr.hs
- compiler/GHC/CmmToAsm/RV64/Ppr.hs
Changes:
=====================================
compiler/GHC/CmmToAsm/RV64.hs
=====================================
@@ -34,7 +34,7 @@ ncgRV64 config
,maxSpillSlots = RV64.maxSpillSlots config
,allocatableRegs = RV64.allocatableRegs platform
,ncgAllocMoreStack = RV64.allocMoreStack platform
- ,ncgMakeFarBranches = const id
+ ,ncgMakeFarBranches = RV64.makeFarBranches
,extractUnwindPoints = const []
,invertCondBranches = \_ _ -> id
}
=====================================
compiler/GHC/CmmToAsm/RV64/CodeGen.hs
=====================================
@@ -1203,7 +1203,7 @@ assignReg_FltCode = assignReg_IntCode
genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
genJump expr = do
(target, _format, code) <- getSomeReg expr
- return (code `appOL` unitOL (annExpr expr (J (TReg target))))
+ return (code `appOL` unitOL (annExpr expr (B (TReg target))))
-- -----------------------------------------------------------------------------
-- Unconditional branches
@@ -1221,12 +1221,12 @@ genCondJump bid expr = do
-- Optimized == 0 case.
CmmMachOp (MO_Eq w) [x, CmmLit (CmmInt 0 _)] -> do
(reg_x, _format_x, code_x) <- getSomeReg x
- return $ code_x `snocOL` annExpr expr (CBZ (OpReg w reg_x) (TBlock bid))
+ return $ code_x `snocOL` annExpr expr (BCOND EQ zero (OpReg w reg_x) (TBlock bid))
-- Optimized /= 0 case.
CmmMachOp (MO_Ne w) [x, CmmLit (CmmInt 0 _)] -> do
(reg_x, _format_x, code_x) <- getSomeReg x
- return $ code_x `snocOL` annExpr expr (CBNZ (OpReg w reg_x) (TBlock bid))
+ return $ code_x `snocOL` annExpr expr (BCOND NE zero (OpReg w reg_x) (TBlock bid))
-- Generic case.
CmmMachOp mop [x, y] -> do
@@ -1244,7 +1244,9 @@ genCondJump bid expr = do
truncateReg (formatToWidth format_y) w reg_y `appOL`
code_y `snocOL`
annExpr expr (BCOND cmp x' y' (TBlock bid))
- _ -> code_x `appOL` code_y `snocOL` annExpr expr (BCOND cmp x' y' (TBlock bid))
+ _ -> code_x `appOL`
+ code_y `snocOL`
+ annExpr expr (BCOND cmp x' y' (TBlock bid))
sbcond w cmp = do
-- compute both sides.
@@ -1252,21 +1254,8 @@ genCondJump bid expr = do
(reg_y, format_y, code_y) <- getSomeReg y
let x' = OpReg w reg_x
y' = OpReg w reg_y
- -- TODO: Reduce duplication in this block.
return $ case w of
- W8 ->
- code_x
- `appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x
- `appOL` code_y
- `appOL` signExtend (formatToWidth format_y) W64 reg_y reg_y
- `appOL` unitOL (annExpr expr (BCOND cmp x' y' (TBlock bid)))
- W16 ->
- code_x
- `appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x
- `appOL` code_y
- `appOL` signExtend (formatToWidth format_y) W64 reg_y reg_y
- `appOL` unitOL (annExpr expr (BCOND cmp x' y' (TBlock bid)))
- W32 ->
+ w | w `elem` [W8, W16, W32] ->
code_x
`appOL` signExtend (formatToWidth format_x) W64 reg_x reg_x
`appOL` code_y
=====================================
compiler/GHC/CmmToAsm/RV64/Cond.hs
=====================================
@@ -1,6 +1,6 @@
module GHC.CmmToAsm.RV64.Cond where
-import GHC.Prelude
+import GHC.Prelude hiding (EQ)
-- FIXME: These conditions originate from the Aarch64 backend. I'm not even sure
-- we use all of them there. For RISCV we need to synthesize some of them, as
@@ -66,3 +66,28 @@ data Cond
| VS -- oVerflow set
| VC -- oVerflow clear
deriving (Eq, Show)
+
+-- | Negate a condition.
+negateCond :: Cond -> Cond
+negateCond ALWAYS = NEVER
+negateCond NEVER = ALWAYS
+negateCond EQ = NE
+negateCond NE = EQ
+negateCond SLT = SGE
+negateCond SLE = SGT
+negateCond SGE = SLT
+negateCond SGT = SLE
+negateCond ULT = UGE
+negateCond ULE = UGT
+negateCond UGE = ULT
+negateCond UGT = ULE
+negateCond OLT = OGE
+negateCond OLE = OGT
+negateCond OGE = OLT
+negateCond OGT = OLE
+negateCond UOLT = UOGE
+negateCond UOLE = UOGT
+negateCond UOGE = UOLT
+negateCond UOGT = UOLE
+negateCond VS = VC
+negateCond VC = VS
=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -31,6 +31,10 @@ import GHC.Utils.Panic
import Data.Maybe (fromMaybe)
import GHC.Stack
+import qualified Data.List.NonEmpty as NE
+import Data.Foldable
+import GHC.Cmm.Info (maxRetInfoTableSizeW)
+import GHC.Types.Unique.FM (listToUFM, lookupUFM)
-- | Stack frame header size in bytes.
--
@@ -118,7 +122,9 @@ regUsageOfInstr platform instr = case instr of
-- 4. Branch Instructions ----------------------------------------------------
J t -> usage (regTarget t, [])
B t -> usage (regTarget t, [])
+ B_FAR _t -> usage ([], [])
BCOND _ l r t -> usage (regTarget t ++ regOp l ++ regOp r, [])
+ BCOND_FAR _ l r b t -> usage (regTarget t ++ regOp l ++ regOp r, [])
BL t ps _rs -> usage (regTarget t ++ ps, callerSavedRegisters)
-- 5. Atomic Instructions ----------------------------------------------------
@@ -257,8 +263,10 @@ patchRegsOfInstr instr env = case instr of
-- 4. Branch Instructions --------------------------------------------------
J t -> J (patchTarget t)
B t -> B (patchTarget t)
+ B_FAR t -> B_FAR t
BL t rs ts -> BL (patchTarget t) rs ts
BCOND c o1 o2 t -> BCOND c (patchOp o1) (patchOp o2) (patchTarget t)
+ BCOND_FAR c o1 o2 b t -> BCOND_FAR c (patchOp o1) (patchOp o2) (patchTarget b) (patchTarget t)
-- 5. Atomic Instructions --------------------------------------------------
-- 6. Conditional Instructions ---------------------------------------------
@@ -308,8 +316,10 @@ isJumpishInstr instr = case instr of
CBNZ{} -> True
J{} -> True
B{} -> True
+ B_FAR{} -> True
BL{} -> True
BCOND{} -> True
+ BCOND_FAR{} -> True
_ -> False
-- | Checks whether this instruction is a jump/branch instruction.
@@ -321,8 +331,10 @@ jumpDestsOfInstr (CBZ _ t) = [ id | TBlock id <- [t]]
jumpDestsOfInstr (CBNZ _ t) = [ id | TBlock id <- [t]]
jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
jumpDestsOfInstr (B t) = [id | TBlock id <- [t]]
+jumpDestsOfInstr (B_FAR t) = [t]
jumpDestsOfInstr (BL t _ _) = [ id | TBlock id <- [t]]
jumpDestsOfInstr (BCOND _ _ _ t) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr (BCOND_FAR _ _ _ _ t) = [ id | TBlock id <- [t]]
jumpDestsOfInstr _ = []
-- | Change the destination of this jump instruction.
@@ -336,8 +348,10 @@ patchJumpInstr instr patchF
CBNZ r (TBlock bid) -> CBNZ r (TBlock (patchF bid))
J (TBlock bid) -> J (TBlock (patchF bid))
B (TBlock bid) -> B (TBlock (patchF bid))
+ B_FAR bid -> B_FAR (patchF bid)
BL (TBlock bid) ps rs -> BL (TBlock (patchF bid)) ps rs
BCOND c o1 o2 (TBlock bid) -> BCOND c o1 o2 (TBlock (patchF bid))
+ BCOND_FAR c o1 o2 b (TBlock bid) -> BCOND_FAR c o1 o2 b (TBlock (patchF bid))
_ -> panic $ "patchJumpInstr: " ++ instrCon instr
-- -----------------------------------------------------------------------------
@@ -652,13 +666,20 @@ data Instr
-- This is a synthetic operation.
| CSET Operand Operand Operand Cond -- if(o2 cond o3) op <- 1 else op <- 0
+ -- TODO: Unused
| CBZ Operand Target -- if op == 0, then branch.
+ -- TODO: Unused
| CBNZ Operand Target -- if op /= 0, then branch.
-- Branching.
+ -- TODO: Unused
| J Target -- like B, but only generated from genJump. Used to distinguish genJumps from others.
| B Target -- unconditional branching b/br. (To a blockid, label or register)
+ -- | pseudo-op for far branch targets
+ | B_FAR BlockId
| BL Target [Reg] [Reg] -- branch and link (e.g. set x30 to next pc, and branch)
| BCOND Cond Operand Operand Target -- branch with condition. b.<cond>
+ -- | pseudo-op for far branch targets
+ | BCOND_FAR Cond Operand Operand Target Target
-- 8. Synchronization Instructions -----------------------------------------
| DMBSY DmbType DmbType
@@ -729,14 +750,17 @@ instrCon i =
CBNZ{} -> "CBNZ"
J{} -> "J"
B{} -> "B"
+ B_FAR{} -> "B_FAR"
BL{} -> "BL"
BCOND{} -> "BCOND"
+ BCOND_FAR{} -> "BCOND_FAR"
DMBSY{} -> "DMBSY"
FCVT{} -> "FCVT"
SCVTF{} -> "SCVTF"
FCVTZS{} -> "FCVTZS"
FABS{} -> "FABS"
+-- TODO: We don't need TLabel.
data Target
= TBlock BlockId
| TLabel CLabel
@@ -910,3 +934,65 @@ isNbitEncodeable n i = let shift = n - 1 in (-1 `shiftL` shift) <= i && i < (1 `
isEncodeableInWidth :: Width -> Integer -> Bool
isEncodeableInWidth = isNbitEncodeable . widthInBits
+
+-- | Making far branches
+
+-- Conditional branch instructions can target labels in a range of +/- 4 KiB.
+-- The assembler can transform this into a J instruction targeting +/- 1MiB.
+-- There are rare cases where this is not enough (e.g. the Happy-generated
+-- @Parser.hs at .) We need to manually transfer these into register based jumps
+-- using @ip@ (register reserved for calculations.) The trick is to invert the
+-- condition, do a far jump in the fall-through case or a short jump when the
+-- (inverted) condition is true.
+-- TODO: Remove comments / annotations
+makeFarBranches ::
+ LabelMap RawCmmStatics ->
+ [NatBasicBlock Instr] ->
+ [NatBasicBlock Instr]
+makeFarBranches info_env blocks
+ | NE.last blockAddresses < nearLimit = zipWith (curry blockStatistics) blockAddressList blocks
+ | otherwise = zipWith handleBlock blockAddressList blocks
+ where
+ blockAddresses = NE.scanl (+) 0 $ map blockLen blocks
+ blockAddressList = toList blockAddresses
+ blockLen (BasicBlock _ instrs) = length instrs
+
+ handleBlock addr (BasicBlock id instrs) =
+ BasicBlock id (zipWith (makeFar id) [addr ..] instrs)
+
+ makeFar :: BlockId -> Int -> Instr -> Instr
+ makeFar bid addr orig@(BCOND cond op1 op2 tgt@(TBlock tgtBid))
+ | abs (addr - targetAddr) >= nearLimit =
+ ANN (text "BCOND_FAR targetAddr:" <+> int targetAddr <+> text ", offset:" <+> int (addr - targetAddr) <+> text ", nearLimit:" <+> int nearLimit) $
+ BCOND_FAR cond op1 op2 (TBlock bid) tgt
+ | otherwise =
+ ANN (text "BCOND targetAddr:" <+> int targetAddr <+> text ", offset:" <+> int (addr - targetAddr) <+> text ", nearLimit:" <+> int nearLimit) orig
+ where
+ Just targetAddr = lookupUFM blockAddressMap tgtBid
+ makeFar _bid addr orig@(B (TBlock tgtBid))
+ | abs (addr - targetAddr) >= nearLimit =
+ ANN (text "B_FAR targetAddr:" <+> int targetAddr <+> text ", offset:" <+> int (addr - targetAddr) <+> text ", nearLimit:" <+> int nearLimit) $
+ B_FAR tgtBid
+ | otherwise =
+ ANN (text "B targetAddr:" <+> int targetAddr <+> text ", offset:" <+> int (addr - targetAddr) <+> text ", nearLimit:" <+> int nearLimit) orig
+ where
+ Just targetAddr = lookupUFM blockAddressMap tgtBid
+ makeFar _bid _addr orig@(BCOND _cond _op1 _op2 (TLabel _l)) = ANN (text "other BCOND: label") orig
+ makeFar _bid _addr orig@(BCOND _cond _op1 _op2 _l) = ANN (text "other BCOND: other") orig
+ makeFar bid addr (ANN desc other) = ANN desc $ makeFar bid addr other
+ makeFar _bid _ other = ANN (text ("makeFar: " ++ instrCon other)) other
+
+ -- 262144 (2^20 / 4) instructions are allowed; let's keep some distance, as
+ -- we have pseudo-insns that are pretty-printed as multiple instructions,
+ -- and it's just not worth the effort to calculate things exactly. The
+ -- conservative guess here is that every instruction does not emit more than
+ -- two in the mean.
+ nearLimit = 131072 - mapSize info_env * maxRetInfoTableSizeW
+
+ blockAddressMap = listToUFM $ zip (map blockId blocks) blockAddressList
+
+ blockStatistics (stat, BasicBlock blockId instrs) =
+ BasicBlock blockId (COMMENT (text "BasicBlock" <+> text (show blockId) <+> text "Address" <+> int stat) : instrs)
+
+annotateBlock :: NatBasicBlock Instr -> NatBasicBlock Instr
+annotateBlock (BasicBlock id instrs) = BasicBlock id (COMMENT (text "annotateBlock: visited") : instrs)
=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -49,8 +49,8 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
-- pprProcAlignment config $$
pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
vcat (map (pprBasicBlock config top_info) blocks) $$
- (if ncgDwarfEnabled config
- then line (pprAsmLabel platform (mkAsmTempEndLabel lbl) <> char ':') else empty) $$
+ ppWhen (ncgDwarfEnabled config)
+ (line (pprBlockEndLabel platform lbl) $$ line (pprProcEndLabel platform lbl)) $$
pprSizeDecl platform lbl
Just (CmmStaticsRaw info_lbl _) ->
@@ -60,6 +60,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
then line (pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> char ':')
else empty) $$
vcat (map (pprBasicBlock config top_info) blocks) $$
+ ppWhen (ncgDwarfEnabled config) (line (pprProcEndLabel platform info_lbl)) $$
-- above: Even the first block gets a label, because with branch-chain
-- elimination, it might be the target of a goto.
(if platformHasSubsectionsViaSymbols platform
@@ -99,11 +100,22 @@ pprAlignForSection _platform _seg
--
pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc
pprSectionAlign _config (Section (OtherSection _) _) =
- panic "AArch64.Ppr.pprSectionAlign: unknown section"
+ -- TODO: Valid for RISCV64?
+ panic "AArch64.Ppr.pprSectionAlign: unknown section"
pprSectionAlign config sec@(Section seg _) =
line (pprSectionHeader config sec)
$$ pprAlignForSection (ncgPlatform config) seg
+pprProcEndLabel :: IsLine doc => Platform -> CLabel -- ^ Procedure name
+ -> doc
+pprProcEndLabel platform lbl =
+ pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> colon
+
+pprBlockEndLabel :: IsLine doc => Platform -> CLabel -- ^ Block name
+ -> doc
+pprBlockEndLabel platform lbl =
+ pprAsmLabel platform (mkAsmTempEndLabel lbl) <> colon
+
-- | Output the ELF .size directive.
pprSizeDecl :: IsDoc doc => Platform -> CLabel -> doc
pprSizeDecl platform lbl
@@ -117,11 +129,15 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
= maybe_infotable $
pprLabel platform asmLbl $$
vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$
- (if ncgDwarfEnabled config
- then line (pprAsmLabel platform (mkAsmTempEndLabel asmLbl) <> char ':')
- else empty
+ ppWhen (ncgDwarfEnabled config) (
+ -- Emit both end labels since this may end up being a standalone
+ -- top-level block
+ line (pprBlockEndLabel platform asmLbl
+ <> pprProcEndLabel platform asmLbl)
)
where
+ -- TODO: Check if we can filter more instructions here.
+ -- TODO: Shouldn't this be a more general check on a higher level?
-- Filter out identity moves. E.g. mov x18, x18 will be dropped.
optInstrs = filter f instrs
where f (MOV o1 o2) | o1 == o2 = False
@@ -137,9 +153,8 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
vcat (map (pprData config) info) $$
pprLabel platform info_lbl $$
c $$
- (if ncgDwarfEnabled config
- then line (pprAsmLabel platform (mkAsmTempEndLabel info_lbl) <> char ':')
- else empty)
+ ppWhen (ncgDwarfEnabled config)
+ (line (pprBlockEndLabel platform info_lbl))
-- Make sure the info table has the right .loc for the block
-- coming right after it. See Note [Info Offset]
infoTableLoc = case instrs of
@@ -167,6 +182,7 @@ pprData :: IsDoc doc => NCGConfig -> CmmStatic -> doc
pprData _config (CmmString str) = line (pprString str)
pprData _config (CmmFileEmbed path _) = line (pprFileEmbed path)
+-- TODO: AFAIK there no Darwin for RISCV, so we may consider to simplify this.
pprData config (CmmUninitialised bytes)
= line $ let platform = ncgPlatform config
in if platformOS platform == OSDarwin
@@ -248,13 +264,13 @@ pprImm p (ImmConstantDiff a b) = pprImm p a <> char '-'
-- aarch64 GNU as uses // for comments.
asmComment :: SDoc -> SDoc
-asmComment c = whenPprDebug $ text "#" <+> c
+asmComment c = text "#" <+> c
asmDoubleslashComment :: SDoc -> SDoc
-asmDoubleslashComment c = whenPprDebug $ text "//" <+> c
+asmDoubleslashComment c = text "//" <+> c
asmMultilineComment :: SDoc -> SDoc
-asmMultilineComment c = whenPprDebug $ text "/*" $+$ c $+$ text "*/"
+asmMultilineComment c = text "/*" $+$ c $+$ text "*/"
pprIm :: IsLine doc => Platform -> Imm -> doc
pprIm platform im = case im of
@@ -437,10 +453,13 @@ isLabel (TLabel _) = True
isLabel _ = False
getLabel :: IsLine doc => Platform -> Target -> doc
-getLabel platform (TBlock bid) = pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
+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
+pprBlockId platform bid = pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
+
pprInstr :: IsDoc doc => Platform -> Instr -> doc
pprInstr platform instr = case instr of
-- Meta Instructions ---------------------------------------------------------
@@ -553,27 +572,33 @@ pprInstr platform instr = case instr of
-- 4. Branch Instructions ----------------------------------------------------
J t -> pprInstr platform (B t)
- B l | isLabel l -> line $ text "\tjal" <+> text "x0" <> comma <+> getLabel platform l
+ -- TODO: This is odd: (B)ranch and branch and link (BL) do the same: branch and link
+ B l | isLabel l -> line $ text "\tjal" <+> pprOp platform x0 <> comma <+> getLabel platform l
B (TReg r) -> line $ text "\tjalr" <+> text "x0" <> comma <+> pprReg W64 r <> comma <+> text "0"
- BL l _ _ | isLabel l-> line $ text "\tjal" <+> text "x1" <> comma <+> getLabel platform l
+ B_FAR bid -> lines_ [ text "\tla" <+> pprOp platform ip <> comma <+> pprBlockId platform bid
+ , text "\tjalr" <+> text "x0" <> comma <+> pprOp platform ip <> comma <+> text "0" ]
+
+ BL l _ _ | isLabel l-> line $ text "\tcall" <+> getLabel platform l
BL (TReg r) _ _ -> line $ text "\tjalr" <+> text "x1" <> comma <+> pprReg W64 r <> comma <+> text "0"
- BCOND c l r t | isLabel t -> case c of
- EQ -> line $ text "\tbeq" <+> pprOp platform l <> comma <+> pprOp platform r <> comma <+> getLabel platform t
- NE -> line $ text "\tbne" <+> pprOp platform l <> comma <+> pprOp platform r <> comma <+> getLabel platform t
- SLT -> line $ text "\tblt" <+> pprOp platform l <> comma <+> pprOp platform r <> comma <+> getLabel platform t
- SLE -> line $ text "\tbge" <+> pprOp platform r <> comma <+> pprOp platform l <> comma <+> getLabel platform t
- SGE -> line $ text "\tbge" <+> pprOp platform l <> comma <+> pprOp platform r <> comma <+> getLabel platform t
- SGT -> line $ text "\tblt" <+> pprOp platform r <> comma <+> pprOp platform l <> comma <+> getLabel platform t
- ULT -> line $ text "\tbltu" <+> pprOp platform l <> comma <+> pprOp platform r <> comma <+> getLabel platform t
- ULE -> line $ text "\tbgeu" <+> pprOp platform r <> comma <+> pprOp platform l <> comma <+> getLabel platform t
- UGE -> line $ text "\tbgeu" <+> pprOp platform l <> comma <+> pprOp platform r <> comma <+> getLabel platform t
- UGT -> line $ text "\tbltu" <+> pprOp platform r <> comma <+> pprOp platform l <> comma <+> getLabel platform t
- _ -> panic $ "RV64.ppr: unhandled BCOND conditional: " ++ show c
+ BCOND c l r t | isLabel t ->
+ line $ text "\t" <> pprBcond c <+> pprOp platform l <> comma <+> pprOp platform r <> comma <+> getLabel platform t
BCOND _ _ _ (TReg _) -> panic "RV64.ppr: No conditional branching to registers!"
+ -- This is the far branches trick: Negate the condition and either do a
+ -- register based jump (ignoring the link result in register zero) or just
+ -- branch to the end of the block, jumping over the far jump instructions.
+ BCOND_FAR c l r b t | isLabel t ->
+ lines_ [ text "\t" <> pprBcond (negateCond c) <+> pprOp platform l <> comma <+> pprOp platform r <> comma <+> getLabel platform b <> text "_end"
+ , text "\tla" <+> pprOp platform ip <> comma <+> getLabel platform t
+ , text "\tjalr" <+> text "x0" <> comma <+> pprOp platform ip <> comma <+> text "0"
+ ]
+
+ BCOND_FAR _ _ _ _ (TReg _) -> panic "RV64.ppr: No conditional branching to registers!"
+
+
-- 5. Atomic Instructions ----------------------------------------------------
-- 6. Conditional Instructions -----------------------------------------------
CSET o l r c -> case c of
@@ -715,36 +740,18 @@ floatOpPrecision _p l r | isFloatOp l && isFloatOp r && isDoubleOp l && isDouble
floatOpPrecision p l r = pprPanic "Cannot determine floating point precission" (text "op1" <+> pprOp p l <+> text "op2" <+> pprOp p r)
pprBcond :: IsLine doc => Cond -> doc
-pprBcond c = text "b." <> pprCond c
+pprBcond c = text "b" <> pprCond c
pprCond :: IsLine doc => Cond -> doc
pprCond c = case c of
- ALWAYS -> text "al" -- Always
- EQ -> text "eq" -- Equal
- NE -> text "ne" -- Not Equal
-
- SLT -> text "lt" -- Signed less than ; Less than, or unordered
- SLE -> text "le" -- Signed less than or equal ; Less than or equal, or unordered
- SGE -> text "ge" -- Signed greater than or equal ; Greater than or equal
- SGT -> text "gt" -- Signed greater than ; Greater than
-
- ULT -> text "lo" -- Carry clear/ unsigned lower ; less than
- ULE -> text "ls" -- Unsigned lower or same ; Less than or equal
- UGE -> text "hs" -- Carry set/unsigned higher or same ; Greater than or equal, or unordered
- UGT -> text "hi" -- Unsigned higher ; Greater than, or unordered
-
- NEVER -> text "nv" -- Never
- VS -> text "vs" -- Overflow ; Unordered (at least one NaN operand)
- VC -> text "vc" -- No overflow ; Not unordered
-
- -- Ordered variants. Respecting NaN.
- OLT -> text "mi"
- OLE -> text "ls"
- OGE -> text "ge"
- OGT -> text "gt"
-
- -- Unordered
- UOLT -> text "lt"
- UOLE -> text "le"
- UOGE -> text "pl"
- UOGT -> text "hi"
+ EQ -> text "eq"
+ NE -> text "ne"
+ SLT -> text "lt"
+ SLE -> text "le"
+ SGE -> text "ge"
+ SGT -> text "gt"
+ ULT -> text "ltu"
+ ULE -> text "leu"
+ UGE -> text "geu"
+ UGT -> text "gtu"
+ _ -> panic $ "RV64.ppr: unhandled BCOND conditional: " ++ show c
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e8fa876f3698eb6d54511131b2aebbe8a062dc2...61bcb6d107fe0076b6554a38a2be0760e20b1590
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3e8fa876f3698eb6d54511131b2aebbe8a062dc2...61bcb6d107fe0076b6554a38a2be0760e20b1590
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/20240128/a6cce132/attachment-0001.html>
More information about the ghc-commits
mailing list