test/f2b-spawn-cost.sgl

1;;; Per-spawn cost of the bounded worker, for whichever shape it is pointed at.

2;;;

3;;; WHAT THIS MEASURES AND WHY IT NEEDS A BASELINE

4;;;

5;;; `run-bounded` spends its wall clock on four things: the `sh -c` wrapper that

6;;; applies `ulimit`, the child's process start, the child runtime's boot, and

7;;; the parse itself. For a small note the parse is sub-millisecond, so the

8;;; figure is essentially START + BOOT -- but "essentially" is a claim, not a

9;;; measurement, and F3 is going to design against this number.

10;;;

11;;; So the harness measures THREE things, and the third is what turns a number

12;;; into an attributable one:

13;;;

14;;; worker a real inspection of a small manuscript

15;;; trivial `sh -c true` through the SAME `run-bounded` path -- the cost of

16;;; the harness itself: fork, the ulimit shell, the poll loop, the

17;;; temp files, the reap

18;;; parse a much larger manuscript, so the parse term is visible rather

19;;; than inferred to be small

20;;;

21;;; `worker - trivial` is then the runtime's own boot, separated from this

22;;; module's overhead, instead of a single figure that silently contains both.

23;;;

24;;; REPORTS MEDIAN AND SPREAD, NOT A MEAN. Process start times have a long right

25;;; tail under any load at all, and a mean over a handful of samples reports the

26;;; tail rather than the typical case. Min is printed too: on a quiet machine it

27;;; is the closest thing to the cost with no interference.

28(import (sigil core)

29 (sigil string)

30 (sigil list)

31 (sigil process)

32 (sigil path)

33 (sigil math)

34 (folio doc bounded))

