Add [PATCH] AArch64: Fix broken conditional jumps for offsets >= 1MB

This is added for aarch64 for now only as that's the only affeted platform.

Author: angerman

overlays/bootstrap.nix

@@ -298,7 +298,7 @@ in {
                 # this one is to allow linking extra symbols from iserv.
                 ++ final.lib.optional (versionAtLeast "9.6.1"  && versionLessThan"9.10" && final.stdenv.targetPlatform.isAndroid) ./patches/ghc/iserv-syms.patch
                 ++ final.lib.optional (versionAtLeast "9.4"                             && final.stdenv.targetPlatform.isWindows) ./patches/ghc/ghc-9.6-fix-code-symbol-jumps.patch
-                ++ final.lib.optional (versionAtLeast "9.6.3"  && versionLessThan "9.10" && final.stdenv.targetPlatform.isAndroid) ./patches/ghc/ghc-9.6-iog.patch                                                                       ./patches/ghc/iserv-syms.patch
+                ++ final.lib.optional (versionAtLeast "9.6.3"  && versionLessThan "9.10" && final.stdenv.targetPlatform.isAndroid) ./patches/ghc/ghc-9.6-iog.patch
                 ++ final.lib.optional (versionAtLeast "9.6"    && versionLessThan "9.12" && final.stdenv.targetPlatform.is32bit) ./patches/ghc/ghc-9.6-genapply-cross-arch.patch
                 ;
         in ({

overlays/patches/ghc/2adc050857a9c1b992040fbfd55fbe65b2851b19.patch

@@ -26,7 +26,7 @@ index 1d489178673..a251370bfaf 100644
 +++ b/compiler/GHC/CmmToAsm.hs
 @@ -655,13 +655,14 @@ cmmNativeGen logger ncgImpl us fileIds dbgMap cmm count
                                  text "cfg not in lockstep") ()
- 
+
          ---- sequence blocks
 -        let sequenced :: [NatCmmDecl statics instr]
 -            sequenced =
@@ -43,20 +43,20 @@ index 1d489178673..a251370bfaf 100644
 +                            shorted
 +
 +        -- massert (checkLayout shorted sequenced)
- 
+
          let branchOpt :: [NatCmmDecl statics instr]
              branchOpt =
 @@ -684,7 +685,7 @@ cmmNativeGen logger ncgImpl us fileIds dbgMap cmm count
                  addUnwind acc proc =
                      acc `mapUnion` computeUnwinding config ncgImpl proc
- 
+
 -        return  ( usAlloc
 +        return  ( us_seq
                  , fileIds'
                  , branchOpt
                  , lastMinuteImports ++ imports
 @@ -704,10 +705,10 @@ maybeDumpCfg logger (Just cfg) msg proc_name
- 
+
  -- | Make sure all blocks we want the layout algorithm to place have been placed.
  checkLayout :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr]
 -            -> [NatCmmDecl statics instr]
@@ -94,7 +94,7 @@ index b77aa73e52b..2a1fa03b1bc 100644
      , generateJumpTableForInstr
 +    , makeFarBranches
  )
- 
+
  where
 @@ -43,9 +44,11 @@ import GHC.Cmm.Utils
  import GHC.Cmm.Switch
@@ -105,7 +105,7 @@ index b77aa73e52b..2a1fa03b1bc 100644
  import GHC.Types.Tickish ( GenTickish(..) )
  import GHC.Types.SrcLoc  ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
 +import GHC.Types.Unique.Supply
- 
+
  -- The rest:
  import GHC.Data.OrdList
 @@ -61,6 +64,9 @@ import GHC.Data.FastString
@@ -115,21 +115,21 @@ index b77aa73e52b..2a1fa03b1bc 100644
 +import GHC.Utils.Monad (mapAccumLM)
 +
 +import GHC.Cmm.Dataflow.Collections
- 
+
  -- Note [General layout of an NCG]
  -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 @@ -161,15 +167,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])
@@ -144,7 +144,7 @@ index b77aa73e52b..2a1fa03b1bc 100644
  -- | Utilities
  ann :: SDoc -> Instr -> Instr
 @@ -1217,6 +1225,7 @@ assignReg_FltCode = assignReg_IntCode
- 
+
  -- -----------------------------------------------------------------------------
  -- Jumps
 +
@@ -154,7 +154,7 @@ index b77aa73e52b..2a1fa03b1bc 100644
 @@ -1302,6 +1311,22 @@ genCondJump bid expr = do
            _ -> pprPanic "AArch64.genCondJump:case mop: " (text $ show expr)
        _ -> pprPanic "AArch64.genCondJump: " (text $ show expr)
