Joseph Ferano
a4c6b996ff
The trio the author decided on 2026-09-20 is now all built: def is CL's defparameter — its initialiser runs on every daemon re-run, unguarded, so an edited initialiser repaints the same storage on C-c C-c plus re-run — defonce (Clojure's name for CL's defvar, per the author) initialises once behind the .init~once. flag, and defconst stays the image. One parse arm reads both forms; the difference is Ast.reinit, carried to Tast.global's grerun. Emit.startup_plan gives a def no guard flag, and Check.check_global lifts every def initialiser — zero and literal included — into global/<n>, so the host's startup reaches it through the function cell and a re-evaluated def swaps it (Session's def_inits; Emit.redefinition declares the cell for a non-sibling target). The old defvar spelling is refused with the rename and both compiling spellings, and every program, test, doc and editor list is swept — except sand.flan, the author's live WIP, whose seven defvar lines are flagged in FIX.org and keep its three dependent tests red on this branch.
83 lines
3.4 KiB
Plaintext
83 lines
3.4 KiB
Plaintext
;;;; StorageExhausted and retry, over a Map — spec-memory.md, "Allocation
|
|
;;;; failure". The rule is one rule over *every* allocating operation, so it has
|
|
;;;; to hold for map-new, put, reserve and clone exactly as exhausted.flan shows
|
|
;;;; it holding for vec-new, push, reserve and clone. put stays (), clone
|
|
;;;; stays the container, and no signature anywhere grows a Result.
|
|
;;;;
|
|
;;;; A map is the harder case of the two, and that is why it gets its own
|
|
;;;; program. A Vec's failing allocation leaves the Vec untouched. A map's
|
|
;;;; growth allocates a whole new block, rehashes into it and only then
|
|
;;;; releases the old one — so a failure partway must leave the map exactly as
|
|
;;;; it was, or the retry re-attempts against a half-moved map.
|
|
|
|
;; Globals, because a handler cannot see the locals of the function that
|
|
;; established it.
|
|
(defonce tight Allocator)
|
|
(defonce failures i64)
|
|
(defonce last-bytes i64)
|
|
(defonce same-allocator bool)
|
|
|
|
(defn main [] i32
|
|
(set tight (heap-allocator))
|
|
;; Enough for the smallest block and not for the one after it. A map's block
|
|
;; is keys, values, hashes and scratch, each rounded to a cache line, so it
|
|
;; is a few hundred bytes at eight slots — the ceiling has to be low enough
|
|
;; to be hit and high enough that the first block fits after one raise.
|
|
(set-alloc-budget tight 64)
|
|
|
|
(handler-bind
|
|
[(StorageExhausted [c]
|
|
(set failures (+ failures 1))
|
|
(set last-bytes (.bytes c))
|
|
(set same-allocator (= (.allocator c) (alloc-id tight)))
|
|
;; Raise the ceiling and re-attempt the same request. The map is
|
|
;; untouched and its allocator is unchanged, which is why this can
|
|
;; succeed — releasing the region instead would invalidate the map,
|
|
;; which is what the epoch check catches and is its own program.
|
|
(set-alloc-budget tight (* 4 (alloc-budget tight)))
|
|
(invoke-restart 'retry))]
|
|
(let [m (map-new i32 i64 tight)]
|
|
;; Several grows, each one a fresh block rehashed into. A put that fails
|
|
;; puts nothing, and the retry puts exactly once — so no entry is lost
|
|
;; and none is doubled.
|
|
(dotimes [i 300] (put m i (* (i64 i) 7)))
|
|
(println (len m)) ; 300
|
|
(let [bad 0]
|
|
(dotimes [i 300]
|
|
(match (get m i)
|
|
(Some v) (if (not (= v (* (i64 i) 7))) (set bad (+ bad 1)))
|
|
None (set bad (+ bad 1))))
|
|
(println bad)) ; 0
|
|
(free m)))
|
|
|
|
(println (> failures 1)) ; true
|
|
(println (> last-bytes 0)) ; true
|
|
(println same-allocator) ; true
|
|
|
|
;; reserve asks for the whole block at once, and clone asks the new allocator
|
|
;; for one big enough to hold the source — both are allocating operations and
|
|
;; neither returns an error.
|
|
(set-alloc-budget tight 64)
|
|
(set failures 0)
|
|
(handler-bind
|
|
[(StorageExhausted [c]
|
|
(set failures (+ failures 1))
|
|
(set-alloc-budget tight (* 8 (alloc-budget tight)))
|
|
(invoke-restart 'retry))]
|
|
(let [m (map-new string i32 tight)]
|
|
(reserve m 200)
|
|
(println (len m)) ; 0
|
|
(put m "a" 1)
|
|
(put m "b" 2)
|
|
(let [w (clone m)]
|
|
(println (len w)) ; 2
|
|
(match (get w "b")
|
|
(Some v) (println v) ; 2
|
|
None (println "missing"))
|
|
(free w))
|
|
(free m)))
|
|
(println (> failures 0)) ; true
|
|
|
|
(set-alloc-budget tight 0)
|
|
0)
|