36(define (args-after-script rest)

37 (cond

38 ((null? rest) '())

39 ((string-ends-with? (car rest) ".sgl") (cdr rest))

40 (else (args-after-script (cdr rest)))))

42(define argv (args-after-script (command-line)))

44;; argv: <worker-argv-json-ish> is awkward to pass; instead take

45;; <n> <small-note> <big-note> <worker-program> [worker-args...]

46(when (< (length argv) 4)

47 (display "usage: <n> <small-note> <big-note> <worker-program> [args...]\n")

48 (exit 2))

50;; ---------------------------------------------------------------------------

51;; THE MACHINE'S LOAD IS AN INPUT, AND IT MUST BE ABLE TO REFUSE THE RUN.

52;;

53;; This harness already checks the repo fingerprint and every sample's outcome.

54;; The third input it was trusting silently was the machine itself: a spawn cost

55;; taken against an unknown competing workload is exactly the unreproducible

56;; number this work exists to avoid, and whoever reads it will design against it.

57;;

58;; Learned the expensive way, 2026-08-23: a measurement window was granted, a

59;; heavy application started partway through it, and a memory ladder ran for two

60;; minutes under 6.7 load before anyone noticed. Nothing in the harness said so.

61;; The spawn-cost run itself turned out to be clean -- it finished 5m23s before

62;; the workload started -- but that was established afterwards from FILE

63;; TIMESTAMPS, which is archaeology, not an instrument.

64;;

65;; So: REFUSE, do not warn. A warning next to a number is read as a number.

66;; This is the same shape as the empty-fingerprint fix in `sabotage-f2b.sh` --

67;; the degenerate case must be SETUP-FAILED, not silently tolerated.

68;;

69;; HONEST LIMITATION, stated because it bounds what this check can do: the

70;; 1-minute load average LAGS. A workload that starts thirty seconds before this

71;; check will not have moved it much, and one that starts mid-run will not be

72;; caught until the post-run sample. That is why BOTH ends are sampled and both

73;; are printed: the post-run figure is what catches contamination that arrived

74;; after the go-ahead. It is a floor on confidence, not a guarantee.

75(define load-ceiling

76 (let ((v (getenv "F2B_LOAD_CEILING")))

77 (if (and v (string->number v)) (string->number v) 2.0)))

79;; `read-file-string` CANNOT READ /proc. Measured: `/proc/loadavg` stats as size

80;; 0 (procfs synthesises content on read), and the reader allocates by stat size,

81;; so it returns "" -- not an error, an EMPTY STRING.

82;;

83;; That is the dangerous shape, and it bit immediately: the load check appeared to

84;; fire, refusing the run with a plausible message, while actually reporting that

85;; it could not read the file at all. A check that always refuses is as useless

86;; as one that never does, and it LOOKS like it is working. It was caught by the

87;; positive control -- raising the ceiling and requiring the run to proceed --

88;; not by the refusal itself firing ([[topics/red-gate-positive-control]]).

89;;

90;; So the value comes through a subprocess, which reads procfs the way the kernel

91;; intends. This runs once before and once after the samples, never inside the

92;; measured path.

93(define (load-average-1min)

94 (let* ((raw (guard (e (#t #f)) (process-output->string "cat" "/proc/loadavg")))

95 (field (and (string? raw) (> (string-length raw) 0)

96 (car (string-split raw " ")))))

97 (and field (string->number field))))

99(define (check-load label)

100 (let ((la (load-average-1min)))

101 (cond

102 ((not la)

103 ;; Cannot read the load: that is SETUP-FAILED, not a pass. An absent

104 ;; measurement must never be treated as a favourable one.

105

       (display "SETUP-FAILED\tcould not read /proc/loadavg; the machine's state is an input and it is unavailable, so this run cannot certify itself\n")

106 (exit 3))

107 ((> la load-ceiling)

108

       (display (format "SETUP-FAILED\tload average ~a at ~a exceeds the ceiling ~a; REFUSING to measure. Timing taken under competing load is unreproducible.~%"

109 la label load-ceiling))

110 (exit 3))

111 (else

112 (display (format "LOAD\t~a\t~a\t(ceiling ~a)~%" label la load-ceiling))

113 la))))

114

115(define n (string->number (car argv)))

116(define small-note (cadr argv))

117(define big-note (caddr argv))

118(define worker-argv (cdddr argv))

119

120;; Generous limits: this measures COST, not containment, and a cap that fired

121;; would silently turn a timing sample into a kill.

122(define limits (make-limits 4194304 120000))

123

124(define (sample-once argv-with-arg)

125 (let ((o (run-bounded argv-with-arg limits)))

126 (list (outcome-kind o) (outcome-reason o) (outcome-elapsed-ms o))))

127

128;; Every sample's OUTCOME is checked, not just its clock. A run that crashed and

129;; a run that succeeded both produce a number, and averaging them would report

130;; the cost of failing.

131(define (collect label argv-with-arg expected-kind expected-reason)

132 (let loop ((i 0) (times '()) (bad 0))

133 (if (>= i n)

134 (begin

135 (unless (= bad 0)

136 (display (format "WARNING\t~a\t~a of ~a samples had the wrong outcome; the figures below are NOT clean~%"

137 label bad n)))

138 (report label (list-sort < times) bad))

139 (let ((s (sample-once argv-with-arg)))

140 (loop (+ i 1)

141 (cons (caddr s) times)

142 (if (and (eq? (car s) expected-kind)

143 (or (not expected-reason) (eq? (cadr s) expected-reason)))

144 bad (+ bad 1)))))))

145

146(define (median sorted)

147 (let ((len (length sorted)))

148 (if (= len 0) 0 (list-ref sorted (quotient len 2)))))

149

150(define (report label sorted bad)

151 (display (format "SAMPLE\t~a\tn=~a\tmin=~a\tmedian=~a\tmax=~a\tbad=~a~%"

152 label (length sorted)

153 (if (null? sorted) 0 (car sorted))

154 (median sorted)

155 (if (null? sorted) 0 (list-ref sorted (- (length sorted) 1)))

156 bad))

157 (median sorted))

158

159(check-load "pre-run")

160(display (format "SPAWN-COST n=~a worker=~a~%" n (car worker-argv)))

161

162;; WARMUP, discarded. The first spawn of a 31 MB bundle pays cold page cache,

163;; and F3's question is the STEADY-STATE cost across thousands of notes, not the

164;; cost of the first one. Reporting a cold first sample as if it were typical

165;; would overstate the figure F3 designs against. Three, then thrown away.

166(let loop ((i 0))

167 (when (< i 3)

168 (run-bounded (append worker-argv (list small-note)) limits)

169 (loop (+ i 1))))

170(display "WARMUP done (3 spawns, discarded)\n")

171

172;; A trivial child through the same path: the harness's own floor.

173(define trivial (collect "trivial-sh" (list "sh" "-c" "true") (quote unindexed) (quote worker-crashed)))

174(define worker (collect "worker-small" (append worker-argv (list small-note)) (quote indexed) #f))

175(define bigp (collect "worker-big" (append worker-argv (list big-note)) (quote indexed) #f))

176

177(display (format "DERIVED\truntime-boot-and-start=~a ms (worker-small median minus trivial-sh median)~%"

178 (- worker trivial)))

179(display (format "DERIVED\tparse-term=~a ms (worker-big median minus worker-small median)~%"

180 (- bigp worker)))

181;; POST-RUN: contamination that arrived after the go-ahead is caught here, and

182;; nowhere else. This is the sample that would have flagged the aborted window.

183(check-load "post-run")

184(display "SPAWN-COST-DONE\n")