- 
+
 +-- A conditional jump with at least +/-128M jump range
 +genCondFarJump :: MonadUnique m => Cond -> Target -> m InstrBlock
 +genCondFarJump cond far_target = do
@@ -171,7 +171,7 @@ index b77aa73e52b..2a1fa03b1bc 100644
 +                , NEWBLOCK jmp_lbl_id
 +                , B far_target
 +                , NEWBLOCK skip_lbl_id]
- 
+
  genCondBranch
      :: BlockId      -- the source of the jump
 @@ -1816,3 +1841,163 @@ genCCall target dest_regs arg_regs bid = do
@@ -344,12 +344,12 @@ index 687daccfda1..7efbb9c70bf 100644
 +++ b/compiler/GHC/CmmToAsm/AArch64/Cond.hs
 @@ -1,6 +1,6 @@
  module GHC.CmmToAsm.AArch64.Cond  where
- 
+
 -import GHC.Prelude
 +import GHC.Prelude hiding (EQ)
- 
+
  -- https://developer.arm.com/documentation/den0024/a/the-a64-instruction-set/data-processing-instructions/conditional-instructions
- 
+
 @@ -60,7 +60,13 @@ data Cond
      | UOGE   -- b.pl
      | UOGT   -- b.hi
@@ -374,8 +374,8 @@ index d8dd1a4dc0c..1fb8193612f 100644
      | TLabel CLabel
      | TReg   Reg
 +    deriving (Eq, Ord)
- 
- 
+
+
  -- Extension
 diff --git a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
 index fd56d37cd39..c672c342376 100644
@@ -384,12 +384,12 @@ index fd56d37cd39..c672c342376 100644
 @@ -1,7 +1,7 @@
  {-# OPTIONS_GHC -fno-warn-orphans #-}
  {-# LANGUAGE CPP #-}
- 
+
 -module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl, pprInstr) where
 +module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl, pprInstr, pprBasicBlock) where
- 
+
  import GHC.Prelude hiding (EQ)
- 
+
 @@ -353,7 +353,10 @@ pprInstr platform instr = case instr of
      -> line (text "\t.loc" <+> int file <+> int line' <+> int col)
    DELTA d   -> dualDoc (asmComment $ text "\tdelta = " <> int d) empty
@@ -400,17 +400,17 @@ index fd56d37cd39..c672c342376 100644
 +                      -- print it for debugging purposes.
 +                      line (text "BLOCK " <> pprAsmLabel platform (blockLbl blockid))
    LDATA _ _  -> panic "pprInstr: LDATA"
- 
+
    -- Pseudo Instructions -------------------------------------------------------
 @@ -567,7 +570,7 @@ pprCond c = case c of
    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
 +  -- NEVER  -> text "nv" -- Never
    VS     -> text "vs" -- Overflow                          ; Unordered (at least one NaN operand)
    VC     -> text "vc" -- No overflow                       ; Not unordered
- 
+
 diff --git a/compiler/GHC/CmmToAsm/BlockLayout.hs b/compiler/GHC/CmmToAsm/BlockLayout.hs
 index fa0929348ce..e2096c90209 100644
 --- a/compiler/GHC/CmmToAsm/BlockLayout.hs
@@ -420,7 +420,7 @@ index fa0929348ce..e2096c90209 100644
  import Control.Monad (foldM, unless)
  import GHC.Data.UnionFind
 +import GHC.Types.Unique.Supply (UniqSM)
- 
+
  {-
    Note [CFG based code layout]
 @@ -794,29 +795,32 @@ sequenceTop
@@ -476,7 +476,7 @@ index fa0929348ce..e2096c90209 100644
 +    far_blocks <- (ncgMakeFarBranches ncgImpl) platform info seq_blocks
 +    pure $ CmmProc info lbl live $ ListGraph far_blocks
 +
- 
+
  -- The old algorithm:
  -- It is very simple (and stupid): We make a graph out of
 diff --git a/compiler/GHC/CmmToAsm/Monad.hs b/compiler/GHC/CmmToAsm/Monad.hs
@@ -508,7 +508,7 @@ index 3fedcc1fc40..8682d1db9d8 100644
 +++ b/compiler/GHC/CmmToAsm/PPC/Instr.hs
 @@ -688,12 +688,13 @@ takeRegRegMoveInstr _  = Nothing
  -- big, we have to work around this limitation.
- 
+
  makeFarBranches
 -        :: LabelMap RawCmmStatics
 +        :: Platform
@@ -538,6 +538,6 @@ index a82674afe8f..a13fa2e4656 100644
     , extractUnwindPoints       = X86.extractUnwindPoints
     , invertCondBranches        = X86.invertCondBranches
     }
--- 
+--
 GitLab