[Git][ghc/ghc][wip/supersven/ghc-9.10-riscv-ncg] Rework the far branches algorithm according to AArch64

Sven Tennie (@supersven) gitlab at gitlab.haskell.org
Tue Jun 18 06:21:03 UTC 2024



Sven Tennie pushed to branch wip/supersven/ghc-9.10-riscv-ncg at Glasgow Haskell Compiler / GHC


Commits:
cb66c228 by Sven Tennie at 2024-06-18T06:19:32+00:00
Rework the far branches algorithm according to AArch64

- - - - -


4 changed files:

- 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/CodeGen.hs
=====================================
@@ -6,11 +6,11 @@
 module GHC.CmmToAsm.RV64.CodeGen (
       cmmTopCodeGen
     , generateJumpTableForInstr
+    , makeFarBranches
 )
 
 where
 
-import Control.Monad (mapAndUnzipM)
 import Data.Maybe
 import Data.Word
 import GHC.Cmm
@@ -55,6 +55,9 @@ import GHC.Utils.Constants (debugIsOn)
 import GHC.Utils.Misc
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Cmm.Dataflow.Label
+import GHC.Types.Unique.Supply
+import GHC.Utils.Monad
 
 -- For an overview of an NCG's structure, see Note [General layout of an NCG]
 
