Simon Jakobi pushed to branch wip/sjakobi/T27448 at Glasgow Haskell Compiler / GHC
Commits:
6813f002 by Simon Jakobi at 2026-06-26T04:51:47-04:00
Reg.Linear: drop Platform argument from most FR (FreeRegs) methods
The FR class has one instance per CPU architecture, so any
architecture-constant information its methods derived from the Platform
argument can instead be baked into the instance. This removes the now
needless Platform argument from frAllocateReg, frGetFreeRegs and
frReleaseReg.
frInitFreeRegs keeps its Platform argument: the initial allocatable set is
genuinely platform-dependent, see Note [Aarch64 Register x18 at Darwin and
Windows].
Fixes #26665
Co-Authored-By: Claude Opus 4.8
- - - - -
3b2a9409 by Zubin Duggal at 2026-06-26T04:52:39-04:00
testsuite: Report fragile failures as skipped in JUnit output
- - - - -
980b9f36 by Simon Jakobi at 2026-06-27T11:53:13+02:00
NCG: reduce allocation in loopInfo.mkDomMap (#27448)
mkDomMap built an intermediate association list with (++)/concatMap before
handing it to mapFromList; in control-flow-heavy code the (++) accounted for a
large share of compiler allocation (#27448). Build the LabelMap directly with
one insert per dominator-tree node instead.
Add a perf test, ManyBasicBlocks: it compiles a generated Cmm procedure with
thousands of basic blocks (~8300 at STAGES=2048, LOOP_PERIOD=16) formed from
split/join diamonds and periodic backedges, to track native code generator
allocation. Compiling it cuts total compiler heap allocation by ~882 MB:
-O1: 3,260,976,336 -> 2,378,768,080 bytes (-27.1%)
-O2: 3,266,691,984 -> 2,384,484,040 bytes (-27.0%)
The saving only appears at -O1 and above, where static control-flow prediction
(Opt_CmmStaticPred) -- and hence loopInfo/mkDomMap -- runs.
This also drops an accidental quirk of the old code: leaves of the dominator
tree included themselves in their dominator set (other nodes did not), because
the leaf case re-emitted an entry whose set already contained the node and
mapFromList's last-wins let it override. The set is consumed only by isBackEdge,
so the sole effect was that a self-loop edge was classified as a back edge iff
its block happened to be a dominator-tree leaf -- inconsistent and unintended.
domMap now holds each block's strict dominators (excluding the entry) uniformly.
Assisted-by: Claude Opus 4.8
- - - - -
11 changed files:
- compiler/GHC/CmmToAsm/CFG.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs
- compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
- compiler/GHC/CmmToAsm/Reg/Linear/X86.hs
- compiler/GHC/CmmToAsm/Reg/Linear/X86_64.hs
- compiler/GHC/CmmToAsm/X86/RegInfo.hs
- compiler/GHC/CmmToAsm/X86/Regs.hs
- testsuite/driver/junit.py
- testsuite/tests/perf/compiler/all.T
- + testsuite/tests/perf/compiler/genManyBasicBlocks
Changes:
=====================================
compiler/GHC/CmmToAsm/CFG.hs
=====================================
@@ -885,17 +885,15 @@ loopInfo cfg root = LoopInfo { liBackEdges = backEdges
in map (\n -> (n, loopCount n)) $ nodes :: [(BlockId, Int)]
mkDomMap :: Tree BlockId -> LabelMap LabelSet
- mkDomMap root = mapFromList $ go setEmpty root
+ -- The entry/root dominates every block and is deliberately excluded, so its
+ -- children start from the empty dominator set.
+ mkDomMap (Node _root children) = foldl' (go setEmpty) mapEmpty children
where
- go :: LabelSet -> Tree BlockId -> [(Label,LabelSet)]
- go parents (Node lbl [])
- = [(lbl, parents)]
- go parents (Node _ leaves)
- = let nodes = map rootLabel leaves
- entries = map (\x -> (x,parents)) nodes
- in entries ++ concatMap
- (\n -> go (setInsert (rootLabel n) parents) n)
- leaves
+ -- `doms`: the dominators of `lbl`, i.e. its ancestors in the dominator
+ -- tree excluding the tree root.
+ go :: LabelSet -> LabelMap LabelSet -> Tree BlockId -> LabelMap LabelSet
+ go doms acc (Node lbl kids)
+ = foldl' (go (setInsert lbl doms)) (mapInsert lbl doms acc) kids
-- We make the CFG a Hoopl Graph, so we can reuse revPostOrder.
newtype BlockNode (e :: Extensibility) (x :: Extensibility) = BN (BlockId,[BlockId])
=====================================
compiler/GHC/CmmToAsm/Reg/Linear.hs
=====================================
@@ -367,7 +367,7 @@ initBlock id block_live
Nothing ->
setFreeRegsR (frInitFreeRegs platform)
Just live ->
- setFreeRegsR $ foldl' (flip $ frAllocateReg platform) (frInitFreeRegs platform)
+ setFreeRegsR $ foldl' (flip frAllocateReg) (frInitFreeRegs platform)
(nonDetEltsUniqSet $ takeRealRegs $ getRegs live)
-- See Note [Unique Determinism and code generation]
setAssigR emptyRegMap
@@ -638,20 +638,19 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = do
releaseRegs :: FR freeRegs => [Reg] -> RegM freeRegs ()
releaseRegs regs = do
- platform <- getPlatform
assig <- getAssigR
free <- getFreeRegsR
let loop assig !free [] = do setAssigR assig; setFreeRegsR free; return ()
- loop assig !free (RegReal rr : rs) = loop assig (frReleaseReg platform rr free) rs
+ loop assig !free (RegReal rr : rs) = loop assig (frReleaseReg rr free) rs
loop assig !free (r:rs) =
case lookupUFM assig r of
Just (Loc (InBoth real _) _) ->
loop (delFromUFM assig r)
- (frReleaseReg platform real free) rs
+ (frReleaseReg real free) rs
Just (Loc (InReg real) _) ->
loop (delFromUFM assig r)
- (frReleaseReg platform real free) rs
+ (frReleaseReg real free) rs
_ ->
loop (delFromUFM assig r) free rs
loop assig free regs
@@ -716,7 +715,7 @@ saveClobberedTemps clobbered dying
freeRegs <- getFreeRegsR
let regclass = targetClassOfRealReg platform reg
- freeRegs_thisClass = frGetFreeRegs platform regclass freeRegs
+ freeRegs_thisClass = frGetFreeRegs regclass freeRegs
case filter (`notElem` clobbered) freeRegs_thisClass of
@@ -724,7 +723,7 @@ saveClobberedTemps clobbered dying
-- clobbered by this instruction; use it to save the
-- clobbered value.
(my_reg : _) -> do
- setFreeRegsR (frAllocateReg platform my_reg freeRegs)
+ setFreeRegsR (frAllocateReg my_reg freeRegs)
let new_assign = addToUFM_Directly assig temp (Loc (InReg my_reg) fmt)
let instr = mkRegRegMoveInstr config fmt
@@ -763,13 +762,13 @@ clobberRegs clobbered
Unified -> Unified.allRegClasses
Separate -> Separate.allRegClasses
NoVectors -> NoVectors.allRegClasses
- allFreeRegs = foldMap (\ rc -> frGetFreeRegs platform rc freeregs) allRegClasses
+ allFreeRegs = foldMap (\ rc -> frGetFreeRegs rc freeregs) allRegClasses
let extra_clobbered = [ r | r <- clobbered, r `elem` allFreeRegs ]
- setFreeRegsR $! foldl' (flip $ frAllocateReg platform) freeregs extra_clobbered
+ setFreeRegsR $! foldl' (flip frAllocateReg) freeregs extra_clobbered
- -- setFreeRegsR $! foldl' (flip $ frAllocateReg platform) freeregs clobbered
+ -- setFreeRegsR $! foldl' (flip frAllocateReg) freeregs clobbered
assig <- getAssigR
setAssigR $! clobber assig (nonDetUFMToList assig)
@@ -896,7 +895,7 @@ allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr vrF
= do platform <- getPlatform
freeRegs <- getFreeRegsR
let regclass = classOfVirtualReg (platformArch platform) vr
- freeRegs_thisClass = frGetFreeRegs platform regclass freeRegs :: [RealReg]
+ freeRegs_thisClass = frGetFreeRegs regclass freeRegs :: [RealReg]
-- Can we put the variable into a register it already was?
pref_reg <- findPrefRealReg vr
@@ -915,7 +914,7 @@ allocRegsAndSpill_spill reading keep spills alloc r@(VirtualRegWithFormat vr vrF
setAssigR $ toRegMap
$ (addToUFM assig vr $! newLocation spill_loc $ RealRegUsage final_reg vrFmt)
- setFreeRegsR $ frAllocateReg platform final_reg freeRegs
+ setFreeRegsR $ frAllocateReg final_reg freeRegs
allocateRegsAndSpill reading keep spills' (final_reg : alloc) rs
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs
=====================================
@@ -43,49 +43,51 @@ import qualified GHC.CmmToAsm.RV64.Instr as RV64.Instr
import qualified GHC.CmmToAsm.LA64.Instr as LA64.Instr
class Show freeRegs => FR freeRegs where
- frAllocateReg :: Platform -> RealReg -> freeRegs -> freeRegs
- frGetFreeRegs :: Platform -> RegClass -> freeRegs -> [RealReg]
+ frAllocateReg :: RealReg -> freeRegs -> freeRegs
+ frGetFreeRegs :: RegClass -> freeRegs -> [RealReg]
+ -- | The initial allocatable set is platform-dependent. See Note
+ -- [Aarch64 Register x18 at Darwin and Windows].
frInitFreeRegs :: Platform -> freeRegs
- frReleaseReg :: Platform -> RealReg -> freeRegs -> freeRegs
+ frReleaseReg :: RealReg -> freeRegs -> freeRegs
instance FR X86.FreeRegs where
- frAllocateReg = \_ -> X86.allocateReg
+ frAllocateReg = X86.allocateReg
frGetFreeRegs = X86.getFreeRegs
frInitFreeRegs = X86.initFreeRegs
- frReleaseReg = \_ -> X86.releaseReg
+ frReleaseReg = X86.releaseReg
instance FR X86_64.FreeRegs where
- frAllocateReg = \_ -> X86_64.allocateReg
+ frAllocateReg = X86_64.allocateReg
frGetFreeRegs = X86_64.getFreeRegs
frInitFreeRegs = X86_64.initFreeRegs
- frReleaseReg = \_ -> X86_64.releaseReg
+ frReleaseReg = X86_64.releaseReg
instance FR PPC.FreeRegs where
- frAllocateReg = \_ -> PPC.allocateReg
- frGetFreeRegs = \_ -> PPC.getFreeRegs
+ frAllocateReg = PPC.allocateReg
+ frGetFreeRegs = PPC.getFreeRegs
frInitFreeRegs = PPC.initFreeRegs
- frReleaseReg = \_ -> PPC.releaseReg
+ frReleaseReg = PPC.releaseReg
instance FR AArch64.FreeRegs where
- frAllocateReg = \_ -> AArch64.allocateReg
- frGetFreeRegs = \_ -> AArch64.getFreeRegs
+ frAllocateReg = AArch64.allocateReg
+ frGetFreeRegs = AArch64.getFreeRegs
frInitFreeRegs = AArch64.initFreeRegs
- frReleaseReg = \_ -> AArch64.releaseReg
+ frReleaseReg = AArch64.releaseReg
instance FR RV64.FreeRegs where
- frAllocateReg = const RV64.allocateReg
- frGetFreeRegs = const RV64.getFreeRegs
+ frAllocateReg = RV64.allocateReg
+ frGetFreeRegs = RV64.getFreeRegs
frInitFreeRegs = RV64.initFreeRegs
- frReleaseReg = const RV64.releaseReg
+ frReleaseReg = RV64.releaseReg
instance FR LA64.FreeRegs where
- frAllocateReg = \_ -> LA64.allocateReg
- frGetFreeRegs = \_ -> LA64.getFreeRegs
+ frAllocateReg = LA64.allocateReg
+ frGetFreeRegs = LA64.getFreeRegs
frInitFreeRegs = LA64.initFreeRegs
- frReleaseReg = \_ -> LA64.releaseReg
+ frReleaseReg = LA64.releaseReg
allFreeRegs :: FR freeRegs => Platform -> freeRegs -> [RealReg]
-allFreeRegs plat fr = foldMap (\rcls -> frGetFreeRegs plat rcls fr) allRegClasses
+allFreeRegs plat fr = foldMap (\rcls -> frGetFreeRegs rcls fr) allRegClasses
where
allRegClasses =
case registerArch (platformArch plat) of
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
=====================================
@@ -15,7 +15,6 @@ import GHC.CmmToAsm.Reg.Linear.Base
import GHC.CmmToAsm.Reg.Linear.FreeRegs
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Instr
-import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.Platform.Reg
@@ -132,12 +131,9 @@ joinToTargets_first block_live new_blocks block_id instr dest dests
block_assig src_assig
to_free
- = do config <- getConfig
- let platform = ncgPlatform config
-
- -- free up the regs that are not live on entry to this block.
+ = do -- free up the regs that are not live on entry to this block.
freeregs <- getFreeRegsR
- let freeregs' = foldl' (flip $ frReleaseReg platform) freeregs to_free
+ let freeregs' = foldl' (flip frReleaseReg) freeregs to_free
-- remember the current assignment on entry to this block.
setBlockAssigR (updateBlockAssignment dest (freeregs', src_assig) block_assig)
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/X86.hs
=====================================
@@ -25,17 +25,17 @@ initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
= foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
-getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
-getFreeRegs platform cls (FreeRegs f) =
+getFreeRegs :: RegClass -> FreeRegs -> [RealReg] -- lazily
+getFreeRegs cls (FreeRegs f) =
case cls of
RcInteger ->
[ RealRegSingle i
- | i <- intregnos platform
+ | i <- intregnos PW4
, testBit f i
]
RcFloatOrVector ->
[ RealRegSingle i
- | i <- xmmregnos platform
+ | i <- xmmregnos PW4
, testBit f i
]
=====================================
compiler/GHC/CmmToAsm/Reg/Linear/X86_64.hs
=====================================
@@ -25,17 +25,17 @@ initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
= foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
-getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
-getFreeRegs platform cls (FreeRegs f) =
+getFreeRegs :: RegClass -> FreeRegs -> [RealReg] -- lazily
+getFreeRegs cls (FreeRegs f) =
case cls of
RcInteger ->
[ RealRegSingle i
- | i <- intregnos platform
+ | i <- intregnos PW8
, testBit f i
]
RcFloatOrVector ->
[ RealRegSingle i
- | i <- xmmregnos platform
+ | i <- xmmregnos PW8
, testBit f i
]
=====================================
compiler/GHC/CmmToAsm/X86/RegInfo.hs
=====================================
@@ -41,9 +41,11 @@ regColors platform = listToUFM (normalRegColors platform)
normalRegColors :: Platform -> [(RealReg,String)]
normalRegColors platform =
- zip (map realRegSingle [0..lastint platform]) colors
- ++ zip (map realRegSingle [firstxmm..lastxmm platform]) greys
+ zip (map realRegSingle [0..lastint wordSize]) colors
+ ++ zip (map realRegSingle [firstxmm..lastxmm wordSize]) greys
where
+ wordSize = platformWordSize platform
+
-- 16 colors - enough for amd64 gp regs
colors = ["#800000","#ff0000","#808000","#ffff00","#008000"
,"#00ff00","#008080","#00ffff","#000080","#0000ff"
=====================================
compiler/GHC/CmmToAsm/X86/Regs.hs
=====================================
@@ -194,27 +194,23 @@ spRel platform n
firstxmm :: RegNo
firstxmm = 16
--- on 32bit platformOSs, only the first 8 XMM/YMM/ZMM registers are available
-lastxmm :: Platform -> RegNo
-lastxmm platform
- | target32Bit platform = firstxmm + 7 -- xmm0 - xmmm7
- | otherwise = firstxmm + 15 -- xmm0 -xmm15
+-- on 32bit platforms, only the first 8 XMM/YMM/ZMM registers are available
+lastxmm :: PlatformWordSize -> RegNo
+lastxmm PW4 = firstxmm + 7 -- xmm0 - xmm7
+lastxmm PW8 = firstxmm + 15 -- xmm0 - xmm15
-lastint :: Platform -> RegNo
-lastint platform
- | target32Bit platform = 7 -- not %r8..%r15
- | otherwise = 15
+lastint :: PlatformWordSize -> RegNo
+lastint PW4 = 7 -- not %r8..%r15
+lastint PW8 = 15
-intregnos :: Platform -> [RegNo]
-intregnos platform = [0 .. lastint platform]
+intregnos :: PlatformWordSize -> [RegNo]
+intregnos wordSize = [0 .. lastint wordSize]
-
-
-xmmregnos :: Platform -> [RegNo]
-xmmregnos platform = [firstxmm .. lastxmm platform]
+xmmregnos :: PlatformWordSize -> [RegNo]
+xmmregnos wordSize = [firstxmm .. lastxmm wordSize]
floatregnos :: Platform -> [RegNo]
-floatregnos platform = xmmregnos platform
+floatregnos platform = xmmregnos (platformWordSize platform)
-- argRegs is the set of regs which are read for an n-argument call to C.
-- For archs which pass all args on the stack (x86), is empty.
@@ -224,7 +220,7 @@ argRegs _ = panic "MachRegs.argRegs(x86): should not be used!"
-- | The complete set of machine registers.
allMachRegNos :: Platform -> [RegNo]
-allMachRegNos platform = intregnos platform ++ floatregnos platform
+allMachRegNos platform = intregnos (platformWordSize platform) ++ floatregnos platform
-- | Take the class of a register.
{-# INLINE classOfRealReg #-}
@@ -236,9 +232,11 @@ classOfRealReg :: Platform -> RealReg -> RegClass
classOfRealReg platform reg
= case reg of
RealRegSingle i
- | i <= lastint platform -> RcInteger
- | i <= lastxmm platform -> RcFloatOrVector
+ | i <= lastint wordSize -> RcInteger
+ | i <= lastxmm wordSize -> RcFloatOrVector
| otherwise -> panic "X86.Reg.classOfRealReg registerSingle too high"
+ where
+ wordSize = platformWordSize platform
-- machine specific ------------------------------------------------------------
=====================================
testsuite/driver/junit.py
=====================================
@@ -14,12 +14,13 @@ def junit(t: TestRun) -> ET.ElementTree:
+ len(t.unexpected_stat_failures)
+ len(t.unexpected_passes)),
errors = str(len(t.framework_failures)),
+ skipped = str(len(t.fragile_failures)),
timestamp = datetime.now().isoformat())
- for res_type, group in [('stat failure', t.unexpected_stat_failures),
- ('unexpected failure', t.unexpected_failures),
- ('unexpected pass', t.unexpected_passes),
- ('fragile failure', t.fragile_failures)]:
+ for kind, res_type, group in [('failure', 'stat failure', t.unexpected_stat_failures),
+ ('failure', 'unexpected failure', t.unexpected_failures),
+ ('failure', 'unexpected pass', t.unexpected_passes),
+ ('skipped', 'fragile failure', t.fragile_failures)]:
for tr in group:
testcase = ET.SubElement(testsuite, 'testcase',
classname = tr.way,
@@ -30,7 +31,7 @@ def junit(t: TestRun) -> ET.ElementTree:
if tr.stderr:
message += ['', 'stderr:', '==========', tr.stderr]
- result = ET.SubElement(testcase, 'failure',
+ result = ET.SubElement(testcase, kind,
type = res_type,
message = tr.reason)
result.text = '\n'.join(message)
=====================================
testsuite/tests/perf/compiler/all.T
=====================================
@@ -857,3 +857,18 @@ test ('T26989',
multimod_compile,
['T26989', '-v0 -O'])
+# A single Cmm procedure with thousands of basic blocks (diamonds plus periodic
+# backedges), stressing the native code generator's CFG construction, edge-weight
+# estimation, register allocation and block layout. Works with all NCG backends
+# (X86, AArch64, WASM, etc.). See #27448.
+test('ManyBasicBlocks',
+ [ only_ways(['optasm']),
+ unless(have_ncg(), skip),
+ cmm_src,
+ collect_compiler_stats('bytes allocated', 2),
+ pre_cmd('./genManyBasicBlocks'),
+ extra_files(['genManyBasicBlocks']),
+ ],
+ compile,
+ ['-O -v0'])
+
=====================================
testsuite/tests/perf/compiler/genManyBasicBlocks
=====================================
@@ -0,0 +1,142 @@
+#!/usr/bin/env bash
+set -euo pipefail
+
+# Generate a Cmm source file that is intentionally heavy on control flow.
+#
+# The benchmark shape is one large procedure containing:
+# - many split/left/right/join diamonds
+# - periodic backedges that make each chunk a natural loop
+#
+# It produces thousands of actual basic blocks in a single Cmm graph (rather
+# than merely a very large source file), stressing the native code generator's
+# CFG construction, edge-weight estimation, register allocation and block
+# layout.
+#
+# Based on GitLab snippet #6044
+#
+# Tuning knobs:
+# STAGES Number of diamond stages to generate. Default: 2048
+# LOOP_PERIOD Number of stages per loop chunk. Default: 16
+# LOOP_TRIPS Runtime trip count for each chunk. Default: 2
+# OUT Output file. Default: ManyBasicBlocks.cmm
+
+: "${STAGES:=2048}"
+: "${LOOP_PERIOD:=16}"
+: "${LOOP_TRIPS:=2}"
+: "${OUT:=ManyBasicBlocks.cmm}"
+
+die() {
+ printf '%s\n' "$*" >&2
+ exit 1
+}
+
+check_nat() {
+ local value=$1
+ local name=$2
+
+ [[ $value =~ ^[0-9]+$ ]] || die "$name must be a non-negative integer"
+}
+
+check_nat "$STAGES" STAGES
+check_nat "$LOOP_PERIOD" LOOP_PERIOD
+check_nat "$LOOP_TRIPS" LOOP_TRIPS
+
+(( STAGES > 0 )) || die "STAGES must be greater than zero"
+(( LOOP_PERIOD > 0 )) || die "LOOP_PERIOD must be greater than zero"
+(( LOOP_TRIPS > 0 )) || die "LOOP_TRIPS must be greater than zero"
+
+chunk_count=$(( (STAGES + LOOP_PERIOD - 1) / LOOP_PERIOD ))
+block_count=$(( 1 + 4 * STAGES + chunk_count ))
+
+emit() {
+ printf '%s\n' "$*"
+}
+
+{
+ emit "// Generated by genManyBasicBlocks"
+ emit "//"
+ emit "// Parameters:"
+ emit "// STAGES=${STAGES}"
+ emit "// LOOP_PERIOD=${LOOP_PERIOD}"
+ emit "// LOOP_TRIPS=${LOOP_TRIPS}"
+ emit "//"
+ emit "// Approximate block count: ${block_count}"
+ emit "#include \"Cmm.h\""
+ emit
+ emit "many_basic_blocks (W_ seed) {"
+ emit " W_ acc;"
+ emit " W_ mix;"
+ for ((chunk = 0; chunk < chunk_count; chunk++)); do
+ emit " W_ trip${chunk};"
+ done
+ emit
+ emit "entry:"
+ emit " acc = seed;"
+ emit " mix = seed + (17 :: W_);"
+ for ((chunk = 0; chunk < chunk_count; chunk++)); do
+ emit " trip${chunk} = 0;"
+ done
+ emit " goto split0;"
+ emit
+
+ for ((stage = 0; stage < STAGES; stage++)); do
+ next_stage=$(( stage + 1 ))
+ chunk=$(( stage / LOOP_PERIOD ))
+ stage1=$(( 4 * stage + 1 ))
+ stage2=$(( 4 * stage + 2 ))
+ stage3=$(( 4 * stage + 3 ))
+ stage4=$(( 4 * stage + 4 ))
+
+ emit "split${stage}:"
+ emit " mix = mix + (${stage1} :: W_);"
+ emit " if (((mix + (${stage2} :: W_)) % (7 :: W_)) < (3 :: W_)) {"
+ emit " goto left${stage};"
+ emit " }"
+ emit " goto right${stage};"
+ emit
+
+ emit "left${stage}:"
+ emit " acc = acc + (${stage3} :: W_);"
+ emit " mix = mix + (${stage4} :: W_);"
+ emit " goto join${stage};"
+ emit
+
+ emit "right${stage}:"
+ emit " acc = acc + (${stage4} :: W_);"
+ emit " mix = mix + (${stage3} :: W_);"
+ emit " goto join${stage};"
+ emit
+
+ emit "join${stage}:"
+ emit " acc = acc + mix + (${stage1} :: W_);"
+ if (( next_stage == STAGES || next_stage % LOOP_PERIOD == 0 )); then
+ emit " goto latch${chunk};"
+ else
+ emit " goto split${next_stage};"
+ fi
+ emit
+ done
+
+ for ((chunk = 0; chunk < chunk_count; chunk++)); do
+ loop_start=$(( chunk * LOOP_PERIOD ))
+ next_stage=$(( (chunk + 1) * LOOP_PERIOD ))
+ latch_mix=$(( 1000000 + chunk ))
+ latch_acc=$(( 2000000 + chunk ))
+
+ emit "latch${chunk}:"
+ emit " trip${chunk} = trip${chunk} + (1 :: W_);"
+ emit " mix = mix + (${latch_mix} :: W_);"
+ emit " acc = acc + (${latch_acc} :: W_);"
+ emit " if (trip${chunk} < (${LOOP_TRIPS} :: W_)) {"
+ emit " goto split${loop_start};"
+ emit " }"
+ if (( next_stage < STAGES )); then
+ emit " goto split${next_stage};"
+ else
+ emit " return (acc);"
+ fi
+ emit
+ done
+
+ emit "}"
+} > "$OUT"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f80b0d6056d77eae0444fb4a7a526a2...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f80b0d6056d77eae0444fb4a7a526a2...
You're receiving this email because of your account on gitlab.haskell.org.