Simon Jakobi pushed to branch wip/sjakobi/T27448 at Glasgow Haskell Compiler / GHC

Commits:

3 changed files:

Changes:

  • compiler/GHC/CmmToAsm/CFG.hs
    ... ... @@ -885,17 +885,11 @@ loopInfo cfg root = LoopInfo { liBackEdges = backEdges
    885 885 
           in  map (\n -> (n, loopCount n)) $ nodes :: [(BlockId, Int)]
    886 886
    887 887 
         mkDomMap :: Tree BlockId -> LabelMap LabelSet
    888 
    -    mkDomMap root = mapFromList $ go setEmpty root
    888 
    +    mkDomMap (Node _root children) = foldl' (go setEmpty) mapEmpty children
    889 889 
           where
    890 
    -        go :: LabelSet -> Tree BlockId -> [(Label,LabelSet)]
    891 
    -        go parents (Node lbl [])
    892 
    -          =  [(lbl, parents)]
    893 
    -        go parents (Node _ leaves)
    894 
    -          = let nodes = map rootLabel leaves
    895 
    -                entries = map (\x -> (x,parents)) nodes
    896 
    -            in  entries ++ concatMap
    897 
    -                            (\n -> go (setInsert (rootLabel n) parents) n)
    898 
    -                            leaves
    890 
    +        go :: LabelSet -> LabelMap LabelSet -> Tree BlockId -> LabelMap LabelSet
    891 
    +        go doms acc (Node lbl kids)
    892 
    +          = foldl' (go (setInsert lbl doms)) (mapInsert lbl doms acc) kids
    899 893
    900 894 
     -- We make the CFG a Hoopl Graph, so we can reuse revPostOrder.
    901 895 
     newtype BlockNode (e :: Extensibility) (x :: Extensibility) = BN (BlockId,[BlockId])

  • testsuite/tests/perf/compiler/all.T
    ... ... @@ -857,3 +857,17 @@ test ('T26989',
    857 857 
           multimod_compile,
    858 858 
           ['T26989', '-v0 -O'])
    859 859
    860 
    +# A single Cmm procedure with thousands of basic blocks (diamonds plus periodic
    861 
    +# backedges), stressing the NCG's CFG construction, edge-weight estimation,
    862 
    +# register allocation and block layout.
    863 
    +test('ManyBasicBlocks',
    864 
    +     [ only_ways(['optasm']),
    865 
    +       unless(have_ncg(), skip),
    866 
    +       cmm_src,
    867 
    +       collect_compiler_stats('bytes allocated', 2),
    868 
    +       pre_cmd('./genManyBasicBlocks'),
    869 
    +       extra_files(['genManyBasicBlocks']),
    870 
    +     ],
    871 
    +     compile,
    872 
    +     ['-O2 -v0'])
    873 
    +

  • testsuite/tests/perf/compiler/genManyBasicBlocks
    1 
    +#!/usr/bin/env bash
    2 
    +set -euo pipefail
    3 
    +
    4 
    +# Generate a Cmm source file that is intentionally heavy on control flow.
    5 
    +#
    6 
    +# The benchmark shape is one large procedure containing:
    7 
    +#   - many split/left/right/join diamonds
    8 
    +#   - periodic backedges that make each chunk a natural loop
    9 
    +#
    10 
    +# It produces thousands of actual basic blocks in a single Cmm graph (rather
    11 
    +# than merely a very large source file), stressing the native code generator's
    12 
    +# CFG construction, edge-weight estimation, register allocation and block
    13 
    +# layout.
    14 
    +#
    15 
    +# Based on GitLab snippet #6044
    16 
    +#
    17 
    +# Tuning knobs:
    18 
    +#   STAGES       Number of diamond stages to generate. Default: 2048
    19 
    +#   LOOP_PERIOD  Number of stages per loop chunk. Default: 16
    20 
    +#   LOOP_TRIPS   Runtime trip count for each chunk. Default: 2
    21 
    +#   OUT          Output file. Default: ManyBasicBlocks.cmm
    22 
    +
    23 
    +: "${STAGES:=2048}"
    24 
    +: "${LOOP_PERIOD:=16}"
    25 
    +: "${LOOP_TRIPS:=2}"
    26 
    +: "${OUT:=ManyBasicBlocks.cmm}"
    27 
    +
    28 
    +die() {
    29 
    +  printf '%s\n' "$*" >&2
    30 
    +  exit 1
    31 
    +}
    32 
    +
    33 
    +check_nat() {
    34 
    +  local value=$1
    35 
    +  local name=$2
    36 
    +
    37 
    +  [[ $value =~ ^[0-9]+$ ]] || die "$name must be a non-negative integer"
    38 
    +}
    39 
    +
    40 
    +check_nat "$STAGES" STAGES
    41 
    +check_nat "$LOOP_PERIOD" LOOP_PERIOD
    42 
    +check_nat "$LOOP_TRIPS" LOOP_TRIPS
    43 
    +
    44 
    +(( STAGES > 0 )) || die "STAGES must be greater than zero"
    45 
    +(( LOOP_PERIOD > 0 )) || die "LOOP_PERIOD must be greater than zero"
    46 
    +(( LOOP_TRIPS > 0 )) || die "LOOP_TRIPS must be greater than zero"
    47 
    +
    48 
    +chunk_count=$(( (STAGES + LOOP_PERIOD - 1) / LOOP_PERIOD ))
    49 
    +block_count=$(( 1 + 4 * STAGES + chunk_count ))
    50 
    +
    51 
    +emit() {
    52 
    +  printf '%s\n' "$*"
    53 
    +}
    54 
    +
    55 
    +{
    56 
    +  emit "// Generated by genManyBasicBlocks"
    57 
    +  emit "//"
    58 
    +  emit "// Parameters:"
    59 
    +  emit "//   STAGES=${STAGES}"
    60 
    +  emit "//   LOOP_PERIOD=${LOOP_PERIOD}"
    61 
    +  emit "//   LOOP_TRIPS=${LOOP_TRIPS}"
    62 
    +  emit "//"
    63 
    +  emit "// Approximate block count: ${block_count}"
    64 
    +  emit "#include \"Cmm.h\""
    65 
    +  emit
    66 
    +  emit "many_basic_blocks (W_ seed) {"
    67 
    +  emit "  W_ acc;"
    68 
    +  emit "  W_ mix;"
    69 
    +  for ((chunk = 0; chunk < chunk_count; chunk++)); do
    70 
    +    emit "  W_ trip${chunk};"
    71 
    +  done
    72 
    +  emit
    73 
    +  emit "entry:"
    74 
    +  emit "  acc = seed;"
    75 
    +  emit "  mix = seed + (17 :: W_);"
    76 
    +  for ((chunk = 0; chunk < chunk_count; chunk++)); do
    77 
    +    emit "  trip${chunk} = 0;"
    78 
    +  done
    79 
    +  emit "  goto split0;"
    80 
    +  emit
    81 
    +
    82 
    +  for ((stage = 0; stage < STAGES; stage++)); do
    83 
    +    next_stage=$(( stage + 1 ))
    84 
    +    chunk=$(( stage / LOOP_PERIOD ))
    85 
    +    stage1=$(( 4 * stage + 1 ))
    86 
    +    stage2=$(( 4 * stage + 2 ))
    87 
    +    stage3=$(( 4 * stage + 3 ))
    88 
    +    stage4=$(( 4 * stage + 4 ))
    89 
    +
    90 
    +    emit "split${stage}:"
    91 
    +    emit "  mix = mix + (${stage1} :: W_);"
    92 
    +    emit "  if (((mix + (${stage2} :: W_)) % (7 :: W_)) < (3 :: W_)) {"
    93 
    +    emit "    goto left${stage};"
    94 
    +    emit "  }"
    95 
    +    emit "  goto right${stage};"
    96 
    +    emit
    97 
    +
    98 
    +    emit "left${stage}:"
    99 
    +    emit "  acc = acc + (${stage3} :: W_);"
    100 
    +    emit "  mix = mix + (${stage4} :: W_);"
    101 
    +    emit "  goto join${stage};"
    102 
    +    emit
    103 
    +
    104 
    +    emit "right${stage}:"
    105 
    +    emit "  acc = acc + (${stage4} :: W_);"
    106 
    +    emit "  mix = mix + (${stage3} :: W_);"
    107 
    +    emit "  goto join${stage};"
    108 
    +    emit
    109 
    +
    110 
    +    emit "join${stage}:"
    111 
    +    emit "  acc = acc + mix + (${stage1} :: W_);"
    112 
    +    if (( next_stage == STAGES || next_stage % LOOP_PERIOD == 0 )); then
    113 
    +      emit "  goto latch${chunk};"
    114 
    +    else
    115 
    +      emit "  goto split${next_stage};"
    116 
    +    fi
    117 
    +    emit
    118 
    +  done
    119 
    +
    120 
    +  for ((chunk = 0; chunk < chunk_count; chunk++)); do
    121 
    +    loop_start=$(( chunk * LOOP_PERIOD ))
    122 
    +    next_stage=$(( (chunk + 1) * LOOP_PERIOD ))
    123 
    +    latch_mix=$(( 1000000 + chunk ))
    124 
    +    latch_acc=$(( 2000000 + chunk ))
    125 
    +
    126 
    +    emit "latch${chunk}:"
    127 
    +    emit "  trip${chunk} = trip${chunk} + (1 :: W_);"
    128 
    +    emit "  mix = mix + (${latch_mix} :: W_);"
    129 
    +    emit "  acc = acc + (${latch_acc} :: W_);"
    130 
    +    emit "  if (trip${chunk} < (${LOOP_TRIPS} :: W_)) {"
    131 
    +    emit "    goto split${loop_start};"
    132 
    +    emit "  }"
    133 
    +    if (( next_stage < STAGES )); then
    134 
    +      emit "  goto split${next_stage};"
    135 
    +    else
    136 
    +      emit "  return (acc);"
    137 
    +    fi
    138 
    +    emit
    139 
    +  done
    140 
    +
    141 
    +  emit "}"
    142 
    +} > "$OUT"

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help