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.
141 lines
6.4 KiB
Plaintext
141 lines
6.4 KiB
Plaintext
;;;; A struct with a dyn field, under an actual collection.
|
|
;;;;
|
|
;;;; Until the per-type descriptors this program did not compile: the checker
|
|
;;;; refused a dyn field outright, because the collector's roots were frames
|
|
;;;; and a struct outlives the frame that built it, so the field's vector was
|
|
;;;; reachable only through memory the marker never walked.
|
|
;;;;
|
|
;;;; What lifted it: every type that holds dyn words at static offsets gets a
|
|
;;;; descriptor — a table of byte offsets, emitted once as static data — and
|
|
;;;; every place a value of that type can live goes on the collector's root
|
|
;;;; stack with the descriptor beside it. The instance never points at its
|
|
;;;; descriptor and the collector never derives one from the bytes; the pairing
|
|
;;;; is made at the push, by the code that knows the static type of what it put
|
|
;;;; there. runtime/flan_dyn.h's flan_dyn_root_push_desc argues that at length.
|
|
;;;;
|
|
;;;; So this file exercises the four places such a value lives, and does it
|
|
;;;; past flan_dyn.c's one-megabyte floor, which is the only way a mark and a
|
|
;;;; sweep actually run:
|
|
;;;;
|
|
;;;; - a frame slot, which is [keep] in [churn];
|
|
;;;; - a global, which is [registry], rooted before the startup function;
|
|
;;;; - the temporary a call's by-value return lands in, which is what
|
|
;;;; [make-row] hands back — the callee rooted that vector and popped it in
|
|
;;;; its epilogue, so between the return and the caller's store the only
|
|
;;;; copy is a register the collector cannot see;
|
|
;;;; - a condition's payload, which crosses a handler boundary as a pointer
|
|
;;;; into a live frame while the handler allocates.
|
|
;;;;
|
|
;;;; Nesting is in here twice over: Row holds a Tag by value, and Tag holds the
|
|
;;;; dyn. A descriptor is flattened, so Row's table names Tag's dyn word at
|
|
;;;; Row's offset plus Tag's, and there is no second descriptor to follow.
|
|
;;;;
|
|
;;;; What a lost root looks like here is not a wrong number. It is a use of
|
|
;;;; freed memory — a crash, or a word that decodes as another tag and traps
|
|
;;;; with a sentence about the wrong type.
|
|
|
|
(defstruct Tag [name dyn])
|
|
(defstruct Row [id i32 tag Tag rows dyn])
|
|
(defstruct Stalled [why dyn id i32])
|
|
|
|
;;; Two types whose names differ only in a character a descriptor symbol's
|
|
;;; mangle flattens: - and + both come out as a dot, so these two once shared
|
|
;;; one entry in the emitter's table and the second of them was pushed with the
|
|
;;; first's descriptor. Three words apart in size and one dyn each at opposite
|
|
;;; ends, so the mistake is not a subtle one — the collector read twenty-four
|
|
;;; bytes past an eight-byte stack object and never marked the word that was
|
|
;;; actually there. ASan called it what it was, a stack-buffer-overflow inside
|
|
;;; gc_mark_all. They are held live across the churn below, which is where a
|
|
;;; descriptor pointing at the wrong offsets shows.
|
|
(defstruct dyn-row [a i64 b i64 c i64 d dyn])
|
|
(defstruct dyn+row [e dyn])
|
|
|
|
;;; A global holding dyn words, which main roots before a line of the program
|
|
;;; runs and never pops. Zero until its field is set, and a zero word is not a
|
|
;;; value the collector follows.
|
|
(defonce registry Row)
|
|
|
|
;;; What the handler saw, read back after the handler had allocated.
|
|
(defonce echoed dyn)
|
|
(defonce stalls i64)
|
|
|
|
;;; The collector's own counters, so that "nothing leaks" is a fact this
|
|
;;; program states rather than one the absence of a crash implies.
|
|
(declare gc-collect [] () "flan_gc_collect")
|
|
(declare gc-count [] i64 "flan_gc_count")
|
|
|
|
;;; Returned by value. The vector is rooted in this frame and unrooted the
|
|
;;; instant the epilogue pops, so the caller's own root is the only thing
|
|
;;; between it and the next allocation.
|
|
(defn make-row [i i32] Row
|
|
(let [rows (vec-new dyn)]
|
|
(push rows i)
|
|
(push rows "row")
|
|
(push rows 2.5)
|
|
(Row {.id i .tag (Tag {.name "tag"}) .rows rows})))
|
|
|
|
;;; An aggregate parameter, which arrives in its slot before the roots are
|
|
;;; pushed. Zeroing its dyn words over the top of the argument would be a
|
|
;;; silent miscompile, so the count this returns is the check for it.
|
|
(defn row-len [r Row] i64 (i64 (len (.rows r))))
|
|
|
|
;;; The payload crosses as a pointer to a value in this frame, and the handler
|
|
;;; below allocates before it reads it.
|
|
(defn stall [i i32] ()
|
|
(let [why (vec-new dyn)]
|
|
(push why "stalled")
|
|
(push why i)
|
|
(signal (Stalled {.why why .id i}))))
|
|
|
|
;;; The garbage is a whole Row per iteration, kept by nothing. The live one
|
|
;;; grows *through* the collections rather than only between them.
|
|
(defn churn [n i32] i64
|
|
(let [keep (make-row 0)
|
|
total (i64 0)
|
|
i 0]
|
|
(while (< i n)
|
|
(let [junk (make-row i)]
|
|
(set total (+ total (row-len junk))))
|
|
(if (= 0 (% i 64)) (push (.rows keep) i))
|
|
(if (= 0 (% i 4096)) (stall i))
|
|
(set i (+ i 1)))
|
|
(set (.rows registry) (.rows keep))
|
|
total))
|
|
|
|
(defn boxed [n i64] dyn
|
|
(let [v (vec-new dyn)]
|
|
(push v n)
|
|
v))
|
|
|
|
(defn main [] ()
|
|
(set (.name (.tag registry)) "registry")
|
|
(set (.rows registry) (vec-new dyn))
|
|
;; Bound before the churn and read after it, wide first so that its
|
|
;; descriptor is the one registered first and the narrow one is what a
|
|
;; shared entry would corrupt.
|
|
(let [wide (dyn-row {.a 1 .b 2 .c 3 .d (boxed 7)})
|
|
narrow (dyn+row {.e (boxed 11)})]
|
|
(handler-bind [(Stalled [c]
|
|
;; Allocate first, then read the payload: if the payload's
|
|
;; vector were unrooted across the transfer, this is the
|
|
;; allocation that would free it.
|
|
(let [noise (vec-new dyn)]
|
|
(push noise "noise"))
|
|
(set stalls (+ stalls 1))
|
|
(set echoed (at (.why c) 0)))]
|
|
(print (churn 40000)) (print "\n"))
|
|
(print stalls) (print "\n")
|
|
(print echoed) (print "\n")
|
|
(print (.name (.tag registry))) (print "\n")
|
|
(print (len (.rows registry))) (print "\n")
|
|
(print (at (.rows registry) 0)) (print "\n")
|
|
;; The two that mangle alike, read after forty thousand rows of churn
|
|
;; collected over them many times.
|
|
(print (at (.d wide) 0)) (print "\n")
|
|
(print (at (.e narrow) 0)) (print "\n")
|
|
;; And the heap after a final collection, which is the leak question asked
|
|
;; rather than assumed. Everything the run built is unreachable by now
|
|
;; except the registry's vector and the handful of words it holds.
|
|
(gc-collect)
|
|
(if (< (gc-count) 2000) (print "bounded\n") (print "LEAKED\n"))))
|