flan/test/programs/exhausted.flan
Joseph Ferano d1443808c6 Review follow-ups: the park had the original bug inside it
- SA_NODEFER. sigaction without it blocks the handler's own signal for the
  whole handler, and here the handler is the park — it never returns. A
  hardware SIGSEGV delivered while SIGSEGV is blocked is not handled: the
  kernel forces the default action. Fault, park, eval something at the
  break loop that faults, daemon gone, exactly the author's session one
  level in. Measured both ways; flan_crash_entered is cleared before the
  hook so each break-loop fault still gets its line, and the case is pinned
  (trap_park ~refault:true), confirmed to fail without the flag.
- Scope the handler to the thread it was armed on. A disposition is per
  process and a merged dev session is one process, so this was shadowing
  OCaml's SIGSEGV handler — and Stack_overflow — for the daemon's whole
  life. Other threads chain to what was installed before. Arming per run
  would leave the parked prompt's evaluations unprotected, since those are
  program code too; the comment says so. Also makes the per-thread
  sigaltstack honest.
- Sweep dyn-view.flan and string-eq.flan, which dev-loop added after the
  first sweep. string-eq:46 wanted the aliasing outright: its comment is
  about two slices sharing a base pointer.
- A StorageExhausted row for bytes, asserting the retry copies once and
  whole rather than re-evaluating its argument.
- Gate the flan_dev_crash_enable declare to dev builds, so this lane adds
  no dev-only text to a release module. flan_bytes_dup stays ungated: a
  release build really calls it.
- Guard the section for wasm32, which compiles this file and has no
  signals.
2026-09-20 23:35:03 +07:00

122 lines
5.5 KiB
Plaintext

;;;; StorageExhausted and retry — spec-memory.md, "Allocation failure".
;;;;
;;;; No allocating operation returns an error and none can fail silently. The
;;;; operation signals StorageExhausted with `error`, whose type is Never,
;;;; inside a restart-case offering `retry` — so push stays (), clone stays
;;;; the container, and no signature anywhere grows a Result. Odin's append
;;;; returns an ignorable Allocator_Error; an append that appends nothing and
;;;; says nothing is the outcome this rule exists to make impossible.
;;;;
;;;; This is also the named exception to plan.org's "restarts go at the resync
;;;; point, once": the restart is established *at the failing allocation*,
;;;; because a restart at an outer loop cannot re-attempt an allocation and
;;;; only the allocation site can.
;;;;
;;;; The handler that works is the one that raises the ceiling and retries.
;;;; Releasing the region the container lives in does not work and must not be
;;;; written: it invalidates the container, which the epoch check then catches
;;;; — and that case is its own program, stale-region.flan.
;; Globals, because a handler cannot see the locals of the function that
;; established it: check.ml's `captured` refuses one by name and says to use a
;; global. That refusal is the accumulation pattern, and it is not built.
(defvar tight Allocator)
(defvar failures i64)
(defvar last-bytes i64)
(defvar last-align i64)
(defvar same-allocator bool)
(defn main [] i32
;; The general-purpose tier, with a ceiling on it. 32 bytes is four i32 and
;; the doubling past it is not.
(set tight (heap-allocator))
(set-alloc-budget tight 32)
(handler-bind
[(StorageExhausted [c]
(set failures (+ failures 1))
;; The condition is a value struct with fixed numeric fields and no
;; rendered message: formatting would allocate, and this is the one path
;; that must not. Rendering happens here, where a working allocator is
;; known.
(set last-bytes (.bytes c))
(set last-align (.align c))
;; It names which region ran out, so a handler holding several can tell
;; them apart.
(set same-allocator (= (.allocator c) (alloc-id tight)))
;; Grow it, then re-attempt the same request. The Vec is untouched and
;; its allocator is unchanged, which is why this retry can succeed.
(set-alloc-budget tight (* 4 (alloc-budget tight)))
(invoke-restart 'retry))]
(let [v (vec-new i32 tight)]
;; Somewhere in here the ceiling is hit, the handler raises it, and the
;; push that failed is re-attempted. No push is lost: a failed push
;; appends nothing and the retry appends exactly once.
(dotimes [i 64] (push v (* i 2)))
(println (len v)) ; 64
(println (at v 0)) ; 0
(println (at v 63)) ; 126
(free v)))
;; The handler ran, more than once, and what it saw were the numbers of the
;; request that did not fit.
(println (> failures 1)) ; true
(println (> last-bytes 0)) ; true
(println last-align) ; 4 — align-of i32, from the call site
(println same-allocator) ; true
;; Every allocating operation, not only push. reserve asks for the whole
;; block at once, and clone asks the new allocator for the source's length.
(set-alloc-budget tight 32)
(set failures 0)
(handler-bind
[(StorageExhausted [c]
(set failures (+ failures 1))
(set-alloc-budget tight 4096)
(invoke-restart 'retry))]
(let [v (vec-new i32 tight)]
(reserve v 256)
(println (len v)) ; 0
(dotimes [i 8] (push v i))
(set-alloc-budget tight 4128)
(let [w (clone v)]
(println (len w)) ; 8
(println (at w 7)) ; 7
(free w))
(free v)))
(println (> failures 0)) ; true
;; And (bytes s), which became an allocating operation when it stopped
;; aliasing the string (FIX.org, the INSERTIONSORT crash). It is under the
;; same rule as everything above and had better prove it: the copy is one
;; request for the string's whole length, so a ceiling below that fails it
;; outright, the handler raises the ceiling and retries, and what comes back
;; is the complete copy rather than a short one.
;;
;; The retry is the half worth pinning. The string is bound to a slot before
;; the guard's loop — the same rule push follows for its element — so a
;; retry re-attempts the *copy* and never re-evaluates the expression that
;; produced the string. A second evaluation would be invisible here if the
;; bytes were right, which is exactly why the count is asserted too.
(set-alloc-budget tight 8)
(set failures 0)
(handler-bind
[(StorageExhausted [c]
(set failures (+ failures 1))
(set-alloc-budget tight 4096)
(invoke-restart 'retry))]
(let [b (bytes "INSERTIONSORT" tight)]
(println (len b)) ; 13 — the whole string, not a prefix
(println (at b 0)) ; 73 — \I
(println (at b 12)) ; 84 — \T, the last byte
;; Writable, which is the point of the copy, and the literal is untouched.
(set (at b 0) \Z)
(println (at b 0)) ; 90
(println "INSERTIONSORT"))) ; INSERTIONSORT
(println failures) ; 1 — failed once, retried once
;; And the restart is not once-per-program: it is established at each
;; allocation, so a later one offers it again.
(set-alloc-budget tight 0)
0)