From 7f92136401189b8d9edd9c6ac7e0e9a68865e2a3 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 20 Sep 2026 18:41:14 +0700 Subject: [PATCH] Old instances of a redefined class now follow the class MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit CLHS 4.3.6's update protocol, minus the user hook, on the dyn side's defclass. Redefining a class used to be silent: a class is sugar for a constructor defn, so the edit replaced a body and the instances already in the program kept their old keys for ever. Three pieces. A registry in flan_dyn.c holding each class's current slot list and a generation, made only of interned kw_entry pointers so the collector has nothing to trace in it and no root to push for it. A uint32 generation on the instance, fitted into the padding kind and mark leave in front of len's alignment — sizeof(flan_obj) is 48 with it and was 48 without, and flan_dyn_obj_size is there so a later field that moves it fails a test. And a registration thunk per reload, run by the agent through flan_reload_call after the module's bodies are published: it has to be a thunk, because the case this exists for is a class redefined and not constructed. Migration is lazy, at want_map, len's map arm and dyn_equal's. Slots kept by name, gained slots nil, dropped slots gone, identity preserved, entries rebuilt in the class's order so a migrated instance is indistinguishable from a fresh one. Equality migrates both operands first, so it is over the class as it is now. The session had to stop refusing the constructor's signature change, and does so only for a defclass and only when no compiled caller is left behind. The checker gets there first in practice; the walk in eval holds the reason locally rather than inheriting it. The registry is advisory: a class instance is an open map, so a key a raw put wrote that the class never declared is dropped by the next migration. FIX.org says that plainly rather than pretending enforcement. --- FIX.org | 224 ++++++++++++++++++++++++++- lib/emit.ml | 1 + lib/session.ml | 176 ++++++++++++++++++++- lib/x86.ml | 12 +- runtime/flan_dyn.c | 270 ++++++++++++++++++++++++++++++++- runtime/flan_dyn.h | 28 ++++ test/dyn_ops.c | 207 +++++++++++++++++++++++++ test/programs/dev-classes.flan | 46 ++++++ test/test_dev.ml | 167 ++++++++++++++++++++ test/test_dyn.ml | 21 ++- test/test_sanitize.ml | 10 +- test/test_session.ml | 92 +++++++++++ 12 files changed, 1239 insertions(+), 15 deletions(-) create mode 100644 test/programs/dev-classes.flan diff --git a/FIX.org b/FIX.org index 9cdda86..bc8fb6a 100644 --- a/FIX.org +++ b/FIX.org @@ -1540,7 +1540,10 @@ inspector reads. ~migrate-instances~. A heterogeneous map has no layout to be stale, so nothing breaks today when a class gains a slot: old instances simply lack it. Enumerating live instances is the part that is missing, and it is the - pool's question rather than this lane's. + pool's question rather than this lane's. **Built after all, and without + the enumeration**: see "Lazy instance migration" below, where the answer + turned out to be CLHS 4.3.6's — do not walk the heap, stamp the instances + and migrate each one when it is next touched. - *The JS backend.* It refuses dyn wholesale, so none of this compiles there. Same parking as the string-equality hole above. @@ -2442,3 +2445,222 @@ failures were that row and the sixth was ~dev-trap-free-all~, so what is racy is ~trap_park~ itself and every row that calls it — which is exactly what the mechanism described there predicts. Per the sweep policy the ~@x86~ and ~@sanitize~ sweeps were not run here. +* Lazy instance migration for a redefined defclass, 2026-09-20 +CLHS 4.3.6 — the ~update-instance-for-redefined-class~ protocol — adapted to +the dyn side's classes, minus the user hook. Redefining a ~defclass~ in the +dev session used to be *silent*: a class is compile-time sugar for a +constructor ~defn~, so the edit replaced a function body, the instances +already in the program kept their old keys for ever, and nothing anywhere +said so. Now the instances follow the class. + +The research is ~docs/SBCL-REDEFINITION-NOTES.md~, candidate C. Its central +finding is why this was cheap and why the same thing is not available for a +typed ~defstruct~: every SBCL mechanism of this kind rests on an instance +carrying a pointer to its shape, and a dyn instance *has a header* where a +flat struct does not. + +** What it does +#+begin_src lisp +(defclass point [x y]) +;; ... a program runs, builds instances, holds them in globals ... +(defclass point [x z]) ; C-c C-c, with the file's callers if any +;; every live instance, at its next touch: +;; :x keeps the value it had (matched by name) +;; :z appears as nil (gained) +;; :y is gone (dropped) +;; the object is the same object (identity preserved) +;; (class-of p) is still :point (so every method still reaches it) +#+end_src + +Nothing is enumerated and no heap is walked, which is the part the old +deferral thought was missing. The redefinition is O(1) — one registry entry +updated — and the work is paid per instance, once, by whoever touches it. + +** The three pieces +*** A registry, in the runtime +~runtime/flan_dyn.c~, under "Classes": one entry per class name, holding the +current slot list and a generation counter. ~flan_dyn_class_def(name, slots, +n)~ registers or re-registers one; ~slots~ is the names packed into a single +string with newlines between. + +*Nothing in it is a collector object, and that is the whole GC argument.* A +class's name and its slots are interned ~kw_entry~ pointers — immortal, not +on the collected heap, never traced — which is the same argument the ~klass~ +header field already makes. The table itself is ~malloc~ed, append-only and +never freed. So no root is pushed for the registry, the marker has nothing to +reach in it, and a collection triggered from inside a migration cannot see a +half-built slot list. A registry of dyn vectors would have needed all three +of those worried about. + +*** A generation, in the instance's header +A ~uint32_t~ in ~flan_obj~, *in the padding between ~mark~ and ~len~*. +~sizeof(flan_obj)~ is 48 with it and was 48 without it — the union is exactly +24 bytes (~items~, ~cap~, ~klass~), so there is no spare word inside the arm +and a field placed after the union would have cost eight bytes on every dyn +value in the heap for a word only class instances read. The obvious guess +before reading the struct is that ~view.is_vec~ leaves four spare bytes at +offset 44; it does not. That word is the *view* arm's and is aliased with +~klass~ — the arms overlap, so nothing inside the union is free. The free +bytes are the ones alignment already wastes, in front of it. + +The number is asserted rather than commented: ~flan_dyn_obj_size()~ is a new +entry point and ~dyn_ops.c~'s ~classes~ mode checks it against 48, so a later +field that pushes it out fails a test instead of costing that silently. + +Zero means "built before any definition was registered", which is every +instance of every program that was built and never reloaded. The first +registration of a name lands on 1, so those instances migrate exactly once, +the first time the class is redefined under them — which is what makes a +program that predates this correct rather than merely unbroken. + +*** A registration thunk, per reload +~lib/session.ml~'s ~change~ emits one nullary function per evaluation that +declared any class, calling ~flan_dyn_class_def~ once per class, and hands it +to ~Emit.redefinition~/~X86.redefinition~ as ~?call~ — the mechanism ~C-x +C-e~ already uses, where the agent finds ~flan_reload_call~ by ~dlsym~ and +runs it after the module's bodies are published and on the game thread. Both +backends, unchanged: the thunk is an ordinary Tast function and the backends +lower ~Rt~ calls generically. + +*It has to be a thunk and not something in the constructor.* The case this +exists for is a class redefined and *not* constructed — old instances touched +after the edit — and a registration that only ran at construction would never +fire for it. That is the same reasoning that rules out registering from +~main~: reload modules re-execute their definitions, not their program. + +*Every* class in the form is registered, not only the ones whose slots +changed, because a class the registry has never seen has to arrive somehow. +The bump is what is conditional: re-registering an identical list changes +nothing, so a ~C-c C-k~ costs one comparison per class and migrates nothing. +Without that rule every save would migrate every instance in the program. + +** Where a migration happens +~want_map~ (so ~get~, ~put~ and ~has-key?~), ~flan_dyn_len~'s map arm, and +~dyn_equal~'s. CLHS asks for "no later than the next time a slot of that +instance is read or written"; those are the three places that read or write +the slot *set*. + +~render~ is deliberately not one of them. It runs inside trap reporting, +where the heap is whatever the trap left, and a printer that reallocates an +object's storage is not something to have on that path. So a stale instance +prints its old slots until something touches it. CLHS's +"implementation-dependent time" allows it and the printer stays a printer. + +The migration rebuilds the entry block rather than compacting it in place, +and writes the slots in the *class's* order. One ~malloc~ per instance per +redefinition, and the property bought is that a migrated instance is +indistinguishable from a freshly constructed one — ~dyn_equal~ compares maps +by lookup and would not have cared, but ~len~ and ~render~ work in insertion +order and would have. + +** Equality across generations: migrate first +Two instances of one class built either side of a redefinition, holding equal +values for the slots the class still has, *are equal*. ~dyn_equal~ migrates +both operands before comparing the tag or the length. The decision recorded: +equality is over the class as it is now, not over the shapes the two values +happened to be born with. The alternative — comparing key sets literally — +would answer "not equal" about a difference the class no longer has, and +would make the answer depend on which of the two had been touched since. + +** The registry is advisory, and this is the honest cost +A class instance is an open map. ~put~ takes any key — FIX.org already defers +refusing ~(get p :z)~ — so a program can write a key the class never +declared, and the next migration *drops it*, because the migration's rule is +that an instance's keys are the class's slots. + +That is data loss, and there is no enforcement behind it to make the loss +impossible. Enforcing would mean refusing an unknown key at ~put~, which is +the static slot discipline the dyn side deliberately does not have, and the +research names this exact risk: "if ~put~ of an arbitrary key stays legal, +the registry describes an intention rather than a constraint". It describes +an intention. ~test_dev.ml~ pins the loss as behaviour rather than leaving it +to be discovered. + +** What the session had to give up to allow it, and what it kept +A slot added or removed is a *constructor signature change*, which +~session.ml~'s ~compatible~ refuses by default — a call site compiled to pass +two dyn words into a three-parameter body leaves the third holding a +register, and a dyn word that is not a value is a wild pointer rather than a +wrong answer. Item 6's own line above — the constructor "is an ordinary +~defn~ — so its arity refusal, its cell in a dev build and its behaviour +under redefinition are the ones every function already has" — is true and +was read one step too far: what every function already has *is* the signature +refusal, so a class could not change its slots at all. That was the first +thing this lane had to fix, before any of the runtime work could be reached. + +The refusal is now lifted for a ~defclass~ constructor *and nothing else*, +and only when no compiled caller is left behind. In practice the checker gets +there first: the whole declaration list is re-checked against the new +constructor before ~compatible~ is consulted, so a declaration still calling +it with the old count is refused at the call site with a line number — which +is the sentence a reader sees, and is what ~test_session.ml~ pins. What +~change~ adds is the *reason* held locally rather than inherited: a caller +that type-checks under the new arity is one whose source changed, so it is in +this form and is republished with the class. The walk over ~t.program~'s +bodies asserts that instead of assuming it, and if it ever fires the answer +is a refusal naming the callers rather than a wild pointer. + +Not touched: typed ~defstruct~ layout changes and typed global type changes +keep their refusals. ~SBCL-REDEFINITION-NOTES.md~ §5 is why — a flat unboxed +struct has no header to stamp and cannot change size in place, so none of +this is available there at any price. + +** Deferred, with the reason +- *~update-instance-for-redefined-class~ itself*, the user hook. CLOS hands + the discarded slots' values to a method so a coordinate change can be + written by hand; the obvious Flan spelling is a generic, + ~(defmethod update-for-redefined point [p added discarded] ...)~, riding + the dispatch that already exists. Left out of v1 because the automatic + half — name matching — is the half that makes redefinition usable, and the + hook is what makes it *expressive*. Nothing about the design blocks it: + the migration already computes both lists. +- *Initargs validation.* CLOS's default method signals on an initarg the + class does not declare. There are no initargs here; construction is + positional. +- *Refusing an unknown ~put~*, which is what would turn the registry from + advisory into enforcing. Same gate as the deferred ~(get p :z)~ check. +- *Rolling a failed migration back.* SBCL wraps the user hook in + ~nlx-protect~ so a signalling method leaves the instance on its old + wrapper. With no user hook the migration cannot signal, so there is nothing + to roll back yet; it becomes a real question the day the hook lands. +- *The whole-program build registers nothing.* A program that is built and + never reloaded has no registry at all, its instances carry generation zero, + and everything behaves exactly as it did before this existed. Registering + at startup would need an initialiser in both backends' executable paths and + buys only introspection — there is no *stale* instance in a program whose + classes never changed. + +** Pinned +- ~test/dyn_ops.c~'s ~classes~ mode, run by ~test_dyn.ml~: the object size, + an unregistered class behaving as before, a slot gained, a slot lost, both + at once, three definitions an instance slept through, a re-registration of + the same list migrating nothing, two generations compared, a plain map + untouched by any of it, and two thousand instances migrated while the + collector runs. Driven from C because the event has no Flan spelling: a + class definition changes between two *modules*, so no single program can + see one change. +- ~test_sanitize.ml~'s ~dyn_sweep~ runs that mode under ASan and UBSan. It is + the one mode that frees an object's entry block while the object stays live + and reachable, which is the shape a wrong marker would show as a + use-after-free and as nothing at all in the checked build. +- ~test_dev.ml~, "a class redefined under its own instances": a real daemon + over ~test/programs/dev-classes.flan~, instances pushed into a dyn global + by ~C-x C-e~ thunks, then four ~C-c C-c~ class redefinitions with the + program's own heap answering between them — gained slot nil, kept slot + kept, count right, *a generic still dispatching after the migration*, an + untouched instance migrating on its own first touch, a lost slot gone, the + third generation, the tag surviving, an unchanged redefinition migrating + nothing, and a raw-~put~ key dropped by the next real one. +- ~test_session.ml~: a slot added and a slot removed both accepted, the + module carrying ~flan_dyn_class_def~ and ~flan_reload_call~ and the packed + slot list, an unchanged class registering anyway, the refusal when a + compiled caller is in the way, and the same edit accepted when the caller + comes with it. + +** Found on the way +~lib/x86.ml~'s ~redefinition~ header said "the transient ~flan_reload_call~ +thunk is not built here, and is refused by name". It has been built there for +some time — the code is at the bottom of the same function — and the comment +had simply not moved with it. Corrected rather than worked around; this +lane's thunk goes through that path on every ~C-c C-c~ of a class, which is +the default backend for ~flan dev~. diff --git a/lib/emit.ml b/lib/emit.ml index 55a0421..a85c1ef 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -3784,6 +3784,7 @@ declare i64 @flan_dyn_vec_new() declare i64 @flan_dyn_map_new() declare i64 @flan_dyn_map_new_class(i64) declare i64 @flan_dyn_class_of(i64) +declare void @flan_dyn_class_def(i64, ptr, i64) declare i64 @flan_dyn_kw(ptr, i64) declare i64 @flan_dyn_map_get(i64, i64) declare void @flan_dyn_map_set(i64, i64, i64) diff --git a/lib/session.ml b/lib/session.ml index 49daeb5..0e99ff2 100644 --- a/lib/session.ml +++ b/lib/session.ml @@ -204,8 +204,8 @@ let known t n = (* Everything here is a change that would load cleanly and then be wrong. The house rule (NEXT.md, Watch for) says recognise it and refuse with the reason, so each one names what it would have broken. *) -let compatible ?(origin = fun _ -> None) ~loc (old_ : Tast.program) - (new_ : Tast.program) = +let compatible ?(origin = fun _ -> None) ?(relaxed = []) ~loc + (old_ : Tast.program) (new_ : Tast.program) = let find_fn p n = List.find_opt (fun (f : Tast.fn) -> String.equal f.Tast.name n) p.Tast.fns in @@ -230,7 +230,16 @@ let compatible ?(origin = fun _ -> None) ~loc (old_ : Tast.program) and caller tracking, none of which exist — so this stays a refusal until they do, rather than becoming a silent mismatch. See plan.org, Hot reload, and open decision #6. *) - if not same then + (* [relaxed] is the caller saying it has already proved, by a + narrower argument than this one can make, that no compiled call + site passes the old arguments. Today that caller is [change], + about a (defclass ...) constructor whose slot list changed, and + only when nothing in the running program still calls it — see the + "A class whose slots changed" block in [eval], which walks the + callers and makes the refusal itself, naming the ones in the way. + Nothing else sets it, and a name that is not in it is refused here + as it always was. *) + if not same && not (List.mem f.Tast.name relaxed) then (* ── When the name is not one the programmer wrote ────────────── A generic's instantiations are named [sort-i32], [sort-f32] and so on, and the mangling carries only the *type variables* @@ -633,7 +642,101 @@ let eval ?(origin = "") ?pause t src : change = (* Nothing above this line has changed the session. A [Loc.Error] from here leaves it exactly as it was. *) let program, env = Check.program_with_env decls in - compatible ~origin:(Check.instantiation_origin env) ~loc t.program program; + (* ── A class whose slots changed ────────────────────────────────────── + Every (defclass ...) in what arrived, and for the ones the session + already had, whether the slot list is the one it had. A changed list is + a changed constructor signature, which [compatible] refuses by default + and for a good reason — a call site compiled to pass two dyn words into + a three-parameter body leaves the third holding whatever was in the + register, and a dyn word that is not a value is a wild pointer, not a + wrong answer. + + So the refusal stands wherever a compiled caller exists, and is lifted + exactly where one cannot: when nothing in the running program still + names the constructor, or when everything that does is being recompiled + by this same evaluation. That is the C-c C-k case — reload the file and + the class and its callers land together — and it is what makes + redefining a class in the dev loop possible at all without the versioned + functions and tracked call sites plan.org's open decision #6 describes. + + **The checker gets there first, and this is still not redundant.** By + the time control reaches here the whole declaration list has been + checked against the new constructor, so a declaration still calling it + with the old argument count has already been refused, at the call site, + with a line number — which is the sentence a reader actually sees, and + is why [test_session.ml] pins that one. What remains is the *reason* the + relaxation is sound, held locally instead of inherited from another + pass: a caller that type-checks under the new arity is a caller whose + source changed, so it is in this form and is republished with the class. + The walk below asserts that rather than assuming it. If it ever fires, + something upstream has stopped being true and the answer is a refusal + and not a wild pointer. + + A class whose slot list did not change is not in here at all: its + constructor has the same signature and goes through [compatible] + untouched. *) + let class_slots (ds : Ast.decl list) n = + List.fold_left + (fun acc (d : Ast.decl) -> + match d.Ast.d with + | Ast.Defclass (m, slots) when String.equal m n -> + Some (List.map fst slots) + | _ -> acc) + None ds + in + let incoming_classes = + List.filter_map + (fun (d : Ast.decl) -> + match d.Ast.d with + | Ast.Defclass (n, slots) -> Some (n, List.map fst slots) + | _ -> None) + incoming + in + let relaxed = + List.filter_map + (fun (n, slots) -> + match class_slots t.decls n with + | Some old when old <> slots -> + (* Every function of the running program that calls the + constructor or takes its address, minus the ones this + evaluation is recompiling. [Tast.walk] rather than a match on + the body's head: a constructor call can be anywhere in an + expression, and a missed one is the wild-pointer case above. *) + let stale = + List.filter_map + (fun (f : Tast.fn) -> + if List.exists (String.equal f.Tast.name) names then None + else begin + let hit = ref false in + let see (e : Tast.expr) = + match e.Tast.e with + | Tast.Call (m, _) when String.equal m n -> hit := true + | Tast.FnAddr (Tast.Flanfn m) when String.equal m n -> + hit := true + | _ -> () + in + List.iter (Tast.walk see) f.Tast.body; + List.iter (Tast.walk see) f.Tast.fdefers; + if !hit then Some f.Tast.name else None + end) + t.program.Tast.fns + in + if stale = [] then Some n + else + fail loc + "%s gains or loses slots, so its constructor takes a different \ + number of arguments, and %s still call%s it with the old \ + one. Evaluate the whole file (C-c C-k) so the class and its \ + callers are compiled together, or restart." + n (String.concat ", " stale) + (if List.length stale = 1 then "s" else "") + (* Unchanged slots: the constructor has the signature it had, and + [compatible] has nothing to say about it. *) + | _ -> None) + incoming_classes + in + compatible ~origin:(Check.instantiation_origin env) ~relaxed ~loc t.program + program; compatible_enums ~loc t.decls decls; (* ── The bodies to install ──────────────────────────────────────────── The names the form declared that have a body in the checked program — @@ -697,7 +800,63 @@ let eval ?(origin = "") ?pause t src : change = program.Tast.globals) names in - let ir = redefinition t ~consts program ~fns in + (* ── Telling the runtime what the classes now are ───────────────────── + A (defclass ...) is compile-time sugar for a constructor [defn], so + nothing about it reaches the running process except a function body — + which is why redefining one used to be silent, and why the instances + already in the program kept their old slots for ever. + + What closes that is one call per class into + [runtime/flan_dyn.c]'s registry, carried by a thunk the agent runs after + the module's bodies are published and on the game thread, which is the + mechanism [C-x C-e] already uses. It has to be a thunk and not something + in the constructor: the case this exists for is a class redefined and + *not* constructed — old instances touched after the edit — and a + registration that only ran at construction would never fire. + + Every class in the form, not only the ones whose slots changed. The + registry ignores a re-registration of the same list, so a C-c C-k costs + a comparison per class and migrates nothing; and a class whose + definition the registry has never seen has to arrive somehow. *) + let class_thunk = + if incoming_classes = [] then None + else begin + t.thunks <- t.thunks + 1; + let tname = Printf.sprintf "classdef/%d" t.thunks in + let str s : Tast.expr = { Tast.e = Tast.Str s; ty = Types.String; loc } in + let body = + List.map + (fun (n, slots) : Tast.expr -> + let kw : Tast.expr = + { Tast.e = Tast.Prim (Tast.Rt "flan_dyn_kw", [ str n ]); + ty = Types.Dyn; loc } + in + (* The slot names in one string, newline between: the runtime + splits them. A dyn vector would have been the obvious shape + and is the wrong one — it is a collector object, so the + registry would hold something the marker has to reach, where + a packed string reaches interned keywords that are immortal + already. *) + { Tast.e = + Tast.Prim (Tast.Rt "flan_dyn_class_def", + [ kw; str (String.concat "\n" slots) ]); + ty = Types.Unit; loc }) + incoming_classes + in + Some + { Tast.name = tname; params = []; ret = Types.Unit; body; + fdefers = []; fparent = None; floc = loc; + slots = [||]; snames = [||] } + end + in + let ir = + match class_thunk with + | None -> redefinition t ~consts program ~fns + | Some th -> + redefinition t ~consts ~call:th.Tast.name + { program with Tast.fns = program.Tast.fns @ [ th ] } + ~fns:(fns @ [ th.Tast.name ]) + in let allocates = List.exists (fun (g : Tast.global) -> not (known t g.Tast.gname)) @@ -716,7 +875,12 @@ let eval ?(origin = "") ?pause t src : change = t.decls <- decls; t.program <- program; t.env <- env; - { ir; x86 = t.x86; names; fns; installs = fns <> [] || allocates || consts <> [] } + (* [class_thunk] counts: a form that is only a (defclass ...) already + installs its constructor, but a module carrying nothing but the + registration still has something for the program to run. *) + { ir; x86 = t.x86; names; fns; + installs = + fns <> [] || allocates || consts <> [] || class_thunk <> None } (* ── Evaluating an expression ──────────────────────────────────────── *) diff --git a/lib/x86.ml b/lib/x86.ml index 7da8fd9..b3419cf 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -4690,9 +4690,15 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false) meeting for the first time has no startup to have missed. [emit.ml] answers it the same way. - {b The scope, and it is still narrower than [Emit.redefinition]'s.} The - transient [flan_reload_call] thunk is not built here, and is refused by name - -- this file's idiom for a case it has not earned the right to compile. *) + {b The scope, and it is still narrower than [Emit.redefinition]'s.} What is + narrower is the IR this backend covers at all: a form it cannot lower is + refused by name, which is this file's idiom for a case it has not earned the + right to compile. The [flan_reload_call] thunk is {i not} one of them -- it + is emitted at the bottom of this function, the same as in [emit.ml], and the + agent finds it by [dlsym] either way. This note used to say it was refused; + the code moved and the sentence did not. Both a [C-x C-e] expression and the + class-registration thunk a redefined [defclass] carries go through it, and + [flan dev] takes this backend unasked. *) let redefinition ~checks ?(dev = true) ?(known = fun _ -> true) ?(retains = true) ?(consts = []) ?call (p : Tast.program) ~fns : string = if not dev then diff --git a/runtime/flan_dyn.c b/runtime/flan_dyn.c index 062a821..82898f0 100644 --- a/runtime/flan_dyn.c +++ b/runtime/flan_dyn.c @@ -229,6 +229,27 @@ typedef struct flan_obj { struct flan_obj *next; /* every object ever allocated, newest first */ uint8_t kind; uint8_t mark; + /* OBJ_MAP with a [klass] only: the generation of the class definition this + instance was built against. Compared against the registry's current + generation on every access that observes the slot set, and a mismatch is + a lazy migration — see [class_sync] and "Classes" below. + + It lives *here*, in the padding that [kind] and [mark] leave in front of + [len]'s alignment, and that placement is the whole reason the field is + free: [sizeof(flan_obj)] is 48 with it and was 48 without it. The union + is exactly 24 bytes — [items], [cap], [klass] fill it — so there is no + spare word inside the arm, and a field after it would have cost every + dyn object in the heap eight bytes for a word only class instances read. + [flan_dyn_obj_size] answers the number and dyn_ops.c's [classes] mode + asserts it, so a later field that pushes it past 48 fails a test rather + than costing that silently. + + Zero means "built before any class definition was registered", which is + also the answer for every map that is not an instance. The registry's + first registration of a name lands on 1, so a gen-0 instance of a + registered class migrates once, which is what makes a program built + before this existed correct rather than merely unbroken. */ + uint32_t gen; int64_t len; /* bytes of a text, elements of a vec or entries of a map */ union { @@ -897,6 +918,7 @@ static flan_obj *gc_alloc(uint8_t kind, int64_t extra) { o->next = gc_all; o->kind = kind; o->mark = 0; + o->gen = 0; o->len = 0; memset(&o->u, 0, sizeof o->u); gc_all = o; @@ -1100,6 +1122,221 @@ flan_dyn flan_dyn_map_new(void) { return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); } +/* ── Classes ─────────────────────────────────────────────────────────── + * + * The registry a redefined (defclass ...) updates, and the lazy migration + * that makes the instances built against the old definition answer the new + * one. This is CLHS 4.3.6 — [update-instance-for-redefined-class] — with the + * user hook left out; docs/SBCL-REDEFINITION-NOTES.md is where the protocol + * was read off and candidate C is this. + * + * **Why a registry at all, when a class instance is already just a map.** + * Because a map cannot be asked what it is *supposed* to hold. The instance + * knows the keys it has; only the class knows the keys it ought to have, and + * "ought to have" is the whole content of a redefinition. So one entry per + * class name, holding the current slot list and a generation, and an + * instance holds the generation it was built against. + * + * **Why nothing here is a GC object.** A class's name and its slots are + * *names*, and [flan_dyn_kw]'s entries are interned, immortal and not on the + * collector's heap — the same argument the [klass] field makes one screen up. + * The table below is [malloc]ed, append-only and never freed, so the marker + * has nothing to trace here and no root has to be pushed for it. A registry + * of dyn vectors would have needed both, and would have needed them to + * survive a collection triggered from inside a migration. + * + * **What the registry does not do.** It does not constrain [put]. A class + * instance is an open map — FIX.org already defers refusing [(get p :z)] — + * so a key nobody declared can be written to one, and the migration below + * will *drop* it at the next redefinition, because its rule is that an + * instance's keys are the class's slots. That is real data loss and it is + * written down as such in FIX.org rather than dressed up as enforcement. + * + * **Where a migration happens.** [want_map], so every [get], [put] and + * [has-key?]; [flan_dyn_len]'s map arm; and [dyn_equal]'s, so two instances + * of different generations are compared as the class currently defines them + * rather than by the shapes they happen to be carrying. CLHS asks for "no + * later than the next time a slot is read or written" and those are the + * three places that read or write the slot *set*. + * + * [render] is deliberately not one of them. It runs inside trap reporting, + * where the heap is whatever the trap left, and a printer that reallocates + * an object's storage is not something to have on that path. A stale + * instance therefore prints its old slots until something touches it, which + * CLHS's "implementation-dependent time" allows and which is worth the + * printer staying a printer. */ + +/* Interning, which is under "Keywords" further down. This file includes no + * header of its own — every entry point is written out in flan_dyn.h and + * defined here in the order the sections read best — so the one call that + * runs ahead of its definition declares itself. */ +flan_dyn flan_dyn_kw(const uint8_t *p, int64_t n); + +typedef struct class_entry { + kw_entry *name; + kw_entry **slots; /* interned, immortal, in declaration order */ + int64_t nslots; + uint32_t gen; +} class_entry; + +static class_entry *classes; +static int64_t classes_n, classes_cap; + +static class_entry *class_find(kw_entry *name) { + int64_t i; + for (i = 0; i < classes_n; i++) + if (classes[i].name == name) return &classes[i]; + return NULL; +} + +/* The generation a new instance of [name] is stamped with. Zero for a class + * no definition has been registered for, which is every class in a program + * that was built and never reloaded: nothing has changed shape, so nothing + * needs to migrate, and the registry earns its keep only once an editor has + * sent a new definition. */ +static uint32_t class_gen(kw_entry *name) { + class_entry *e = class_find(name); + return e == NULL ? 0u : e->gen; +} + +/* One class's current slot list, as the compiler's per-reload thunk hands it + * over: the class's name as a keyword, and the slot names packed into one + * string, newline between and no leading colons — the shape a string literal + * already crosses in, rather than a dyn vector this would have to root. + * + * The generation is bumped only when the list actually differs. That is what + * makes C-c C-k idempotent: reloading a file re-runs every one of its class + * definitions, and a bump per reload would migrate every instance in the + * program every time anybody saved, for no change. */ +void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n) { + kw_entry *k; + kw_entry **list = NULL; + int64_t count = 0, i, start; + class_entry *e; + if (flan_dyn_tag(name) != FLAN_DYN_TAG_KEYWORD) + /* No location: the caller is the thunk a reload runs, which has no + source position of its own — the class's own [defclass] is where a + reader would look, and it is not on any stack by the time this runs. + Unreachable from written Flan in any case; only the compiler emits + this call, and it emits a keyword. */ + trap1(NULL, 0, TYPE_TRAP, "class definition", + "a class name is a keyword", name); + k = dyn_kw(name); + if (n < 0) n = 0; + /* Count first, then fill: one allocation of the right size, and an empty + * class — (defclass marker []) is in the corpus — allocates nothing. */ + for (i = 0, start = 0; i <= n; i++) + if (i == n ? i > start : slots[i] == '\n') { + if (i > start) count++; + start = i + 1; + } + if (count > 0) { + list = (kw_entry **)malloc((size_t)count * sizeof *list); + if (list == NULL) trap_oom(count * (int64_t)sizeof *list); + count = 0; + for (i = 0, start = 0; i <= n; i++) + if (i == n ? i > start : slots[i] == '\n') { + if (i > start) + list[count++] = dyn_kw(flan_dyn_kw(slots + start, i - start)); + start = i + 1; + } + } + e = class_find(k); + if (e != NULL) { + int same = e->nslots == count; + if (same) + for (i = 0; i < count; i++) + if (e->slots[i] != list[i]) { same = 0; break; } + if (same) { free(list); return; } + free(e->slots); + e->slots = list; + e->nslots = count; + /* Wrapping is not a correctness question — what matters is that the new + * generation differs from the one the live instances carry — but zero is + * reserved for "no definition registered", so it is stepped over. */ + e->gen = e->gen + 1u; + if (e->gen == 0u) e->gen = 1u; + return; + } + if (classes_n == classes_cap) { + int64_t cap = classes_cap ? classes_cap * 2 : 8; + class_entry *t = + (class_entry *)realloc(classes, (size_t)cap * sizeof *t); + if (t == NULL) trap_oom(cap * (int64_t)sizeof *t); + classes = t; + classes_cap = cap; + } + classes[classes_n].name = k; + classes[classes_n].slots = list; + classes[classes_n].nslots = count; + /* One, never zero: an instance built before this registration carries zero + * and has to be seen as stale, because the definition it was built from is + * exactly the one nobody recorded. */ + classes[classes_n].gen = 1u; + classes_n++; +} + +/* The migration. [o] is left holding exactly the class's current slots, in + * the class's order, with the values it already had for the ones it still + * has and nil for the ones it has just gained — which is precisely the + * property CLHS 4.3.6 guarantees, matched by name, with the instance's + * identity preserved because none of this allocates a new object. + * + * Rebuilt into a fresh block rather than compacted in place, and the order is + * the class's rather than the instance's, so that a migrated instance is + * indistinguishable from one the constructor has just built. [dyn_equal] + * compares maps by lookup and would not have cared; [render] and [len] print + * and count in insertion order and would have. One malloc per instance per + * redefinition is the price, and a migration happens once. + * + * Nothing here allocates on the collector's heap, so no collection can run + * part-way through and see an object whose [len] and [items] disagree. + * + * Nor can it free a block something above it is walking. The block it frees + * is [o]'s, and every caller syncs [o] before it starts walking [o] — so a + * re-entry through a nested [dyn_equal], including a map used as a key of + * itself, finds [o] already current and returns at the generation compare. + * The key scan here uses the interned identity compare and calls + * [dyn_equal] not at all, so it cannot re-enter from inside. */ +static void class_sync(flan_obj *o) { + class_entry *e; + flan_dyn *fresh = NULL; + int64_t i, j; + if (o->kind != OBJ_MAP || o->u.v.klass == NULL) return; + e = class_find(o->u.v.klass); + if (e == NULL || e->gen == o->gen) return; + if (e->nslots > 0) { + fresh = (flan_dyn *)malloc((size_t)e->nslots * 2 * sizeof *fresh); + if (fresh == NULL) trap_oom(e->nslots * 2 * (int64_t)sizeof *fresh); + } + for (j = 0; j < e->nslots; j++) { + flan_dyn v = dyn_make(BOX_NIL, 0); + for (i = 0; i < o->len; i++) { + flan_dyn key = o->u.v.items[i * 2]; + /* [flan_dyn_tag] and not a bare [dyn_box]: a float is not boxed at + all, so its payload bits can read as any box tag, and reading a + non-keyword's payload as a [kw_entry *] is a wild pointer. A raw + [put] can have left a float — or anything else — in here. */ + if (flan_dyn_tag(key) == FLAN_DYN_TAG_KEYWORD + && dyn_kw(key) == e->slots[j]) { + v = o->u.v.items[i * 2 + 1]; + break; + } + } + fresh[j * 2] = dyn_make(BOX_KW, (uint64_t)(uintptr_t)e->slots[j]); + fresh[j * 2 + 1] = v; + } + /* Charged the way [map_set]'s growth is, in both directions: a class that + * lost slots gives the bytes back, or the trigger drifts up by whatever + * every migration in the program ever released. */ + gc_bytes += (e->nslots - o->u.v.cap) * 2 * (int64_t)sizeof(flan_dyn); + free(o->u.v.items); + o->u.v.items = fresh; + o->u.v.cap = e->nslots; + o->len = e->nslots; + o->gen = e->gen; +} + /* The same map with a shape tag on it: what a (defclass ...) constructor * calls. [k] is a keyword and anything else traps by name — the compiler * hands it the class's own name and nothing else can reach this. */ @@ -1112,6 +1349,10 @@ flan_dyn flan_dyn_map_new_class(flan_dyn k) { o->u.v.items = NULL; o->u.v.cap = 0; o->u.v.klass = dyn_kw(k); + /* Stamped at construction against whatever the registry currently says, so + * an instance built by the constructor this reload just installed is + * already current and never migrates. */ + o->gen = class_gen(o->u.v.klass); return dyn_make(BOX_OBJ, (uint64_t)(uintptr_t)o); } @@ -1119,6 +1360,8 @@ flan_dyn flan_dyn_map_new_class(flan_dyn k) { * traps. Absence is an answer here for the reason it is one in [map_get] — * asking what class a value is, is a question every value can be asked, and * an ordinary map, a number and nil all truthfully answer "none". */ +int64_t flan_dyn_obj_size(void) { return (int64_t)sizeof(flan_obj); } + flan_dyn flan_dyn_class_of(flan_dyn v) { flan_obj *o; if (flan_dyn_tag(v) != FLAN_DYN_TAG_MAP) return flan_dyn_nil(); @@ -1609,6 +1852,14 @@ static int dyn_equal(flan_dyn a, flan_dyn b, int depth) { int64_t i, j; if (x == y) return 1; if (depth >= EQ_DEPTH) return 0; + /* Two instances of one class built either side of a redefinition hold + different key sets, and comparing those key sets would answer "not + equal" about a difference the class no longer has. So both are brought + to the current definition first and the comparison is then the ordinary + one. The decision this records: equality is over the class as it is + now, and not over the shapes the two values were born with. */ + class_sync(x); + class_sync(y); /* The shape tag is part of the value. Two instances of one class compare * by their entries as any two maps do; an instance and a plain map with * the same entries do not, which is Clojure's answer for a record beside @@ -1793,7 +2044,15 @@ flan_dyn flan_dyn_view_flat(void *data, int64_t len, int32_t elem) { } flan_dyn flan_dyn_len(flan_dyn v) { - if (is_text(v) || is_map(v)) return flan_dyn_from_i64(dyn_obj(v)->len); + if (is_text(v)) return flan_dyn_from_i64(dyn_obj(v)->len); + /* A map's length is its slot count, so a stale instance would answer the + count of a definition that no longer exists. Migrated first for the same + reason [get] is. */ + if (is_map(v)) { + flan_obj *o = dyn_obj(v); + class_sync(o); + return flan_dyn_from_i64(o->len); + } if (is_vec(v)) { flan_obj *o = dyn_obj(v); if (o->kind == OBJ_VIEW) return flan_dyn_from_i64(view_len("len", o)); @@ -1920,8 +2179,15 @@ static int64_t map_find(flan_obj *o, flan_dyn k) { } static flan_obj *want_map(const char *op, flan_dyn m, flan_dyn k) { + flan_obj *o; if (!is_map(m)) trap2(NULL, 0, TYPE_TRAP, op, "only a map answers it", m, k); - return dyn_obj(m); + o = dyn_obj(m); + /* The lazy half of the redefinition protocol: [get], [put] and [has-key?] + all arrive here, and CLHS 4.3.6 asks for the update to happen no later + than the next read or write of a slot. A plain map returns from the + first line of [class_sync] untouched. */ + class_sync(o); + return o; } flan_dyn flan_dyn_map_get(flan_dyn m, flan_dyn k) { diff --git a/runtime/flan_dyn.h b/runtime/flan_dyn.h index 49643de..5806ebc 100644 --- a/runtime/flan_dyn.h +++ b/runtime/flan_dyn.h @@ -94,6 +94,34 @@ flan_dyn flan_dyn_map_new_class(flan_dyn k); * — an ordinary map included. Never traps. */ flan_dyn flan_dyn_class_of(flan_dyn v); +/* A class definition, registered or re-registered: [name] is the class's name + * as a keyword and [slots]/[n] is its slot names packed into one string, + * newline between and no leading colons. The compiler emits one call per + * (defclass ...) into the thunk a reload runs, so a definition that changed + * lands here before anything touches an instance. + * + * The generation moves only when the slot list really differs, so re-running + * a file's definitions unchanged — every C-c C-k — costs a comparison and + * migrates nothing. When it does move, every instance built against an + * earlier definition migrates lazily at its next [get], [put], [has-key?], + * [len] or equality comparison: slots the class still has keep their values + * matched by name, slots it has gained appear as nil, and keys it no longer + * declares are dropped. The instance's identity is preserved throughout; + * this is CLHS 4.3.6 without the user hook. + * + * The drop is unconditional, which is the honest cost of a class instance + * being an open map: a key written by a raw [put] that the class never + * declared is dropped by the next migration too. The registry describes the + * class's intention and does not enforce it. */ +void flan_dyn_class_def(flan_dyn name, const uint8_t *slots, int64_t n); + +/* [sizeof(flan_obj)], for the one test that asserts it. The generation a + * class instance carries was fitted into the padding between [mark] and + * [len] precisely so that this number did not move; a field that pushed it + * up would cost every dyn value in the heap, so the number is asserted + * rather than left to a comment. */ +int64_t flan_dyn_obj_size(void); + /* A keyword: :foo as a run-time value. Interned — the runtime keeps one entry * per distinct name forever, so two keywords with the same bytes are the same * word and equality is an identity compare, never a memcmp. The entries are diff --git a/test/dyn_ops.c b/test/dyn_ops.c index 50ac322..be8711f 100644 --- a/test/dyn_ops.c +++ b/test/dyn_ops.c @@ -1017,6 +1017,209 @@ static void refuse(const char *what) { exit(3); } +/* ── Redefining a class ──────────────────────────────────────────────── + * + * CLHS 4.3.6 as flan_dyn.c implements it: a class definition is registered, + * an instance is stamped with the generation it was built against, and the + * first access after the definition changes migrates the instance — slots + * kept by name, gained slots nil, dropped slots gone, identity preserved. + * + * Driven from C rather than from Flan because the *event* being tested has + * no Flan spelling: [flan_dyn_class_def] is called by a thunk the reload + * agent runs, so a single program can never see its class change. The + * daemon case in test_dev.ml is the same protocol with a real editor at one + * end; this is the protocol itself, at a granularity a daemon cannot show. */ + +static flan_dyn slot(flan_dyn m, const char *name) { + return flan_dyn_map_get(m, flan_dyn_kw((const uint8_t *)name, + (int64_t)strlen(name))); +} + +static void define(const char *name, const char *slots) { + flan_dyn_class_def(flan_dyn_kw((const uint8_t *)name, + (int64_t)strlen(name)), + (const uint8_t *)slots, (int64_t)strlen(slots)); +} + +/* One instance of :point with the two slots the first definition gives it. + * Built through the same entry point a constructor uses, so it is stamped + * exactly as compiled code would stamp it. */ +static flan_dyn a_point(int64_t x, int64_t y) { + flan_dyn p = flan_dyn_map_new_class(flan_dyn_kw((const uint8_t *)"point", 5)); + flan_dyn_map_set(p, flan_dyn_kw((const uint8_t *)"x", 1), + flan_dyn_from_i64(x)); + flan_dyn_map_set(p, flan_dyn_kw((const uint8_t *)"y", 1), + flan_dyn_from_i64(y)); + return p; +} + +static void classes(void) { + flan_dyn p = flan_dyn_nil(), q = flan_dyn_nil(), plain = flan_dyn_nil(); + flan_dyn keep = flan_dyn_nil(); + int64_t i; + + flan_gc_init(); + flan_dyn_root_push(&p); + flan_dyn_root_push(&q); + flan_dyn_root_push(&plain); + flan_dyn_root_push(&keep); + + /* The word this whole design rests on. The generation went into the two + bytes of padding between [mark] and [len] precisely so that a dyn object + stayed the size it was; a later field that pushed it out would cost every + value in the heap and would do it silently. */ + check(flan_dyn_obj_size() == 48, "a dyn object is still 48 bytes"); + + /* ── Nothing registered ── + A program built and never reloaded has no registry at all, and its + instances must behave exactly as they did before any of this existed. */ + p = a_point(1, 2); + prints(p, "#point{ :x 1 :y 2}"); + check(num(slot(p, "x")) == 1, "an unregistered class reads its slot"); + check(num(flan_dyn_len(p)) == 2, "an unregistered class has its length"); + + /* ── A slot gained ── + The first registration lands on generation one, so the instance built a + moment ago — carrying zero, the generation of a definition nobody + recorded — is stale and migrates at the next touch. [:z] appears as nil + and [:x] keeps the value it was constructed with. */ + define("point", "x\ny\nz"); + check(flan_dyn_tag(slot(p, "z")) == FLAN_DYN_TAG_NIL, + "a gained slot arrives as nil"); + check(num(slot(p, "x")) == 1, "a kept slot keeps its value"); + check(num(flan_dyn_len(p)) == 3, "a gained slot is counted"); + prints(p, "#point{ :x 1 :y 2 :z nil}"); + /* And the tag survived: a migration must not turn an instance into a map. */ + check(truth(flan_dyn_eq(flan_dyn_class_of(p), + flan_dyn_kw((const uint8_t *)"point", 5))), + "a migrated instance is still an instance"); + + /* ── A slot lost ── + Dropped by name and not by position: [:y] goes, [:x] and [:z] stay where + they were. This is also the case that quietly documents the advisory + registry — a key put into an instance that the class does not declare + would be dropped by exactly this pass. */ + flan_dyn_map_set(p, flan_dyn_kw((const uint8_t *)"z", 1), + flan_dyn_from_i64(9)); + define("point", "x\nz"); + check(num(flan_dyn_len(p)) == 2, "a lost slot is gone from the length"); + check(flan_dyn_tag(slot(p, "y")) == FLAN_DYN_TAG_NIL, + "a lost slot reads as absent"); + check(num(slot(p, "z")) == 9, "a slot either side of a lost one is kept"); + prints(p, "#point{ :x 1 :z 9}"); + + /* ── Gained and lost at once, and the third bump ── + Three definitions have now been registered after the first, so the + generation has moved three times; an instance that has been touched + between each of them has followed every step. */ + define("point", "z\nw"); + check(num(slot(p, "z")) == 9, "a kept slot survives a third redefinition"); + check(flan_dyn_tag(slot(p, "w")) == FLAN_DYN_TAG_NIL, + "the third redefinition's new slot is nil"); + check(flan_dyn_tag(slot(p, "x")) == FLAN_DYN_TAG_NIL, + "the third redefinition's dropped slot is gone"); + /* The slot order is the class's, not the instance's history: a migrated + instance has to be indistinguishable from a freshly constructed one, or + [len], [render] and insertion order would each tell a different story. */ + prints(p, "#point{ :z 9 :w nil}"); + + /* ── Re-registering the same list changes nothing ── + This is what makes evaluating a whole file idempotent. If a bump + happened per registration, every save would migrate every instance in + the program for no change at all — and here it would reset [:z] to nil, + because the value below is written *after* the re-registration. */ + flan_dyn_map_set(p, flan_dyn_kw((const uint8_t *)"w", 1), + flan_dyn_from_i64(4)); + define("point", "z\nw"); + check(num(slot(p, "w")) == 4, "an unchanged redefinition migrates nothing"); + + /* ── An instance never touched across three redefinitions ── + The migration is lazy, so an instance can sit through any number of + definitions and meet only the last one. [q] is built at the generation + [p] started from and is not read until the end. */ + q = a_point(5, 6); + define("point", "z\nw\nq1"); + define("point", "z\nw\nq2"); + define("point", "z\nw\nq3"); + check(num(flan_dyn_len(q)) == 3, "a long-stale instance migrates once"); + check(flan_dyn_tag(slot(q, "x")) == FLAN_DYN_TAG_NIL, + "a long-stale instance loses what the last definition dropped"); + check(flan_dyn_tag(slot(q, "q3")) == FLAN_DYN_TAG_NIL, + "a long-stale instance gains the last definition's slots"); + check(flan_dyn_tag(slot(q, "q1")) == FLAN_DYN_TAG_NIL, + "and none of the definitions in between"); + + /* ── Mixed generations compare as the class now is ── + Two instances of one class, one built before a redefinition and one + after, holding the same values for the slots the class still has. The + decision recorded here is that they are equal: equality migrates first, + so it is over the class as it is now and not over the shapes the two + values were born with. */ + define("point", "x\ny"); + p = a_point(1, 2); /* two slots, the definition of the day */ + define("point", "x\ny\nn"); + /* Built by hand rather than through [a_point], because it is the instance + the *new* constructor would build: three slots, stamped current. */ + q = flan_dyn_map_new_class(flan_dyn_kw((const uint8_t *)"point", 5)); + flan_dyn_map_set(q, flan_dyn_kw((const uint8_t *)"x", 1), + flan_dyn_from_i64(1)); + flan_dyn_map_set(q, flan_dyn_kw((const uint8_t *)"y", 1), + flan_dyn_from_i64(2)); + flan_dyn_map_set(q, flan_dyn_kw((const uint8_t *)"n", 1), flan_dyn_nil()); + check(truth(flan_dyn_eq(p, q)), + "two generations of one class with equal slots are equal"); + + /* ── A plain map is untouched by any of it ── + No tag, so no registry entry is ever looked up: the key a class happens + to have declared is just a key here, and nothing is added, dropped or + reordered however many times :point is redefined. */ + plain = flan_dyn_map_new(); + flan_dyn_map_set(plain, flan_dyn_kw((const uint8_t *)"y", 1), + flan_dyn_from_i64(7)); + flan_dyn_map_set(plain, flan_dyn_kw((const uint8_t *)"x", 1), + flan_dyn_from_i64(8)); + define("point", "x\ny\nz\nzz"); + check(num(flan_dyn_len(plain)) == 2, "a plain map gains no slot"); + prints(plain, "{ :y 7 :x 8}"); + check(flan_dyn_tag(flan_dyn_class_of(plain)) == FLAN_DYN_TAG_NIL, + "a plain map has no class"); + + /* ── Migration under collection ── + The one thing a migration must not do is confuse the marker. It frees + the instance's entry block and installs another, so an object whose + [len] and [items] disagreed for even an instant would be a walk off the + end of a block on the next mark. Two thousand instances, held in a + rooted vec, all stale, all migrated while the heap is collecting around + them — and then read back, which is what says the values survived rather + than merely that nothing crashed. */ + flan_gc_set_floor(16 * 1024); + define("point", "x\ny"); + keep = flan_dyn_vec_new(); + for (i = 0; i < 2000; i++) flan_dyn_push(keep, a_point(i, i + 1)); + define("point", "y\nx\ndeep"); + for (i = 0; i < 2000; i++) { + flan_dyn e = flan_dyn_at(keep, flan_dyn_from_i64(i)); + /* Allocation between each migration, so a collection lands part-way + through the set and has both shapes to mark. */ + flan_dyn_map_set(e, flan_dyn_kw((const uint8_t *)"deep", 4), + flan_dyn_vec_new()); + } + flan_gc_collect(); + { + int ok = 1; + for (i = 0; i < 2000; i++) { + flan_dyn e = flan_dyn_at(keep, flan_dyn_from_i64(i)); + if (num(slot(e, "x")) != i || num(slot(e, "y")) != i + 1) ok = 0; + if (flan_dyn_tag(slot(e, "deep")) != FLAN_DYN_TAG_VEC) ok = 0; + if (num(flan_dyn_len(e)) != 3) ok = 0; + } + check(ok, "two thousand instances migrated across a collection"); + } + + flan_dyn_root_pop(4); + printf(failures == 0 ? "classes ok\n" : "classes failed\n"); +} + int main(int argc, char **argv) { flan_rt_init(argc, argv); if (argc < 2) { @@ -1034,6 +1237,10 @@ int main(int argc, char **argv) { if (strcmp(argv[1], "unrooted") == 0) { unrooted(); return 0; } if (strcmp(argv[1], "park") == 0) { park(); return 0; } if (strcmp(argv[1], "desc") == 0) { desc(); return 0; } + if (strcmp(argv[1], "classes") == 0) { + classes(); + return failures == 0 ? 0 : 1; + } if (strcmp(argv[1], "view") == 0) { view(); return failures == 0 ? 0 : 1; diff --git a/test/programs/dev-classes.flan b/test/programs/dev-classes.flan new file mode 100644 index 0000000..459aaa9 --- /dev/null +++ b/test/programs/dev-classes.flan @@ -0,0 +1,46 @@ +;;;; A class, instances of it, and a session that changes the class. +;;;; +;;;; dev-class.flan already asks whether a *method* added to a running +;;;; program reaches a call site compiled before it existed. This asks the +;;;; harder half: whether the instances already in the program survive their +;;;; class being redefined. They are ordinary dyn maps held in a dyn global, +;;;; so the reload cannot touch them — a redefinition makes a program's +;;;; globals external and never re-initialises them, which is the whole of +;;;; "edit the code, keep the sand" — and what the editor sends is a new +;;;; constructor plus a registration of the class's new slot list. The +;;;; migration happens lazily, in the runtime, at the first touch after that. +;;;; +;;;; [instances] is a global rather than a local for exactly that reason: an +;;;; expression the editor evaluates is a thunk with a frame of its own, so +;;;; anything it is supposed to still be holding an hour later has to live +;;;; somewhere the thunk is not. +;;;; +;;;; The instances are pushed by the editor rather than by [main], and that +;;;; is not incidental. A (defclass ...) whose slots change is a constructor +;;;; whose signature changes, and the session refuses that wherever a +;;;; compiled caller of the constructor is left standing — a call site that +;;;; passes two dyn words into a three-parameter body leaves the third +;;;; holding a register, and a dyn word that is not a value is a wild +;;;; pointer. A [main] calling [(point 3 4)] would be exactly such a caller, +;;;; so this program has none and the instances arrive from thunks, which +;;;; leave nothing behind. test_session.ml pins the refusal itself. +;;;; +;;;; It keeps running rather than returning, for dev-class.flan's reason: an +;;;; expression typed at the editor is a thunk the agent runs at a frame +;;;; boundary, and a parked program has none. +(import agent "vendor:agent") + +(defclass point [x y]) + +(defgeneric area [self] dyn) + +(defmethod area point [p] (* (get p :x) (get p :y))) + +(defvar instances dyn) + +(defn main [] i32 + (agent/start "/tmp/flan-dev-classes-fallback.sock") + (set instances (vec-new dyn)) + (dotimes [i 4000] + (agent/wait 5)) + 0) diff --git a/test/test_dev.ml b/test/test_dev.ml index 0f578f3..d02b7b3 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -5317,6 +5317,173 @@ let () = List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ psock; pout ]; + (* ── A class redefined under its own instances ────────────────── + CLHS 4.3.6's update protocol, end to end, with a real editor at one + end and the running program's own heap at the other. "A method added + to a running program", further up, adds a *method* to a live + program; this changes what the class *is*, + which is the case that used to be silent — a (defclass ...) is + compile-time sugar for a constructor, so redefining one replaced a + function body and told the instances nothing. + + What closes it: the module the session builds now carries a + registration of the class's new slot list, run by the agent after the + bodies are published, and the runtime migrates each instance lazily at + its next touch. Everything below is asked of the program, on its own + thread, against objects it has been holding since before the edit. + + Every answer is compared inside the expression for the reason the + block above gives: a dyn value renders to the program's stdout and a + typed [1] lands in the reply's [:value], which takes the timing out of + the test. *) + let msock = tmp "migrate.sock" and mout = tmp "migrate.out" in + (try Sys.remove msock with Sys_error _ -> ()); + let mfd = Unix.openfile mout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in + let mpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-classes.flan"; "-s"; msock |] + Unix.stdin mfd Unix.stderr + in + Unix.close mfd; + if not (listening ~pid:mpid msock) then begin + fail "the migration daemon %s (%S)" !listen_why + (In_channel.with_open_bin mout In_channel.input_all); + (try Unix.kill mpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect msock in + let said r = Option.value ~default:"" (Wire.string_field r "message") in + let value r = Option.value ~default:"" (Wire.string_field r "value") in + let ask code = + request c + (Printf.sprintf + "(:op \"eval-expr\" :code %S :file \"programs/dev-classes.flan\")" + code) + in + let redefine code = + request c + (Printf.sprintf + "(:op \"eval\" :code %S :file \"programs/dev-classes.flan\")" + code) + in + (* [what] is the claim, [code] an expression that answers 1 when it + holds. A miss reports the code as well as the answer, because at + this density the line number is not enough to say which step. *) + let holds what code = + let r = ask code in + if status r <> "ok" then fail "%s: %s" what (said r) + else if value r <> "1" then + fail "%s answered %S (%s)" what (value r) code + in + (* Two instances, built by the constructor the program was compiled + with. The first ask is retried for the class block's reason: the + agent's thread is let go only after the socket is bound. *) + let started () = status (ask "(do (push instances (point 3 4)) 1)") = "ok" in + if not (await started) then + fail "the migration daemon never reached a frame boundary" + else begin + holds "a second instance" "(do (push instances (point 5 6)) 1)"; + holds "the class the program was built with" + "(if (= (area (at instances 0)) 12) 1 0)"; + + (* ── A slot gained ── *) + let r = redefine "(defclass point [x y z])" in + if status r <> "ok" then fail "adding a slot to a class: %s" (said r) + else begin + (* The instance is the one that was pushed before the edit — same + object, same position in the same global vec — and it now + answers the new definition. This is the whole feature in three + lines: the gained slot is nil, the kept slots kept their values, + and the count is the new one. *) + holds "a gained slot is nil on an old instance" + "(if (= (get (at instances 0) :z) nil) 1 0)"; + holds "a kept slot keeps its value" + "(if (= (get (at instances 0) :x) 3) 1 0)"; + holds "the migrated instance has the new slot count" + "(if (= (len (at instances 0)) 3) 1 0)"; + (* Dispatch after migration. The generic reaches its method by the + instance's shape tag, and a migration rebuilds the instance's + entries — so this is the line that says the tag came through it. + [area] reads :x and :y, both of which the new definition still + has, so the answer is the one it always was. *) + holds "a generic still dispatches on a migrated instance" + "(if (= (area (at instances 0)) 12) 1 0)"; + (* And an instance that has not been touched since the edit is not + special: it migrates when it is asked, not when the class + changed. *) + holds "an untouched instance migrates on its own first touch" + "(if (= (len (at instances 1)) 3) 1 0)" + end; + + (* ── A slot lost, and a second generation ── + [:y] goes. Nothing calls [area] after this: its method reads :y, + which is now nil, and a generic that traps on a slot its class no + longer has is the program being wrong rather than the migration. *) + let r = redefine "(defclass point [x z])" in + if status r <> "ok" then fail "removing a slot from a class: %s" (said r) + else begin + holds "a lost slot reads as absent" + "(if (= (get (at instances 0) :y) nil) 1 0)"; + holds "a lost slot is gone from the count" + "(if (= (len (at instances 0)) 2) 1 0)"; + holds "the slots either side of it are untouched" + "(if (= (get (at instances 0) :x) 3) 1 0)" + end; + + (* ── The third redefinition ── + Three changed definitions have now been registered, so the + generation has moved three times and the instances have followed + each move. A generation that was not bumped, or was bumped to a + value an instance already carried, would leave this one stale. *) + let r = redefine "(defclass point [x z w])" in + if status r <> "ok" then fail "a third redefinition: %s" (said r) + else begin + holds "the third definition's slot count" + "(if (= (len (at instances 1)) 3) 1 0)"; + holds "the third definition's new slot is nil" + "(if (= (get (at instances 1) :w) nil) 1 0)"; + holds "and the value from before the first edit is still there" + "(if (= (get (at instances 1) :x) 5) 1 0)"; + (* The tag is not a slot and no migration touches it: [class-of] + answers what it always did, which is what keeps every method + ever written for this class reachable. *) + holds "the instance is still an instance of its class" + "(if (= (class-of (at instances 1)) :point) 1 0)" + end; + + (* ── A definition that did not change ── + Every C-c C-k re-runs a file's class definitions, and a generation + bumped per registration rather than per *change* would migrate + every instance in the program on every save. Here that would be + visible: the value written below is put into a slot the class + declares, and a spurious migration would keep it — so the + discriminating half is the raw key on the line after, which a real + migration drops and an ignored re-registration leaves alone. *) + holds "a key written straight into an instance" + "(do (put (at instances 0) :scratch 7) 1)"; + let r = redefine "(defclass point [x z w])" in + if status r <> "ok" then fail "re-evaluating an unchanged class: %s" (said r) + else + holds "an unchanged definition migrates nothing" + "(if (= (get (at instances 0) :scratch) 7) 1 0)"; + (* And the same key after a definition that *did* change, which is + the advisory registry stated as a test rather than as a hope: a + class instance is an open map, [put] accepts any key, and the next + migration drops the ones the class does not declare. FIX.org says + so in as many words. *) + let r = redefine "(defclass point [x z w q])" in + if status r <> "ok" then fail "a fourth redefinition: %s" (said r) + else + holds "a migration drops a key the class never declared" + "(if (= (get (at instances 0) :scratch) nil) 1 0)" + end; + (try Unix.close c with Unix.Unix_error _ -> ()); + (try Unix.kill mpid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] mpid) with Unix.Unix_error _ -> ()) + end; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) + [ msock; mout ]; + List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out; bsock; bout ]; Test_support.report ~label:"dev" () diff --git a/test/test_dyn.ml b/test/test_dyn.ml index 6e80f33..6d94cc3 100644 --- a/test/test_dyn.ml +++ b/test/test_dyn.ml @@ -20,6 +20,12 @@ desc an aggregate root: a struct whose dyn fields are named by a descriptor rather than pushed one at a time. Without it a collector that never freed would pass everything + classes a (defclass ...) redefined: the registry, the generation an + instance carries, and the lazy migration at its next touch — + a slot gained, a slot lost, both at once, three definitions + an instance never woke up for, two generations compared, + a plain map left alone, and two thousand instances migrated + while the collector runs nested a chain of vecs sixty-four deep, traced through one root sharing one object held three times — written through one path and read through another, and swept once when the last goes @@ -41,7 +47,7 @@ mismatched write on each of the three element kinds, and a push against a flat (slice or array) view - One binary, built once, run thirty-eight times. The build is the expensive + One binary, built once, run thirty-nine times. The build is the expensive part and the runs are milliseconds, which is what keeps this inside `dune test` rather than behind an alias. *) @@ -137,6 +143,17 @@ let () = fail "an aggregate root\n got: %S (exit %d)\n wanted: %S" out code want_desc; + (* Redefining a class, which is CLHS 4.3.6's lazy update protocol as + flan_dyn.c implements it: a registry of slot lists per class name, a + generation on the instance, and a migration at the first access after + the definition moved. Driven from C because the event has no Flan + spelling — a class definition changes between two *modules*, so no + single program can see one change. test_dev.ml's daemon case is the + same protocol with a real editor at one end. *) + let code, out, err = run "classes" in + if code <> 0 || out <> "classes ok\n" then + fail "redefining a class\n got: %S (exit %d, err %S)" out code err; + let code, out, _ = run "nested" in if code <> 0 || out <> "chain of 64 intact: yes\n" then fail "a chain of nested vecs\n got: %S (exit %d)" out code; @@ -247,7 +264,7 @@ let () = (* A line on the way out, because a test that says nothing when it passes is a test nobody can tell from a test that did not run. *) if !failures = 0 then - Printf.printf " ok the dyn runtime: %d refusals and nine runs\n" + Printf.printf " ok the dyn runtime: %d refusals and ten runs\n" (List.length refusals + List.length view_refusals) else exit 1 | _ -> print_endline "SKIP test_dyn: no clang" diff --git a/test/test_sanitize.ml b/test/test_sanitize.ml index ad37a9d..09a124e 100644 --- a/test/test_sanitize.ml +++ b/test/test_sanitize.ml @@ -306,7 +306,15 @@ let dyn_sweep () = if reported text then fail "dyn %s: sanitizer report\n%s" mode text else if code <> 0 then fail "dyn %s: exit %d under the sanitizers\n%s" mode code text) - [ "ops"; "gc"; "unrooted"; "desc"; "nested"; "sharing"; "park" ]; + (* [classes] is in here for the reason this whole function is: it is + the one mode that *frees* an object's entry block while the object + stays live and reachable. A migration swaps an instance's storage + for a differently-sized one, and its last two thousand instances do + it with the collector running around them, so a marker that read + the old block, or a [len] that outlived the block it described, + is a use-after-free here and nothing anywhere else. *) + [ "ops"; "gc"; "unrooted"; "desc"; "nested"; "sharing"; "park"; + "classes" ]; (try Sys.remove exe with Sys_error _ -> ()) (* The positive controls, which are the only evidence that a clean sweep means diff --git a/test/test_session.ml b/test/test_session.ml index 360b2e8..5b0384f 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -1061,4 +1061,96 @@ let () = | exception Loc.Error { Loc.dmsg = m; _ } -> fail "an expression that instantiates a generic: %s" m); + (* ── A class whose slots changed ──────────────────────────────── + The dev loop's half of CLHS 4.3.6. Three things have to be true of the + session for the runtime's migration to ever be reached: a changed slot + list has to be *accepted*, the module has to carry the registration that + tells the runtime about it, and the case where accepting it would be + unsound has to stay refused. test_dev.ml runs the protocol against a + real program; these are the decisions taken before any of it is built. + + Accepted first. A slot added is a constructor taking one more argument, + which is the signature change [compatible] refuses by default — and + rightly, since a call site compiled to pass two dyn words into a + three-parameter body leaves the third holding a register. Nothing in + dev-class.flan calls [point], so there is no such call site and the + refusal has nothing to protect. *) + (let t, _ = Session.create ~file:"programs/dev-class.flan" () in + match Session.eval t "(defclass point [x y z])" with + | c -> + if not (List.mem "point" c.Session.fns) then + fail "adding a slot to a class installed %s" + (String.concat " " c.Session.fns); + (* The registration, and the thunk that runs it. Without the first the + runtime never hears that the class changed; without the second the + module defines a function nothing calls. *) + if not (has c.Session.ir "flan_dyn_class_def") then + fail "a redefined class did not register its slots"; + if not (has c.Session.ir "flan_reload_call") then + fail "the class registration had nothing to run it"; + (* And the slot names, in the packed form the runtime splits. *) + if not (has c.Session.ir "x\\0Ay\\0Az") then + fail "the registration did not carry the new slot list" + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "adding a slot to a class was refused: %s" m); + (* A slot removed is the same decision in the other direction, and it is + worth its own case: the refusal compares signatures and does not care + which way the arity moved. *) + (let t, _ = Session.create ~file:"programs/dev-class.flan" () in + match Session.eval t "(defclass point [y])" with + | c -> + if not (List.mem "point" c.Session.fns) then + fail "removing a slot from a class installed %s" + (String.concat " " c.Session.fns) + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "removing a slot from a class was refused: %s" m); + (* A class that did not change registers anyway — the runtime ignores a + re-registration of the same list, and something has to tell it the list + in the first place. *) + (let t, _ = Session.create ~file:"programs/dev-class.flan" () in + match Session.eval t "(defclass point [x y])" with + | c -> + if not (has c.Session.ir "flan_dyn_class_def") then + fail "an unchanged class definition registered nothing" + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "re-evaluating an unchanged class was refused: %s" m); + (* Now the refusal that stands, which is the whole reason the relaxation + above is safe. A function of the running program calls the constructor + and this evaluation is not recompiling it, so accepting the edit would + leave a call site passing two dyn words into a three-parameter body — + and the third would hold whatever was in the register, which is a wild + pointer rather than a wrong answer. + + The sentence a reader gets is the *checker's*: the whole declaration + list is re-checked against the new constructor before the session's + compatibility rules are consulted at all, so the complaint lands at the + call site with a line number rather than at the class. [session.ml]'s + own walk over the callers is the backstop behind it and is not what + fires here; its comment says so. *) + (let t, _ = Session.create ~file:"programs/dev-class.flan" () in + ignore (Session.eval t "(defn origin [] dyn (point 0 0))"); + match Session.eval t "(defclass point [x y z])" with + | _ -> fail "a class with a compiled caller changed its slots anyway" + | exception Loc.Error { Loc.dmsg = m; _ } -> + if not (has m "point takes 3 arguments") then + fail "the refusal was not about the call that would be left behind: %s" + m); + (* And the same edit accepted when the caller comes with it, which is what + C-c C-k sends: the class and everything that constructs one are + recompiled in the same module, so no call site is left passing the old + arguments. *) + (let t, _ = Session.create ~file:"programs/dev-class.flan" () in + ignore (Session.eval t "(defn origin [] dyn (point 0 0))"); + match + Session.eval t + "(do (defclass point [x y z]) (defn origin [] dyn (point 0 0 0)))" + with + | c -> + if not (List.mem "point" c.Session.fns && List.mem "origin" c.Session.fns) + then + fail "a class and its caller together installed %s" + (String.concat " " c.Session.fns) + | exception Loc.Error { Loc.dmsg = m; _ } -> + fail "a class and its caller evaluated together: %s" m); + Test_support.report ~label:"session" ()