#!/usr/bin/perl
#
# ============================================================================
# PetaPerl Benchmark Harness - PERFORMANCE COMPARISON
# ============================================================================
#
# IMPORTANT: This script runs under PERL5 (/usr/bin/perl), NOT pperl!
#
# ARCHITECTURE:
#   For EVERY benchmark snippet, we run BOTH perl5 and pperl, then COMPARE.
#
# TWO MODES:
#
#   1. Throughput mode (default):
#      - Auto-calibrates loop count so each benchmark runs ~1 second
#      - Reports operations/second (ops/sec)
#      - Each program times its OWN loop with an in-program
#        CLOCK_MONOTONIC bracket (BENCH v2, docs/how-it-works.md);
#        startup is excluded by construction, NOT by baseline subtraction.
#        No baseline twin - ops = iterations / elapsed, a direct rate.
#
#   2. Startup mode (--startup):
#      - Runs complete scripts end-to-end (no loop wrapping)
#      - Measures total wall-clock time including interpreter startup
#      - Reports milliseconds per invocation (ms)
#      - Uses more iterations (20) for statistical stability
#
# MEMORY PROFILING:
#   Pass --memory to show peak RSS (resident set size) for each benchmark.
#   Reads VmHWM from /proc/$pid/status during child execution.
#
# ============================================================================

use strict;
use warnings;
use POSIX qw(WNOHANG SIGKILL SIGTERM strftime);
use IO::Select;
use Time::HiRes qw(time alarm sleep);
use Cwd qw(abs_path);
use File::Basename qw(dirname);
use File::Path qw(make_path);
use File::Temp qw(tempfile);
use JSON::PP;

# ============================================================================
# Color support
# ============================================================================

my $USE_COLOR = -t STDOUT;

sub RED    { $USE_COLOR ? "\e[31m" : "" }
sub GREEN  { $USE_COLOR ? "\e[32m" : "" }
sub YELLOW { $USE_COLOR ? "\e[33m" : "" }
sub CYAN   { $USE_COLOR ? "\e[36m" : "" }
sub BOLD   { $USE_COLOR ? "\e[1m"  : "" }
sub RESET  { $USE_COLOR ? "\e[0m"  : "" }

# ============================================================================
# Configuration
# ============================================================================

my $TIMEOUT_SECONDS = $ENV{PPERL_BENCH_TIMEOUT} || 30;
my $MEMORY_LIMIT_MB = $ENV{PPERL_BENCH_MEMORY}  || 512;
my $CPU_LIMIT_SECS  = $ENV{PPERL_BENCH_CPU}     || 60;

my $DEFAULT_ITERATIONS = 5;       # Repeat each measurement N times
my $STARTUP_ITERATIONS = 20;      # More iterations for startup (fast per-run)
my $TARGET_SECONDS     = 1.0;     # Target wall-clock time per benchmark run
my $MIN_LOOPS          = 100;     # Floor for loop count
# Ceiling for the measured loop count. Raised from 5M to 2G: the old
# ceiling was sized for the interpreter (5M loops ≈ 1s) and guarded a
# now-stale OOM — `for (1..N)` was believed to materialise a Vec, but a
# 500M-element foreach range now peaks at ~11MB (lazy integer iterator,
# perl5-faithful pp_enteriter). At 5M loops a JIT row finished in a few
# ms, so its baseline-subtracted net collapsed into timing jitter and the
# throughput/ratio exploded (the 100000x garbage). 2G loops gives even
# the fastest JIT rows (~1.5 Gop/s) a real ~1s signal.
my $MAX_LOOPS          = 2_000_000_000;
my $PILOT_LOOPS        = 1000;    # Smallest calibration pilot (cheap sample
                                  # for slow rows). See @pilots in calibrate().

my $RESULTS_DIR = '.benchresults';

# ============================================================================
# Find interpreters
# ============================================================================

my $PERL5 = $^X;

# Where this script lives. benchmarks/ and .benchresults are its siblings, so
# BENCH runs from any cwd - including an unpacked tarball with no source tree
# around it.
my $BENCH_HOME = abs_path(dirname(__FILE__));

# Locating pperl must NOT depend on finding a Cargo.toml: this harness is
# shipped standalone, where no source tree exists. Resolution order, first
# hit wins:
#
#   1. --pperl=PATH        explicit, always honoured
#   2. $ENV{PPERL}         the documented override
#   3. ./pperl             in the current directory
#   4. <BENCH's dir>/pperl next to this script - the standalone layout,
#                          where someone has only a binary and no sources
#   5. ../target/release/pperl   in-checkout convenience (t/ -> repo root)
#   6. pperl on $PATH      an installed build
#
# 3 and 4 are the same file in the common case (cd into the bundle, drop
# the binary beside BENCH, run it); 3 additionally covers invoking BENCH by
# an absolute path from a directory that holds the binary.
#
# The value may be a bare name, a relative path, or absolute; anything
# executable is accepted. Called after argument parsing so --pperl wins,
# and before the chdir below so relative paths resolve against the caller's
# cwd, not BENCH's.
my $PPERL;
sub resolve_pperl {
    my ($explicit) = @_;
    my @tried;
    for my $cand (
        $explicit,
        $ENV{PPERL},
        './pperl',
        "$BENCH_HOME/pperl",
        "$BENCH_HOME/../target/release/pperl",
        search_path('pperl'),
    ) {
        next unless defined $cand && length $cand;
        push @tried, $cand;
        return abs_path($cand) if -x $cand && !-d $cand;
    }
    die "Cannot find a pperl binary. Tried:\n"
      . join('', map { "  $_\n" } @tried)
      . "Pass --pperl=PATH, set PPERL=/path/to/pperl, or drop the binary\n"
      . "next to this script as $BENCH_HOME/pperl.\n";
}