@@ -125,14 +128,17 @@ basicBlockCodeGen block = do
   let
         (top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs
 
-        mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
-          = ([], BasicBlock id instrs : blocks, statics)
-        mkBlocks (LDATA sec dat) (instrs,blocks,statics)
-          = (instrs, blocks, CmmData sec dat:statics)
-        mkBlocks instr (instrs,blocks,statics)
-          = (instr:instrs, blocks, statics)
   return (BasicBlock id top : other_blocks, statics)
 
+mkBlocks :: Instr
+          -> ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
+          -> ([Instr], [GenBasicBlock Instr], [GenCmmDecl RawCmmStatics h g])
+mkBlocks (NEWBLOCK id) (instrs,blocks,statics)
+  = ([], BasicBlock id instrs : blocks, statics)
+mkBlocks (LDATA sec dat) (instrs,blocks,statics)
+  = (instrs, blocks, CmmData sec dat:statics)
+mkBlocks instr (instrs,blocks,statics)
+  = (instr:instrs, blocks, statics)
 
 -- -----------------------------------------------------------------------------
 -- | Utilities
@@ -1495,7 +1501,7 @@ genCCall target dest_regs arg_regs bid = do
                        then 8 * (stackSpace' `div` 8 + 1)
                        else stackSpace'
 
-      (returnRegs, readResultsCode)   <- readResults allGpArgRegs allFpArgRegs dest_regs [] nilOL
+      readResultsCode   <- readResults allGpArgRegs allFpArgRegs dest_regs [] nilOL
 
       let moveStackDown 0 = toOL [ PUSH_STACK_FRAME
                                  , DELTA (-16) ]
@@ -1513,7 +1519,7 @@ genCCall target dest_regs arg_regs bid = do
       let code = call_target_code          -- compute the label (possibly into a register)
             `appOL` moveStackDown (stackSpace `div` 8)
             `appOL` passArgumentsCode      -- put the arguments into x0, ...
-            `snocOL` BL call_target passRegs returnRegs -- branch and link.
+            `snocOL` BL call_target passRegs  -- branch and link.
             `appOL` readResultsCode        -- parse the results into registers
             `appOL` moveStackUp (stackSpace `div` 8)
       return (code, Nothing)
@@ -1801,8 +1807,8 @@ genCCall target dest_regs arg_regs bid = do
 
     passArguments _ _ _ _ _ _ = pprPanic "passArguments" (text "invalid state")
 
-    readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM ([Reg], InstrBlock)
-    readResults _ _ [] accumRegs accumCode = return (accumRegs, accumCode)
+    readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM InstrBlock
+    readResults _ _ [] _ accumCode = return accumCode
     readResults [] _ _ _ _ = do
       platform <- getPlatform
       pprPanic "genCCall, out of gp registers when reading results" (pdoc platform target)
@@ -1830,3 +1836,220 @@ genCCall target dest_regs arg_regs bid = do
       let dst = getRegisterReg platform (CmmLocal dest_reg)
       let code = code_fx `appOL` op (OpReg w dst) (OpReg w reg_fx)
       return (code, Nothing)
+
+{- Note [RISCV64 far jumps]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+RISCV64 conditional jump instructions can only encode an offset of +/-4KiB
+(12bits) which is usually enough but can be exceeded in edge cases. In these
+cases we will replace:
+
+  b.cond <cond> foo
+
+with the sequence:
+
+  b.cond <cond> <lbl_true>
+  b <lbl_false>
+  <lbl_true>:
+  la reg foo
+  b reg
+  <lbl_false>:
+
+Compared to AArch64 the target label is loaded to a register, because
+unconditional jump instructions can only address +/-1MiB. The LA
+pseudo-instruction will be replaced by up to two real instructions, ensuring
+correct addressing.
+
+RISCV has many pseudo-instructions which emit more than one real instructions.
+Thus, our counting algorithm is approximative. (This could be optimized by
+either only using real instructions or accounting pseudo-instructions by their
+real size.)
+
+We make some simplifications in the name of performance which can result in overestimating
+jump <-> label offsets:
+
+* To avoid having to recalculate the label offsets once we replaced a jump we simply
+  assume all jumps will be expanded to a three instruction far jump sequence.
+* For labels associated with a info table we assume the info table is 64byte large.
+  Most info tables are smaller than that but it means we don't have to distinguish
+  between multiple types of info tables.
+
+In terms of implementation we walk the instruction stream at least once calculating
+label offsets, and if we determine during this that the functions body is big enough
+to potentially contain out of range jumps we walk the instructions a second time, replacing
+out of range jumps with the sequence of instructions described above.
+
+-}
+
+-- | A conditional jump to a far target
+--
+-- By loading the far target into a register for the jump, we can address the
+-- whole memory range.
+genCondFarJump :: (MonadUnique m) => Cond -> Operand -> Operand -> BlockId -> m InstrBlock
+genCondFarJump cond op1 op2 far_target = do
+  skip_lbl_id <- newBlockId
+  jmp_lbl_id <- newBlockId
+
+  -- TODO: We can improve this by inverting the condition
+  -- but it's not quite trivial since we don't know if we
+  -- need to consider float orderings.
+  -- So we take the hit of the additional jump in the false
+  -- case for now.
+  return
+    $ toOL
+      [ ann (text "Conditional far jump to: " <> ppr far_target)
+          $ BCOND cond op1 op2 (TBlock jmp_lbl_id),
+        B (TBlock skip_lbl_id),
+        NEWBLOCK jmp_lbl_id,
+        LDR II64 (OpReg W64 ipReg) (OpImm (ImmCLbl (blockLbl far_target))),
+        B (TReg ipReg),
+        NEWBLOCK skip_lbl_id
+      ]
+
+-- | An unconditional jump to a far target
+--
+-- By loading the far target into a register for the jump, we can address the
+-- whole memory range.
+genFarJump :: (MonadUnique m) => BlockId -> m InstrBlock
+genFarJump far_target =
+  return
+    $ toOL
+      [ ann (text "Unconditional far jump to: " <> ppr far_target)
+          $ LDR II64 (OpReg W64 ipReg) (OpImm (ImmCLbl (blockLbl far_target))),
+        B (TReg ipReg)
+      ]
+
+-- | An unconditional jump to a far target
+--
+-- By loading the far target into a register for the jump, we can address the
+-- whole memory range.
+genFarBranchAndLink :: (MonadUnique m) => BlockId -> [Reg] -> m InstrBlock
+genFarBranchAndLink far_target ps =
+  return
+    $ toOL
+      [ ann (text "Unconditional branch and link to: " <> ppr far_target)
+          $ LDR II64 (OpReg W64 ipReg) (OpImm (ImmCLbl (blockLbl far_target))),
+        BL (TReg ipReg) ps
+      ]
+
+-- See Note [RISCV64 far jumps]
+data BlockInRange = InRange | NotInRange BlockId
+
+-- See Note [RISCV64 far jumps]
+makeFarBranches :: Platform -> LabelMap RawCmmStatics -> [NatBasicBlock Instr]
+                -> UniqSM [NatBasicBlock Instr]
+makeFarBranches {- only used when debugging -} _platform statics basic_blocks = do
+  -- All offsets/positions are counted in multiples of 4 bytes (the size of RISCV64 instructions)
+  -- That is an offset of 1 represents a 4-byte/one instruction offset.
+  let (func_size, lblMap) = foldl' calc_lbl_positions (0, mapEmpty) basic_blocks
+  if func_size < max_jump_dist
+    then pure basic_blocks
+    else do
+      (_,blocks) <- mapAccumLM (replace_blk lblMap) 0 basic_blocks
+      pure $ concat blocks
+      -- pprTrace "lblMap" (ppr lblMap) $ basic_blocks
+
+  where
+    -- 2^11, 12 bit immediate with one bit is reserved for the sign
+    max_jump_dist = 2^(11::Int) - 1 :: Int
+    -- Currently all inline info tables fit into 64 bytes.
+    max_info_size     = 16 :: Int
+    long_bc_jump_size =  5 :: Int
+    long_b_jump_size = 2 :: Int
+
+    -- Replace out of range conditional jumps with unconditional jumps.
+    replace_blk :: LabelMap Int -> Int -> GenBasicBlock Instr -> UniqSM (Int, [GenBasicBlock Instr])
+    replace_blk !m !pos (BasicBlock lbl instrs) = do
+      -- Account for a potential info table before the label.
+      let !block_pos = pos + infoTblSize_maybe lbl
+      (!pos', instrs') <- mapAccumLM (replace_jump m) block_pos instrs
+      let instrs'' = concat instrs'
+      -- We might have introduced new labels, so split the instructions into basic blocks again if neccesary.
+      let (top, split_blocks, no_data) = foldr mkBlocks ([],[],[]) instrs''
+      -- There should be no data in the instruction stream at this point
+      massert (null no_data)
+
+      let final_blocks = BasicBlock lbl top : split_blocks
+      pure (pos', final_blocks)
+
+    replace_jump :: LabelMap Int -> Int -> Instr -> UniqSM (Int, [Instr])
+    replace_jump !m !pos instr = do
+      case instr of
+        ANN ann instr -> do
+          (idx,instr':instrs') <- replace_jump m pos instr
+          pure (idx, ANN ann instr':instrs')
+        BCOND cond op1 op2 t
+          -> case target_in_range m t pos of
+              InRange -> pure (pos+long_bc_jump_size,[instr])
+              NotInRange far_target -> do
+                jmp_code <- genCondFarJump cond op1 op2 far_target
+                pure (pos+long_bc_jump_size, fromOL jmp_code)
+        B t
+          -> case target_in_range m t pos of
+              InRange -> pure (pos+long_b_jump_size,[instr])
+              NotInRange far_target -> do
+                jmp_code <- genFarJump far_target
+                pure (pos+long_b_jump_size, fromOL jmp_code)
+        J t
+          -> case target_in_range m t pos of
+              InRange -> pure (pos+long_b_jump_size,[instr])
+              NotInRange far_target -> do
+                jmp_code <- genFarJump far_target
+                pure (pos+long_b_jump_size, fromOL jmp_code)
+        BL t ps
+          -> case target_in_range m t pos of
+              InRange -> pure (pos+long_b_jump_size,[instr])
+              NotInRange far_target -> do
+                jmp_code <- genFarBranchAndLink far_target ps
+                pure (pos+long_b_jump_size, fromOL jmp_code)
+        instr
+          | isMetaInstr instr -> pure (pos,[instr])
+          | otherwise -> pure (pos+1, [instr])
+
+    target_in_range :: LabelMap Int -> Target -> Int -> BlockInRange
+    target_in_range m target src =
+      case target of
+        (TReg{}) -> InRange
+        (TBlock bid) -> block_in_range m src bid
+
+    block_in_range :: LabelMap Int -> Int -> BlockId -> BlockInRange
+    block_in_range m src_pos dest_lbl =
+      case mapLookup dest_lbl m of
+        Nothing       ->
+          pprTrace "not in range" (ppr dest_lbl) $
+            NotInRange dest_lbl
+        Just dest_pos -> if abs (dest_pos - src_pos) < max_jump_dist
+          then InRange
+          else NotInRange dest_lbl
+
+    calc_lbl_positions :: (Int, LabelMap Int) -> GenBasicBlock Instr -> (Int, LabelMap Int)
+    calc_lbl_positions (pos, m) (BasicBlock lbl instrs)
+      = let !pos' = pos + infoTblSize_maybe lbl
+        in foldl' instr_pos (pos',mapInsert lbl pos' m) instrs
+
+    instr_pos :: (Int, LabelMap Int) -> Instr -> (Int, LabelMap Int)
+    instr_pos (pos, m) instr =
+      case instr of
+        ANN _ann instr -> instr_pos (pos, m) instr
+        NEWBLOCK _bid -> panic "mkFarBranched - unexpected NEWBLOCK" -- At this point there should be no NEWBLOCK
+                                                                     -- in the instruction stream
+                                                                     -- (pos, mapInsert bid pos m)
+        COMMENT{} -> (pos, m)
+        instr
+          | Just jump_size <- is_expandable_jump instr -> (pos+jump_size, m)
+          | otherwise -> (pos+1, m)
+
+    infoTblSize_maybe bid =
+      case mapLookup bid statics of
+        Nothing           -> 0 :: Int
+        Just _info_static -> max_info_size
+
+    -- These jumps have a 12bit immediate as offset which is quite
+    -- limiting so we potentially have to expand them into
+    -- multiple instructions.
+    is_expandable_jump i = case i of
+      BCOND{} -> Just long_bc_jump_size
+      J (TBlock _) -> Just long_b_jump_size
+      B (TBlock _) -> Just long_b_jump_size
+      BL (TBlock _) _ -> Just long_b_jump_size
+      _ -> Nothing


=====================================
compiler/GHC/CmmToAsm/RV64/Cond.hs
=====================================
@@ -1,4 +1,7 @@
-module GHC.CmmToAsm.RV64.Cond where
+module GHC.CmmToAsm.RV64.Cond
+  ( Cond (..),
+  )
+where
 
 import GHC.Prelude hiding (EQ)
 
@@ -37,22 +40,3 @@ data Cond
   | -- | floating point instruction @fgt@
     FGT
   deriving (Eq, Show)
-
--- | Negate a condition.
---
--- This is useful to e.g. construct far branches from usual branches.
-negateCond :: Cond -> Cond
-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 FLT = FGE
-negateCond FLE = FGT
-negateCond FGE = FLT
-negateCond FGT = FLE


=====================================
compiler/GHC/CmmToAsm/RV64/Instr.hs
=====================================
@@ -28,10 +28,6 @@ import GHC.Utils.Panic
 import Data.Maybe
 
 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)
 import GHC.Data.FastString (LexicalFastString)
 
 -- | Stack frame header size in bytes.
@@ -109,10 +105,8 @@ regUsageOfInstr platform instr = case instr of
   J t                      -> usage (regTarget t, [])
   J_TBL _ _ t              -> usage ([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 _ t        -> usage (regTarget t ++ regOp l ++ regOp r, [])
-  BL t ps _rs              -> usage (regTarget t ++ ps, callerSavedRegisters)
+  BL t ps                  -> usage (regTarget t ++ ps, callerSavedRegisters)
 
   -- 5. Atomic Instructions ----------------------------------------------------
   -- 6. Conditional Instructions -----------------------------------------------
@@ -209,10 +203,8 @@ patchRegsOfInstr instr env = case instr of
     J t            -> J (patchTarget t)
     J_TBL ids mbLbl t    -> J_TBL ids mbLbl (env t)
     B t            -> B (patchTarget t)
-    B_FAR t            -> B_FAR t
-    BL t rs ts     -> BL (patchTarget t) rs ts
+    BL t ps          -> BL (patchTarget t) ps
     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 ---------------------------------------------
@@ -257,10 +249,8 @@ isJumpishInstr instr = case instr of
   J {} -> True
   J_TBL {} -> True
   B {} -> True
-  B_FAR {} -> True
   BL {} -> True
   BCOND {} -> True
-  BCOND_FAR {} -> True
   _ -> False
 
 -- | Get the `BlockId`s of the jump destinations (if any)
@@ -269,10 +259,8 @@ jumpDestsOfInstr (ANN _ i) = jumpDestsOfInstr i
 jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
 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]]
+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 (potential) jump instruction.
@@ -286,10 +274,8 @@ patchJumpInstr instr patchF =
     J (TBlock bid) -> J (TBlock (patchF bid))
     J_TBL ids mbLbl r -> J_TBL (map (fmap patchF) ids) mbLbl r
     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
+    BL (TBlock bid) ps -> BL (TBlock (patchF bid)) ps
     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
 
 -- -----------------------------------------------------------------------------
@@ -596,12 +582,9 @@ data Instr
     -- | A `J` instruction with data for switch jump tables
     | J_TBL [Maybe BlockId] (Maybe CLabel) Reg
     | 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)
+    | BL Target [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
@@ -661,10 +644,8 @@ instrCon i =
       J{} -> "J"
       J_TBL{} -> "J_TBL"
       B{} -> "B"
-      B_FAR{} -> "B_FAR"
       BL{} -> "BL"
       BCOND{} -> "BCOND"
-      BCOND_FAR{} -> "BCOND_FAR"
       DMBSY{} -> "DMBSY"
       FCVT{} -> "FCVT"
       SCVTF{} -> "SCVTF"
@@ -809,75 +790,3 @@ isFloatReg (RegReal (RealRegSingle i)) | i > 31 = True
 isFloatReg (RegVirtual (VirtualRegF _)) = True
 isFloatReg (RegVirtual (VirtualRegD _)) = True
 isFloatReg _ = False
-
-
--- | 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 transform 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.
-makeFarBranches ::
-  Platform ->
-  LabelMap RawCmmStatics ->
-  [NatBasicBlock Instr] ->
-  UniqSM [NatBasicBlock Instr]
-makeFarBranches _platform info_env blocks
-  | NE.last blockAddresses < nearLimit = pure blocks
-  | otherwise = pure $ 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)
-
-    -- TODO: Use UniqSM to generate unique block ids.
-    makeFar :: BlockId -> Int -> Instr -> Instr
-    makeFar bid addr orig@(BCOND cond op1 op2 tgt@(TBlock tgtBid))
-      | abs (addr - targetAddr) >= nearLimit =
-          annotate addr targetAddr $
-            BCOND_FAR cond op1 op2 (TBlock bid) tgt
-      | otherwise =
-          annotate addr targetAddr orig
-      where
-        targetAddr = fromJust $ lookupUFM blockAddressMap tgtBid
-    makeFar _bid addr orig@(B (TBlock tgtBid))
-      | abs (addr - targetAddr) >= nearLimit =
-          annotate addr targetAddr $
-            B_FAR tgtBid
-      | otherwise =
-          annotate addr targetAddr orig
-      where
-        targetAddr = fromJust $ lookupUFM blockAddressMap tgtBid
-    makeFar bid addr (ANN desc other) = ANN desc $ makeFar bid addr other
-    makeFar _bid _ 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 as linker
-    -- relaxations are applied later (optimizing away our flaws.) The educated
-    -- 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
-
-    -- We may want to optimize the limit in future. So, annotate the most
-    -- important values of the decision.
-    annotate :: Int -> Int -> Instr -> Instr
-    annotate addr targetAddr instr =
-      ANN
-        ( text (instrCon instr)
-            <+> text "targetAddr" <> colon
-            <+> int targetAddr <> comma
-            <+> text "offset" <> colon
-            <+> int (addr - targetAddr) <> comma
-            <+> text "nearLimit" <> colon
-            <+> int nearLimit
-        )
-        instr


=====================================
compiler/GHC/CmmToAsm/RV64/Ppr.hs
=====================================
@@ -512,30 +512,14 @@ pprInstr platform instr = case instr of
   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"
 
-  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"
+  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 ->
     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 "far_branch_end"
-           , text "\tla" <+> pprOp platform ip <> comma <+> getLabel platform t
-           , text "\tjalr" <+> text "x0" <> comma <+> pprOp platform ip <> comma <+> text "0"
-           , text "\t" <> getLabel platform b <> text "far_branch_end" <> colon
-           ]
-
-  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



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb66c228cd836270da6e26a160f71785acd47940

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cb66c228cd836270da6e26a160f71785acd47940
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/20240618/b1d5ce6d/attachment-0001.html>


More information about the ghc-commits mailing list