A redefined defclass migrates its live instances on their next touch
# Conflicts: # FIX.org
This commit is contained in:
commit
66f925c36f
277
FIX.org
277
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.
|
||||
|
||||
@ -2622,3 +2625,275 @@ the ~int~/~float~ section's paragraph about "the ~arity~ precedent, where
|
||||
the builtin wins" is revised in place — that precedent is what this lane
|
||||
deleted.
|
||||
The heavy sweeps (~@x86~, ~@sanitize~, ~@valgrind~) were left to the batch.
|
||||
|
||||
* 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*.
|
||||
|
||||
*Neither printer is one of them*, and that has a consequence somebody will
|
||||
meet. ~render~ — which ~print~ goes through, and which the editor renders
|
||||
every dyn value with — and ~say_render~ — the 96-byte sentence a trap
|
||||
prints — both walk the entries raw and neither syncs. ~say_render~ runs
|
||||
inside trap reporting, where the heap is whatever the trap left, and a
|
||||
printer that frees an object's entry block and installs another is not
|
||||
something to have on that path; ~render~ is its sibling and is reached from
|
||||
it for nested values, so splitting them would put the mutation one recursion
|
||||
below a trap anyway.
|
||||
|
||||
So: *a stale instance shows its old slots to the editor until something
|
||||
touches it.* A watch expression, the value ~C-x C-e~ answers and the
|
||||
inspector's render of a dyn all arrive through ~render~, so in the moment
|
||||
after a ~defclass~ is redefined the inspector can show a slot the class no
|
||||
longer has and omit one it has gained — while ~(get p :z)~ typed at the same
|
||||
instant answers the new definition, migrates the instance, and makes the
|
||||
inspector agree from then on. CLHS's "implementation-dependent time" permits
|
||||
it; it is the price of the printer staying a printer; and it is disclosed
|
||||
here rather than discovered.
|
||||
|
||||
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 five ~C-c C-c~ evaluations of the class — four
|
||||
of which change the slot list — 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, the one unchanged re-evaluation migrating nothing, and a
|
||||
raw-~put~ key dropped by the next real redefinition.
|
||||
- And the same protocol once more against a ~flan dev --llvm~ daemon. The
|
||||
block above runs on x86, which is what ~flan dev~ takes unasked; the subset
|
||||
under LLVM is the part that is backend-specific — whether the registration
|
||||
thunk reaches the runtime at all — and everything past that point is
|
||||
flan_dyn.c's, which does not know who called it. Written because
|
||||
~x86.ml~'s header had claimed for some time that it did *not* emit
|
||||
~flan_reload_call~, which is exactly the kind of sentence not to trust
|
||||
twice.
|
||||
- ~test_session.ml~: a slot added and a slot removed both accepted, the
|
||||
module carrying a ~call~ to ~flan_dyn_class_def~, a definition of
|
||||
~flan_reload_call~ and the packed slot-list constant, an unchanged class
|
||||
registering anyway with its own list, 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~.
|
||||
|
||||
A second one, found by the review rather than by the lane: two of the
|
||||
~test_session.ml~ pins above asserted the string ~flan_dyn_class_def~ against
|
||||
the module's IR text, and ~emit.ml~ writes a ~declare~ for every runtime
|
||||
entry point into every module it emits — so both passed against a module that
|
||||
registered nothing. They assert ~call void @flan_dyn_class_def~ and the packed
|
||||
slot-list constant now. Confirmed by mutation: with the thunk suppressed the
|
||||
old needles pass and the new ones fail. Worth carrying as a habit rather than
|
||||
as a fix — a needle that names a runtime symbol is matching the declare block
|
||||
unless it says ~call~.
|
||||
|
||||
** What was run
|
||||
~dune test --root .~ green (exit 0, no FAIL lines) before and after the
|
||||
rebase onto dev-loop, and ~test_dev.exe~ run directly afterwards because its
|
||||
label can be swallowed by a cached run. ~dune build --root . @sanitize~ clean
|
||||
on the committed source, which is where the two-thousand-instance migration
|
||||
under collection actually gets looked at.
|
||||
|
||||
The rebase is worth a line of its own. Three conflicts were additive —
|
||||
FIX.org, ~want_map~ (the diagnostics lane gave ~trap2~ a location pair, this
|
||||
one put a ~class_sync~ beside it, both wanted), and ~test_dev.ml~'s
|
||||
agent-socket block beside this one's. The fourth was not a conflict at all
|
||||
and is the one to remember: ~flan_dyn_class_def~'s argument check was written
|
||||
against the four-argument ~trap1~ and merged clean into a tree where ~trap1~
|
||||
takes a location first, so the class name would have been read as a length.
|
||||
*~dune build~ does not compile ~flan_dyn.c~* — it is a string the compiler
|
||||
carries and hands to clang at ~flan run~ — so a green build is not evidence
|
||||
about that file at all. ~dune test~ is, and so is running any program.
|
||||
|
||||
@ -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)
|
||||
|
||||
189
lib/session.ml
189
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,114 @@ let eval ?(origin = "<eval>") ?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.
|
||||
|
||||
**Known to be dead today, and deliberately not tightened.**
|
||||
The checker refuses every caller before this runs, so [stale]
|
||||
is empty on every path anyone has found; a global's [ginit] is
|
||||
not walked here for the same reason it need not be — a global
|
||||
initialised by calling a constructor is re-checked with
|
||||
everything else, and a mismatch there is the checker's
|
||||
refusal too. What this branch is for is the day that stops
|
||||
being true. It is a tripwire, not a filter: if it ever fires,
|
||||
the answer is a refusal naming the callers rather than a
|
||||
module that loads and then reads a register as a pointer. Do
|
||||
not delete it because it is unreachable — unreachable is the
|
||||
property being asserted. *)
|
||||
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 +813,63 @@ let eval ?(origin = "<eval>") ?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 +888,12 @@ let eval ?(origin = "<eval>") ?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 ──────────────────────────────────────── *)
|
||||
|
||||
|
||||
12
lib/x86.ml
12
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
|
||||
|
||||
@ -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,238 @@ 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*.
|
||||
*
|
||||
* **The two printers are deliberately not among them**, and the consequence
|
||||
* is visible to whoever is sitting in front of the editor, so it is written
|
||||
* out rather than left as a footnote. [render] — which [print] and every
|
||||
* value the editor renders go through — and [say_render] — the 96-byte
|
||||
* sentence a trap prints — both walk [items] raw and neither syncs.
|
||||
*
|
||||
* The reason is the same for both: [say_render] runs inside trap reporting,
|
||||
* where the heap is whatever the trap left, and a printer that frees an
|
||||
* object's entry block and installs another is not something to have on
|
||||
* that path; [render] is the same function's sibling and is called from it
|
||||
* for nested values, so splitting them would put a mutation one recursion
|
||||
* below a trap anyway.
|
||||
*
|
||||
* What that costs: **a stale instance shows its OLD slots to the editor
|
||||
* until something touches it.** A watch expression, the value [C-x C-e]
|
||||
* answers, and the inspector's render of a dyn all reach a class instance
|
||||
* through [render], so immediately after a [defclass] is redefined the
|
||||
* inspector can show a slot the class no longer has, and not show one it
|
||||
* has gained — while [(get p :z)] typed at the same instant answers the new
|
||||
* definition and migrates it, after which the inspector agrees. CLHS's
|
||||
* "implementation-dependent time" permits it and it is the price of the
|
||||
* printer staying a printer; it is not a bug report waiting to happen only
|
||||
* because it is written down here, in FIX.org, and nowhere else. */
|
||||
|
||||
/* 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 +1366,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 +1377,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 +1869,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 +2061,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 +2196,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) {
|
||||
|
||||
@ -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
|
||||
|
||||
207
test/dyn_ops.c
207
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;
|
||||
|
||||
46
test/programs/dev-classes.flan
Normal file
46
test/programs/dev-classes.flan
Normal file
@ -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)
|
||||
240
test/test_dev.ml
240
test/test_dev.ml
@ -5317,6 +5317,246 @@ 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 ];
|
||||
|
||||
(* ── The same thing through the other backend ───────────────────
|
||||
The block above runs on x86, because that is what [flan dev] takes
|
||||
when nobody says. The registration a redefined class carries rides
|
||||
the [flan_reload_call] thunk, which both backends emit and the agent
|
||||
finds by [dlsym] either way — and "both backends emit it" is a
|
||||
sentence [x86.ml]'s own header got wrong for long enough to be worth
|
||||
not trusting a second time. So the shortest subset that would notice:
|
||||
one instance, one slot added, and the three answers that say the
|
||||
migration happened.
|
||||
|
||||
Short on purpose. What is backend-specific is the thunk reaching the
|
||||
runtime at all; everything the block above pins beyond that is
|
||||
flan_dyn.c's, and flan_dyn.c does not know which backend called
|
||||
it. *)
|
||||
let lsock2 = tmp "migrate-llvm.sock" and lout2 = tmp "migrate-llvm.out" in
|
||||
(try Sys.remove lsock2 with Sys_error _ -> ());
|
||||
let lfd2 = Unix.openfile lout2 [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
||||
let lpid2 =
|
||||
Unix.create_process flan
|
||||
[| flan; "dev"; "programs/dev-classes.flan"; "-s"; lsock2; "--llvm" |]
|
||||
Unix.stdin lfd2 Unix.stderr
|
||||
in
|
||||
Unix.close lfd2;
|
||||
if not (listening ~pid:lpid2 lsock2) then begin
|
||||
fail "the LLVM migration daemon %s (%S)" !listen_why
|
||||
(In_channel.with_open_bin lout2 In_channel.input_all);
|
||||
(try Unix.kill lpid2 Sys.sigkill with Unix.Unix_error _ -> ())
|
||||
end
|
||||
else begin
|
||||
let c = connect lsock2 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 holds what code =
|
||||
let r = ask code in
|
||||
if status r <> "ok" then fail "llvm: %s: %s" what (said r)
|
||||
else if value r <> "1" then
|
||||
fail "llvm: %s answered %S (%s)" what (value r) code
|
||||
in
|
||||
let started () = status (ask "(do (push instances (point 3 4)) 1)") = "ok" in
|
||||
if not (await started) then
|
||||
fail "the LLVM migration daemon never reached a frame boundary"
|
||||
else begin
|
||||
let r =
|
||||
request c
|
||||
"(:op \"eval\" :code \"(defclass point [x y z])\" \
|
||||
:file \"programs/dev-classes.flan\")"
|
||||
in
|
||||
if status r <> "ok" then
|
||||
fail "llvm: adding a slot to a class: %s" (said r)
|
||||
else begin
|
||||
holds "a gained slot is nil through the LLVM backend"
|
||||
"(if (= (get (at instances 0) :z) nil) 1 0)";
|
||||
holds "a kept slot keeps its value through the LLVM backend"
|
||||
"(if (= (get (at instances 0) :x) 3) 1 0)";
|
||||
holds "the slot count through the LLVM backend"
|
||||
"(if (= (len (at instances 0)) 3) 1 0)";
|
||||
holds "a generic still dispatches through the LLVM backend"
|
||||
"(if (= (area (at instances 0)) 12) 1 0)"
|
||||
end
|
||||
end;
|
||||
(try Unix.close c with Unix.Unix_error _ -> ());
|
||||
(try Unix.kill lpid2 Sys.sigkill with Unix.Unix_error _ -> ());
|
||||
(try ignore (Unix.waitpid [] lpid2) with Unix.Unix_error _ -> ())
|
||||
end;
|
||||
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
|
||||
[ lsock2; lout2 ];
|
||||
|
||||
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
|
||||
[ sock; out; bsock; bout ];
|
||||
Test_support.report ~label:"dev" ()
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -1061,4 +1061,117 @@ 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.
|
||||
|
||||
[call void @] and not the bare symbol, which is the difference
|
||||
between a pin and a decoration: [emit.ml]'s declare block names
|
||||
every runtime entry point in every module it writes, so
|
||||
"flan_dyn_class_def" on its own is in the text of a module that
|
||||
registers nothing. Checked by mutation — the bare needle passes with
|
||||
the thunk deleted. *)
|
||||
if not (has c.Session.ir "call void @flan_dyn_class_def") then
|
||||
fail "a redefined class did not register its slots";
|
||||
if not (has c.Session.ir "define void @flan_reload_call") then
|
||||
fail "the class registration had nothing to run it";
|
||||
(* And the slot names, in the packed form the runtime splits — which is
|
||||
what says the call carries *this* class's new list and not some
|
||||
other module's leftovers. *)
|
||||
if not (has c.Session.ir "c\"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. This is the C-c C-k shape: every class in the file
|
||||
arrives, whether or not any of them moved.
|
||||
|
||||
The needles are the same two discriminating ones, and the slot list is
|
||||
the *old* one, which is what says the registration is of this class as
|
||||
it currently stands rather than a leftover from the case above. That
|
||||
the runtime then declines to bump the generation is flan_dyn.c's half
|
||||
and is pinned where it happens: dyn_ops.c's [classes] mode writes a
|
||||
value and re-registers the same list under it, and test_dev.ml does the
|
||||
same against a live program. Neither is visible in IR text, which is
|
||||
why neither is asserted here. *)
|
||||
(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 "call void @flan_dyn_class_def") then
|
||||
fail "an unchanged class definition registered nothing";
|
||||
if not (has c.Session.ir "c\"x\\0Ay\"") then
|
||||
fail "an unchanged class registered some other slot list"
|
||||
| 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" ()
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user