# First executable $name on $PATH, or undef. Avoids a File::Which dependency
# (this harness sticks to core modules so it runs on a bare perl).
sub search_path {
    my ($name) = @_;
    for my $dir (split /:/, ($ENV{PATH} // '')) {
        next unless length $dir;
        my $p = "$dir/$name";
        return $p if -x $p && !-d $p;
    }
    return undef;
}

$PERL5 = abs_path($PERL5);

# ============================================================================
# Parse arguments
# ============================================================================

my $iterations    = undef;                    # set per-mode below
my $loops_override;                           # undef = auto-calibrate
my $target_time   = $TARGET_SECONDS;
my $filter        = undef;
my $show_raw      = 0;
my $compare       = 0;
my $save          = 1;
my $list_only     = 0;
my $verbose       = 0;
my $display_file  = undef;
my $startup_mode  = 0;
my $show_memory   = 0;
my $interrupted   = 0;
my @pperl_extra_args;                         # extra args passed to pperl
my $base_override;                            # --base=PATH baseline perl
my $pperl_override;                           # --pperl=PATH binary under test

# ---------------------------------------------------------------------------
# pperl CONFIGURATIONS measured per row.
#
# One perl5 column (the baseline) and three pperl columns, because the
# interesting question is not "is pperl fast" but "how much does each
# acceleration layer add, and does it ever SUBTRACT". A row where +jit
# beats pperl but +jitp is worse than +jit is a Rayon loss - invisible if
# you only ever run one configuration.
#
# +jitp pins to PHYSICAL cores, not logical: measured on 3 machines
# (design/rayon-policy.md), uniform work saturates exactly at the physical
# count and hyperthreads add nothing, so the physical count is the honest
# "parallel" number and leaves the box usable.
# ---------------------------------------------------------------------------
sub physical_cores {
    # Distinct thread-sibling groups = physical cores (Linux-only, which
    # matches the project's platform constraint; no extra dependency).
    my %seen;
    for my $f (glob('/sys/devices/system/cpu/cpu*/topology/thread_siblings_list')) {
        open my $fh, '<', $f or next;
        my $line = <$fh>;
        close $fh;
        next unless defined $line;
        chomp $line;
        $seen{$line} = 1;
    }
    return scalar(keys %seen) || 0;
}

my $PHYS_CORES = physical_cores();

# Two config sets, selected PER ROW (configs_for). JIT-eligible rows get
# the full JIT/Rayon columns. `native::` rows measure a NATIVE Rust module
# (List::Util, MIME::Base64, ...): the Cranelift JIT NEVER touches compiled
# native code, so a +jit column there measures nothing (it reads
# noise-identical to plain pperl). Those rows show +jit as N/A and use the
# last column for +rayon instead - a native module's OWN Rayon path (e.g.
# Base64 line-parallel encode), which IS a real, measurable variant.
my @JIT_CONFIGS = (
    { key => 'pperl',       label => 'pperl',      args => ['--no-jit', '--no-parallel'] },
    { key => 'pperl_jit',   label => 'pperl+jit',  args => ['--no-parallel'] },
    { key => 'pperl_jitp',  label => 'pperl+jitp',
      args => ['--threads=' . ($PHYS_CORES || 1)] },
);
# Native set: same col-2 pperl baseline; col 3 is N/A (JIT inapplicable,
# not run); col 4 is +rayon (native Rayon, JIT off - it is irrelevant to
# native execution). `na => 1` marks a column that is not measured and
# renders as "N/A".
my @NATIVE_CONFIGS = (
    { key => 'pperl',        label => 'pperl',       args => ['--no-jit', '--no-parallel'] },
    { key => 'pperl_jit',    label => 'pperl+jit',   na => 1 },
    { key => 'pperl_rayon',  label => 'pperl+rayon',
      args => ['--no-jit', '--threads=' . ($PHYS_CORES || 1)] },
);

# Is this a native-module row? (Selects the config set + table header.)
# Returns 0/1 (not the match-list) so it sorts and compares numerically.
sub is_native_row { $_[0] =~ /^native::/ ? 1 : 0 }

# The config set for a given benchmark name.
sub configs_for { is_native_row($_[0]) ? \@NATIVE_CONFIGS : \@JIT_CONFIGS }

# Union of column keys across both sets, in display order, deduped -
# used by the geomean summary which aggregates whatever columns rows
# actually produced (native rows contribute pperl+pperl_rayon; JIT rows
# contribute pperl+pperl_jit+pperl_jitp). The shared `pperl` appears once.
my @ALL_CONFIG_KEYS = do {
    my %seen;
    grep { !$seen{ $_->{key} }++ } (@JIT_CONFIGS, @NATIVE_CONFIGS);
};

# Benchmark-name column width. The longest names are native rows like
# `native::file_spec::file_name_is_absolute` (40 chars); size to fit the
# longest + a space so nothing overflows into the perl5 column (an
# overflow shoved every following column out of alignment). Feeds both the
# config-table format (`%-${NAME_W}s`) and config_spec's name_w; all table
# widths derive from the specs via rule_width, so there is no separate
# table-width constant to keep in sync.
my $NAME_W = 42;

$SIG{INT} = $SIG{TERM} = sub {
    $interrupted = 1;
    print "\n*** Interrupted ***\n";
    exit 130;
};

while (@ARGV) {
    my $arg = shift @ARGV;
    if ($arg eq '--help' || $arg eq '-h') {
        print_usage();
        exit 0;
    } elsif ($arg =~ /^--iterations=(\d+)$/) {
        $iterations = $1;
    } elsif ($arg =~ /^--loops=(\d+)$/) {
        $loops_override = $1;
    } elsif ($arg =~ /^--target-time=([0-9.]+)$/) {
        $target_time = $1 + 0;
    } elsif ($arg =~ /^--filter=(.+)$/) {
        $filter = $1;
    } elsif ($arg =~ /^--timeout=(\d+)$/) {
        $TIMEOUT_SECONDS = $1;
    } elsif ($arg eq '--raw') {
        $show_raw = 1;
    } elsif ($arg eq '--compare' || $arg eq '-c') {
        $compare = 1;
    } elsif ($arg eq '--no-save') {
        $save = 0;
    } elsif ($arg eq '--list' || $arg eq '-l') {
        $list_only = 1;
    } elsif ($arg eq '--verbose' || $arg eq '-v') {
        $verbose = 1;
    } elsif ($arg =~ /^--display=(.+)$/) {
        $display_file = $1;
    } elsif ($arg eq '--display' || $arg eq '-d') {
        $display_file = shift @ARGV // die "--display requires a filename\n";
    } elsif ($arg eq '--startup' || $arg eq '-s') {
        $startup_mode = 1;
    } elsif ($arg eq '--memory' || $arg eq '-m') {
        $show_memory = 1;
    } elsif ($arg =~ /^--base=(.+)$/) {
        $base_override = $1;
    } elsif ($arg =~ /^--pperl=(.+)$/) {
        $pperl_override = $1;
    } elsif ($arg =~ /^--pperl-args=(.+)$/) {
        push @pperl_extra_args, split(/\s+/, $1);
    } elsif ($arg =~ /^-/) {
        die "Unknown option: $arg\nUse --help for usage.\n";
    } else {
        $filter = $arg;
    }
}

# Baseline override: the default baseline is $^X (whichever perl runs
# this script) — usually the system perl, which on this platform is a
# THREADED build paying a workload-dependent 2-17% per-op tax (measured:
# hash ~11%, sub calls ~17%, arith ~2%) that pperl (unthreaded) does not
# pay. --base points at an alternative (e.g. an unthreaded, double-NV
# build) for an engine-vs-engine comparison; the header always prints
# the baseline's traits so the handicap is never invisible.
if (defined $base_override) {
    -x $base_override or die "--base: not executable: $base_override\n";
    $PERL5 = abs_path($base_override);
}

# Set default iterations based on mode
$iterations //= $startup_mode ? $STARTUP_ITERATIONS : $DEFAULT_ITERATIONS;

sub print_usage {
    print <<'USAGE';
PetaPerl Benchmark Harness - PERFORMANCE COMPARISON

Usage: perl BENCH [OPTIONS] [FILTER]

Runs benchmark snippets under BOTH perl5 and pperl, and compares performance.

Modes:
  (default)          Throughput mode: auto-calibrated ops/sec comparison
  --startup, -s      Startup mode: total wall-clock time (ms) per invocation

Options:
  --iterations=N     Repeat each measurement N times (default: 5 / 20 startup)
  --target-time=SECS Target runtime per benchmark for calibration (default: 1.0)
  --base=PATH        Baseline perl binary (default: the perl running this
                     script). The header shows the baseline's build traits
                     (threaded/unthreaded, double/longdouble NV).
  --pperl=PATH       Binary under test. Without it: \$PPERL, then ./pperl,
                     then pperl next to this script, then
                     ../target/release/pperl, then pperl on \$PATH.
  --loops=N          Override auto-calibration with fixed loop count
  --filter=PAT       Only run benchmarks matching PAT (substring or /regex/)
  --timeout=SECS     Timeout per benchmark run (default: 30)
  --memory, -m       Show peak RSS memory usage per benchmark
  --pperl-args=ARGS  Extra arguments passed to pperl
  --raw              Show raw times instead of comparison table
  --display=FILE, -d Display results from a saved JSON file
  --compare, -c      Compare against previous saved results
  --no-save          Don't save results
  --list, -l         List available benchmarks without running
  --verbose, -v      Show detailed output (calibration info, errors)
  --help, -h         Show this help

Environment:
  PPERL               Path to pperl binary
  PPERL_BENCH_TIMEOUT  Default timeout in seconds
  PPERL_BENCH_MEMORY   Default memory limit in MB

Examples:
  perl BENCH                           # Run all throughput benchmarks
  perl BENCH --startup                 # Run startup benchmarks
  perl BENCH --startup --memory        # Startup + memory profiling
  perl BENCH --memory                  # Throughput + memory profiling
  perl BENCH --filter=call             # Only call:: benchmarks
  perl BENCH --loops=10000 --iter=3    # Fixed loop count (old behavior)
  perl BENCH --target-time=0.5         # Faster run (0.5s per benchmark)
  perl BENCH --list                    # Show available benchmarks
  perl BENCH --compare                 # Compare vs previous run
  perl BENCH -d .benchresults/FILE.json # Display saved results
USAGE
}

# ============================================================================
# Display mode — render a saved JSON file and exit (before loading benchmarks)
# ============================================================================

if (defined $display_file) {
    display_saved_results($display_file);
    exit 0;
}

# Resolved after parsing (so --pperl outranks $PPERL and the fallbacks) and
# after the display-mode exit above, which re-renders a saved run and needs
# no binary at all.
$PPERL = resolve_pperl($pperl_override);

# Run from where BENCH lives, so benchmarks/ and .benchresults resolve the
# same way whether invoked as `t/BENCH`, `./BENCH` from inside t/, or from an
# unpacked tarball. Replaces the old `chdir 't' if -d 't'` heuristic, which
# silently did the wrong thing anywhere a directory named t/ happened to sit
# next to the caller.
chdir $BENCH_HOME or die "Cannot chdir to $BENCH_HOME: $!\n";

# ============================================================================
# Load benchmark snippets
# ============================================================================

my $bench_dir = $startup_mode ? 'benchmarks/startup' : 'benchmarks';
die "Cannot find $bench_dir/ directory\n" unless -d $bench_dir;

my @bench_files = sort glob("$bench_dir/*.bench");
die "No .bench files found in $bench_dir/\n" unless @bench_files;

my @benchmarks;
for my $file (@bench_files) {
    my $snippets = do "./$file";
    if ($@) {
        warn "Error loading $file: $@\n";
        next;
    }
    if (!defined $snippets) {
        warn "Error reading $file: $!\n";
        next;
    }
    if (ref $snippets ne 'ARRAY') {
        warn "$file did not return an array ref\n";
        next;
    }

    my $i = 0;
    while ($i < @$snippets) {
        my $name = $snippets->[$i];
        my $spec = $snippets->[$i + 1];
        if (!defined $name || ref $spec ne 'HASH') {
            warn "Invalid snippet at index $i in $file\n";
            $i += 2;
            next;
        }

        # Apply filter
        if (defined $filter) {
            if ($filter =~ m{^/(.+)/$}) {
                my $re = $1;
                $i += 2, next unless $name =~ /$re/;
            } else {
                $i += 2, next unless index($name, $filter) >= 0;
            }
        }

        push @benchmarks, { name => $name, file => $file, %$spec };
        $i += 2;
    }
}

if (!@benchmarks) {
    if (defined $filter) {
        die "No benchmarks matching '$filter'\n";
    } else {
        die "No benchmarks found in $bench_dir/*.bench\n";
    }
}

# Group JIT-eligible rows first, native:: rows last (stable within each
# group, preserving file/spec order). The throughput table streams a
# "Native-Modules" sub-header the first time a native row appears, so the
# native rows (different col-3/col-4 meaning) must be contiguous at the
# end. See configs_for / is_native_row.
@benchmarks = sort {
    is_native_row($a->{name}) <=> is_native_row($b->{name})
} @benchmarks;

# ============================================================================
# List mode
# ============================================================================

if ($list_only) {
    my $mode_label = $startup_mode ? "Startup" : "Throughput";
    print BOLD() . "$mode_label benchmarks:" . RESET() . "\n";
    my $current_file = '';
    for my $b (@benchmarks) {
        if ($b->{file} ne $current_file) {
            $current_file = $b->{file};
            my $short = $current_file;
            $short =~ s{^benchmarks/(startup/)?}{};
            print "\n" . BOLD() . "=== $short ===" . RESET() . "\n";
        }
        my $desc = $b->{desc} // ($b->{script} // $b->{code} // '');
        printf "  %-38s %s\n", $b->{name}, $desc;
    }
    printf "\n%d benchmarks in %d files\n",
        scalar @benchmarks, scalar @bench_files;
    exit 0;
}

# ============================================================================
# Version probes (one sub-ms spawn each at startup; negligible vs the run)
# ============================================================================

# pperl: `--version` prints "... version X.Y.Z (perl ...)".
sub pperl_version {
    my ($bin) = @_;
    my $out = qx{$bin --version 2>/dev/null} // '';
    return $1 if $out =~ /version\s+(\d+\.\d+\.\d+)/;
    return '?';
}

# perl5: $^V as a dotted string, e.g. "5.43.9".
sub perl5_version {
    my ($bin) = @_;
    my $out = qx{$bin -e 'printf "%vd", \$^V' 2>/dev/null} // '';
    return $out =~ /^(\d+\.\d+(?:\.\d+)?)/ ? $1 : '?';
}

# Baseline build traits, shown in the header: a threaded baseline pays
# a workload-dependent 2-17% per-op tax pperl does not (flatters our
# columns); a longdouble one slows NV paths (penalizes them). Either
# way the comparison is only honest if the handicap is visible.
sub perl5_build_traits {
    my ($bin) = @_;
    my $out = qx{$bin -V:useithreads -V:uselongdouble 2>/dev/null} // '';
    my $thr = $out =~ /useithreads='define'/   ? 'threaded'   : 'unthreaded';
    my $nv  = $out =~ /uselongdouble='define'/ ? 'longdouble' : 'double NV';
    return "$thr, $nv";
}

# ============================================================================
# Header
# ============================================================================

my $run_start = time;   # wall clock for the total-runtime line at the end

my $mode_label = $startup_mode ? "Startup" : "Throughput";
print BOLD() . "PetaPerl Benchmark Harness" . RESET()
    . " ($mode_label" . ($show_memory ? " + Memory" : "") . ")\n";
print "=" x 78, "\n";
print "Started: ", strftime("%Y-%m-%d %H:%M:%S", localtime($run_start)), "\n";
print "Using:   $PPERL (", pperl_version($PPERL), ")\n";
print "Base:    $PERL5 (", perl5_version($PERL5), "; ",
      perl5_build_traits($PERL5), ")\n";
if ($startup_mode) {
    print "Mode:    startup (end-to-end wall time), Iterations: $iterations\n";
} elsif (defined $loops_override) {
    print "Loops:   $loops_override (fixed), Iterations: $iterations\n";
} else {
    print "Mode:    auto-calibrate to ~${target_time}s, Iterations: $iterations\n";
}
print "Timeout: ${TIMEOUT_SECONDS}s per run\n";
if (@pperl_extra_args) {
    print "pperl args: @pperl_extra_args\n";
}
print "\n";

# ============================================================================
# Build benchmark programs (throughput mode only)
# ============================================================================

# Build a self-timing throughput program (BENCH v2, see
# docs/how-it-works.md). The program brackets its OWN loop
# with a CLOCK_MONOTONIC read and prints `BENCH <N> <elapsed_s>` for the
# harness to parse (parse_bench_line). There is NO baseline twin: v2
# measures a rate directly (iterations/elapsed), never a difference of
# two times, so the JIT compiling the loop cannot drive a subtracted net
# negative (the #59 `2000000.0G` class). Startup/construction happen
# BEFORE $__bench_t0__ and are excluded by construction, not subtracted.
# The two clock reads fire once each, OUTSIDE the loop, so they do not
# perturb the loop the JIT compiles (they are ordinary entersub ops the
# walker declines - a clean boundary it will not fold across).
sub build_program {
    my ($spec, $loop_count) = @_;

    my $setup = $spec->{setup} // '';
    my $pre   = $spec->{pre}   // '';
    my $post  = $spec->{post}  // '';
    my $code  = $spec->{code};
    my $sink  = $spec->{sink}  // '';

    # Build loop body, only including non-empty pre/post
    my @body;
    push @body, "    $pre;"  if $pre  ne '';
    push @body, "    $code;";
    push @body, "    $post;" if $post ne '';
    my $body_str = join("\n", @body);

    my $setup_str = $setup ne '' ? "$setup;\n" : '';

    # ANTI-ELIMINATION via after-loop SINK, NOT loop-carried dependency.
    # A body that reads its own accumulator (`$a = $a + $i`) is
    # non-eliminable BUT strictly sequential - Rayon can never parallelize
    # it, so such a row can never exercise the +jitp column (it was a
    # self-sabotaging design). Instead: the loop body is INDEPENDENT per
    # iteration (a reduction `$sum += f($__bench_i__)` whose RHS never
    # reads $sum, or per-index writes), and the `sink` field consumes the
    # result AFTER the loop so the JIT cannot prove it dead. The sink runs
    # OUTSIDE the CLOCK_MONOTONIC bracket (after $__bench_t1__), so it adds
    # ZERO measurement cost while defeating elimination. A reduction `+=`
    # is exactly the reassociation-safe shape parallel.rs folds per-thread
    # (detect_reductions), so these rows now genuinely parallelize.
    my $sink_str = $sink ne '' ? "my \$__bench_sink__ = $sink;\n"
                               . "print STDERR '' if \$__bench_sink__ eq \"\\0impossible\";\n"
                               : '';

    my $prog = <<"PERL";
use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC);
${setup_str}my \$__bench_t0__ = clock_gettime(CLOCK_MONOTONIC);
for my \$__bench_i__ (1..$loop_count) {
$body_str
}
my \$__bench_t1__ = clock_gettime(CLOCK_MONOTONIC);
${sink_str}printf "BENCH %d %.9f\\n", $loop_count, \$__bench_t1__ - \$__bench_t0__;
PERL

    return $prog;
}

