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

Commits:

8 changed files:

Changes:

  • compiler/GHC/CmmToAsm/CFG.hs
    ... ... @@ -885,17 +885,12 @@ 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 = go setEmpty mapEmpty
    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 children)
    892 
    +          = let !doms' = setInsert lbl doms
    893 
    +            in  foldl' (go doms') (mapInsert lbl doms' acc) children
    899 894
    900 895 
     -- We make the CFG a Hoopl Graph, so we can reuse revPostOrder.
    901 896 
     newtype BlockNode (e :: Extensibility) (x :: Extensibility) = BN (BlockId,[BlockId])

  • testsuite/tests/cmm/should_compile/T28083.cmm
    1 
    +#include "Cmm.h"
    2 
    +
    3 
    +// The entry is a bare goto, so the Cmm control-flow optimiser makes L the
    4 
    +// entry, heading the loop L -> B -> L. Expected: L -> B outweighs the exit
    5 
    +// edge. Without loop detection they tie.
    6 
    +stg_loop {
    7 
    +  goto L;
    8 
    +L:
    9 
    +  if (R1 > 0) { goto B; }
    10 
    +  jump stg_loop [R1];
    11 
    +B:
    12 
    +  R1 = R1 - 1;
    13 
    +  goto L;
    14 
    +}

  • testsuite/tests/cmm/should_compile/T28083.stderr
    1 
    +==================== CFG Weights - Final ====================
    2 
    +stg_loop:
    3 
    +digraph {
    4 
    +	c1 -> c4[label="0.25000",weight="0.25000"];
    5 
    +	c1 -> c2[label="0.75000",weight="0.75000"];
    6 
    +	c2 -> c1[label="0.75000",weight="0.75000"];
    7 
    +}

  • testsuite/tests/cmm/should_compile/all.T
    ... ... @@ -21,3 +21,13 @@ test('T24474-cmm-opt-order', cmm_src, compile, ['-optc-DFOO '
    21 21 
                                                     '-optCmmP-UFOO '
    22 22 
                                                     '-optCmmP-UBAR '
    23 23 
                                                     '-optc-DBAR'])
    24 
    +test('T28083', [cmm_src, only_ways(['optasm']),
    25 
    +                unless(arch('x86_64'), skip),
    26 
    +                when(leading_underscore(), skip),
    27 
    +                multiline_grep_errmsg(r'=+ CFG Weights - Final[^}]*}')],
    28 
    +     compile, ['-no-hs-main -ddump-cfg-weights'])
    29 
    +test('selfloop_weights', [cmm_src, only_ways(['optasm']),
    30 
    +                          unless(arch('x86_64'), skip),
    31 
    +                          when(leading_underscore(), skip),
    32 
    +                          multiline_grep_errmsg(r'=+ CFG Weights - Final[^}]*}')],
    33 
    +     compile, ['-no-hs-main -ddump-cfg-weights'])

  • testsuite/tests/cmm/should_compile/selfloop_weights.cmm
    1 
    +#include "Cmm.h"
    2 
    +
    3 
    +// S is a self-loop. The entry does work, so it isn't merged into S.
    4 
    +// Expected: the self edge outweighs the exit edge. Without loop detection
    5 
    +// both get weight 0.
    6 
    +stg_self {
    7 
    +  R1 = R1 + 1;
    8 
    +  goto S;
    9 
    +S:
    10 
    +  R1 = R1 - 1;
    11 
    +  if (R1 > 0) { goto S; }
    12 
    +  jump stg_self [R1];
    13 
    +}

  • testsuite/tests/cmm/should_compile/selfloop_weights.stderr
    1 
    +==================== CFG Weights - Final ====================
    2 
    +stg_self:
    3 
    +digraph {
    4 
    +	c1 -> c4[label="1.00000",weight="1.00000"];
    5 
    +	c5 -> c1[label="1.00000",weight="1.00000"];
    6 
    +	c1 -> c1[label="7.00000",weight="7.00000"];
    7 
    +}

  • testsuite/tests/perf/compiler/all.T
    ... ... @@ -890,3 +890,14 @@ test ('T26989',
    890 890 
           multimod_compile,
    891 891 
           ['T26989', '-v0 -O'])
    892 892
    893 
    +test('ManyBasicBlocks',
    894 
    +     [ only_ways(['optasm']),
    895 
    +       unless(have_ncg(), skip),
    896 
    +       cmm_src,
    897 
    +       collect_compiler_stats('bytes allocated', 2),
    898 
    +       pre_cmd('./genManyBasicBlocks'),
    899 
    +       extra_files(['genManyBasicBlocks']),
    900 
    +     ],
    901 
    +     compile,
    902 
    +     ['-O2 -v0'])
    903 
    +

  • 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,
    11 
    +# stressing the control-flow handling of the NCG and Wasm backends.
    12 
    +#
    13 
    +# Tuning knobs:
    14 
    +#   STAGES       Number of diamond stages to generate. Default: 2048
    15 
    +#   LOOP_PERIOD  Number of stages per loop chunk. Default: 16
    16 
    +#   LOOP_TRIPS   Runtime trip count for each chunk. Default: 2
    17 
    +#   OUT          Output file. Default: ManyBasicBlocks.cmm
    18 
    +#
    19 
    +# With STAGES=2, LOOP_PERIOD=2, LOOP_TRIPS=2 the output looks like:
    20 
    +#
    21 
    +#   #include "Cmm.h"
    22 
    +#
    23 
    +#   many_basic_blocks (W_ seed) {
    24 
    +#     W_ acc;
    25 
    +#     W_ mix;
    26 
    +#     W_ trip0;
    27 
    +#
    28 
    +#   entry:
    29 
    +#     acc = seed;
    30 
    +#     mix = seed + (17 :: W_);
    31 
    +#     trip0 = 0;
    32 
    +#     goto split0;
    33 
    +#
    34 
    +#   split0:
    35 
    +#     mix = mix + (1 :: W_);
    36 
    +#     if (((mix + (2 :: W_)) % (7 :: W_)) < (3 :: W_)) {
    37 
    +#       goto left0;
    38 
    +#     }
    39 
    +#     goto right0;
    40 
    +#
    41 
    +#   left0:
    42 
    +#     acc = acc + (3 :: W_);
    43 
    +#     mix = mix + (4 :: W_);
    44 
    +#     goto join0;
    45 
    +#
    46 
    +#   right0:
    47 
    +#     acc = acc + (4 :: W_);
    48 
    +#     mix = mix + (3 :: W_);
    49 
    +#     goto join0;
    50 
    +#
    51 
    +#   join0:
    52 
    +#     acc = acc + mix + (1 :: W_);
    53 
    +#     goto split1;
    54 
    +#
    55 
    +#   split1:
    56 
    +#     mix = mix + (5 :: W_);
    57 
    +#     if (((mix + (6 :: W_)) % (7 :: W_)) < (3 :: W_)) {
    58 
    +#       goto left1;
    59 
    +#     }
    60 
    +#     goto right1;
    61 
    +#
    62 
    +#   left1:
    63 
    +#     acc = acc + (7 :: W_);
    64 
    +#     mix = mix + (8 :: W_);
    65 
    +#     goto join1;
    66 
    +#
    67 
    +#   right1:
    68 
    +#     acc = acc + (8 :: W_);
    69 
    +#     mix = mix + (7 :: W_);
    70 
    +#     goto join1;
    71 
    +#
    72 
    +#   join1:
    73 
    +#     acc = acc + mix + (5 :: W_);
    74 
    +#     goto latch0;
    75 
    +#
    76 
    +#   latch0:
    77 
    +#     trip0 = trip0 + (1 :: W_);
    78 
    +#     mix = mix + (1000000 :: W_);
    79 
    +#     acc = acc + (2000000 :: W_);
    80 
    +#     if (trip0 < (2 :: W_)) {
    81 
    +#       goto split0;
    82 
    +#     }
    83 
    +#     return (acc);
    84 
    +#
    85 
    +#   }
    86 
    +
    87 
    +: "${STAGES:=2048}"
    88 
    +: "${LOOP_PERIOD:=16}"
    89 
    +: "${LOOP_TRIPS:=2}"
    90 
    +: "${OUT:=ManyBasicBlocks.cmm}"
    91 
    +
    92 
    +die() {
    93 
    +  printf '%s\n' "$*" >&2
    94 
    +  exit 1
    95 
    +}
    96 
    +
    97 
    +check_nat() {
    98 
    +  local value=$1
    99 
    +  local name=$2
    100 
    +
    101 
    +  [[ $value =~ ^[0-9]+$ ]] || die "$name must be a non-negative integer"
    102 
    +}
    103 
    +
    104 
    +check_nat "$STAGES" STAGES
    105 
    +check_nat "$LOOP_PERIOD" LOOP_PERIOD
    106 
    +check_nat "$LOOP_TRIPS" LOOP_TRIPS
    107 
    +
    108 
    +(( STAGES > 0 )) || die "STAGES must be greater than zero"
    109 
    +(( LOOP_PERIOD > 0 )) || die "LOOP_PERIOD must be greater than zero"
    110 
    +(( LOOP_TRIPS > 0 )) || die "LOOP_TRIPS must be greater than zero"
    111 
    +
    112 
    +chunk_count=$(( (STAGES + LOOP_PERIOD - 1) / LOOP_PERIOD ))
    113 
    +block_count=$(( 1 + 4 * STAGES + chunk_count ))
    114 
    +
    115 
    +emit() {
    116 
    +  printf '%s\n' "$*"
    117 
    +}
    118 
    +
    119 
    +{
    120 
    +  emit "// Generated by genManyBasicBlocks"
    121 
    +  emit "//"
    122 
    +  emit "// Parameters:"
    123 
    +  emit "//   STAGES=${STAGES}"
    124 
    +  emit "//   LOOP_PERIOD=${LOOP_PERIOD}"
    125 
    +  emit "//   LOOP_TRIPS=${LOOP_TRIPS}"
    126 
    +  emit "//"
    127 
    +  emit "// Approximate block count: ${block_count}"
    128 
    +  emit "#include \"Cmm.h\""
    129 
    +  emit
    130 
    +  emit "many_basic_blocks (W_ seed) {"
    131 
    +  emit "  W_ acc;"
    132 
    +  emit "  W_ mix;"
    133 
    +  for ((chunk = 0; chunk < chunk_count; chunk++)); do
    134 
    +    emit "  W_ trip${chunk};"
    135 
    +  done
    136 
    +  emit
    137 
    +  emit "entry:"
    138 
    +  emit "  acc = seed;"
    139 
    +  emit "  mix = seed + (17 :: W_);"
    140 
    +  for ((chunk = 0; chunk < chunk_count; chunk++)); do
    141 
    +    emit "  trip${chunk} = 0;"
    142 
    +  done
    143 
    +  emit "  goto split0;"
    144 
    +  emit
    145 
    +
    146 
    +  for ((stage = 0; stage < STAGES; stage++)); do
    147 
    +    next_stage=$(( stage + 1 ))
    148 
    +    chunk=$(( stage / LOOP_PERIOD ))
    149 
    +    stage1=$(( 4 * stage + 1 ))
    150 
    +    stage2=$(( 4 * stage + 2 ))
    151 
    +    stage3=$(( 4 * stage + 3 ))
    152 
    +    stage4=$(( 4 * stage + 4 ))
    153 
    +
    154 
    +    emit "split${stage}:"
    155 
    +    emit "  mix = mix + (${stage1} :: W_);"
    156 
    +    emit "  if (((mix + (${stage2} :: W_)) % (7 :: W_)) < (3 :: W_)) {"
    157 
    +    emit "    goto left${stage};"
    158 
    +    emit "  }"
    159 
    +    emit "  goto right${stage};"
    160 
    +    emit
    161 
    +
    162 
    +    emit "left${stage}:"
    163 
    +    emit "  acc = acc + (${stage3} :: W_);"
    164 
    +    emit "  mix = mix + (${stage4} :: W_);"
    165 
    +    emit "  goto join${stage};"
    166 
    +    emit
    167 
    +
    168 
    +    emit "right${stage}:"
    169 
    +    emit "  acc = acc + (${stage4} :: W_);"
    170 
    +    emit "  mix = mix + (${stage3} :: W_);"
    171 
    +    emit "  goto join${stage};"
    172 
    +    emit
    173 
    +
    174 
    +    emit "join${stage}:"
    175 
    +    emit "  acc = acc + mix + (${stage1} :: W_);"
    176 
    +    if (( next_stage == STAGES || next_stage % LOOP_PERIOD == 0 )); then
    177 
    +      emit "  goto latch${chunk};"
    178 
    +    else
    179 
    +      emit "  goto split${next_stage};"
    180 
    +    fi
    181 
    +    emit
    182 
    +  done
    183 
    +
    184 
    +  for ((chunk = 0; chunk < chunk_count; chunk++)); do
    185 
    +    loop_start=$(( chunk * LOOP_PERIOD ))
    186 
    +    next_stage=$(( (chunk + 1) * LOOP_PERIOD ))
    187 
    +    latch_mix=$(( 1000000 + chunk ))
    188 
    +    latch_acc=$(( 2000000 + chunk ))
    189 
    +
    190 
    +    emit "latch${chunk}:"
    191 
    +    emit "  trip${chunk} = trip${chunk} + (1 :: W_);"
    192 
    +    emit "  mix = mix + (${latch_mix} :: W_);"
    193 
    +    emit "  acc = acc + (${latch_acc} :: W_);"
    194 
    +    emit "  if (trip${chunk} < (${LOOP_TRIPS} :: W_)) {"
    195 
    +    emit "    goto split${loop_start};"
    196 
    +    emit "  }"
    197 
    +    if (( next_stage < STAGES )); then
    198 
    +      emit "  goto split${next_stage};"
    199 
    +    else
    200 
    +      emit "  return (acc);"
    201 
    +    fi
    202 
    +    emit
    203 
    +  done
    204 
    +
    205 
    +  emit "}"
    206 
    +} > "$OUT"

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/99f9863731f035ae8e2df3718d96763a7eaa86ac at 1793819869