# Parse the `BENCH <N> <elapsed_s>` line a v2 program prints. Returns
# ($iterations, $elapsed_s) or () if the line is absent/malformed (a
# crash, timeout, or a workload that printed nothing). Tolerant of other
# stdout: scans for the marker line anywhere in the captured output.
sub parse_bench_line {
    my ($output) = @_;
    for my $line (split /\n/, $output // '') {
        if ($line =~ /^BENCH\s+(\d+)\s+([\d.eE+-]+)\s*$/) {
            return ($1, $2);
        }
    }
    return ();
}

# ============================================================================
# Protected execution (adapted from t/TEST)
# ============================================================================
#
# Returns: ($elapsed, $exit_code, $status, $output, $peak_rss_kb)
#   peak_rss_kb: peak RSS from /proc/$pid/status VmHWM (0 if unavailable)

# {{{ load gate
#
# Foreign-load gate: a measurement taken on a contended machine is
# garbage (a concurrent cargo build depressed whole columns 10-30%,
# jitp worst — it wants every core). Checked once at the START of each
# benchmark row, never during one.
#
# The 1-minute loadavg CANNOT be the signal: this harness itself
# drives it far above 1 (every +jitp measurement runs nthreads-wide
# and the average decays over a minute), so it would self-pause
# forever. Instead read the INSTANTANEOUS runnable count
# (/proc/loadavg field 4 numerator), subtract this process, and take
# the MIN of a few spaced samples — a scheduler blip fails one sample,
# a real build keeps all of them high.

sub foreign_runnable {
    my ($samples) = @_;
    $samples //= 1;
    my $min;
    for my $s (1 .. $samples) {
        open my $fh, '<', '/proc/loadavg' or return 0;
        my $line = <$fh> // '';
        close $fh;
        my ($runq) = $line =~ m{ \s (\d+) / \d+ \s }xms;
        my $foreign = ($runq // 1) - 1;    # minus this process
        $foreign = 0 if $foreign < 0;
        $min = $foreign if !defined $min || $foreign < $min;
        select undef, undef, undef, 0.05 if $s < $samples;
    }
    return $min // 0;
}

sub wait_for_quiet_machine {
    # Fast path: one ~microsecond /proc read on a quiet machine.
    return if foreign_runnable(1) <= 1;
    my $load = foreign_runnable(3);    # confirm: min of spaced samples
    return if $load <= 1;
    print "\n" . YELLOW()
        . "high machine load detected - pausing benchmark"
        . RESET() . " (foreign runnable tasks: $load)\n";
    while (1) {
        sleep 5;
        $load = foreign_runnable(3);
        last if $load <= 1;
        print "  still loaded (foreign runnable tasks: $load) - waiting\n";
    }
    print GREEN() . "load normalized - resuming" . RESET() . "\n";
    return;
}

# }}}

sub run_protected {
    my ($interpreter, $program_text, $use_file, $args) = @_;

    # If $use_file is set, $program_text is already a file path — use it directly.
    # Otherwise, write the program text to a temp file.
    my $tmpfile;
    my $is_temp = 0;
    if ($use_file) {
        $tmpfile = $program_text;
    } else {
        my $fh;
        ($fh, $tmpfile) = tempfile("bench_XXXXX", SUFFIX => '.pl', TMPDIR => 1);
        print $fh $program_text;
        close $fh;
        $is_temp = 1;
    }

    my $output = '';
    my $exit_code = 0;
    my $status = 'ok';
    my $peak_rss_kb = 0;
    my $start_time = time();

    pipe(my $reader, my $writer) or die "pipe: $!";

    my $pid = fork();
    die "fork: $!" unless defined $pid;

    if ($pid == 0) {
        close $reader;
        open STDIN, '<', '/dev/null' or die "redirect stdin: $!";
        open STDOUT, '>&', $writer or die "dup stdout: $!";
        open STDERR, '>&', $writer or die "dup stderr: $!";
        close $writer;

        eval {
            require BSD::Resource;
            BSD::Resource::setrlimit(
                BSD::Resource::RLIMIT_AS(),
                $MEMORY_LIMIT_MB * 1024 * 1024,
                $MEMORY_LIMIT_MB * 1024 * 1024
            );
            BSD::Resource::setrlimit(
                BSD::Resource::RLIMIT_CPU(),
                $CPU_LIMIT_SECS,
                $CPU_LIMIT_SECS
            );
        };
        # Extra args for pperl: an explicit per-run list (the config
        # columns pass their own) else the global --pperl-args.
        my @extra = ($interpreter eq $PPERL)
                  ? ($args ? @{$args} : @pperl_extra_args)
                  : ();

        if ($@) {
            my $mem_kb = $MEMORY_LIMIT_MB * 1024;
            exec("sh", "-c",
                "ulimit -v $mem_kb 2>/dev/null; " .
                "ulimit -t $CPU_LIMIT_SECS 2>/dev/null; " .
                "exec \"\$@\"",
                "--", $interpreter, @extra, $tmpfile);
        } else {
            exec($interpreter, @extra, $tmpfile);
        }
        die "exec $interpreter: $!";
    }

    # Parent
    close $writer;

    my $select = IO::Select->new($reader);
    my $deadline = time() + $TIMEOUT_SECONDS;
    my $child_done = 0;

    while (!$child_done) {
        my $remaining = $deadline - time();
        if ($remaining <= 0) {
            kill SIGTERM, $pid;
            sleep 0.1;
            kill SIGKILL, $pid;
            waitpid($pid, 0);
            $status = 'timeout';
            last;
        }

        # Poll memory from /proc (VmHWM = high water mark RSS, monotonically increasing)
        if (open my $proc_fh, '<', "/proc/$pid/status") {
            while (<$proc_fh>) {
                if (/^VmHWM:\s+(\d+)\s+kB/) {
                    $peak_rss_kb = $1 if $1 > $peak_rss_kb;
                    last;
                }
            }
            close $proc_fh;
        }

        my $wait_time = $remaining > 1 ? 1 : $remaining;
        if ($select->can_read($wait_time)) {
            my $buf;
            my $n = sysread($reader, $buf, 4096);
            if ($n) {
                $output .= $buf;
            } elsif (!defined $n) {
                last;
            }
        }

        my $kid = waitpid($pid, WNOHANG);
        if ($kid > 0) {
            $child_done = 1;
            $exit_code = $? >> 8;
            my $signal = $? & 127;
            $status = 'killed' if $signal;

            while ($select->can_read(0.1)) {
                my $buf;
                my $n = sysread($reader, $buf, 4096);
                last unless $n;
                $output .= $buf;
            }
        }
    }

    close $reader;
    unlink $tmpfile if $is_temp;

    my $elapsed = time() - $start_time;
    return ($elapsed, $exit_code, $status, $output, $peak_rss_kb);
}

# ============================================================================
# Calibration — determine loop count for target runtime (throughput mode)
# ============================================================================

sub calibrate {
    my ($interpreter, $spec, $args) = @_;

    # BENCH v2: size N so this interpreter runs ~$target_time. Uses the
    # program's OWN in-loop CLOCK_MONOTONIC elapsed (parse_bench_line) -
    # no baseline, no subtraction. Startup is already excluded by the
    # bracket, so a pilot's elapsed IS the work time; extrapolation is a
    # clean rate scale, not a difference of two contaminated wall-times.
    #
    # Three pilots, GEOMETRICALLY equidistant across [PILOT_LOOPS ..
    # MAX_LOOPS/5], escalating only until one clears the signal floor so
    # its rate is stable enough to extrapolate. Slow rows stop at the
    # bottom rung; fast rows (incl. an aggressive JIT) climb until a pilot
    # takes long enough to time precisely.
    my $lo = $PILOT_LOOPS;
    my $hi = int($MAX_LOOPS / 5);
    my $ratio_step = ($hi / $lo) ** (1 / 2);   # 3 points => 2 steps
    my @pilots = map { int($lo * $ratio_step ** $_) } 0 .. 2;
    my $elapsed;
    my $pilot;

    for my $try_loops (@pilots) {
        $pilot = $try_loops;
        my $prog = build_program($spec, $pilot);

        my ($p_time, $p_exit, $p_status, $p_output) = run_protected($interpreter, $prog, undef, $args);
        if ($p_status ne 'ok' || $p_exit != 0) {
            if ($verbose) {
                warn "  [calibrate] pilot=$pilot status=$p_status exit=$p_exit\n";
                warn "  [calibrate] output: $p_output\n" if $p_output;
            }
            return (undef, "pilot failed: $p_status exit=$p_exit");
        }

        my ($n, $e) = parse_bench_line($p_output);
        return (undef, "pilot printed no BENCH line")
            unless defined $e;
        $elapsed = $e;

        # Enough signal (>=10ms of measured work) to extrapolate a stable N.
        last if $elapsed >= 0.01;
    }

    # Extrapolate N to fill target_time from the measured rate.
    if ($elapsed < 0.001) {
        # Immeasurably fast even at the largest pilot: run at the ceiling.
        # With in-program timing there is no active/baseline asymmetry, so
        # this now genuinely means "the body is so cheap it barely times
        # at 400M iters" (e.g. a JIT-deleted affine loop) - a row that is
        # DELIBERATELY reducible declares `phenotype => 1` and is handled
        # before calibration; anything else just runs at MAX_LOOPS.
        return ($MAX_LOOPS, undef);
    }

    my $rate   = $pilot / $elapsed;
    my $target = int($rate * $target_time);

    # Clamp to bounds
    $target = $MIN_LOOPS if $target < $MIN_LOOPS;
    $target = $MAX_LOOPS if $target > $MAX_LOOPS;

    return ($target, undef);
}

# ============================================================================
# Statistics
# ============================================================================

# Ops/sec from a config's ELAPSED samples (BENCH v2). Each sample is the
# in-program CLOCK_MONOTONIC delta the workload printed (parse_bench_line),
# already excluding startup. NO baseline, NO subtraction: ops = loops /
# elapsed. The headline uses the MINIMUM elapsed (== maximum ops): timing
# noise is one-sided (a run can only be slowed, never run below its true
# cost), so the fastest observed run is the least-contaminated estimate -
# the same min-noise argument the old min-min used, now on a single
# positive rate instead of a difference. Returns a compute_stats-shaped
# hash so downstream (table/JSON/display) is unchanged: {median} carries
# the headline ops value; {min}/{max} bound the observed spread.
sub compute_ops {
    my ($loops, $elapsed) = @_;
    return { median => 0, mean => 0, stddev => 0, min => 0, max => 0 }
        unless $elapsed && @$elapsed;

    my @e = sort { $a <=> $b } @$elapsed;
    # Guard a zero/degenerate elapsed (a workload that somehow measured
    # ~0s): floor it so we report a finite, obviously-suspect huge rate
    # rather than divide by zero. This is NOT the old net<0 clamp - there
    # is no subtraction here, so a floored value means "ran too fast to
    # time at this N", i.e. raise N, not a broken measurement.
    my $emin = $e[0]  > 0.000001 ? $e[0]  : 0.000001;
    my $emax = $e[-1] > 0.000001 ? $e[-1] : 0.000001;
    my $ops  = $loops / $emin;

    return {
        median => $ops,                # headline (min elapsed -> max ops)
        mean   => $ops,
        stddev => 0,
        min    => $loops / $emax,      # slowest observed -> fewest ops
        max    => $loops / $emin,      # fastest observed -> most ops
    };
}

sub compute_stats {
    my (@values) = @_;
    return { median => 0, mean => 0, stddev => 0, min => 0, max => 0 }
        unless @values;

    my @sorted = sort { $a <=> $b } @values;
    my $n = scalar @sorted;

    my $min = $sorted[0];
    my $max = $sorted[-1];
    my $median = $n % 2 ? $sorted[int($n/2)]
                        : ($sorted[$n/2 - 1] + $sorted[$n/2]) / 2;

    my $sum = 0;
    $sum += $_ for @sorted;
    my $mean = $sum / $n;

    my $var_sum = 0;
    $var_sum += ($_ - $mean) ** 2 for @sorted;
    my $stddev = $n > 1 ? sqrt($var_sum / ($n - 1)) : 0;

    return {
        median => $median,
        mean   => $mean,
        stddev => $stddev,
        min    => $min,
        max    => $max,
    };
}

# ============================================================================
# Formatting helpers
# ============================================================================

# ---------------------------------------------------------------------------
# Threshold colouring — SINGLE SOURCE.
#
# Every coloured verdict in this script (table speedup cells, the summary
# geomean lines, the startup ratio, the memory ratio) reads its GREEN/
# YELLOW/RED boundary from HERE, so the table body can never disagree with
# its own footer legend on the next edit. Two verdict scales exist:
#
#   'speedup' (higher_better): pperl_ops/perl5_ops.  >=1.0 GREEN (at least
#      perl5), >=0.8 YELLOW (slower, within 20%), else RED (>20% slower).
#   'ratio'   (lower_better):  perl5-relative time/ratio.  The boundaries
#      are the RECIPROCALS of the speedup ones — a 0.8 speedup IS a 1.25
#      ratio, the same 20%-slower line — so they are DERIVED, not retyped.
#
# The memory ratio is its own lower_better scale (looser bounds: 1.2 / 2.0)
# because an RSS delta is judged differently from a throughput delta.
use constant {
    SPEEDUP_GREEN  => 1.0,     # >= perl5 speed
    SPEEDUP_YELLOW => 0.8,     # within 20% slower
    MEM_GREEN      => 1.2,     # RSS within ~20%
    MEM_YELLOW     => 2.0,     # up to 2x RSS
};
# Ratio bounds are the reciprocals of the speedup bounds (1/1.0, 1/0.8).
use constant {
    RATIO_GREEN  => 1 / SPEEDUP_GREEN,    # 1.0
    RATIO_YELLOW => 1 / SPEEDUP_YELLOW,   # 1.25
};

# Return the colour escape (GREEN/YELLOW/RED — each already honours
# $USE_COLOR) for $value on the named scale. Callers keep their own
# sprintf so byte-width is unchanged; only the branch is centralised.
#   speedup:    higher is better (green_bound=1.0, yellow_bound=0.8)
#   ratio, mem: lower is better  (<=green -> GREEN, <=yellow -> YELLOW)
sub threshold_color {
    my ($value, $scale) = @_;
    if ($scale eq 'speedup') {
        return $value >= SPEEDUP_GREEN  ? GREEN()
             : $value >= SPEEDUP_YELLOW ? YELLOW()
             :                            RED();
    }
    my ($green, $yellow) = $scale eq 'mem' ? (MEM_GREEN,   MEM_YELLOW)
                                           : (RATIO_GREEN, RATIO_YELLOW);
    return $value <= $green  ? GREEN()
         : $value <= $yellow ? YELLOW()
         :                     RED();
}

# The one-line legend that matches a scale's thresholds, printed from the
# same constants the colouring uses so the numbers can never drift from the
# boundaries. Returns the coloured fragment (no trailing newline).
sub legend_text {
    my ($scale) = @_;
    if ($scale eq 'speedup') {
        return GREEN()  . ">=1 = at least perl5"        . RESET() . ", "
             . YELLOW() . "0.8-1 = slower"              . RESET() . ", "
             . RED()    . "<0.8 = more than 20% slower" . RESET();
    }
    if ($scale eq 'ratio') {
        return GREEN()  . "<1 = pperl faster" . RESET() . ", "
             . YELLOW() . ">1 = perl5 faster" . RESET();
    }
    # mem
    return GREEN() . "<1.2 = similar"        . RESET() . ", "
         . RED()   . ">2 = pperl uses more"  . RESET();
}

sub format_ops {
    my ($ops) = @_;
    return "     ---" if $ops <= 0;
    if ($ops >= 1_000_000_000) { return sprintf("%6.1fG", $ops / 1_000_000_000) }
    if ($ops >= 1_000_000)     { return sprintf("%6.1fM", $ops / 1_000_000) }
    if ($ops >= 1_000)         { return sprintf("%6.1fK", $ops / 1_000) }
    return sprintf("%6.0f ", $ops);
}

sub format_time_ms {
    my ($ms) = @_;
    return "     ---" if !$ms || $ms <= 0;
    if ($ms >= 10_000) { return sprintf("%6.1fs", $ms / 1000) }
    if ($ms >= 100)    { return sprintf("%5.0fms", $ms) }
    if ($ms >= 1)      { return sprintf("%5.1fms", $ms) }
    return sprintf("%5.2fms", $ms);
}

sub format_mem {
    my ($kb) = @_;
    return "    ---" unless $kb && $kb > 0;
    if ($kb >= 1024 * 1024) { return sprintf("%5.1fG", $kb / (1024 * 1024)) }
    if ($kb >= 10240)       { return sprintf("%5.1fM", $kb / 1024) }
    if ($kb >= 1024)        { return sprintf("%5.2fM", $kb / 1024) }
    return sprintf("%5dK", $kb);
}

# One "ops/speedup" cell, e.g. "  5.5G/62.5" or " 21.9G/244.5".
#
# SPEEDUP, not ratio: pperl_ops / perl5_ops, so higher is better and the
# colour reads the way a reader expects. `ratio` elsewhere is perl5/pperl
# (lower is better), which inverts the intuition on a table whose whole
# point is "did this acceleration layer help".
#   >=1.0   GREEN   at least perl5's speed
#   0.8-1.0 YELLOW  slower, within 20% (strictly below 1)
#   <0.8    RED     more than 20% slower than perl5
# The cell is padded to a fixed VISIBLE width first: colour escapes have
# no width, so %15s on an already-coloured string mis-pads the column.
sub format_cell {
    my ($ops, $speedup, $bold) = @_;
    my $txt = sprintf("%s/%s", format_ops($ops),
                      $speedup >= 10 ? sprintf("%.1f", $speedup)
                                     : sprintf("%.3g", $speedup));
    $txt = sprintf("%15s", $txt);
    return $bold ? BOLD() . $txt . RESET() : $txt unless $USE_COLOR;
    my $color = threshold_color($speedup, 'speedup');
    # BOLD after the colour so the fastest column stands out within its
    # own colour class (bold green stays green, just brighter/heavier).
    return $color . ($bold ? BOLD() : "") . $txt . RESET();
}

# Render one benchmark's config row: "name  perl5_ops  cell cell cell".
# The fastest pperl config (highest ops) is printed BOLD so the winning
# column is obvious at a glance. Shared by the live run and --display so
# both render identically.
# $disp is the printed name column when it differs from $name (the live
# run prefixes "[NN/121] "). Classification (configs_for) must see the
# RAW benchmark name: the prefix broke the anchored ^native:: match, the
# row fell into the JIT config set, and the measured pperl_rayon cell
# rendered as "-" (a missing pperl_jitp) on every native row.
sub format_config_row {
    my ($name, $p5_ops, $configs, $mem, $disp) = @_;
    $disp //= $name;
    my $cfgs = configs_for($name);   # per-row config set (JIT or native)

    # Which config has the most ops? That cell gets bolded. `na` columns
    # (native +jit) are never candidates.
    my $best_key;
    my $best_ops = -1;
    for my $cfg (@$cfgs) {
        next if $cfg->{na};
        my $c = $configs->{ $cfg->{key} } or next;
        my $ops = $c->{ops}{median} // 0;
        if ($ops > $best_ops) { $best_ops = $ops; $best_key = $cfg->{key} }
    }

    my $row = sprintf("%-${NAME_W}s %9s", $disp, format_ops($p5_ops));
    for my $cfg (@$cfgs) {
        my $c = $configs->{ $cfg->{key} };
        if ($cfg->{na} || ($c && $c->{na})) { $row .= sprintf(" %15s", 'N/A'); next }
        if (!$c || !$c->{ops}{median}) { $row .= sprintf(" %15s", '-'); next }
        $row .= " " . format_cell($c->{ops}{median}, $c->{speedup},
                                  $cfg->{key} eq $best_key);
    }
    # Optional trailing mem column (--memory): the WORST pperl-config RSS
    # vs perl5 - surfaces a parallel path's memory balloon regardless of
    # which config caused it. $mem is [perl5_rss_kb, {key=>rss_kb,...}].
    if ($mem) {
        my ($p5_rss, $cfg_rss) = @$mem;
        my $worst = 0;
        for my $cfg (@$cfgs) {
            next if $cfg->{na};
            my $r = $cfg_rss->{ $cfg->{key} } // 0;
            $worst = $r if $r > $worst;
        }
        my $mr = ($p5_rss > 0 && $worst > 0) ? $worst / $p5_rss : 0;
        $row .= sprintf(" %8s %8s %s",
            format_mem($p5_rss), format_mem($worst), format_mem_ratio($mr));
    }
    return $row;
}

# The " SLOW!" suffix a startup/legacy row carries when pperl is >5x
# perl5's time. One definition so the threshold and text can't drift.
sub startup_flag { $_[0] > 5 ? " SLOW!" : "" }

# The cell portion of a startup row — everything AFTER the name column:
# "p5_ms pp_ms  ratio [p5_mem pp_mem mem]  SLOW!". The name is printed
# separately (the live run pre-prints it padded to the widened width; the
# --display path prints it inline), so this returns only the tail, letting
# both callers share ONE cell layout. The SLOW! flag is appended in BOTH
# the plain AND the --memory variant (previously the mem variant silently
# dropped it — a row could be 8x slower and unflagged under --memory).
sub format_startup_cells {
    my (%arg) = @_;
    my $ratio = $arg{ratio};
    my $flag  = startup_flag($ratio);
    if ($arg{has_memory}) {
        my $p5_mem = $arg{p5_mem} // 0;
        my $pp_mem = $arg{pp_mem} // 0;
        my $mem_ratio = ($p5_mem > 0 && $pp_mem > 0) ? $pp_mem / $p5_mem : 0;
        return sprintf("%8s %8s  %s %7s %7s %s%s",
            format_time_ms($arg{p5_ms}), format_time_ms($arg{pp_ms}),
            format_ratio($ratio),
            format_mem($p5_mem), format_mem($pp_mem),
            format_mem_ratio($mem_ratio), $flag);
    }
    return sprintf("%10s %10s  %s%s",
        format_time_ms($arg{p5_ms}), format_time_ms($arg{pp_ms}),
        format_ratio($ratio), $flag);
}

# A legacy config-less throughput row, rendered from either the old
# time-based JSON ("%8.3fs") or the ops-based JSON ("%8sop/s"). $kind is
# 'time' or 'ops'; values are already the raw medians. --display only.
sub format_legacy_row {
    my (%arg) = @_;
    my $flag = startup_flag($arg{ratio});
    if ($arg{kind} eq 'time') {
        return sprintf("%-40s %8.3fs %8.3fs  %s%s",
            $arg{name}, $arg{p5}, $arg{pp}, format_ratio($arg{ratio}), $flag);
    }
    return sprintf("%-40s %8sop/s %8sop/s  %s%s",
        $arg{name}, format_ops($arg{p5}), format_ops($arg{pp}),
        format_ratio($arg{ratio}), $flag);
}

# ---------------------------------------------------------------------------
# Table specs + one header renderer.
#
# A TABLE SPEC describes a summary table as DATA: the name-column width and
# an ordered list of trailing columns { label, width }. From that, both the
# header printf and the rule width are DERIVED, so a table's === / --- rules
# can never disagree with its own header again (the startup/legacy display
# tables used to print an 81- or 70-char header inside a hardcoded 78-char
# rule). Every non-config layout is a spec; the config layout is built the
# same way from its per-row config set, so ALL headers flow through
# render_header.
#
# rule_w = name_w + SUM over cols of (1 space + col width). The header fmt
# is "%-{name_w}s" followed by " %{width}s" per column.

# The mem tail shared by both startup and config specs under --memory.
# Widths match the historical hand-rolled headers so output is unchanged.
sub mem_header_cols {
    return ({ label => 'p5_mem', width => 8 },
            { label => 'pp_mem', width => 8 },
            { label => 'mem',    width => 5 });
}

# Spec for the startup table (perl5/pperl/ratio [+ mem tail]). Column
# widths mirror the previous printf EXACTLY: with mem
# "%-34s %8s %8s %6s %7s %7s %5s"; plain "%-40s %10s %10s %7s". NOTE the
# startup mem tail is 7/7/5, NARROWER than the config table's 8/8/5 tail —
# these were always distinct, so startup keeps its own widths rather than
# sharing mem_header_cols(). $name_extra widens the name column for the
# live run's "[NN/NN] " row prefix (0 on --display, which has none).
sub startup_spec {
    my ($has_memory, $name_extra) = @_;
    $name_extra //= 0;
    if ($has_memory) {
        return {
            name_w => 34 + $name_extra,
            cols   => [ { label => 'perl5',  width => 8 },
                        { label => 'pperl',  width => 8 },
                        { label => 'ratio',  width => 6 },
                        { label => 'p5_mem', width => 7 },
                        { label => 'pp_mem', width => 7 },
                        { label => 'mem',    width => 5 } ],
        };
    }
    return {
        name_w => 40 + $name_extra,
        cols   => [ { label => 'perl5', width => 10 },
                    { label => 'pperl', width => 10 },
                    { label => 'ratio', width => 7 } ],
    };
}

# Spec for the legacy config-less throughput table ("%-40s %10s %10s %7s").
sub legacy_ops_spec {
    return {
        name_w => 40,
        cols   => [ { label => 'perl5', width => 10 },
                    { label => 'pperl', width => 10 },
                    { label => 'ratio', width => 7 } ],
    };
}

# Spec for the config table: perl5 (%9s) + one %15s cell per config, plus
# the mem tail under --memory. Built from the per-row config set so the
# JIT and Native-Modules headers share this one path.
sub config_spec {
    my ($cfgs, $has_memory) = @_;
    my @cols = ({ label => 'perl5', width => 9 },
                map { { label => $_->{label}, width => 15 } } @$cfgs);
    push @cols, mem_header_cols() if $has_memory;
    return { name_w => $NAME_W, cols => \@cols };
}

# The visible width a spec's table occupies — i.e. the width of its === and
# --- rules. Every table rule in the script derives from this, so a rule can
# never be hardcoded out of sync with the header it brackets.
sub rule_width {
    my ($spec) = @_;
    my $w = $spec->{name_w};
    $w += 1 + $_->{width} for @{ $spec->{cols} };
    return $w;
}

# Render a table header from a spec: === rule, bold column labels, --- rule,
# all at the SAME derived width. $title fills the name column. The live
# startup table brackets its labels with only the trailing --- (no leading
# ===, matching the historical layout), so $skip_top_rule omits the ===.
sub render_header {
    my ($spec, $title, $skip_top_rule) = @_;
    my $w   = rule_width($spec);
    my $fmt = "%-$spec->{name_w}s" . join('', map { " %$_->{width}s" } @{ $spec->{cols} });
    my @labels = ($title, map { $_->{label} } @{ $spec->{cols} });
    print "=" x $w, "\n" unless $skip_top_rule;
    printf BOLD() . $fmt . RESET() . "\n", @labels;
    print "-" x $w, "\n";
}

# Print a config-table header (=== rule, column labels, --- rule) for a
# given title and config set. Used for the JIT header up front and the
# "Native-Modules" sub-header injected when native rows begin. With $mem,
# three trailing memory columns (p5_mem pp_mem mem) are appended, matching
# format_config_row's optional mem tail. Thin wrapper over render_header.
sub print_table_header {
    my ($title, $cfgs, $mem) = @_;
    render_header(config_spec($cfgs, $mem), $title);
}

# Startup RATIO is pperl_ms/perl5_ms — LOWER is better (the inverse
# of the throughput speedup). Colour with the inverse of the table's
# tightened thresholds (green >=1, yellow 0.8-1, red <0.8): a ratio of
# 1.25 is the same 20%-slower boundary as a 0.8 speedup.
sub format_ratio {
    my ($ratio) = @_;
    return "   ~0 " if $ratio == 0;
    return threshold_color($ratio, 'ratio') . sprintf("%7.3fx", $ratio) . RESET();
}

# Memory ratio: >1 means pperl uses more memory (red), <1 means less (green)
sub format_mem_ratio {
    my ($ratio) = @_;
    return " ~0 " if $ratio == 0;
    return threshold_color($ratio, 'mem') . sprintf("%5.2fx", $ratio) . RESET();
}

# ============================================================================
# display_saved_results — render a saved JSON file
# ============================================================================

sub display_saved_results {
    my ($file) = @_;

    local $/;
    open my $fh, '<', $file or die "Cannot open $file: $!\n";
    my $json = <$fh>;
    close $fh;

    my $data = eval { JSON::PP->new->utf8->decode($json) };
    die "Cannot parse $file: $@\n" if $@;

    my $benchmarks = $data->{benchmarks} // {};
    die "No benchmarks in $file\n" unless keys %$benchmarks;

    my $is_startup = ($data->{mode} // '') eq 'startup';
    my $has_memory = 0;
    # Detect if any benchmark has memory data
    for my $b (values %$benchmarks) {
        if (($b->{perl5_rss_kb} // 0) > 0 || ($b->{pperl_rss_kb} // 0) > 0) {
            $has_memory = 1;
            last;
        }
    }
    # Per-config columns (pperl / +jit / +jitp). Absent in results saved
    # by older runs, so the single-pperl layout stays as the fallback.
    my $has_configs = 0;
    for my $b (values %$benchmarks) {
        if (ref $b->{configs} eq 'HASH' && keys %{ $b->{configs} }) {
            $has_configs = 1;
            last;
        }
    }

    # Header
    my $config_mode = !$is_startup && $has_configs;
    my $mode_str = $is_startup ? "Startup" : "Throughput";
    $mode_str .= " + Memory" if $has_memory;

    # The one spec that describes this display's summary table. --display
    # rows carry NO "[NN/NN]" prefix (that widening happens after the
    # display early-exit), so the startup spec's name_extra is 0. The banner
    # underline and every table rule DERIVE from this spec, so the frame is
    # one consistent width — previously the startup/legacy headers printed
    # wider (81/70) than their hardcoded 78-char rules.
    my $table_spec = $config_mode ? config_spec(\@JIT_CONFIGS, $has_memory)
                   : $is_startup  ? startup_spec($has_memory)
                   :                 legacy_ops_spec();
    my $rule_w = rule_width($table_spec);

    print BOLD() . "PetaPerl Benchmark Results" . RESET()
        . " ($data->{timestamp}, $mode_str)\n";
    print "=" x $rule_w, "\n";
    print "pperl: $data->{pperl}\n" if $data->{pperl};
    print "perl5: $data->{perl5}\n" if $data->{perl5};
    printf "Iterations: %d\n", $data->{iterations} // '?';
    print "\n";

    # Summary table. Non-startup config-mode uses the SAME unified config
    # renderer as the live run (render_header/format_config_row), with the
    # mem tail when $has_memory - so --display matches the live table
    # (correct alignment, speedup convention, per-config +rayon/N/A). Startup
    # and legacy config-less JSON use their own flat specs, all through the
    # one render_header. In config mode the Native-Modules sub-header is
    # streamed later, in the row loop.
    render_header($table_spec, "Benchmark");

    # Group JIT rows first, native rows last (matches the live run), so the
    # Native-Modules sub-header lands in the right place on --display too.
    my @disp_names = sort {
        is_native_row($a) <=> is_native_row($b) || $a cmp $b
    } keys %$benchmarks;
    my $native_header_done = 0;
    for my $name (@disp_names) {
        my $b = $benchmarks->{$name};

        if ($config_mode && !$native_header_done && is_native_row($name)) {
            print "\n";
            print_table_header("Native-Modules Benchmark", \@NATIVE_CONFIGS, $has_memory);
            $native_header_done = 1;
        }
        # Eliminated phenotype rows: no measurement, render distinctly and
        # skip the geomean (same treatment as the live run).
        if (($b->{status} // '') eq 'eliminated') {
            printf "%-${NAME_W}s %s\n", $name,
                GREEN() . "ELIMINATED" . RESET()
                . " (JIT deleted the loop; phenotype row, not timed)";
            next;
        }
        my $ratio = $b->{ratio} // 0;

        if ($is_startup) {
            # Name column (spec width, no [NN/NN] prefix on --display) then
            # the shared cell tail. SLOW! now shows in the mem variant too.
            printf "%-$table_spec->{name_w}s ", $name;
            print format_startup_cells(
                has_memory => $has_memory,
                ratio      => $ratio,
                p5_ms      => $b->{perl5_ms}{median} // 0,
                pp_ms      => $b->{pperl_ms}{median} // 0,
                p5_mem     => $b->{perl5_rss_kb} // 0,
                pp_mem     => $b->{pperl_rss_kb} // 0), "\n";
        } else {
            my $p5_ops = $b->{perl5_ops}{median} // 0;
            my $pp_ops = $b->{pperl_ops}{median} // 0;

            # Old format stored times, not ops
            if (!$p5_ops && $b->{perl5} && $b->{perl5}{median}) {
                print format_legacy_row(
                    kind  => 'time',
                    name  => $name,
                    p5    => $b->{perl5}{median},
                    pp    => $b->{pperl}{median},
                    ratio => $ratio), "\n";
                next;
            }

            if ($config_mode) {
                # Unified config renderer, same as the live run. Under
                # --memory, build the mem tail from per-config rss_kb (worst
                # pperl-config RSS vs perl5). The Memory geomean is fed
                # separately by collect_footer_stats below.
                my $mem;
                if ($has_memory) {
                    my $p5_rss = $b->{perl5_rss_kb} // 0;
                    my %crss = map {
                        $_ => ($b->{configs}{$_}{rss_kb} // 0)
                    } keys %{ $b->{configs} // {} };
                    $mem = [$p5_rss, \%crss];
                }
                print format_config_row($name, $p5_ops, $b->{configs} // {}, $mem),
                      "\n";
            } else {
                print format_legacy_row(
                    kind  => 'ops',
                    name  => $name,
                    p5    => $p5_ops,
                    pp    => $pp_ops,
                    ratio => $ratio), "\n";
            }
        }
    }

    # Closing rule matches the frame (same spec the header derived from).
    print "-" x rule_width($table_spec), "\n";

    # Single aggregation pass over the saved rows. Memory is aggregated
    # only in the modes that RENDER a mem column (startup, or config mode);
    # the legacy ops-only layout shows no memory geomean even when the JSON
    # carries rss_kb, so it must not collect one. The per-config agg /
    # worst-config RSS reduction is config-mode's; startup uses pperl RSS.
    my $agg_memory = ($is_startup || $config_mode) && $has_memory ? 1 : 0;
    my $stats = collect_footer_stats(
        results     => $benchmarks,
        has_configs => $config_mode ? 1 : 0,
        show_memory => $agg_memory);
    print_summary_stats(
        ratios      => $stats->{ratios},
        mem_ratios  => $stats->{mem_ratios},
        is_startup  => $is_startup,
        has_configs => $has_configs,
        configs_agg => $has_configs ? $stats->{agg} : undef);
}

# ============================================================================
# Print summary statistics (shared by live run and display)
# ============================================================================

# Walk a {name => result} hash ONCE and produce the three footer inputs
# (ratios, mem_ratios, per-config speedup aggregate). This is the single
# aggregation pass shared by the throughput-live footer, the startup-live
# footer, and --display — previously three near-identical copies that could
# drift. Element ORDER in the returned lists is irrelevant: every consumer
# (count, mean, grep faster/slower, geomean) is order-independent.
#
# Named args:
#   results     => \%hash        rows keyed by name (live %results OR saved JSON)
#   has_configs => 0|1           per-config columns present (throughput config mode)
#   show_memory => 0|1           collect mem ratios
# Mem-ratio reduction matches each mode's convention:
#   config rows -> WORST pperl-config RSS / perl5 RSS (a parallel path's balloon)
#   startup/legacy rows -> pperl RSS / perl5 RSS
sub collect_footer_stats {
    my (%arg)       = @_;
    my $results     = $arg{results};
    my $has_configs = $arg{has_configs};
    my $show_memory = $arg{show_memory};

    my @ratios;
    my @mem_ratios;
    my %agg = map { $_->{key} => [] } @ALL_CONFIG_KEYS;

    for my $name (keys %$results) {
        my $r = $results->{$name};
        next unless $r;
        # Skip rows that never measured. The two row sources spell "ok"
        # differently: live %results sets status => 'ok'; saved JSON OMITS
        # status on measured rows (only 'eliminated' / *_error rows carry
        # one). So the measured test is "no disqualifying status", not
        # "status eq 'ok'" — the latter would reject every saved row.
        my $status = $r->{status} // 'ok';
        next if $status eq 'eliminated' || $status =~ /error/;

        my $ratio = $r->{ratio} // 0;
        push @ratios, $ratio if $ratio > 0;

        if ($has_configs && ref $r->{configs} eq 'HASH') {
            # Per-config speedups feed one geomean line per column; worst
            # config RSS is the config-mode memory numerator.
            my $worst_rss = 0;
            for my $cfg (@{ configs_for($name) }) {
                next if $cfg->{na};
                my $c = $r->{configs}{ $cfg->{key} } or next;
                push @{ $agg{ $cfg->{key} } }, $c->{speedup}
                    if ($c->{speedup} // 0) > 0;
                my $rr = $c->{rss_kb} // 0;
                $worst_rss = $rr if $rr > $worst_rss;
            }
            if ($show_memory) {
                my $p5r = $r->{perl5_rss_kb} // 0;
                push @mem_ratios, $worst_rss / $p5r
                    if $p5r > 0 && $worst_rss > 0;
            }
        }
        elsif ($show_memory) {
            # Startup / legacy: a single pperl RSS, not a config spread.
            my $p5_mem = $r->{perl5_rss_kb} // 0;
            my $pp_mem = $r->{pperl_rss_kb} // 0;
            push @mem_ratios, $pp_mem / $p5_mem
                if $p5_mem > 0 && $pp_mem > 0;
        }
    }

    return {
        ratios     => \@ratios,
        mem_ratios => \@mem_ratios,
        agg        => \%agg,
    };
}

# Geometric mean of a list (empty -> 0).
sub geomean {
    my @v = grep { $_ > 0 } @_;
    return 0 unless @v;
    my $s = 0;
    $s += log($_) for @v;
    return exp($s / @v);
}

# Colour a speedup by the same thresholds as the table cells (no bold;
# bold in the table marks the fastest column, not applicable here).
sub color_speedup {
    my ($s) = @_;
    return threshold_color($s, 'speedup') . sprintf("%.2fx", $s) . RESET();
}

sub print_summary_stats {
    my (%arg)       = @_;
    my $ratios      = $arg{ratios};
    my $mem_ratios  = $arg{mem_ratios};
    my $is_startup  = $arg{is_startup};
    my $has_configs = $arg{has_configs};
    my $configs_agg = $arg{configs_agg};

    # Config layout: no ratio, one geomean-SPEEDUP line PER column, each
    # vs perl5 (pperl / pperl+jit / pperl+jitp). The table already went
    # from the inverted ratio to the intuitive speedup; the summary
    # follows suit, and shows what EACH acceleration layer buys, not one
    # blended number for the no-jit column alone.
    if ($has_configs && $configs_agg) {
        printf "Benchmarks: %d\n", scalar @$ratios;
        print "\n";
        print "Geometric-mean speedup vs perl5, per config:\n";
        # One line per column that ANY row produced (JIT rows -> pperl/
        # +jit/+jitp; native rows -> pperl/+rayon). A column with no
        # samples (e.g. +rayon when no native rows ran) is skipped.
        my $w = 0;
        for my $cfg (@ALL_CONFIG_KEYS) { $w = length $cfg->{label} if length $cfg->{label} > $w }
        for my $cfg (@ALL_CONFIG_KEYS) {
            my $samples = $configs_agg->{ $cfg->{key} } // [];
            next unless @$samples;
            my $sp = geomean(@$samples);
            printf "  perl5 <-> %-*s  %s\n", $w, $cfg->{label}, color_speedup($sp);
        }
        print "\n";
        print "Speedup: pperl_ops/perl5_ops. ";
        print legend_text('speedup') . "\n";
        print "A +jitp cell BELOW its +jit cell is a Rayon loss on that row.\n";
        return;
    }

    return unless @$ratios;

    my $sum = 0;
    $sum += $_ for @$ratios;
    my $avg = $sum / @$ratios;
    my $geo = geomean(@$ratios);

    # Both modes: ratio >1 = pperl slower, <1 = pperl faster
    my $faster = scalar grep { $_ < 1 } @$ratios;
    my $slower = scalar grep { $_ > 1 } @$ratios;

    printf "Benchmarks: %d\n", scalar @$ratios;
    printf "pperl faster: %d, pperl slower: %d\n", $faster, $slower;
    printf "Average ratio:  %7.3fx (arithmetic mean)\n", $avg;
    printf "Geometric mean: " . BOLD() . "%7.3fx" . RESET() . "\n", $geo;

    if (@$mem_ratios) {
        my $mem_geomean = geomean(@$mem_ratios);
        printf "Memory geomean:  " . BOLD() . "%6.2fx" . RESET() . "\n", $mem_geomean;
    }

    print "\n";
    if ($is_startup) {
        print "Ratio: pperl_ms/perl5_ms. ";
    } else {
        print "Ratio: perl5_ops/pperl_ops. ";
    }
    print legend_text('ratio') . "\n";
    if (@$mem_ratios) {
        print "Memory: pperl_rss/perl5_rss. ";
        print legend_text('mem') . "\n";
    }
}

# ============================================================================
# Run benchmarks — STARTUP MODE
# ============================================================================

my %results;
my $bench_count = 0;
my $bench_total = scalar @benchmarks;

# Rows are numbered "[ 12/104] name ..." in BOTH modes — the number
# lives inside the name column, so widen it once and every consumer
# (table header, result rows, error labels) stays aligned. config_spec
# reads the widened $NAME_W, so the config table's rule_width tracks it.
my $NUM_W     = length($bench_total);
my $ROW_PFX_W = 2 * $NUM_W + 4;    # "[NN/NN] "
$NAME_W += $ROW_PFX_W;

if ($startup_mode) {
    # ONE table, streamed: each row prints its times+ratio as it
    # finishes. (The old separate "[N/M] name ratio" progress pass
    # duplicated every row ahead of the summary table — superfluous.)
    # The name column is widened by $ROW_PFX_W for the "[NN/NN] " prefix.
    # render_header derives the --- rule from the spec so it matches the
    # header width (was hardcoded 78+prefix, 3 short of the mem header).
    my $startup_spec = startup_spec($show_memory, $ROW_PFX_W);
    my $sname_w = $startup_spec->{name_w};
    render_header($startup_spec, "Benchmark", 1);   # 1 = no leading === rule

    for my $bench (@benchmarks) {
        $bench_count++;
        wait_for_quiet_machine();
        my $name = $bench->{name};
        my $desc = $bench->{desc} // $bench->{script} // '?';

        my $disp = sprintf("[%*d/%d] %s", $NUM_W, $bench_count, $bench_total, $name);
        printf "%-${sname_w}s ", $disp;
        $| = 1;

        my $script = $bench->{script};
        my $file   = $bench->{file};    # real file path (for cache benchmarks)
        unless (defined $script || defined $file) {
            print RED() . "no script or file defined" . RESET() . "\n";
            $results{$name} = { status => 'error' };
            next;
        }

        # Determine what to pass to run_protected
        my $run_arg  = defined $file ? $file : $script;
        my $use_file = defined $file ? 1 : 0;

        # Run script N times for each interpreter, collect wall times
        my (@p5_times, @pp_times);
        my ($p5_peak_rss, $pp_peak_rss) = (0, 0);
        my $perl5_ok = 1;
        my $pperl_ok = 1;

        for my $iter (1 .. $iterations) {
            # perl5
            my ($p5_time, $p5_exit, $p5_status, $p5_out, $p5_rss) =
                run_protected($PERL5, $run_arg, $use_file);
            if ($p5_status ne 'ok' || $p5_exit != 0) {
                $perl5_ok = 0;
                print YELLOW() . "perl5 failed" . RESET()
                    . " ($p5_status, exit=$p5_exit)\n";
                if ($verbose && $p5_out) {
                    print "      p5: $_\n" for split /\n/, $p5_out;
                }
                last;
            }
            push @p5_times, $p5_time * 1000;  # convert to ms
            $p5_peak_rss = $p5_rss if $p5_rss > $p5_peak_rss;

            # pperl
            my ($pp_time, $pp_exit, $pp_status, $pp_out, $pp_rss) =
                run_protected($PPERL, $run_arg, $use_file);
            if ($pp_status ne 'ok' || $pp_exit != 0) {
                $pperl_ok = 0;
                print RED() . "pperl failed" . RESET()
                    . " ($pp_status, exit=$pp_exit)\n";
                if ($verbose && $pp_out) {
                    print "      pp: $_\n" for split /\n/, $pp_out;
                }
                last;
            }
            push @pp_times, $pp_time * 1000;
            $pp_peak_rss = $pp_rss if $pp_rss > $pp_peak_rss;
        }

        if (!$perl5_ok) {
            $results{$name} = { status => 'perl5_error' };
            next;
        }
        if (!$pperl_ok) {
            $results{$name} = { status => 'pperl_error' };
            next;
        }

        my $p5_stats = compute_stats(@p5_times);
        my $pp_stats = compute_stats(@pp_times);

        # Ratio for startup: pperl_ms / perl5_ms
        # Same direction as throughput: >1 = pperl slower, <1 = pperl faster
        my $ratio = $p5_stats->{median} > 0
                  ? $pp_stats->{median} / $p5_stats->{median}
                  : 0;

        $results{$name} = {
            status      => 'ok',
            perl5_ms    => $p5_stats,
            pperl_ms    => $pp_stats,
            perl5_rss_kb => $p5_peak_rss,
            pperl_rss_kb => $pp_peak_rss,
            ratio       => $ratio,
        };

        # Complete the streamed table row in place (name already printed,
        # padded, before the run). Same cell tail as --display; SLOW! now
        # shows in the mem variant too.
        print format_startup_cells(
            has_memory => $show_memory,
            ratio      => $ratio,
            p5_ms      => $p5_stats->{median},
            pp_ms      => $pp_stats->{median},
            p5_mem     => $p5_peak_rss,
            pp_mem     => $pp_peak_rss), "\n";
    }
} else {

# ============================================================================
# Run benchmarks — THROUGHPUT MODE (default)
# ============================================================================

    # Squashed output: no separate calibration/progress pass. We print the
    # results table header ONCE up front, then stream each row as its
    # benchmark finishes. `--memory` uses the SAME config renderer with
    # three trailing memory columns appended (was a separate stale layout
    # with an inverted ratio and misaligned columns - now unified).
    print_table_header("Benchmark", \@JIT_CONFIGS, $show_memory);
    # Benchmarks are grouped JIT-first, native-last (sorted at load). The
    # first native row streams a "Native-Modules" sub-header whose col-3/4
    # labels are N/A +jit and +rayon.
    my $native_header_done = 0;

    for my $bench (@benchmarks) {
        $bench_count++;
        wait_for_quiet_machine();
        my $name = $bench->{name};
        my $desc = $bench->{desc} // $bench->{code};
        my $row_start = time;   # per-row wall-clock, recorded in the JSON

        if (!$native_header_done && is_native_row($name)) {
            print "\r", " " x 50, "\r";   # clear any pending (calibrating...) stub
            print "\n";
            print_table_header("Native-Modules Benchmark", \@NATIVE_CONFIGS, $show_memory);
            $native_header_done = 1;
        }

        # Row number inside the name column ($NAME_W was widened for it).
        my $disp = sprintf("[%*d/%d] %s", $NUM_W, $bench_count, $bench_total, $name);

        # Calibration+run take seconds with no output, so show
        # "name (calibrating...)" on a carriage-returned line first; the
        # finished row overwrites it in place (\r + full row).
        printf "\r%-${NAME_W}s %s", $disp, "(calibrating...)";
        $| = 1;  # flush

        # A failure has no separate line to attach to, so overwrite the
        # "(calibrating...)" stub (\r) with the name.
        my $rowlbl = sprintf("\r%-${NAME_W}s ", $disp);

        # --- Calibrate loop counts (or use fixed override) ---
        my ($p5_loops, $pp_loops);

        # Loop counts are calibrated PER CONFIG: a JIT-compiled loop can
        # do orders of magnitude more iterations per second than --no-jit,
        # so one shared count would either starve the fast config or time
        # out the slow one.
        # PHENOTYPE row: a DELIBERATELY reducible-to-nothing loop, declared
        # `phenotype => 1` in its .bench spec. The JIT is SUPPOSED to
        # delete it — it is a correctness probe, not a throughput row.
        # Skip timing entirely (any number would be perl5's real work
        # divided by the JIT's deleted loop) and render/exclude it as
        # such. Detection is explicit, not timing-inferred: timing can't
        # tell "deleted" from "very fast" once the loop ceiling is high.
        if ($bench->{phenotype}) {
            $results{$name} = { status => 'eliminated' };
            my $tag = GREEN() . "ELIMINATED" . RESET()
                    . " (phenotype: JIT must delete this loop; not timed)";
            printf "\r%-${NAME_W}s %s\n", $disp, $tag;
            next;
        }

        # The config set for THIS row: JIT set, or the native set (col-3
        # +jit N/A, col-4 +rayon) for native:: rows. `na` columns are not
        # measured. See configs_for.
        my @cfgs = @{ configs_for($name) };
        my @meas_cfgs = grep { !$_->{na} } @cfgs;   # columns actually run

        my %cfg_loops;
        if (defined $loops_override) {
            $p5_loops = $loops_override;
            $cfg_loops{$_->{key}} = $loops_override for @meas_cfgs;
        } else {
            my ($p5_cal, $p5_err) = calibrate($PERL5, $bench);
            if (!defined $p5_cal) {
                print $rowlbl . YELLOW() . "perl5 calibration failed" . RESET() . " ($p5_err)\n";
                $results{$name} = { status => 'perl5_error' };
                next;
            }
            $p5_loops = $p5_cal;

            my $cal_failed;
            for my $cfg (@meas_cfgs) {
                my ($c, $e) = calibrate($PPERL, $bench, $cfg->{args});
                if (!defined $c) {
                    print $rowlbl . RED() . "pperl calibration failed" . RESET()
                        . " ($cfg->{label}: $e)\n";
                    $cal_failed = 1;
                    last;
                }
                $cfg_loops{$cfg->{key}} = $c;
            }
            if ($cal_failed) {
                $results{$name} = { status => 'pperl_error' };
                next;
            }
        }
        # The legacy single-pperl fields track the plain runtime config
        # (`pperl`, col 2 - always the first, present in both sets).
        $pp_loops = $cfg_loops{ $meas_cfgs[0]{key} };

        if ($verbose) {
            printf "\n%44s loops: p5=%d pp=%d\n", "", $p5_loops, $pp_loops;
        }

        # --- Build programs (BENCH v2: one self-timing program per
        # (interpreter, N); no baseline twin). ---
        my $p5_prog = build_program($bench, $p5_loops);
        my $pp_prog = build_program($bench, $pp_loops);

        # --- Collect iterations ---
        # Each run prints its OWN in-loop CLOCK_MONOTONIC elapsed
        # (parse_bench_line); we collect those elapseds and reduce to
        # ops/sec via compute_ops (min elapsed -> max ops; noise is
        # one-sided). No baseline, no subtraction - the #59 astronomical
        # class cannot arise. See docs/how-it-works.md.
        my @p5_elapsed;
        my %cfg_elapsed = map { $_->{key} => [] } @meas_cfgs;
        my %cfg_rss     = map { $_->{key} => 0  } @meas_cfgs;  # peak RSS per config
        my ($p5_peak_rss, $pp_peak_rss) = (0, 0);
        my $perl5_ok = 1;
        my $pperl_ok = 1;

        for my $iter (1 .. $iterations) {
            # --- perl5 ---
            my ($p5_wall, $p5_exit, $p5_status, $p5_out, $p5_rss) =
                run_protected($PERL5, $p5_prog);

            if ($p5_status ne 'ok' || $p5_exit != 0) {
                $perl5_ok = 0;
                print $rowlbl . YELLOW() . "perl5 failed" . RESET() . " ($p5_status, exit=$p5_exit)\n";
                if ($verbose && $p5_out) {
                    for my $line (split /\n/, $p5_out) {
                        print "      p5: $line\n";
                    }
                }
                last;
            }

            my ($p5_n, $p5_e) = parse_bench_line($p5_out);
            if (!defined $p5_e) {
                $perl5_ok = 0;
                print $rowlbl . YELLOW() . "perl5 printed no BENCH line" . RESET() . "\n";
                last;
            }

            # Track peak RSS from the run
            $p5_peak_rss = $p5_rss if $p5_rss > $p5_peak_rss;
            push @p5_elapsed, $p5_e;

            # --- pperl, once per measured configuration (na columns
            # skipped) ---
            for my $cfg (@meas_cfgs) {
                my $loops = $cfg_loops{ $cfg->{key} };
                # Each config has its own calibrated loop count, so it
                # needs its own program text.
                my $prog = build_program($bench, $loops);

                my ($wall, $exit, $status, $out, $rss) =
                    run_protected($PPERL, $prog, undef, $cfg->{args});

                if ($status ne 'ok' || $exit != 0) {
                    $pperl_ok = 0;
                    print $rowlbl . RED() . "pperl failed" . RESET()
                        . " ($cfg->{label}: $status, exit=$exit)\n";
                    if ($verbose && $out) {
                        print "      pp: $_\n" for split /\n/, $out;
                    }
                    last;
                }

                my ($n, $e) = parse_bench_line($out);
                if (!defined $e) {
                    $pperl_ok = 0;
                    print $rowlbl . RED() . "pperl printed no BENCH line" . RESET()
                        . " ($cfg->{label})\n";
                    last;
                }
                push @{ $cfg_elapsed{ $cfg->{key} } }, $e;

                # Peak RSS per config (the mem column can then show a
                # PARALLEL path's memory balloon, not just col 2's).
                $cfg_rss{ $cfg->{key} } = $rss if $rss > $cfg_rss{ $cfg->{key} };
                # The plain-runtime config (col 2) feeds the legacy RSS field.
                if ($cfg->{key} eq $meas_cfgs[0]{key}) {
                    $pp_peak_rss = $rss if $rss > $pp_peak_rss;
                }
            }
            last if !$pperl_ok;
        }

        if (!$perl5_ok) {
            $results{$name} = { status => 'perl5_error' };
            next;
        }
        if (!$pperl_ok) {
            $results{$name} = { status => 'pperl_error' };
            next;
        }

        my $p5_stats = compute_ops($p5_loops, \@p5_elapsed);
        my $pp_stats = compute_ops($pp_loops,
                          $cfg_elapsed{ $meas_cfgs[0]{key} });

        # Ratio: perl5_ops / pperl_ops — >1 means pperl is slower
        my $ratio = $pp_stats->{median} > 0
                  ? $p5_stats->{median} / $pp_stats->{median}
                  : 0;

        # Per-config stats + SPEEDUP vs perl5 (higher is better, unlike
        # `ratio`, which is perl5/pperl and inverts the intuition). An
        # `na` column (native +jit) carries no measurement; it is recorded
        # as {na=>1} so the renderer prints "N/A".
        my %cfg_stats;
        for my $cfg (@cfgs) {
            if ($cfg->{na}) {
                $cfg_stats{ $cfg->{key} } = { na => 1 };
                next;
            }
            my $s = compute_ops($cfg_loops{ $cfg->{key} },
                       $cfg_elapsed{ $cfg->{key} });
            $cfg_stats{ $cfg->{key} } = {
                ops     => $s,
                loops   => $cfg_loops{ $cfg->{key} },
                speedup => ($p5_stats->{median} > 0)
                         ? $s->{median} / $p5_stats->{median} : 0,
                rss_kb  => $cfg_rss{ $cfg->{key} },   # peak RSS this config
            };
        }

        $results{$name} = {
            status      => 'ok',
            perl5_ops   => $p5_stats,
            pperl_ops   => $pp_stats,
            perl5_loops => $p5_loops,
            pperl_loops => $pp_loops,
            perl5_rss_kb => $p5_peak_rss,
            pperl_rss_kb => $pp_peak_rss,
            ratio       => $ratio,
            native      => is_native_row($name),
            configs     => \%cfg_stats,
            # Wall-clock this row cost (calibration + all configs + all
            # iterations). Recorded so a full run leaves a durable record
            # of WHERE the time goes when tuning target_time/iterations.
            row_seconds => time - $row_start,
        };

        # The result row IS the output - overwrite the "(calibrating...)"
        # stub in place (\r) with the finished row, fastest config bold.
        # Under --memory the row gains the trailing p5_mem/pp_mem/mem cells.
        my $mem = $show_memory ? [$p5_peak_rss, { %cfg_rss }] : undef;
        print "\r",
              format_config_row($name, $p5_stats->{median}, \%cfg_stats, $mem, $disp),
              "\n";
    }
}

# ============================================================================
# Summary table
# ============================================================================
#
# The config layout (throughput, no --memory) already STREAMED its header
# and rows during the run — squashed calibration+result into one visual.
# Here it only closes the rule and prints stats. The startup and memory
# layouts still render their full table at the end.

# The config table (incl. --memory) streams inline; only startup mode
# renders its full table at the end.
my $inline_done = !$startup_mode;

if ($inline_done) {
    # Rows are already on screen; the single aggregation pass collects the
    # ratios (for the count), the per-config speedup lists (one geomean line
    # per column), and - under --memory - the mem ratios (worst pperl-config
    # RSS vs perl5) for the Memory geomean line.
    my $stats = collect_footer_stats(
        results => \%results, has_configs => 1, show_memory => $show_memory);
    # Closing rule = the config table's derived width (same spec the streamed
    # header used), so it tracks --memory without a parallel formula.
    print "-" x rule_width(config_spec(\@JIT_CONFIGS, $show_memory)), "\n";
    print_summary_stats(
        ratios      => $stats->{ratios},
        mem_ratios  => $stats->{mem_ratios},
        is_startup  => $startup_mode,
        has_configs => 1,
        configs_agg => $stats->{agg});
} else {
    # STARTUP MODE: rows already streamed in the table above — the same
    # aggregation pass (no per-config columns; pperl-vs-perl5 mem ratio).
    my $stats = collect_footer_stats(
        results => \%results, has_configs => 0, show_memory => $show_memory);
    # Closing rule = the startup table's derived width (spec includes the
    # [NN/NN] prefix widening), fixing the old hardcoded 78+prefix that fell
    # short of the actual header.
    print "-" x rule_width(startup_spec($show_memory, $ROW_PFX_W)), "\n";
    print_summary_stats(
        ratios      => $stats->{ratios},
        mem_ratios  => $stats->{mem_ratios},
        is_startup  => $startup_mode,
        has_configs => 0);
}

# ============================================================================
# Save results
# ============================================================================

my $saved_filename;   # track what we saved so --compare can skip it

if ($save && !$interrupted) {
    make_path($RESULTS_DIR) unless -d $RESULTS_DIR;
    cleanup_results_dir();

    my $timestamp = strftime("%Y%m%d-%H%M%S", localtime);
    my $mode_suffix = $startup_mode ? "-startup" : "";
    my $filename = "$RESULTS_DIR/$timestamp$mode_suffix.json";
    $saved_filename = $filename;

    my %save_data = (
        timestamp   => strftime("%Y-%m-%dT%H:%M:%S", localtime),
        pperl       => $PPERL,
        perl5       => $PERL5,
        mode        => $startup_mode ? "startup" : "throughput",
        iterations  => $iterations,
        pperl_args  => (@pperl_extra_args ? join(' ', @pperl_extra_args) : undef),
        benchmarks  => {},
        # Runtime accounting: total wall-clock for the run plus the
        # start/end timestamps. Per-row costs live in each benchmark's
        # row_seconds. Lets us tune target_time/iterations against real
        # timing rather than estimates.
        started_at      => strftime("%Y-%m-%dT%H:%M:%S", localtime($run_start)),
        finished_at     => strftime("%Y-%m-%dT%H:%M:%S", localtime),
        total_seconds   => (time - $run_start),
    );

    unless ($startup_mode) {
        $save_data{target_time} = $target_time;
        $save_data{loops_mode} = defined $loops_override ? "fixed:$loops_override" : "auto";
    }

    for my $name (sort keys %results) {
        my $r = $results{$name};
        # Eliminated (phenotype) rows carry no measurement; persist just
        # the status so --display can re-render them as ELIMINATED.
        if ($r->{status} eq 'eliminated') {
            $save_data{benchmarks}{$name} = { status => 'eliminated' };
            next;
        }
        next unless $r->{status} eq 'ok';

        my %bench_data = (
            ratio => $r->{ratio},
        );
        # Per-row wall-clock (see row_seconds above). Kept for both modes.
        $bench_data{row_seconds} = $r->{row_seconds} if defined $r->{row_seconds};

        if ($startup_mode) {
            $bench_data{perl5_ms} = $r->{perl5_ms};
            $bench_data{pperl_ms} = $r->{pperl_ms};
        } else {
            $bench_data{perl5_ops}   = $r->{perl5_ops};
            $bench_data{pperl_ops}   = $r->{pperl_ops};
            $bench_data{perl5_loops} = $r->{perl5_loops};
            $bench_data{pperl_loops} = $r->{pperl_loops};
            # Per-config (pperl / +jit / +jitp) ops + speedup. Saved so a
            # later --display or --compare shows the same columns as the
            # live run.
            $bench_data{configs}     = $r->{configs} if $r->{configs};
        }

        # Memory data (both modes)
        $bench_data{perl5_rss_kb} = $r->{perl5_rss_kb} if ($r->{perl5_rss_kb} // 0) > 0;
        $bench_data{pperl_rss_kb} = $r->{pperl_rss_kb} if ($r->{pperl_rss_kb} // 0) > 0;

        $save_data{benchmarks}{$name} = \%bench_data;
    }

    my $json = JSON::PP->new->utf8->pretty->canonical->encode(\%save_data);
    if (open my $fh, '>', $filename) {
        print $fh $json;
        close $fh;
        print "\nResults saved to: $filename\n";
    } else {
        warn "Cannot write $filename: $!\n";
    }
}

# ============================================================================
# Compare with previous results
# ============================================================================

if ($compare) {
    my $prev = load_previous_results($saved_filename);
    if ($prev && keys %{$prev->{benchmarks}}) {
        print "\n" . BOLD() . "Comparison with previous run" . RESET();
        print " ($prev->{timestamp})\n";
        print "-" x 78, "\n";
        printf "%-40s %7s %7s %8s\n", "Benchmark", "before", "now", "change";
        print "-" x 78, "\n";

        my $improvements = 0;
        my $regressions = 0;

        for my $name (sort keys %results) {
            next unless $results{$name}{status} eq 'ok';
            next unless exists $prev->{benchmarks}{$name};

            my $old_ratio = $prev->{benchmarks}{$name}{ratio};
            my $new_ratio = $results{$name}{ratio};
            next unless $old_ratio > 0;

            my $change_pct = (($new_ratio - $old_ratio) / $old_ratio) * 100;
            my $change_color;
            # Both modes: ratio DOWN = improvement, UP = regression
            if ($change_pct <= -5) {
                $change_color = GREEN();
                $improvements++;
            } elsif ($change_pct >= 5) {
                $change_color = RED();
                $regressions++;
            } else {
                $change_color = "";       # within noise
            }

            printf "%-40s %6.1fx %6.1fx  %s%+.1f%%%s\n",
                $name, $old_ratio, $new_ratio,
                $change_color, $change_pct, RESET();
        }

        print "-" x 78, "\n";
        if ($improvements || $regressions) {
            print GREEN() . "$improvements improved" . RESET() . ", ";
            print RED() . "$regressions regressed" . RESET() . "\n";
        } else {
            print "No significant changes (threshold: 5%)\n";
        }
    } else {
        print "\nNo previous results found for comparison.\n";
    }
}

# Total wall-clock runtime (always shown, save or not). With MAX_LOOPS at
# 2G a full JIT run genuinely takes a while — this makes the cost visible.
my $elapsed = time - $run_start;
my $rt = $elapsed >= 3600 ? sprintf("%dh %dm %ds", $elapsed / 3600,
                                    ($elapsed % 3600) / 60, $elapsed % 60)
       : $elapsed >= 60   ? sprintf("%dm %ds", $elapsed / 60, $elapsed % 60)
       :                    sprintf("%.1fs", $elapsed);
print "\nFinished: ", strftime("%Y-%m-%d %H:%M:%S", localtime),
      "  (total runtime: $rt)\n";

exit 0;

# ============================================================================
# Helper functions
# ============================================================================

sub load_previous_results {
    my ($exclude_file) = @_;
    return undef unless -d $RESULTS_DIR;

    my @files = sort glob("$RESULTS_DIR/*.json");
    # Skip the file we just saved (so we compare against a PREVIOUS run)
    @files = grep { $_ ne ($exclude_file // '') } @files;

    # Match mode: startup results should compare to startup, throughput to throughput
    my $want_mode = $startup_mode ? "startup" : "throughput";
    for my $f (reverse @files) {
        local $/;
        open my $fh, '<', $f or next;
        my $json = <$fh>;
        close $fh;
        my $data = eval { JSON::PP->new->utf8->decode($json) };
        next unless $data;
        my $file_mode = $data->{mode} // "throughput";
        return $data if $file_mode eq $want_mode;
    }
    return undef;
}

sub cleanup_results_dir {
    return unless -d $RESULTS_DIR;

    my $one_week_ago = time() - (7 * 24 * 60 * 60);
    for my $file (glob("$RESULTS_DIR/*.json")) {
        my @stat = stat($file);
        next unless @stat;
        unlink $file if $stat[9] < $one_week_ago || $stat[7] < 50;
    }
}
