A changed signature installs, its stale callers are named, and a handler is off while its own clause runs
This commit is contained in:
commit
14da41e1d9
18
TODO.org
18
TODO.org
@ -1765,13 +1765,17 @@ Only instantiations reach the function list, so a generic name used to report th
|
||||
it had installed nothing at all. The session expands to instantiations before
|
||||
reporting.
|
||||
|
||||
** NEXT Signature generations and stale-caller warnings
|
||||
Decided 2026-09-25: SBCL's behaviour: the new definition always installs, the stale callers are listed by file and line, and a stale call stops in the break buffer naming its site. The check is a signature word the cell carries, compared at each dev-build call site; a release build has neither. Per-block control of runtime checks (Zig's =@setRuntimeSafety=, Odin's =#no_bounds_check=) is a separate question, not built.
|
||||
The biggest hole in "you never restart the program". A changed signature is
|
||||
refused outright today and that is a placeholder, not the design. It needs function
|
||||
versions, a trampoline per version, and caller tracking good enough to name the
|
||||
sites; the cell gives the indirection, and what is missing is that a cell holds one
|
||||
bare pointer with no signature, so there is nowhere to put a second version.
|
||||
** DONE Signature generations and stale-caller warnings
|
||||
CLOSED: [2026-09-25]
|
||||
A changed signature installs. A dev cell is three words (body, signature word,
|
||||
signature text), and every call through it, and every function value taken from
|
||||
it, compares the word against the one the site was compiled for; a mismatch
|
||||
signals =StaleCall= and the call is not made. The reply's =:stale= lists every
|
||||
compiled caller by file:line, and recompiling one clears it. The word is a hash
|
||||
of the signature, so changing it back makes old callers current again. Rules
|
||||
out versioned bodies and trampolines, and redirecting a value taken before the
|
||||
change. =main= stays refused: its caller is startup code no cell reaches.
|
||||
docs/BUILT.md, "A signature change installs".
|
||||
|
||||
** DONE A module carrying a string literal is never unloaded
|
||||
The transient rule is that a module retaining nothing may go, and a string literal
|
||||
|
||||
@ -1459,6 +1459,76 @@ pass and the transcript would read 246 instead of 432.
|
||||
Sizes are spelled LLVM's way — `ptrtoint (ptr getelementptr (T, ptr null, i32 1) to i64)` — rather than by a layout
|
||||
calculator in OCaml that would have to agree with LLVM's on every target.
|
||||
|
||||
### A signature change installs
|
||||
|
||||
SBCL's bargain, copied: a function whose parameters or return change installs anyway, the callers compiled against
|
||||
the old signature are listed, and a stale call stops where it is made. SBCL gets there by recording the approximate
|
||||
type each caller used and comparing it when the function is redefined (`valid-approximate-type`,
|
||||
`src/compiler/ctype.lisp`), then style-warns — "The function was previously called with one argument, but wants at
|
||||
least two" — and lets the old caller fail at run time with a wrong-number-of-arguments error. Flan has no argument
|
||||
count at run time to fail on, so the run-time half is a check it has to emit.
|
||||
|
||||
**A dev cell is three words**: `{ ptr body, i64 word, ptr text }`. The body is first, so a plain load of the cell is
|
||||
still the body and `spike/x86/cells.sh`'s store through `dlsym` still works. The word is a hash (FNV-1a) of the
|
||||
signature spelled the way a `defn` writes it — `[i64 i64] i64` — and the text is that spelling as a C string.
|
||||
`Emit.sig_text` and `Emit.sig_word` are the one definition both backends use. A redefinition module's installer
|
||||
stores the word and the text beside the body; a registry cell (`flan_dev_cell`) is three zeroed words until then.
|
||||
|
||||
**Every call through a cell compares the word** against the one the call site was compiled for, after the arguments and
|
||||
beside the body load, for the reason the body load is there: an argument can poll and install. Equal is a load, a
|
||||
compare and a branch not taken. Different calls `flan_stale_call`, which signals `StaleCall` — callee, the signature
|
||||
the site was compiled for, the one the cell holds now — through the handler stack and then the break hook, exactly as
|
||||
`flan_bounds_error` signals `BoundsError`, and the call is never made. A `Fnval` is checked where the address is
|
||||
taken, not where the value is called: the value's type is the taking site's idea of the signature. A value taken
|
||||
*before* a change holds the old body and goes on computing the old thing, which is consistent and is left alone.
|
||||
|
||||
The word is the signature and not a count of changes. A signature changed and then changed back is the one the old
|
||||
callers were compiled for, and they are right to call it again; a generation counter would trap them.
|
||||
|
||||
The strings a call site hands the trap go through `fi_bytes` and not `string_bytes`, and `flan_stale_call` copies them
|
||||
(and leaks the copies — a stale call is rare and is fixed by hand). `m.nstr` is the test that keeps an expression
|
||||
thunk's module mapped, and a thunk that calls a function would otherwise never be unloaded.
|
||||
|
||||
**The session names the callers before anyone runs them.** `Session.built` is every compiled body the process has, by
|
||||
symbol, with its call sites — callee, the signature it had when the body was compiled, location. It starts as the
|
||||
host program and each accepted module replaces the bodies it compiled. After an evaluation, `stale_sites` is every
|
||||
recorded site whose callee's signature in the new program is not the one recorded, and it rides on the reply as
|
||||
`:stale`; the editor puts each in `*flan-diagnostics*`. Recompiling a caller replaces its record and drops it from the
|
||||
list. A site is named by the declaration its body belongs to, so a call in a handler clause lifted out of `step` is
|
||||
`step`'s.
|
||||
|
||||
**Except in `main`.** Recompiling a function changes what its *next* call runs, and `main` is not called again while
|
||||
the program runs: its loop is the activation the stale call is in. So while the program runs, a stale site in `main`
|
||||
is flagged `:running`, and when `main` is recompiled the body it started with is kept in `Session.live` and stays on
|
||||
the list until a re-run (`Session.rerun`) — the editor's sentence then says to change the callee back or re-run,
|
||||
since evaluating `main` again cannot help. A re-run enters `main` through its cell and so reaches the new body. Any
|
||||
other function the program never leaves has the same property and is not tracked: the dev shadow stack could say
|
||||
which bodies are live, but the x86 backend pushes no frames onto it.
|
||||
|
||||
**A stale caller's source may no longer check**, and that must not refuse the form that changed the callee:
|
||||
`(scale ticks)` after `scale` gained a parameter is an arity error in a body nobody is recompiling. So `Check` has a
|
||||
tolerant entry point: a body failure is excused when the session says the declaration is a stale caller — not in
|
||||
this form, and owning a compiled site whose callee's signature, as pass one collected it, differs from the recorded
|
||||
one — or when the failure is at the line of such a site, which is how a generic's copy gets through (the error lands in
|
||||
whichever function asked for the copy). The declaration is left out of the checked program, everything its failed
|
||||
check registered (lifted clauses, generic copies) is taken back, and the session puts back the checked body it
|
||||
already had — which is the body the process is running, and the one the break loop has to describe. Anything else
|
||||
still fails as it always did.
|
||||
|
||||
A `(defclass ...)` whose slot list changed is a constructor whose signature changed, and takes this road; the
|
||||
bespoke caller walk that refused it is gone. `defn-` privacy is not bypassed: a caller is excused only for a body that
|
||||
calls a changed signature, and one that also broke privacy reports that when it is recompiled. A package's callers are
|
||||
compiled bodies like any other and are listed by their own file and line, the calls a package's macros wrote into the
|
||||
importer included. The prelude has no stale callers to list, because a session cannot redefine a prelude function at
|
||||
all — the form is refused as a second definition.
|
||||
|
||||
A release build has no cells, so it has neither the word nor the compare. Measured against master's compiler on a
|
||||
200M-call loop of a one-line function, dev build, with `perf stat` counting user-mode events because wall time on a
|
||||
shared machine moved by more than the difference: x86 runs 5 more instructions a call (13.0G to 14.0G) and about 2 more
|
||||
cycles (median 9.23G to 9.49G); LLVM `-O2` runs 2 more instructions a call (2.6G to 3.0G) and *fewer* cycles (median
|
||||
1.24G to 1.04G), consistently across rounds — a layout effect, not investigated. Wall time at the fastest of nine runs:
|
||||
x86 2.03 s to 2.27 s, LLVM 0.30 s to 0.26 s.
|
||||
|
||||
### The agent — dev loop step 3
|
||||
|
||||
`vendor/agent/` is a package like any other: `agent.flan` declares three calls, `flan_agent.c` implements them, `link`
|
||||
@ -1532,20 +1602,14 @@ as new, gets a registry cell nobody publishes, and the first call jumps to null
|
||||
|
||||
| Change | What it would have broken |
|
||||
|---|---|
|
||||
| a function's signature | a cell is a bare `ptr`; every call site compiled before the change still passes the old arguments through it — **and this is now a stopgap**, see below |
|
||||
| a global's type | the storage exists and has a shape — reuse reads at the wrong offsets, replacement discards the state the reload exists to preserve |
|
||||
| a struct's fields | the values the process is holding have the old layout |
|
||||
| a `defconst`'s value, **when the checker consumed it** | it is in the *shape* of the program — `(defconst rows (/ h c))` decides `grid`'s type before anything else resolves — so no store can reach it |
|
||||
| a `defenum` member | `:space` is erased to an `i32` literal in the caller, so it is folded there too |
|
||||
|
||||
**The signature row is the one the plan has moved past.** plan.org now says a signature-changing redefinition should
|
||||
make a new internal function version with its own trampoline: newly compiled code resolves the name to it, while
|
||||
existing callers and stored `Fn` values keep the old version and stay safe, and the session warns at every tracked
|
||||
caller site still targeting the old signature — recompiling one either retargets it or gives an ordinary type error.
|
||||
Open decision #6 records it the same way. None of the three parts exists: there are no function versions, no trampolines
|
||||
(a cell holds a body address today), and no record of which source locations called what. So the refusal stays, because
|
||||
the alternative to refusing is not the new design, it is a silent argument mismatch. It is a stopgap and the message
|
||||
should not be read as the final answer.
|
||||
A function's signature was the first row of that table, and is not any more — see "A signature change installs"
|
||||
below. `main` is the one function whose signature change is still refused: its caller is the startup code the process
|
||||
was built with, which no cell reaches.
|
||||
|
||||
A `defonce`'s *initial value* is deliberately **not** in that table. Its storage holds live state the program moved past
|
||||
long ago, and refusing to change the initialiser would be refusing "edit the code, keep the sand". Same `Tast.global`
|
||||
|
||||
@ -824,28 +824,51 @@ for a bug in your program.
|
||||
|
||||
---
|
||||
|
||||
## A changed signature
|
||||
|
||||
A function whose parameters or return type change is installed like any other
|
||||
change. The callers compiled against the old signature are still in the running
|
||||
program, and the reply names each one by file and line. They are listed in
|
||||
`*flan-diagnostics*`, where `next-error` visits them, and the echo area says how
|
||||
many there are.
|
||||
|
||||
A stale caller never passes the old arguments to the new body. Each call to a
|
||||
Flan function in a dev build compares the signature the caller was compiled for
|
||||
with the one the function has now, and when they differ the program stops in the
|
||||
break buffer on a `StaleCall` condition. Its fields are the function called, the
|
||||
signature the call was compiled for, and the current one; the break names the
|
||||
call site. Evaluating the caller again compiles it against the new signature,
|
||||
and a restart resumes the program.
|
||||
|
||||
```
|
||||
(defn scale [x i64] i64 (* x 2))
|
||||
(defn step [] i64 (scale ticks))
|
||||
```
|
||||
|
||||
Evaluating `(defn scale [x i64 k i64] i64 (* x k))` installs the new `scale`
|
||||
and names `step` as a stale caller. The next call from `step` stops on
|
||||
`StaleCall`; evaluating `step` again, calling `(scale ticks 3)`, clears it.
|
||||
|
||||
A call in `main` is the exception to that fix. While the program runs, it is
|
||||
inside the `main` it started with, and that body never returns to be called
|
||||
again, so evaluating `main` again does not reach the loop it is in. The listing
|
||||
says so for each such call, and the program keeps stopping there until `scale`
|
||||
is defined with the old signature again or the program is re-run with `M-x
|
||||
flan-rerun`. The same holds for any function the program never leaves.
|
||||
|
||||
A function value taken before the change keeps the body it was taken from and
|
||||
goes on computing what it did. A value taken by a stale caller after the change
|
||||
stops where it is taken.
|
||||
|
||||
Changing a signature back to the one a caller was compiled for makes that caller
|
||||
current again.
|
||||
|
||||
`main` is the exception. The program's startup code calls it and was built for
|
||||
the signature it had, so changing `main`'s parameters or return needs a
|
||||
restart. A release build has none of this: it has no cells and no checks.
|
||||
|
||||
## When a change is refused
|
||||
|
||||
Two different things wear the same refusal today, and only one of them is the
|
||||
design.
|
||||
|
||||
### A changed signature — a placeholder, not a rule
|
||||
|
||||
The intended behaviour, and what plan.org specifies, is that changing a
|
||||
function's signature makes a **new version** of it: new callers resolve the new
|
||||
one, existing callers and any stored `Fn` value stay safely on the old one, and
|
||||
the session **warns** at each tracked stale caller site so you know what to
|
||||
re-evaluate. Nothing should have to restart.
|
||||
|
||||
That needs function versions, trampolines and caller tracking, none of which are
|
||||
built yet. Until they are, the session refuses rather than letting an
|
||||
indirection cell hand old arguments to a new body — a wrong answer would be
|
||||
worse than a refusal. `lib/session.ml` says so at the refusal itself, and
|
||||
plan.org tracks it as open decision #6.
|
||||
|
||||
So if you hit this: it is a limitation with a date on it, not how the language
|
||||
is meant to work.
|
||||
|
||||
### A changed struct layout — the genuinely hard one
|
||||
|
||||
Rejected while live values of that struct exist, and this one plan.org does
|
||||
|
||||
@ -2353,6 +2353,33 @@ of the tenth name tells you neither how many there were nor which."
|
||||
(t (format "%d names (%s, …)" (length names)
|
||||
(string-join (seq-take names flan-names-shown) ", ")))))
|
||||
|
||||
(defun flan--stale-message (site)
|
||||
"The sentence for SITE, one entry of a reply's `:stale' list."
|
||||
(let ((callee (plist-get site :callee))
|
||||
(compiled (plist-get site :compiled)))
|
||||
(concat
|
||||
(format "this call to %s was compiled for %s, and %s is defined as %s. "
|
||||
callee compiled callee (plist-get site :current))
|
||||
(if (plist-get site :running)
|
||||
;; `main' is the one caller no evaluation can reach: the program is
|
||||
;; inside the body it started with and never calls it again.
|
||||
(format "It is in %s, which is still running the body it started \
|
||||
with, so evaluating %s again does not reach it. Define %s with %s again, or \
|
||||
re-run the program (M-x flan-rerun)."
|
||||
(plist-get site :caller) (plist-get site :caller) callee
|
||||
compiled)
|
||||
(format "Evaluate %s again to compile it against the new definition."
|
||||
(plist-get site :caller))))))
|
||||
|
||||
(defun flan--report-stale (stale)
|
||||
"Log every call site in STALE, a reply's `:stale' list.
|
||||
A redefinition that changed a function's parameters or return installs, and
|
||||
the callers compiled against the old signature are still in the running
|
||||
program; each stops at its call until it is evaluated again. They go to the
|
||||
diagnostics list, where each one is a line `next-error' can visit."
|
||||
(dolist (site stale)
|
||||
(flan--record-diagnostic (plist-get site :loc) (flan--stale-message site))))
|
||||
|
||||
(defun flan--report (reply what &optional at)
|
||||
"Report REPLY, describing WHAT was sent.
|
||||
AT, when given, is the end of the form that was sent: the position that says
|
||||
@ -2364,7 +2391,8 @@ has nothing to sit beside."
|
||||
(let ((fns (plist-get reply :fns))
|
||||
(names (plist-get reply :names))
|
||||
(note (plist-get reply :note))
|
||||
(value (plist-get reply :value)))
|
||||
(value (plist-get reply :value))
|
||||
(stale (plist-get reply :stale)))
|
||||
;; Accepted, so whatever the last rejection marked is no longer true.
|
||||
;; Redundant now that any command clears it — the command that ran this
|
||||
;; evaluation already did — and kept because it is the claim being
|
||||
@ -2387,6 +2415,7 @@ has nothing to sit beside."
|
||||
;; any more, but because the order is what survives: a `message'
|
||||
;; written first is wiped by whatever the drawing does to the buffer.
|
||||
(when value (ignore-errors (flan--show-result value at)))
|
||||
(when stale (ignore-errors (flan--report-stale stale)))
|
||||
(when flan-echo-result
|
||||
(cond
|
||||
;; An expression's value, rendered inside the running program —
|
||||
@ -2410,13 +2439,23 @@ has nothing to sit beside."
|
||||
;; is then empty by construction rather than a repeat of it. Now
|
||||
;; that `C-x C-e' reaches this path too, that sentence is also how
|
||||
;; you tell an installed declaration from an expression's `=>'.
|
||||
(message "flan: %s installed in %.0f ms%s"
|
||||
(message "flan: %s installed in %.0f ms%s%s"
|
||||
(flan--names-phrase (or fns names) what)
|
||||
(or (plist-get reply :ms) 0)
|
||||
(let ((vars (and fns (seq-difference names fns))))
|
||||
(if vars (format " (also %s)"
|
||||
(flan--names-phrase vars ""))
|
||||
"")))))))
|
||||
""))
|
||||
;; The callers a signature change left behind are the
|
||||
;; part of this install that still needs doing, so the
|
||||
;; sentence says how many and where they are listed.
|
||||
(if stale
|
||||
(format "; %d call%s compiled against an old \
|
||||
signature, listed in %s"
|
||||
(length stale)
|
||||
(if (= (length stale) 1) "" "s")
|
||||
flan-diagnostics-buffer)
|
||||
""))))))
|
||||
;; The daemon reports where, so mark it there. This must not itself
|
||||
;; signal: the error the caller is owed is the daemon's, and losing it to a
|
||||
;; bad location would report the wrong thing entirely.
|
||||
|
||||
@ -996,6 +996,27 @@ already rely on it — so nothing here is a stand-in for the real thing."
|
||||
(test-flan--check "clearing the list takes both sections"
|
||||
(= (point-min) (point-max))))
|
||||
|
||||
;; ── The callers a signature change leaves behind ───────────────────────
|
||||
;;
|
||||
;; An install whose reply carries `:stale' lists each call site in the
|
||||
;; diagnostics buffer, at its location, with both signatures and the
|
||||
;; function to evaluate again. test_dev.ml has the daemon's half.
|
||||
(flan--report '(:status "ok" :names ("scale") :fns ("scale") :ms 3
|
||||
:stale ((:loc "f.flan:23:15" :caller "step" :callee "scale"
|
||||
:compiled "[i64] i64" :current "[i64 i64] i64")))
|
||||
"form")
|
||||
(with-current-buffer (flan--diagnostics-buffer)
|
||||
(let ((s (buffer-string)))
|
||||
(test-flan--check "a stale caller is listed at its call"
|
||||
(string-match-p
|
||||
(regexp-quote
|
||||
"f.flan:23:15: this call to scale was compiled for \
|
||||
[i64] i64, and scale is defined as [i64 i64] i64.")
|
||||
s))
|
||||
(test-flan--check "and names the function to evaluate again"
|
||||
(string-match-p "Evaluate step again" s))))
|
||||
(flan-clear-diagnostics)
|
||||
|
||||
;; ── The break loop ────────────────────────────────────────────────────
|
||||
;;
|
||||
;; An unhandled `error' stops the program on the frame that erred instead of
|
||||
|
||||
88
lib/check.ml
88
lib/check.ml
@ -12278,8 +12278,61 @@ let escape_check (fn : Tast.fn) =
|
||||
deny "a return" [ last ]
|
||||
| _ -> ())
|
||||
|
||||
let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env =
|
||||
let build_program ~keep_going ?tolerate (decls : Ast.decl list) :
|
||||
Tast.program * env * string list =
|
||||
let env = new_env () in
|
||||
(* ── A declaration left as it was compiled ───────────────────────────
|
||||
A dev session installs a function whose signature changed, and a
|
||||
caller compiled against the old one is still in the running program and
|
||||
still in the declaration list. Its unchanged source may no longer check
|
||||
against the new signature — but it is not being recompiled, the process
|
||||
is running the body it was built with, and that body is what the break
|
||||
loop has to describe if the call stops. So [tolerate] may answer yes for
|
||||
a declaration whose body fails here, and the declaration is left out of
|
||||
the program rather than refused; the session puts the checked body it
|
||||
already had in its place. Everything the failed check registered on its
|
||||
way down — a lifted clause, a generic copy — is taken back, so nothing
|
||||
half-checked reaches the backend.
|
||||
|
||||
Only a body. A signature is collected in pass one and nothing here
|
||||
excuses it, and with no [tolerate] this is the compiler it always was. *)
|
||||
let tolerated = ref [] in
|
||||
let tolerant name f =
|
||||
match tolerate with
|
||||
| None -> f ()
|
||||
| Some ok ->
|
||||
let lifted = env.lifted and instances = env.instances in
|
||||
(* The generic-copy cache as well as the copies. A copy the failed body
|
||||
asked for would otherwise stay cached, and the next body asking for
|
||||
it would be handed the name of a copy the program does not have. *)
|
||||
let insts =
|
||||
Hashtbl.fold (fun g r acc -> (g, r, !r) :: acc) env.insts []
|
||||
in
|
||||
(match f () with
|
||||
| x -> x
|
||||
| exception (Loc.Error d as e) ->
|
||||
if ok env name d then begin
|
||||
Hashtbl.filter_map_inplace
|
||||
(fun g r ->
|
||||
match List.find_opt (fun (h, _, _) -> String.equal g h) insts with
|
||||
| None ->
|
||||
List.iter (fun (_, _, sym) -> Hashtbl.remove env.fns sym) !r;
|
||||
None
|
||||
| Some (_, _, before) ->
|
||||
List.iter
|
||||
(fun ((_, _, sym) as e) ->
|
||||
if not (List.memq e before) then Hashtbl.remove env.fns sym)
|
||||
!r;
|
||||
r := before;
|
||||
Some r)
|
||||
env.insts;
|
||||
env.lifted <- lifted;
|
||||
env.instances <- instances;
|
||||
tolerated := name :: !tolerated;
|
||||
None
|
||||
end
|
||||
else raise e)
|
||||
in
|
||||
let decls = Parse.program (Prelude.forms ()) @ decls in
|
||||
(* Before anything is collected: every (declare-c ...) becomes an ordinary
|
||||
flattened [declare] with a Flan [defn] over it, and the C that does the
|
||||
@ -12332,12 +12385,19 @@ let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env =
|
||||
(fun (d : Ast.decl) ->
|
||||
match d.Ast.d with
|
||||
| Ast.Defn fn when Hashtbl.mem env.gsigs fn.Ast.name ->
|
||||
ignore (Loc.caught s (fun () -> check_generic env fn))
|
||||
ignore
|
||||
(Loc.caught s (fun () ->
|
||||
tolerant fn.Ast.name (fun () -> Some (check_generic env fn))))
|
||||
| _ -> ())
|
||||
decls;
|
||||
let globals =
|
||||
List.filter_map
|
||||
(fun d -> Option.join (Loc.caught s (fun () -> check_global env d)))
|
||||
(fun (d : Ast.decl) ->
|
||||
Option.join
|
||||
(Loc.caught s (fun () ->
|
||||
match Ast.declared_name d with
|
||||
| Some n -> tolerant n (fun () -> check_global env d)
|
||||
| None -> check_global env d)))
|
||||
decls
|
||||
in
|
||||
let fns =
|
||||
@ -12347,7 +12407,10 @@ let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env =
|
||||
(* A generic [defn] does not reach the typed IR at all. Only its
|
||||
instantiations do, and they are collected below. *)
|
||||
| Ast.Defn fn when Hashtbl.mem env.gsigs fn.Ast.name -> None
|
||||
| Ast.Defn fn -> Loc.caught s (fun () -> check_fn env fn)
|
||||
| Ast.Defn fn ->
|
||||
Option.join
|
||||
(Loc.caught s (fun () ->
|
||||
tolerant fn.Ast.name (fun () -> Some (check_fn env fn))))
|
||||
| _ -> None)
|
||||
decls
|
||||
in
|
||||
@ -12397,21 +12460,30 @@ let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env =
|
||||
reach and which it cannot. It needs every declaration in hand, which is
|
||||
what makes it a pass here rather than a check at each one. *)
|
||||
dyn_descriptors p;
|
||||
(p, env)
|
||||
(p, env, List.rev !tolerated)
|
||||
|
||||
(** The program and the environment, stopping at the first refusal. What a
|
||||
session needs, and it raises [Loc.Error] and never [Loc.Errors]. *)
|
||||
let program_with_env (decls : Ast.decl list) : Tast.program * env =
|
||||
build_program ~keep_going:false decls
|
||||
let p, env, _ = build_program ~keep_going:false decls in
|
||||
(p, env)
|
||||
|
||||
(** The same, with [tolerate] deciding which body failures leave a
|
||||
declaration out rather than refuse it — see [build_program]. The names
|
||||
left out come back beside the program; nothing else about it changes. *)
|
||||
let program_tolerant ~tolerate (decls : Ast.decl list) =
|
||||
build_program ~keep_going:false ~tolerate decls
|
||||
|
||||
let program (decls : Ast.decl list) : Tast.program =
|
||||
fst (build_program ~keep_going:false decls)
|
||||
let p, _, _ = build_program ~keep_going:false decls in
|
||||
p
|
||||
|
||||
(** The same, reporting every declaration whose body it refuses rather than the
|
||||
first. Raises [Loc.Errors], so only a caller prepared for a list should be
|
||||
calling it. *)
|
||||
let program_all (decls : Ast.decl list) : Tast.program =
|
||||
fst (build_program ~keep_going:true decls)
|
||||
let p, _, _ = build_program ~keep_going:true decls in
|
||||
p
|
||||
|
||||
(* ── What a session needs to know about instantiations ──────────────────
|
||||
A generic [defn] never reaches [Tast.fns] — only its copies do — so the
|
||||
|
||||
27
lib/dev.ml
27
lib/dev.ml
@ -861,6 +861,27 @@ let install_note t ~parked =
|
||||
over, which is the loop this whole feature exists to remove. What does
|
||||
change is the note: "at its next frame boundary" is not a promise anyone can
|
||||
read while the program is parked. *)
|
||||
(* The callers a signature change left compiled against the old signature,
|
||||
one plist each, where an editor can list them and jump to them. Left off
|
||||
the reply when there are none, so a reply that has it always means
|
||||
something. *)
|
||||
let stale_field (ss : Session.stale list) =
|
||||
match ss with
|
||||
| [] -> []
|
||||
| ss ->
|
||||
[ ":stale "
|
||||
^ Wire.list
|
||||
(List.map
|
||||
(fun (x : Session.stale) ->
|
||||
Printf.sprintf
|
||||
"(:loc %s :caller %s :callee %s :compiled %s :current %s%s)"
|
||||
(Wire.quote (Loc.to_string x.Session.at))
|
||||
(Wire.quote x.Session.caller) (Wire.quote x.Session.target)
|
||||
(Wire.quote x.Session.compiled)
|
||||
(Wire.quote x.Session.current)
|
||||
(if x.Session.running then " :running t" else ""))
|
||||
ss) ]
|
||||
|
||||
let eval t ~code ~origin ~pause =
|
||||
let now = liveness t in
|
||||
let parked_now = now = Parked in
|
||||
@ -884,7 +905,7 @@ let eval t ~code ~origin ~pause =
|
||||
let refused msg = Session.restore t.session before; error msg in
|
||||
if now = Gone then error gone
|
||||
else
|
||||
match Session.eval ~origin ?pause t.session code with
|
||||
match Session.eval ~origin ?pause ~running:(not parked_now) t.session code with
|
||||
| c when not c.Session.installs ->
|
||||
(* Accepted into the session and nothing to send: a declaration the
|
||||
program already has, with no body and no new storage. Saying "ok" and
|
||||
@ -939,6 +960,7 @@ let eval t ~code ~origin ~pause =
|
||||
":fns " ^ Wire.strings c.Session.fns;
|
||||
Printf.sprintf ":ms %.1f"
|
||||
(timing.Build.llc_ms +. timing.Build.link_ms) ]
|
||||
@ stale_field c.Session.stale
|
||||
@ (match pause with
|
||||
| Some (l, c) ->
|
||||
[ ":pause " ^ Wire.quote (Printf.sprintf "%d:%d" l c) ]
|
||||
@ -2668,7 +2690,7 @@ let render_addr (s : Session.t) ~addr ~(ty : Types.t)
|
||||
(* Through the session's own chooser, so that this thunk is compiled by
|
||||
whichever backend built the process it is about to be loaded into. *)
|
||||
let ir = Session.redefinition s ~call:name program ~fns:[ name ] in
|
||||
Ok { Session.ir; x86 = s.Session.x86; names = []; fns = []; installs = true }
|
||||
Ok { Session.ir; x86 = s.Session.x86; names = []; fns = []; installs = true; stale = [] }
|
||||
|
||||
(* [(:op "at" :addr N :type "Enemy")] — point at any heap address.
|
||||
|
||||
@ -3309,6 +3331,7 @@ let rerun t =
|
||||
let stopped_in_park = liveness t = Parked && at_break in
|
||||
(match Program.rerun ~stopped:at_break () with
|
||||
| Ok () ->
|
||||
Session.rerun t.session;
|
||||
(* The park this session was explaining is over, so the park after it
|
||||
gets the explanation again — see [install_note]. Cleared here as
|
||||
well as in [eval] because a run can start and finish with nothing
|
||||
|
||||
189
lib/emit.ml
189
lib/emit.ml
@ -73,6 +73,53 @@ let sname n = "%" ^ quoted n
|
||||
have no cells and call the symbol directly. *)
|
||||
let cellname n = "@" ^ quoted (Mangle.cell n)
|
||||
|
||||
(* ── The signature a cell carries ──────────────────────────────────────
|
||||
|
||||
A dev cell is three words, not one: the body, the signature word of that
|
||||
body, and the signature spelled out as a C string.
|
||||
|
||||
{ ptr body, i64 word, ptr text }
|
||||
|
||||
The body is first, so everything that only ever wanted the body — a load
|
||||
of the cell, [spike/x86/cells.sh]'s store through [dlsym] — reads the
|
||||
same address it always did.
|
||||
|
||||
The word is what makes a signature change installable. A redefinition that
|
||||
changes a function's parameters or return type publishes its new word with
|
||||
its new body, and every call site through the cell compares the word it
|
||||
was compiled against with the one the cell holds. A caller compiled before
|
||||
the change finds them different and signals [StaleCall] instead of passing
|
||||
arguments the body does not take. A caller recompiled after it finds them
|
||||
equal and pays a load and a compare. A release build has no cells, so it
|
||||
has neither.
|
||||
|
||||
The word is a hash of the text and not a counter the session keeps, and
|
||||
that is a decision: a signature changed and then changed back is the
|
||||
signature the old callers were compiled against, and they are right to
|
||||
call it again. A counter would trap them. FNV-1a over the text — any
|
||||
stable 64-bit hash would do, and this one needs no table.
|
||||
|
||||
The text is [defn]'s spelling, the parameters in brackets and then the
|
||||
return — the same one the stale-caller report and the condition print. *)
|
||||
let sig_text (params : Types.t list) (ret : Types.t) =
|
||||
Printf.sprintf "[%s] %s"
|
||||
(String.concat " " (List.map Types.to_string params))
|
||||
(Types.to_string ret)
|
||||
|
||||
let sig_word params ret =
|
||||
let s = sig_text params ret in
|
||||
let h = ref 0xcbf29ce484222325L in
|
||||
String.iter
|
||||
(fun c ->
|
||||
h := Int64.logxor !h (Int64.of_int (Char.code c));
|
||||
h := Int64.mul !h 0x100000001b3L)
|
||||
s;
|
||||
!h
|
||||
|
||||
(* The cell's LLVM type, spelled once for the host's definition and every
|
||||
module's declaration of it. *)
|
||||
let cell_ty = "{ ptr, i64, ptr }"
|
||||
|
||||
(* A name the host was never built with — a defn or a defonce typed in after the
|
||||
process started — has no symbol to bind to, so it is keyed by string through
|
||||
[flan_dev_cell] / [flan_dev_global] and the answer is cached in one of these
|
||||
@ -460,6 +507,12 @@ type m = {
|
||||
type the base program already named therefore gets its own copy, which is
|
||||
harmless — a descriptor is read-only and has no identity. *)
|
||||
descs : (string, string * int list * int) Hashtbl.t;
|
||||
(* Every Flan function in the program, by name, with its parameters and its
|
||||
return: what a dev call site compares the cell's signature word against.
|
||||
Filled from the program the module is built from, which in a
|
||||
redefinition module is the whole checked program — so a call site is
|
||||
compiled against the signature its callee has in the same check. *)
|
||||
fsigs : (string, Types.t list * Types.t) Hashtbl.t;
|
||||
}
|
||||
|
||||
(* The attribute group every emitted function names, empty unless sanitizing.
|
||||
@ -2194,8 +2247,8 @@ and value_at f (e : Tast.expr) : string =
|
||||
when (match e.Tast.ty with Types.Fn _ -> true | _ -> false) ->
|
||||
let code, env =
|
||||
match e.Tast.e with
|
||||
| Tast.FnAddr r -> fnaddr f r, "null"
|
||||
| Tast.Closure (r, env) -> fnaddr f r, value f env
|
||||
| Tast.FnAddr r -> fnaddr f ~loc:e.Tast.loc r, "null"
|
||||
| Tast.Closure (r, env) -> fnaddr f ~loc:e.Tast.loc r, value f env
|
||||
(* The widening: the thunk's code, with the bare address stored where
|
||||
an environment would be. The thunk reads it back out and calls it,
|
||||
which is what keeps every indirect call exactly typed. *)
|
||||
@ -2210,7 +2263,7 @@ and value_at f (e : Tast.expr) : string =
|
||||
ins f "%s = insertvalue %%fnv %s, ptr %s, 1" b a env;
|
||||
b
|
||||
end
|
||||
| Tast.FnAddr r -> fnaddr f r
|
||||
| Tast.FnAddr r -> fnaddr f ~loc:e.Tast.loc r
|
||||
| Tast.Closure _ | Tast.Thicken _ ->
|
||||
(* Unreachable: both are [Fn] values and the arm above has already taken
|
||||
every [Fn]-typed node. Here because nothing else could be meant. *)
|
||||
@ -2220,7 +2273,7 @@ and value_at f (e : Tast.expr) : string =
|
||||
| Tast.Call (name, args) ->
|
||||
(match Hashtbl.find_opt f.md.externs name with
|
||||
| Some sym -> extern_call f e.Tast.ty ("@" ^ sym) args
|
||||
| None -> call f e.Tast.ty name args)
|
||||
| None -> call f ~loc:e.Tast.loc e.Tast.ty name args)
|
||||
| Tast.CallPtr (callee, args) -> call_ptr f e.Tast.ty callee args
|
||||
| Tast.Do body -> block f body
|
||||
| Tast.Let (bs, body) ->
|
||||
@ -2598,28 +2651,68 @@ and block f body =
|
||||
build is the symbol; a dev build is whatever the indirection cell holds, and
|
||||
there are two spellings of that because a function this module emitted has
|
||||
its cell as a symbol and one it does not has only a cached address. *)
|
||||
and body_of f flan =
|
||||
and body_of f ?loc flan =
|
||||
if not f.md.dev then fname flan
|
||||
else if f.md.known flan then begin
|
||||
else begin
|
||||
let cell =
|
||||
if f.md.known flan then cellname flan
|
||||
else begin
|
||||
(* The cell itself is not a symbol here; its address was looked up
|
||||
by name at install time and cached. *)
|
||||
let c = fresh f in
|
||||
ins f "%s = load ptr, ptr %s" c (cellptr flan);
|
||||
c
|
||||
end
|
||||
in
|
||||
let p = fresh f in
|
||||
ins f "%s = load ptr, ptr %s" p (cellname flan);
|
||||
p
|
||||
end else begin
|
||||
(* The cell itself is not a symbol here; its address was looked up by
|
||||
name at install time and cached. *)
|
||||
let c = fresh f in
|
||||
ins f "%s = load ptr, ptr %s" c (cellptr flan);
|
||||
let p = fresh f in
|
||||
ins f "%s = load ptr, ptr %s" p c;
|
||||
ins f "%s = load ptr, ptr %s" p cell;
|
||||
(match loc, Hashtbl.find_opt f.md.fsigs flan with
|
||||
| Some loc, Some (ps, r) -> stale_check f loc flan cell ps r
|
||||
| _ -> ());
|
||||
p
|
||||
end
|
||||
|
||||
and call f ret flan args =
|
||||
(* The signature word, at a call site through a cell: the one the cell holds
|
||||
against the one this site was compiled with. Equal is the whole of the fast
|
||||
path — a load, a compare, a branch not taken.
|
||||
|
||||
Different means the body in the cell was installed with other parameters
|
||||
or another return since this site was compiled, and calling it would pass
|
||||
arguments it does not take. So the call is not made. [flan_stale_call]
|
||||
signals [StaleCall] naming the site and both signatures, and returns only
|
||||
when something transferred — the same shape as a bounds failure, and a
|
||||
guard after it for the same reason.
|
||||
|
||||
Its strings go through [fi_bytes] and not [string_bytes]: [m.nstr] is the
|
||||
test that keeps an expression thunk's module mapped, and a thunk that
|
||||
calls a function would otherwise never be unloaded. Nothing holds these
|
||||
once the call returns — the runtime copies what it keeps. *)
|
||||
and stale_check f loc flan cell ps r =
|
||||
let wp = fresh f in
|
||||
ins f "%s = getelementptr inbounds i8, ptr %s, i64 8" wp cell;
|
||||
let w = fresh f in
|
||||
ins f "%s = load i64, ptr %s" w wp;
|
||||
let ok = fresh f in
|
||||
ins f "%s = icmp eq i64 %s, %Ld" ok w (sig_word ps r);
|
||||
let good = fresh_label f "sig" and bad = fresh_label f "stale" in
|
||||
term f "br i1 %s, label %%%s, label %%%s" ok good bad;
|
||||
label f bad;
|
||||
let cstr s = fst (fi_bytes f.md (s ^ "\000")) in
|
||||
ins f "call void @flan_stale_call(ptr %s, ptr %s, ptr %s, ptr %s, ptr %s)"
|
||||
(cstr (Loc.to_string loc)) (cstr flan) (cstr (sig_text ps r)) cell
|
||||
xfer_param;
|
||||
guard f;
|
||||
term f "unreachable";
|
||||
label f good
|
||||
|
||||
and call f ?loc ret flan args =
|
||||
let vs = map_lr (fun (a : Tast.expr) ->
|
||||
let v = value f a in Printf.sprintf "%s %s" (ll a.Tast.ty) v) args in
|
||||
(* The cell is loaded *after* the arguments, so a redefinition that lands
|
||||
between two calls still cannot land in the middle of one. *)
|
||||
let callee = body_of f flan in
|
||||
between two calls still cannot land in the middle of one. The signature
|
||||
word is read beside it, for the same reason: an argument that polls can
|
||||
install a new body, and the word checked has to be the body's own. *)
|
||||
let callee = body_of f ?loc flan in
|
||||
call_through f ret callee vs
|
||||
|
||||
(* A call through a function value. Identical to the direct case once the
|
||||
@ -2666,11 +2759,16 @@ and call_ptr f ret callee args =
|
||||
one is still the old body, because there is nothing left to re-resolve once
|
||||
the address is in a slot. Named in docs/BUILT.md rather than papered over
|
||||
with a trampoline. *)
|
||||
and fnaddr f (r : Tast.fnref) =
|
||||
and fnaddr f ?loc (r : Tast.fnref) =
|
||||
match r with
|
||||
| Tast.Flanfn n -> fname n
|
||||
| Tast.Rtfn n -> "@" ^ n
|
||||
| Tast.Fnval n -> body_of f n
|
||||
(* Checked where the address is taken, not where the value is called: the
|
||||
value's type is this site's idea of the signature, and a body installed
|
||||
with another one must not become a value of it. A value taken *before*
|
||||
the change holds the old body and goes on computing the old thing, which
|
||||
is consistent and is left alone. *)
|
||||
| Tast.Fnval n -> body_of f ?loc n
|
||||
|
||||
(* [env] is present on exactly one kind of call: one through a [(Fn ...)]
|
||||
value, which cannot know whether the body it reaches declared one. Every
|
||||
@ -4340,6 +4438,11 @@ declare void @flan_slice_promise_error(ptr, i64, i64, ptr) cold
|
||||
; something answered it. The i32 is the op code and the two i64s are the
|
||||
; operands, or the destination's range for a cast.
|
||||
declare void @flan_arith_error(ptr, i64, i32, i64, i64, ptr) cold
|
||||
; A dev call site whose callee was installed with another signature since it
|
||||
; was compiled: the site, the callee's name and the signature the site expects
|
||||
; as C strings, then the cell and the channel. Signals StaleCall; returns when
|
||||
; something answered.
|
||||
declare void @flan_stale_call(ptr, ptr, ptr, ptr, ptr) cold
|
||||
declare ptr @flan_context_allocator()
|
||||
declare ptr @flan_context_temp()
|
||||
declare ptr @flan_heap_allocator()
|
||||
@ -4671,6 +4774,13 @@ let new_dbg (p : Tast.program) =
|
||||
file);
|
||||
d
|
||||
|
||||
let fsigs_of (p : Tast.program) =
|
||||
let t = Hashtbl.create 64 in
|
||||
List.iter
|
||||
(fun (f : Tast.fn) -> Hashtbl.replace t f.Tast.name (f.Tast.params, f.Tast.ret))
|
||||
p.Tast.fns;
|
||||
t
|
||||
|
||||
let new_module ~checks ~dev ~known ?(debug = false) ?(sanitize = false)
|
||||
?(annotate = false) (p : Tast.program) =
|
||||
let m = {
|
||||
@ -4682,6 +4792,7 @@ let new_module ~checks ~dev ~known ?(debug = false) ?(sanitize = false)
|
||||
checks; dev; known; nstr = 0; nfi = 0; sanitize; ann = annotate;
|
||||
descs = Hashtbl.create 8;
|
||||
dbg = (if debug then Some (new_dbg p) else None);
|
||||
fsigs = fsigs_of p;
|
||||
} in
|
||||
List.iter (fun (s : Tast.structure) -> Hashtbl.replace m.structs s.Tast.sname s)
|
||||
p.Tast.structs;
|
||||
@ -4944,8 +5055,10 @@ let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = [])
|
||||
List.iter
|
||||
(fun (fn : Tast.fn) ->
|
||||
Buffer.add_string m.out
|
||||
(Printf.sprintf "%s = global ptr %s\n" (cellname fn.Tast.name)
|
||||
(fname fn.Tast.name)))
|
||||
(Printf.sprintf "%s = global %s { ptr %s, i64 %Ld, ptr %s }\n"
|
||||
(cellname fn.Tast.name) cell_ty (fname fn.Tast.name)
|
||||
(sig_word fn.Tast.params fn.Tast.ret)
|
||||
(cstring m (sig_text fn.Tast.params fn.Tast.ret))))
|
||||
p.Tast.fns;
|
||||
(* And the allocation registry is armed, which is the whole of what makes
|
||||
it a dev-build feature at run time. A constructor rather than a line in
|
||||
@ -5152,7 +5265,8 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
|
||||
if not (transient f.Tast.name) then
|
||||
Buffer.add_string m.out
|
||||
(if known f.Tast.name then
|
||||
Printf.sprintf "%s = external global ptr\n" (cellname f.Tast.name)
|
||||
Printf.sprintf "%s = external global %s\n" (cellname f.Tast.name)
|
||||
cell_ty
|
||||
else
|
||||
Printf.sprintf "%s = internal global ptr null\n"
|
||||
(cellptr f.Tast.name)))
|
||||
@ -5170,7 +5284,8 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
|
||||
if not (transient f.Tast.name) then
|
||||
Buffer.add_string m.out
|
||||
(if known f.Tast.name then
|
||||
Printf.sprintf "%s = external global ptr\n" (cellname f.Tast.name)
|
||||
Printf.sprintf "%s = external global %s\n" (cellname f.Tast.name)
|
||||
cell_ty
|
||||
else
|
||||
Printf.sprintf "%s = internal global ptr null\n"
|
||||
(cellptr f.Tast.name)))
|
||||
@ -5258,18 +5373,32 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
|
||||
(Printf.sprintf " store %s %s, ptr %s\n" (ll g.Tast.gty)
|
||||
(const m g.Tast.ginit) (gname g.Tast.gname)))
|
||||
p.Tast.globals;
|
||||
(* The body and its signature together, the word before the body. Both
|
||||
stores happen here, on the game thread, at a frame boundary — so no
|
||||
call site can see one without the other, and the order is for a
|
||||
reader rather than for a race. *)
|
||||
let publish cell (f : Tast.fn) =
|
||||
let wp = fresh () and tp = fresh () in
|
||||
Buffer.add_string b
|
||||
(Printf.sprintf
|
||||
" %s = getelementptr inbounds i8, ptr %s, i64 8\n \
|
||||
store i64 %Ld, ptr %s\n \
|
||||
%s = getelementptr inbounds i8, ptr %s, i64 16\n \
|
||||
store ptr %s, ptr %s\n \
|
||||
store ptr %s, ptr %s\n"
|
||||
wp cell (sig_word f.Tast.params f.Tast.ret) wp
|
||||
tp cell (cstring m (sig_text f.Tast.params f.Tast.ret)) tp
|
||||
(fname f.Tast.name) cell)
|
||||
in
|
||||
List.iter
|
||||
(fun (f : Tast.fn) ->
|
||||
if transient f.Tast.name then ()
|
||||
else if known f.Tast.name then
|
||||
Buffer.add_string b
|
||||
(Printf.sprintf " store ptr %s, ptr %s\n" (fname f.Tast.name)
|
||||
(cellname f.Tast.name))
|
||||
else if known f.Tast.name then publish (cellname f.Tast.name) f
|
||||
else begin
|
||||
let t = fresh () in
|
||||
Buffer.add_string b
|
||||
(Printf.sprintf " %s = load ptr, ptr %s\n store ptr %s, ptr %s\n"
|
||||
t (cellptr f.Tast.name) (fname f.Tast.name) t)
|
||||
(Printf.sprintf " %s = load ptr, ptr %s\n" t (cellptr f.Tast.name));
|
||||
publish t f
|
||||
end)
|
||||
targets;
|
||||
Buffer.add_string m.out
|
||||
|
||||
@ -154,6 +154,27 @@ let source = {flan|
|
||||
;; pushed here.
|
||||
(defstruct ArithError [op i32 lhs i64 rhs i64])
|
||||
|
||||
;; A call that was compiled against one signature, reaching a function that
|
||||
;; now has another. It exists only in a dev build: there every call to a Flan
|
||||
;; function goes through a cell, the cell carries the signature its body was
|
||||
;; compiled with, and a function redefined with other parameters or another
|
||||
;; return installs anyway — so a caller compiled before the change finds the
|
||||
;; two different at the call and signals this instead of passing arguments
|
||||
;; the new body does not take. A release build has no cells and never
|
||||
;; signals it.
|
||||
;;
|
||||
;; `callee` is the function called, `compiled` the signature the call site
|
||||
;; was compiled for and `current` the one the function has now, both written
|
||||
;; the way a defn writes them: "[i32 i32] i64". Evaluating the caller again
|
||||
;; compiles it against `current`, and the call works from then on.
|
||||
;;
|
||||
;; Signalled from the runtime — flan_stale_call in runtime/flan_rt.c — so
|
||||
;; **these three fields are a C struct that has to agree with this one**, the
|
||||
;; agreement flan_bounds_cond keeps with BoundsError. No restart is
|
||||
;; established at the call, BoundsError's decision for BoundsError's reason:
|
||||
;; nothing a handler supplies makes the old arguments fit the new body.
|
||||
(defstruct StaleCall [callee string compiled string current string])
|
||||
|
||||
;; What a generic function signals when no method answers. `generic` is the
|
||||
;; name written at the defgeneric or defmulti, and `value` is what the
|
||||
;; dispatch actually produced -- the class of the first argument for a
|
||||
|
||||
502
lib/session.ml
502
lib/session.ml
@ -18,16 +18,48 @@
|
||||
and the first call jumps to null. It has to come from the *checked*
|
||||
program, because [Check.program] prepends the prelude and no accumulated
|
||||
AST contains it.
|
||||
- **what the memory of that process looks like.** A cell is a bare pointer
|
||||
and carries no signature, so a redefined function whose parameters
|
||||
changed is called by every existing call site with the old ones — no link
|
||||
error, no trap, a wrong number. Struct fields and global types are the
|
||||
same class. Those are refused here, with the reason, rather than loaded.
|
||||
- **what the memory of that process looks like.** Struct fields and
|
||||
global types are storage the process already has in a shape, so a change
|
||||
to either is refused here, with the reason, rather than loaded.
|
||||
- **what every function in the process was compiled against.** A dev cell
|
||||
carries its body's signature word (see [Emit.sig_text]), so a function
|
||||
whose parameters or return changed installs anyway and a caller compiled
|
||||
before the change stops on [StaleCall] at the call rather than passing
|
||||
the old arguments. [built] is how the session names those callers
|
||||
before anyone runs them: the call sites of every body the process has,
|
||||
each with the signature it was compiled for. See [stale_sites].
|
||||
|
||||
Not here, and deliberately: evaluating an expression. That is a separate
|
||||
primitive — synthesize a function around the form, call it, render the
|
||||
value — and it is not what redefining a name is. *)
|
||||
|
||||
(* One call site in a body the process is running: the function it calls,
|
||||
the signature that function had when this body was compiled, and where the
|
||||
call is written. A function value taken by name is a site too — the dev
|
||||
build checks the signature where the address is taken. *)
|
||||
type site = { callee : string; csig : string; sloc : Loc.t }
|
||||
|
||||
(* What the session knows about one compiled body: the declaration it belongs
|
||||
to — itself, the function a clause was lifted out of, or the generic a copy
|
||||
was made from — and its call sites. *)
|
||||
type built = { owner : string; sites : site list }
|
||||
|
||||
module SM = Map.Make (String)
|
||||
|
||||
(* A call site compiled against a signature its callee no longer has. *)
|
||||
type stale = {
|
||||
caller : string; (* the compiled body the site is in *)
|
||||
target : string; (* the function it calls *)
|
||||
compiled : string; (* the signature it was compiled for *)
|
||||
current : string; (* the signature the function has now *)
|
||||
at : Loc.t;
|
||||
(* True when the call is in [main] and the program is running: the
|
||||
activation it is in is [main]'s loop, which never returns to be called
|
||||
again, so compiling [main] again cannot reach it. Changing the callee
|
||||
back or re-running the program does. *)
|
||||
running : bool;
|
||||
}
|
||||
|
||||
type t = {
|
||||
file : string; (* resolves an import's relative path *)
|
||||
mutable decls : Ast.decl list; (* post-Load: flat, one namespace *)
|
||||
@ -64,10 +96,101 @@ type t = {
|
||||
returns a struct. Both ends are set from one flag -- see [Dev.start] --
|
||||
and [flan.abi.x86] is the backstop if they ever come apart. *)
|
||||
x86 : bool;
|
||||
(* Every body the running process has, by symbol, with the call sites it
|
||||
was compiled with. Seeded from [host] and replaced, body by body, as
|
||||
modules are accepted — so it is what was *compiled*, which after a
|
||||
signature change is not what [program] would check to. *)
|
||||
mutable built : built SM.t;
|
||||
(* The bodies of [main], and of the clauses lifted out of it, as the
|
||||
running activation was compiled — kept when [main] is compiled again
|
||||
while the program runs, because the loop the program is in is still the
|
||||
old one and nothing re-enters it until a re-run. Emptied by [rerun]. *)
|
||||
mutable live : built SM.t;
|
||||
}
|
||||
|
||||
let fail = Loc.fail
|
||||
|
||||
(* ── What each compiled body calls ──────────────────────────────────── *)
|
||||
|
||||
(* The call sites of one body, each with the signature its callee has in
|
||||
[p] — the program the body is being compiled from, which is the signature
|
||||
both backends compare the cell's word against at that site. *)
|
||||
let sites_of (p : Tast.program) (fn : Tast.fn) =
|
||||
let sigs = Hashtbl.create 64 in
|
||||
List.iter
|
||||
(fun (f : Tast.fn) ->
|
||||
Hashtbl.replace sigs f.Tast.name (Emit.sig_text f.Tast.params f.Tast.ret))
|
||||
p.Tast.fns;
|
||||
let found = ref [] in
|
||||
let see (e : Tast.expr) =
|
||||
let at m =
|
||||
match Hashtbl.find_opt sigs m with
|
||||
| Some csig -> found := { callee = m; csig; sloc = e.Tast.loc } :: !found
|
||||
| None -> ()
|
||||
in
|
||||
match e.Tast.e with
|
||||
| Tast.Call (m, _) -> at m
|
||||
| Tast.FnAddr (Tast.Fnval m) | Tast.Closure (Tast.Fnval m, _) -> at m
|
||||
| _ -> ()
|
||||
in
|
||||
List.iter (Tast.walk see) fn.Tast.body;
|
||||
List.iter (Tast.walk see) fn.Tast.fdefers;
|
||||
List.rev !found
|
||||
|
||||
(* The declaration a compiled body belongs to, which is what the checker
|
||||
names when that body's source no longer checks. A widening thunk belongs
|
||||
to nobody and is left out: each module carries its own copy, so a name
|
||||
says nothing about which copy the process reaches. *)
|
||||
let owner_of env (fn : Tast.fn) =
|
||||
match fn.Tast.fparent with
|
||||
| Some "<thick>" -> None
|
||||
| Some p -> Some p
|
||||
| None ->
|
||||
(match Check.instantiation_origin env fn.Tast.name with
|
||||
| Some (g, _) -> Some g
|
||||
| None -> Some fn.Tast.name)
|
||||
|
||||
let record_built env (p : Tast.program) (fns : Tast.fn list) m =
|
||||
List.fold_left
|
||||
(fun m (fn : Tast.fn) ->
|
||||
match owner_of env fn with
|
||||
| None -> m
|
||||
| Some owner -> SM.add fn.Tast.name { owner; sites = sites_of p fn } m)
|
||||
m fns
|
||||
|
||||
(* Every compiled call site whose callee's signature in [p] is not the one
|
||||
it was compiled for, in source order. A callee [p] does not have is
|
||||
skipped rather than reported: nothing could have been installed under it
|
||||
since, so the cell still holds what the site was compiled against. *)
|
||||
let stale_sites ?(live = SM.empty) ?(running = false) built (p : Tast.program) :
|
||||
stale list =
|
||||
let sigs = Hashtbl.create 64 in
|
||||
List.iter
|
||||
(fun (f : Tast.fn) ->
|
||||
Hashtbl.replace sigs f.Tast.name (Emit.sig_text f.Tast.params f.Tast.ret))
|
||||
p.Tast.fns;
|
||||
(* Named by the declaration a body belongs to: a clause lifted out of
|
||||
[step] is [step]'s call, and a generic's copy is the generic's. *)
|
||||
let from ~kept m acc =
|
||||
SM.fold
|
||||
(fun _ b acc ->
|
||||
let running = kept || (running && String.equal b.owner "main") in
|
||||
List.fold_left
|
||||
(fun acc (st : site) ->
|
||||
match Hashtbl.find_opt sigs st.callee with
|
||||
| Some now when not (String.equal now st.csig) ->
|
||||
{ caller = b.owner; target = st.callee; compiled = st.csig;
|
||||
current = now; at = st.sloc; running } :: acc
|
||||
| _ -> acc)
|
||||
acc b.sites)
|
||||
m acc
|
||||
in
|
||||
from ~kept:true live (from ~kept:false built [])
|
||||
|> List.sort (fun a b ->
|
||||
match String.compare a.at.Loc.file b.at.Loc.file with
|
||||
| 0 -> Loc.before a.at b.at
|
||||
| c -> c)
|
||||
|
||||
(* Structural, and conservative: anything this does not recognise counts as
|
||||
changed. Comparing emitted text instead would be wrong — [Emit.const] on a
|
||||
string allocates a name off a per-module counter, so two different strings
|
||||
@ -120,7 +243,8 @@ let create ?(debug = false) ?(x86 = false) ~file () =
|
||||
package the program imports, the bare name wins for a form typed into
|
||||
that buffer. [macro_union] keeps the left. *)
|
||||
macros = Load.macro_union (own_macros forms) l.Load.macros;
|
||||
thunks = 0; debug; x86 }, l)
|
||||
thunks = 0; debug; x86;
|
||||
built = record_built env p p.Tast.fns SM.empty; live = SM.empty }, l)
|
||||
|
||||
(* What a macro may call, for the same reason [macros] is held: an evaluation
|
||||
parses one form with no import in sight, and a package macro whose body
|
||||
@ -204,102 +328,32 @@ let known t n =
|
||||
(* Everything here is a change that would load cleanly and then be wrong. The
|
||||
house rule (docs/BUILT.md, "The session") says recognise it and refuse with
|
||||
the reason, so each one names what it would have broken. *)
|
||||
let compatible ?(origin = fun _ -> None) ?(relaxed = []) ~loc
|
||||
(old_ : Tast.program) (new_ : Tast.program) =
|
||||
let compatible ~loc (old_ : Tast.program) (new_ : Tast.program) =
|
||||
(* A function's signature is not in this list. A dev cell carries its
|
||||
body's signature word, so a function whose parameters or return changed
|
||||
installs and every caller compiled before the change stops at the call
|
||||
with [StaleCall] — see [Emit.sig_text] and [stale_sites].
|
||||
|
||||
[main] is the one exception, because its caller is not a call site a
|
||||
cell can check. The startup code calls it, and that code was compiled
|
||||
into the program when it started; a re-run calls it again the same
|
||||
way. *)
|
||||
let find_fn p n =
|
||||
List.find_opt (fun (f : Tast.fn) -> String.equal f.Tast.name n) p.Tast.fns
|
||||
in
|
||||
List.iter
|
||||
(fun (f : Tast.fn) ->
|
||||
match find_fn old_ f.Tast.name with
|
||||
| None -> ()
|
||||
| Some g ->
|
||||
let same =
|
||||
List.length f.Tast.params = List.length g.Tast.params
|
||||
&& List.for_all2 Types.equal f.Tast.params g.Tast.params
|
||||
&& Types.equal f.Tast.ret g.Tast.ret
|
||||
in
|
||||
(* A cell holds a bare pointer. Every call site compiled before this
|
||||
change still passes the old arguments through it.
|
||||
|
||||
This refusal is correct for what is built and is *not* the design
|
||||
plan.org now describes: a signature change should make a new
|
||||
internal function version with its own trampoline, leave existing
|
||||
callers and stored [Fn] values safely on the old one, and warn at
|
||||
each tracked stale caller site. That needs versions, trampolines
|
||||
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. *)
|
||||
(* [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. *)
|
||||
(* A lifted initialiser, [global/<n>], is not a function anybody
|
||||
wrote: its signature is its global's type, so the only way it can
|
||||
change is the global being retyped — and the loop below says that
|
||||
in the words a reader can act on, naming the global and its two
|
||||
types. Left in, this arm gets there first and answers a question
|
||||
about [global/paint] that nothing in the source mentions. So the
|
||||
fact is refused exactly once, by the pass that can name it. *)
|
||||
let lifted_init =
|
||||
match f.Tast.fparent with
|
||||
| Some parent -> String.equal f.Tast.name ("global/" ^ parent)
|
||||
| None -> false
|
||||
in
|
||||
if not same && not lifted_init && 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*
|
||||
— so editing the generic's other parameters changes every copy's
|
||||
signature at once, under the same names. The refusal then
|
||||
arrives about [sort-i32], which appears nowhere in the file
|
||||
being edited, for a reason invisible at the edited line.
|
||||
|
||||
So the refusal says where the name came from: which generic, at
|
||||
which types, and that every copy changed together. The
|
||||
programmer's next move is a restart either way — the point is
|
||||
that they can tell *why* without going looking for a function
|
||||
that does not exist in the source.
|
||||
|
||||
Note what does *not* come through here: adding or removing a
|
||||
[where] clause changes no signature at all. It changes which
|
||||
call sites are legal, and those refusals land at the call sites,
|
||||
in the checker, before this is ever reached. *)
|
||||
let what, note =
|
||||
match origin f.Tast.name with
|
||||
| None -> f.Tast.name, ""
|
||||
| Some (gname, tys) ->
|
||||
( Printf.sprintf "%s, the copy of the generic %s at %s"
|
||||
f.Tast.name gname
|
||||
(String.concat ", " (List.map Types.to_string tys)),
|
||||
Printf.sprintf
|
||||
" Editing %s changed every copy of it at once, so this \
|
||||
refusal is about a function the source does not name."
|
||||
gname )
|
||||
in
|
||||
(* The parameters and the return as a [defn] writes them, and not
|
||||
as [(Fn [...] ...)]. That spelling was harmless while [Fn] was
|
||||
the only function type and is not now: it is a real type, it is
|
||||
not the same as [(CFn [...] ...)], and a *declaration* is
|
||||
neither of them — rendering one as a type invites a reader to
|
||||
go looking for which of the two this function's name carries,
|
||||
which is a question about taking its address and not about the
|
||||
edit that was refused. *)
|
||||
fail loc
|
||||
"%s changes signature, from [%s] %s to [%s] %s.%s \
|
||||
Restart to change it."
|
||||
what
|
||||
(String.concat " " (List.map Types.to_string g.Tast.params))
|
||||
(Types.to_string g.Tast.ret)
|
||||
(String.concat " " (List.map Types.to_string f.Tast.params))
|
||||
(Types.to_string f.Tast.ret)
|
||||
note)
|
||||
new_.Tast.fns;
|
||||
(match find_fn old_ "main", find_fn new_ "main" with
|
||||
| Some g, Some f
|
||||
when not
|
||||
(List.length f.Tast.params = List.length g.Tast.params
|
||||
&& List.for_all2 Types.equal f.Tast.params g.Tast.params
|
||||
&& Types.equal f.Tast.ret g.Tast.ret) ->
|
||||
fail loc
|
||||
"main changes signature, from %s to %s. The program's startup code \
|
||||
calls main, and it was built for the first one. Restart the program \
|
||||
to change it."
|
||||
(Emit.sig_text g.Tast.params g.Tast.ret)
|
||||
(Emit.sig_text f.Tast.params f.Tast.ret)
|
||||
| _ -> ());
|
||||
List.iter
|
||||
(fun (g : Tast.global) ->
|
||||
match
|
||||
@ -458,6 +512,11 @@ type change = {
|
||||
for a change that cannot have had an effect, and costs the program a
|
||||
frame's worth of reload it did not need. *)
|
||||
installs : bool;
|
||||
(* Every call site in the running program compiled against a signature its
|
||||
callee no longer has, once this change is in: the callers a signature
|
||||
change leaves behind, and the ones earlier changes left that this one
|
||||
did not recompile. Empty for anything that builds no module. *)
|
||||
stale : stale list;
|
||||
}
|
||||
|
||||
(* [pause] is [C-u C-c C-c]: the position, in the source just sent, of the form
|
||||
@ -570,18 +629,29 @@ type held = {
|
||||
hprogram : Tast.program;
|
||||
henv : Check.env;
|
||||
hmacros : Form.t list;
|
||||
(* And what the process was compiled with, which an acceptance moves too:
|
||||
a module that never arrived compiled nothing. *)
|
||||
hbuilt : built SM.t;
|
||||
hlive : built SM.t;
|
||||
}
|
||||
|
||||
let held t =
|
||||
{ hdecls = t.decls; hprogram = t.program; henv = t.env; hmacros = t.macros }
|
||||
{ hdecls = t.decls; hprogram = t.program; henv = t.env; hmacros = t.macros;
|
||||
hbuilt = t.built; hlive = t.live }
|
||||
|
||||
let restore t h =
|
||||
t.decls <- h.hdecls;
|
||||
t.program <- h.hprogram;
|
||||
t.env <- h.henv;
|
||||
t.macros <- h.hmacros
|
||||
t.macros <- h.hmacros;
|
||||
t.built <- h.hbuilt;
|
||||
t.live <- h.hlive
|
||||
|
||||
let eval ?(origin = "<eval>") ?pause t src : change =
|
||||
(* A re-run calls [main] through its cell, so the body it enters is the
|
||||
newest one and no older activation is left running. *)
|
||||
let rerun t = t.live <- SM.empty
|
||||
|
||||
let eval ?(origin = "<eval>") ?pause ?(running = true) t src : change =
|
||||
let forms = Reader.read_all ~file:origin src in
|
||||
(* What an annotated listing quotes for this form is what was sent, not what
|
||||
the file on disk said when it was last read. *)
|
||||
@ -713,49 +783,78 @@ let eval ?(origin = "<eval>") ?pause t src : change =
|
||||
let decls = kept @ added in
|
||||
(* 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
|
||||
(* ── 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.
|
||||
(* ── Callers compiled against a signature that changed ─────────────
|
||||
A redefinition may change a function's parameters or return, and it
|
||||
installs: every caller compiled before the change stops at the call on
|
||||
[StaleCall] rather than passing the old arguments (see [Emit.sig_text]).
|
||||
Those callers are still in [decls], unchanged, and their source may no
|
||||
longer check against the new signature — [(helper 1)] after [helper]
|
||||
gained a parameter. They are not being recompiled, so that is not a
|
||||
reason to refuse the form that changed [helper]; it is the thing the
|
||||
reply reports.
|
||||
|
||||
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.
|
||||
So a body whose check fails is tolerated exactly when it is a stale
|
||||
caller: not in this form, and compiled with a call site whose callee's
|
||||
signature, as the new check collected it, is not the one it was compiled
|
||||
for. A failure at the line of such a site is tolerated too, which is
|
||||
what lets a generic's copy through — the error then lands in whichever
|
||||
function asked for the copy, and the stale site is in the generic's
|
||||
body. Anything else fails as it always did, and a body that still
|
||||
checks is simply checked; either way it is not recompiled, and the
|
||||
report below names it.
|
||||
|
||||
**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
|
||||
What stands in for a tolerated body is the checked body the session
|
||||
already had, which is the body the process is running. *)
|
||||
let stale_owner (env : Check.env) name (d : Loc.diag) =
|
||||
let now callee =
|
||||
match Hashtbl.find_opt env.Check.fns callee with
|
||||
| Some (ps, r) -> Some (Emit.sig_text ps r)
|
||||
| None -> None
|
||||
in
|
||||
let stale_site (st : site) =
|
||||
match now st.callee with
|
||||
| Some n -> not (String.equal n st.csig)
|
||||
| None -> false
|
||||
in
|
||||
(not (List.mem name names))
|
||||
&& SM.exists
|
||||
(fun fname b ->
|
||||
(String.equal b.owner name || String.equal fname name
|
||||
|| List.exists
|
||||
(fun (st : site) ->
|
||||
String.equal st.sloc.Loc.file d.Loc.dloc.Loc.file
|
||||
&& st.sloc.Loc.line = d.Loc.dloc.Loc.line)
|
||||
b.sites)
|
||||
&& List.exists stale_site b.sites)
|
||||
t.built
|
||||
in
|
||||
let program, env, tolerated =
|
||||
Check.program_tolerant ~tolerate:stale_owner decls
|
||||
in
|
||||
let program =
|
||||
if tolerated = [] then program
|
||||
else
|
||||
let kept_fns =
|
||||
List.filter
|
||||
(fun (f : Tast.fn) ->
|
||||
List.mem f.Tast.name tolerated
|
||||
|| (match f.Tast.fparent with
|
||||
| Some p -> List.mem p tolerated
|
||||
| None -> false))
|
||||
t.program.Tast.fns
|
||||
and kept_globals =
|
||||
List.filter
|
||||
(fun (g : Tast.global) -> List.mem g.Tast.gname tolerated)
|
||||
t.program.Tast.globals
|
||||
in
|
||||
{ program with
|
||||
Tast.fns = program.Tast.fns @ kept_fns;
|
||||
globals = program.Tast.globals @ kept_globals }
|
||||
in
|
||||
(* A (defclass ...) whose slot list changed is a constructor whose
|
||||
signature changed, and it takes the same road: it installs, and a
|
||||
compiled caller of the old constructor is a stale caller like any
|
||||
other. *)
|
||||
let incoming_classes =
|
||||
List.filter_map
|
||||
(fun (d : Ast.decl) ->
|
||||
@ -764,64 +863,7 @@ let eval ?(origin = "<eval>") ?pause t src : change =
|
||||
| _ -> 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 ~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 —
|
||||
@ -905,10 +947,20 @@ let eval ?(origin = "<eval>") ?pause t src : change =
|
||||
let def_inits =
|
||||
List.map (fun (g : Tast.global) -> "global/" ^ g.Tast.gname) def_globals
|
||||
in
|
||||
(* Filtered by what the program holds: a copy a tolerated caller asked for
|
||||
on its way to failing is in the tables and not in the program, and there
|
||||
is nothing of it to install. *)
|
||||
let from_generics =
|
||||
List.concat_map
|
||||
(fun n ->
|
||||
if Check.is_generic env n then Check.instantiations env n else [])
|
||||
if Check.is_generic env n then
|
||||
List.filter
|
||||
(fun c ->
|
||||
List.exists
|
||||
(fun (f : Tast.fn) -> String.equal f.Tast.name c)
|
||||
program.Tast.fns)
|
||||
(Check.instantiations env n)
|
||||
else [])
|
||||
names
|
||||
in
|
||||
let new_instances =
|
||||
@ -1041,16 +1093,50 @@ let eval ?(origin = "<eval>") ?pause t src : change =
|
||||
daemon, and both can refuse — so the caller takes a [held] first and puts
|
||||
it back when they do. See [restore] above for what a session that kept the
|
||||
declaration anyway does to the program. *)
|
||||
(* The bodies this module compiles, and what each of them now calls: the
|
||||
ones it installs by name and the clauses lifted out of them, which is
|
||||
[Emit.redefinition]'s own list. Every stale caller the report names
|
||||
afterwards is one this left alone. *)
|
||||
let rebuilt =
|
||||
List.filter
|
||||
(fun (f : Tast.fn) ->
|
||||
List.mem f.Tast.name fns
|
||||
|| (match f.Tast.fparent with
|
||||
| Some "<thick>" -> false
|
||||
| Some p -> List.mem p fns
|
||||
| None -> false))
|
||||
program.Tast.fns
|
||||
in
|
||||
let built = record_built env program rebuilt t.built in
|
||||
(* [main]'s running activation is the body the program started with, and
|
||||
compiling [main] again does not reach it: the loop it is in never
|
||||
returns to be called again. So while the program runs, the body it was
|
||||
started with is kept, and its stale sites stay on the list. *)
|
||||
let live =
|
||||
if not running then t.live
|
||||
else
|
||||
List.fold_left
|
||||
(fun live (f : Tast.fn) ->
|
||||
match SM.find_opt f.Tast.name t.built with
|
||||
| Some b when String.equal b.owner "main"
|
||||
&& not (SM.mem f.Tast.name live) ->
|
||||
SM.add f.Tast.name b live
|
||||
| _ -> live)
|
||||
t.live rebuilt
|
||||
in
|
||||
t.macros <- !macros;
|
||||
t.decls <- decls;
|
||||
t.program <- program;
|
||||
t.env <- env;
|
||||
t.built <- built;
|
||||
t.live <- live;
|
||||
(* [run_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 <> [] || run_thunk <> None }
|
||||
fns <> [] || allocates || consts <> [] || run_thunk <> None;
|
||||
stale = stale_sites ~live ~running built program }
|
||||
|
||||
(* ── Evaluating an expression ──────────────────────────────────────── *)
|
||||
|
||||
@ -1364,7 +1450,7 @@ let render_locals ?(origin = "<locals>") t ~frame ~(fn : Tast.fn) ~bound
|
||||
redefinition t ~call:name program ~fns:[ name ]
|
||||
in
|
||||
ignore origin;
|
||||
({ ir; x86 = t.x86; names = []; fns = []; installs = true }, List.rev !refused)
|
||||
({ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = [] }, List.rev !refused)
|
||||
|
||||
(* ── The fields of the condition a break is holding ────────────────── *)
|
||||
|
||||
@ -1448,7 +1534,7 @@ let render_condition t ~(st : Tast.structure) : change * (string * string) list
|
||||
externs = t.program.Tast.externs @ externs }
|
||||
in
|
||||
let ir = redefinition t ~call:name program ~fns:[ name ] in
|
||||
({ ir; x86 = t.x86; names = []; fns = []; installs = true }, List.rev !refused)
|
||||
({ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = [] }, List.rev !refused)
|
||||
|
||||
(* ── One slot of a stopped frame, walked ───────────────────────────── *)
|
||||
|
||||
@ -1735,7 +1821,7 @@ let render_slot ?(origin = "<inspect>") t ~frame ~(fn : Tast.fn) ~slot ~path
|
||||
in
|
||||
ignore origin;
|
||||
Ok
|
||||
({ ir; x86 = t.x86; names = []; fns = []; installs = true },
|
||||
({ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = [] },
|
||||
name ^ path_text path,
|
||||
Types.to_string v.Tast.ty)))
|
||||
|
||||
@ -2016,7 +2102,7 @@ let write_slot ?(origin = "<set>") t ~frame ~(fn : Tast.fn) ~slot ~path
|
||||
t.program <-
|
||||
{ t.program with Tast.fns = t.program.Tast.fns @ fresh };
|
||||
Ok
|
||||
({ ir; x86 = t.x86; names = []; fns = []; installs = true },
|
||||
({ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = [] },
|
||||
where, Types.to_string shown.Tast.ty))))
|
||||
|
||||
(* ── The globals a stopped stack reaches ───────────────────────────── *)
|
||||
@ -2103,7 +2189,7 @@ let render_globals ?(origin = "<globals>") t ~(globals : Tast.global list)
|
||||
redefinition t ~call:name program ~fns:[ name ]
|
||||
in
|
||||
ignore origin;
|
||||
({ ir; x86 = t.x86; names = []; fns = []; installs = true }, List.rev !refused)
|
||||
({ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = [] }, List.rev !refused)
|
||||
|
||||
(* [pause] is [C-u C-x C-e] — §9's "last expression" target. It is a flag and
|
||||
not a position, because there is only one form here and it is the whole of
|
||||
@ -2215,7 +2301,7 @@ let eval_expr ?(origin = "<eval>") ?(pause = false) t src : change =
|
||||
when either fails — a copy the session holds and no module defines is a
|
||||
null cell exactly as a stranded declaration is. *)
|
||||
t.program <- { t.program with Tast.fns = t.program.Tast.fns @ fresh };
|
||||
{ ir; x86 = t.x86; names = []; fns = []; installs = true }
|
||||
{ ir; x86 = t.x86; names = []; fns = []; installs = true; stale = [] }
|
||||
|
||||
(* ── What a macro call expands to ──────────────────────────────────── *)
|
||||
|
||||
|
||||
111
lib/x86.ml
111
lib/x86.ml
@ -490,7 +490,7 @@ let layout_ctx ~checks ~dev (p : Tast.program) : Emit.m =
|
||||
{ Emit.out = Buffer.create 1; strs = Buffer.create 1; structs; datas; unions;
|
||||
globals; externs = Hashtbl.create 1; checks;
|
||||
dev; known = (fun _ -> true); dbg = None; sanitize = false; ann = false;
|
||||
nstr = 0; nfi = 0; descs = Hashtbl.create 8 }
|
||||
nstr = 0; nfi = 0; descs = Hashtbl.create 8; fsigs = Emit.fsigs_of p }
|
||||
|
||||
let sizeof md t = fst (Emit.lay md t)
|
||||
|
||||
@ -1404,6 +1404,71 @@ let guard f =
|
||||
test_rr f.b ~a:r11 ~c:r11;
|
||||
jcc_lbl f.b ~cc:cc_ne (current_pad f)
|
||||
|
||||
(* ── The signature word at a call site ──────────────────────────────────
|
||||
|
||||
[Emit.stale_check] on this side, and the same bargain: a cell is three
|
||||
words, body then signature word then signature text, and a dev call site
|
||||
compares the word against the one it was compiled with before it calls.
|
||||
See [Emit.sig_text] for what the word is.
|
||||
|
||||
[r11] holds the cell's *address* on entry and still holds it on the fast
|
||||
path out. The compare uses [r10] and [rax], neither of which carries an
|
||||
argument into a Flan call — [emit_args] has already placed every argument
|
||||
when this runs, and it runs after them for [call_flan]'s reason.
|
||||
|
||||
The cold path abandons the call. It clobbers the argument registers
|
||||
putting its own in, which is fine because the call is not going to be
|
||||
made: [flan_stale_call] signals [StaleCall] and returns only when
|
||||
something transferred, and the guard then leaves through the pad. The
|
||||
strings go through [fi_bytes], NUL-terminated, so a thunk that calls a
|
||||
function is still a thunk the agent may unload afterwards. *)
|
||||
let cell_addr f ~dst s =
|
||||
match f.slot s with
|
||||
| Some sl -> load_int f.b ~dst ~mm:(Sym (sl, 0)) ~size:8 ~signed:false
|
||||
| None -> addr_sym f ~dst s
|
||||
|
||||
let stale_check f ~(loc : Loc.t) name =
|
||||
match Hashtbl.find_opt f.md.Emit.fsigs name with
|
||||
| None -> ()
|
||||
| Some (ps, r) ->
|
||||
note f
|
||||
"The signature word: the cell's, against the one this call site was compiled \
|
||||
with. Equal is the whole fast path.";
|
||||
let r10 = 10 in
|
||||
load_int f.b ~dst:r10 ~mm:(Reg (r11, 8)) ~size:8 ~signed:false;
|
||||
movabs f.b ~dst:rax (Emit.sig_word ps r);
|
||||
cmp_rr f.b ~a:r10 ~c:rax;
|
||||
let ok = new_label f "sig" in
|
||||
jcc_lbl f.b ~cc:cc_e ok;
|
||||
let cstr s =
|
||||
let l, _ = fi_bytes f (s ^ "\000") in
|
||||
l
|
||||
in
|
||||
let site = cstr (Loc.to_string loc)
|
||||
and callee = cstr name
|
||||
and want = cstr (Emit.sig_text ps r) in
|
||||
mov_rr f.b ~dst:rcx ~src:r11;
|
||||
lea f.b ~dst:rdi ~mm:(Sym (site, 0));
|
||||
lea f.b ~dst:rsi ~mm:(Sym (callee, 0));
|
||||
lea f.b ~dst:rdx ~mm:(Sym (want, 0));
|
||||
chan_into f ~reg:r8;
|
||||
xor_rr f.b ~dst:rax ~src:rax;
|
||||
call_sym f.b "flan_stale_call";
|
||||
guard f;
|
||||
ud2 f.b;
|
||||
lbl f.b ok
|
||||
|
||||
(* A function's address as a value, checked where it is taken. See
|
||||
[Emit.fnaddr]: a value taken by a site compiled against another signature
|
||||
must not become a value of this site's type. *)
|
||||
let fnaddr_at f ~(loc : Loc.t) ~reg (r : Tast.fnref) =
|
||||
match r with
|
||||
| Tast.Fnval n when f.md.Emit.dev ->
|
||||
cell_addr f ~dst:r11 (csym n);
|
||||
stale_check f ~loc n;
|
||||
load_int f.b ~dst:reg ~mm:(Reg (r11, 0)) ~size:8 ~signed:false
|
||||
| _ -> fnaddr f ~reg r
|
||||
|
||||
(* Run [g] with a fresh pad on top of the stack, and answer the pad's label
|
||||
beside whether anything aimed at it. *)
|
||||
let with_pad f tag g =
|
||||
@ -1740,8 +1805,8 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit =
|
||||
when (match t with Types.Fn _ -> true | _ -> false) ->
|
||||
let env =
|
||||
match e.Tast.e with
|
||||
| Tast.FnAddr r -> fnaddr f ~reg:rax r; None
|
||||
| Tast.Closure (r, env) -> fnaddr f ~reg:rax r; Some env
|
||||
| Tast.FnAddr r -> fnaddr_at f ~loc:e.Tast.loc ~reg:rax r; None
|
||||
| Tast.Closure (r, env) -> fnaddr_at f ~loc:e.Tast.loc ~reg:rax r; Some env
|
||||
(* The widening: the thunk's code, with the bare address stored where
|
||||
an environment would be. The thunk reads it back out and calls it,
|
||||
which is what keeps every indirect call exactly typed. *)
|
||||
@ -1754,7 +1819,7 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit =
|
||||
| Some ev -> let l = eval f ev in load_loc f ~reg:rax l (Types.Ptr Types.Unit));
|
||||
store_int f.b ~src:rax ~mm:(lmem f (shift dst 8) ~scratch:r11) ~size:8
|
||||
| Tast.FnAddr r ->
|
||||
fnaddr f ~reg:rax r;
|
||||
fnaddr_at f ~loc:e.Tast.loc ~reg:rax r;
|
||||
store_int f.b ~src:rax ~mm:(lmem f dst ~scratch:r11) ~size:8
|
||||
| Tast.Closure _ | Tast.Thicken _ ->
|
||||
(* Unreachable: the arm above has taken every [Fn]-typed node, and both of
|
||||
@ -1768,7 +1833,8 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit =
|
||||
(* A dev build calls through the cell so that a redefinition reaches
|
||||
every existing call site; a release build names the symbol. *)
|
||||
call_flan f
|
||||
~target:(if f.md.Emit.dev then `Cell (csym name) else `Sym (fsym name))
|
||||
~target:(if f.md.Emit.dev then `Cell (name, e.Tast.loc)
|
||||
else `Sym (fsym name))
|
||||
~args ~rty:t dst)
|
||||
| Tast.CallPtr (callee, args) ->
|
||||
(* Through a [(Fn ...)]: both words out of one value, the code address as
|
||||
@ -2916,12 +2982,14 @@ and call_flan f ?env ~target ~args ~rty dst =
|
||||
and there is no cell to keep out of an argument list. *)
|
||||
(match callee with
|
||||
| `Sym s -> call_sym f.b s
|
||||
| `Cell s ->
|
||||
| `Cell (name, loc) ->
|
||||
note f
|
||||
"The indirection cell. A dev build calls through it rather than to the symbol, so \
|
||||
that a redefinition installed while the process runs is reached by the next \
|
||||
call.";
|
||||
load_sym f ~dst:r11 s;
|
||||
cell_addr f ~dst:r11 (csym name);
|
||||
stale_check f ~loc name;
|
||||
load_int f.b ~dst:r11 ~mm:(Reg (r11, 0)) ~size:8 ~signed:false;
|
||||
call_r f.b r11
|
||||
| `Loc o ->
|
||||
load_int f.b ~dst:r11 ~mm:(Frame o) ~size:8 ~signed:false;
|
||||
@ -4545,14 +4613,26 @@ let emit_globals_init ?(ann = false) ?body ~sym (md : Emit.m) ~externs ~fns
|
||||
let emit_cells (p : Tast.program) =
|
||||
let out = Buffer.create 256 in
|
||||
Buffer.add_string out "\t.data\n";
|
||||
List.iter
|
||||
(fun (fn : Tast.fn) ->
|
||||
(* Three words, body first: see [Emit.sig_text] for the other two. The
|
||||
text is a C string in [.rodata], and the cell holds its address. *)
|
||||
let texts = Buffer.create 256 in
|
||||
List.iteri
|
||||
(fun i (fn : Tast.fn) ->
|
||||
let c = csym fn.Tast.name in
|
||||
let tl = Printf.sprintf ".Lflan.sigtext.%d" i in
|
||||
Buffer.add_string out
|
||||
(Printf.sprintf "\t.globl\t%s\n\t.align\t8\n\t.type\t%s, @object\n\
|
||||
\t.size\t%s, 8\n%s:\n\t.quad\t%s\n"
|
||||
c c c c (fsym fn.Tast.name)))
|
||||
\t.size\t%s, 24\n%s:\n\t.quad\t%s\n\t.quad\t%Ld\n\
|
||||
\t.quad\t%s\n"
|
||||
c c c c (fsym fn.Tast.name)
|
||||
(Emit.sig_word fn.Tast.params fn.Tast.ret) tl);
|
||||
Buffer.add_string texts
|
||||
(Printf.sprintf "%s:\n\t.byte\t%s\n" tl
|
||||
(escape_bytes (Emit.sig_text fn.Tast.params fn.Tast.ret ^ "\000"))))
|
||||
p.Tast.fns;
|
||||
Buffer.add_string out "\t.section\t.rodata\n";
|
||||
Buffer.add_buffer out texts;
|
||||
Buffer.add_string out "\t.data\n";
|
||||
Buffer.contents out
|
||||
|
||||
(* ── The DWARF sections ──────────────────────────────────────────────── *)
|
||||
@ -5255,6 +5335,15 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
|
||||
else
|
||||
load_int f.b ~dst:rax ~mm:(Sym (cellp fn.Tast.name, 0)) ~size:8
|
||||
~signed:false;
|
||||
(* The signature word and its text beside the body, as
|
||||
[Emit.redefinition] publishes them: a call site compiled against
|
||||
another signature reads the word and stops rather than passing
|
||||
arguments this body does not take. *)
|
||||
movabs f.b ~dst:r11 (Emit.sig_word fn.Tast.params fn.Tast.ret);
|
||||
store_int f.b ~src:r11 ~mm:(Reg (rax, 8)) ~size:8;
|
||||
let tl = string_const f (Emit.sig_text fn.Tast.params fn.Tast.ret) in
|
||||
lea f.b ~dst:r11 ~mm:(Sym (tl, 0));
|
||||
store_int f.b ~src:r11 ~mm:(Reg (rax, 16)) ~size:8;
|
||||
lea f.b ~dst:r11 ~mm:(Sym (fsym fn.Tast.name, 0));
|
||||
store_int f.b ~src:r11 ~mm:(Reg (rax, 0)) ~size:8
|
||||
end)
|
||||
|
||||
@ -43,8 +43,14 @@
|
||||
|
||||
typedef struct {
|
||||
const char *name; /* strdup'd: the module that passed it may go away */
|
||||
void *cell; /* a function's cell, or a global's storage */
|
||||
void *cell; /* a global's storage */
|
||||
size_t size; /* a global's size; 0 for a function */
|
||||
/* A function's cell: the body, the signature word it was installed with,
|
||||
* and that signature as a C string — the same three words a host's own
|
||||
* cell has (Emit.sig_text). All zero until a module publishes into it, and
|
||||
* a zero word matches no signature, so a call that somehow ran first would
|
||||
* stop on StaleCall rather than jump to null. */
|
||||
void *fn[3];
|
||||
} entry;
|
||||
|
||||
static entry table[FLAN_DEV_MAX];
|
||||
@ -69,6 +75,7 @@ static entry *intern(const char *name) {
|
||||
if (e->name == NULL) die("out of memory", name);
|
||||
e->cell = NULL;
|
||||
e->size = 0;
|
||||
e->fn[0] = e->fn[1] = e->fn[2] = NULL;
|
||||
return e;
|
||||
}
|
||||
|
||||
@ -79,7 +86,7 @@ static entry *intern(const char *name) {
|
||||
void **flan_dev_cell(const char *name) {
|
||||
entry *e = find(name);
|
||||
if (e == NULL) e = intern(name);
|
||||
return &e->cell;
|
||||
return e->fn;
|
||||
}
|
||||
|
||||
/* Storage for a run-time-introduced global, allocated once.
|
||||
|
||||
@ -72,10 +72,22 @@ void flan_handler_pop(flan_handler *h) {
|
||||
*
|
||||
* A handler that transfers stops the walk. The remaining handlers are for a
|
||||
* signal that is still looking for someone; this one has been answered. */
|
||||
/* While a clause runs, the handlers in force are the ones that were in force
|
||||
* when its handler-bind was established — the frames below it — and not the
|
||||
* whole stack. That is Common Lisp's rule (CLHS 9.1.4.1; SBCL's
|
||||
* %handler-bind rebinds *handler-clusters* to the rest of the list around
|
||||
* each call), and without it a clause that signals the condition it handles
|
||||
* reaches itself again, and again, until the stack runs out. The stack is put
|
||||
* back afterwards whether or not the clause transferred: a transfer's target
|
||||
* can be a restart-case inside the handler-bind's own body, whose frame does
|
||||
* not pop this handler on the way there. */
|
||||
void flan_signal(uint32_t type_id, void *condition, void *xfer) {
|
||||
for (flan_handler *h = handlers; h != NULL; h = h->prev)
|
||||
flan_handler *saved = handlers;
|
||||
for (flan_handler *h = saved; h != NULL; h = h->prev)
|
||||
if (h->type_id == type_id) {
|
||||
handlers = h->prev;
|
||||
h->fn(condition, xfer, h->env);
|
||||
handlers = saved;
|
||||
if (*(void **)xfer != NULL) return;
|
||||
}
|
||||
}
|
||||
@ -1058,6 +1070,82 @@ void flan_arith_error(const uint8_t *loc, int64_t loclen, int32_t op,
|
||||
flan_arith_fail(loc, loclen, op, lhs, rhs);
|
||||
}
|
||||
|
||||
/* ── A call compiled against another signature ─────────────────────────
|
||||
*
|
||||
* A dev build's cell is three words: the body, the signature word it was
|
||||
* installed with, and that signature as text (Emit.sig_text). Every call
|
||||
* through a cell compares the word against the one the call site was
|
||||
* compiled with, and lands here when they differ: the function was
|
||||
* redefined with other parameters or another return since this caller was
|
||||
* compiled, and making the call would pass it arguments it does not take.
|
||||
* So the call is not made. A release build has no cells and never gets
|
||||
* here.
|
||||
*
|
||||
* It signals StaleCall with `error`, BoundsError's shape and BoundsError's
|
||||
* decision about restarts: nothing a handler supplies makes the old
|
||||
* arguments fit the new body, so none is established here, and what answers
|
||||
* it is the restart the program already has — or, in the dev loop, the
|
||||
* break buffer, where evaluating the caller again and taking a restart is
|
||||
* the whole of the fix.
|
||||
*
|
||||
* The strings are copied, and never freed. The call site's three live in
|
||||
* the image of whatever module compiled it, and an expression thunk's module
|
||||
* is unloaded once the thunk returns — a condition a handler kept, or the
|
||||
* break site the agent's snapshot reads, must not point into it. A stale call
|
||||
* is a rare event that the programmer fixes; a few leaked bytes for each one
|
||||
* is the price of never pinning a module for it.
|
||||
*
|
||||
* The condition must agree field for field with the prelude's
|
||||
* (defstruct StaleCall [callee string compiled string current string]),
|
||||
* the same hand-kept agreement flan_bounds_cond has with BoundsError. */
|
||||
|
||||
typedef struct { flan_slice callee, compiled, current; } flan_stale_cond;
|
||||
|
||||
static const uint8_t flan_stale_name[] = "StaleCall";
|
||||
#define FLAN_STALE_NAMELEN 9
|
||||
|
||||
static flan_slice flan_stale_copy(const char *s) {
|
||||
flan_slice r;
|
||||
size_t n = strlen(s);
|
||||
char *p = malloc(n + 1);
|
||||
if (p == NULL) { r.ptr = (const uint8_t *)""; r.len = 0; return r; }
|
||||
memcpy(p, s, n + 1);
|
||||
r.ptr = (const uint8_t *)p;
|
||||
r.len = (int64_t)n;
|
||||
return r;
|
||||
}
|
||||
|
||||
void flan_stale_call(const char *site, const char *callee, const char *want,
|
||||
void *const *cell, void *xfer) {
|
||||
/* A registry cell nothing has published into yet has no text. */
|
||||
const char *now = cell[2] != NULL ? (const char *)cell[2] : "(no body)";
|
||||
flan_stale_cond c;
|
||||
c.callee = flan_stale_copy(callee);
|
||||
c.compiled = flan_stale_copy(want);
|
||||
c.current = flan_stale_copy(now);
|
||||
flan_slice where = flan_stale_copy(site);
|
||||
uint32_t id = flan_name_id(flan_stale_name, FLAN_STALE_NAMELEN);
|
||||
flan_signal(id, &c, xfer);
|
||||
if (*(void **)xfer != NULL) return;
|
||||
if (flan_break_hook != NULL) {
|
||||
flan_break_site = where.ptr;
|
||||
flan_break_site_len = where.len;
|
||||
flan_break_hook(flan_stale_name, FLAN_STALE_NAMELEN, &c, xfer);
|
||||
flan_break_site = NULL;
|
||||
flan_break_site_len = 0;
|
||||
if (*(void **)xfer != NULL) return;
|
||||
}
|
||||
rt_flush_out();
|
||||
fprintf(stderr,
|
||||
"%s: this call to %s was compiled for %s, and %s is defined as %s. "
|
||||
"Evaluating the function this call is in again fixes its next call. "
|
||||
"A function that is still running, such as main's loop, is never "
|
||||
"called again: define %s with %s again, or run the program "
|
||||
"again.\n",
|
||||
site, callee, want, callee, now, callee, want);
|
||||
rt_die();
|
||||
}
|
||||
|
||||
/* ── Allocators, spec-memory.md ────────────────────────────────────────
|
||||
*
|
||||
* One type-erased procedure plus an opaque data pointer, which is Odin's
|
||||
|
||||
46
test/programs/dev-stale.flan
Normal file
46
test/programs/dev-stale.flan
Normal file
@ -0,0 +1,46 @@
|
||||
;;;; A program whose callers go stale, for the signature word a dev cell
|
||||
;;;; carries (docs/BUILT.md, "A signature change installs").
|
||||
;;;;
|
||||
;;;; [scale] is the function whose signature the tests change. [step] calls it
|
||||
;;;; every frame and [pick] takes it as a value, so both are callers compiled
|
||||
;;;; against the signature it starts with — two sites the session has to name
|
||||
;;;; after the change, and one the running program has to stop at rather than
|
||||
;;;; call. [lonely] has no caller at all, so changing its signature leaves
|
||||
;;;; nothing behind.
|
||||
;;;;
|
||||
;;;; The frame loop's `skip-frame' restart is what the break buffer resumes
|
||||
;;;; with once [step] is compiled again. Without it a stale call would have
|
||||
;;;; nowhere to go but the exit.
|
||||
(import agent "vendor:agent")
|
||||
|
||||
(defonce ticks i64)
|
||||
(defonce seen i64)
|
||||
|
||||
(defn scale [x i64] i64 (* x 2))
|
||||
|
||||
(defn step [] i64
|
||||
(set ticks (+ ticks 1))
|
||||
(set seen (scale ticks))
|
||||
seen)
|
||||
|
||||
(defn pick [] (Fn [i64] i64) scale)
|
||||
|
||||
(defn lonely [x i64] i64 x)
|
||||
|
||||
(defn main [] i32
|
||||
(agent/start "/tmp/flan-dev-stale-fallback.sock")
|
||||
(dotimes [i 6000]
|
||||
(agent/wait 5)
|
||||
(restart-case (step)
|
||||
(skip-frame [] 0)))
|
||||
0)
|
||||
|
||||
;;; A stale call inside a handler-bind clause that handles StaleCall. The body's
|
||||
;;; call to [scale] signals, the clause runs, and the clause's own call to
|
||||
;;; [scale] signals again — which reaches the handlers outside this
|
||||
;;; handler-bind and not the clause itself, so it stops in the break buffer
|
||||
;;; rather than recursing until the stack runs out. The clause is a lifted
|
||||
;;; function, and the stale list names it as [guarded].
|
||||
(defn guarded [] i64
|
||||
(handler-bind [(StaleCall [c] (set seen (scale 1)))]
|
||||
(scale 5)))
|
||||
46
test/programs/handler-reentry.flan
Normal file
46
test/programs/handler-reentry.flan
Normal file
@ -0,0 +1,46 @@
|
||||
;;;; A handler-bind clause that signals the condition it is handling.
|
||||
;;;;
|
||||
;;;; While a clause runs, the handlers in force are the ones that were in force
|
||||
;;;; when its handler-bind was established (CLHS 9.1.4.1). So the inner clause's
|
||||
;;;; own bad index reaches the *outer* clause, once, and not the inner one
|
||||
;;;; again — which used to recurse until the stack ran out.
|
||||
;;;;
|
||||
;;;; The second half is the other order: after the inner clause has run and
|
||||
;;;; declined, the handler it belongs to is in force again for the next signal.
|
||||
|
||||
(defonce hits i64)
|
||||
(def grid [4 i32] [1 2 3 4])
|
||||
|
||||
(defn bad [i i32] i32 (at grid i))
|
||||
|
||||
(defn nested [] i64
|
||||
(restart-case
|
||||
(handler-bind [(BoundsError [c] (set hits (+ hits 100)) (invoke-restart 'outer))]
|
||||
(restart-case
|
||||
(handler-bind [(BoundsError [c]
|
||||
(set hits (+ hits 1))
|
||||
(bad 9)
|
||||
(invoke-restart 'inner))]
|
||||
(bad 7))
|
||||
(inner [] 0)))
|
||||
(outer [] 0))
|
||||
hits)
|
||||
|
||||
(defn again [] i64
|
||||
(set hits 0)
|
||||
(restart-case
|
||||
(handler-bind [(BoundsError [c] (set hits (+ hits 1)) (invoke-restart 'out))]
|
||||
(handler-bind [(BoundsError [c] (set hits (+ hits 10)))]
|
||||
(bad 5)
|
||||
0))
|
||||
(out [] 0))
|
||||
(restart-case
|
||||
(handler-bind [(BoundsError [c] (set hits (+ hits 1000)) (invoke-restart 'out))]
|
||||
(bad 6))
|
||||
(out [] 0))
|
||||
hits)
|
||||
|
||||
(defn main [] i32
|
||||
(println (nested))
|
||||
(println (again))
|
||||
0)
|
||||
13
test/programs/stale-generic.flan
Normal file
13
test/programs/stale-generic.flan
Normal file
@ -0,0 +1,13 @@
|
||||
;;;; A stale caller that asks for a generic copy on its way to failing.
|
||||
;;;;
|
||||
;;;; When [scale]'s return type changes to f64, [through]'s unchanged source
|
||||
;;;; instantiates [same] at f64 and then fails to return it as an i64. The
|
||||
;;;; session excuses that — [through] is a caller compiled against the old
|
||||
;;;; signature — and the checker takes back what the failed check made. The
|
||||
;;;; copy has to go with it, or a body in the same form that really needs
|
||||
;;;; [same] at f64 is handed a copy nothing generated.
|
||||
(defn same [x $t] $t x)
|
||||
|
||||
(defn scale [x i64] i64 (* x 2))
|
||||
|
||||
(defn through [] i64 (same (scale 1)))
|
||||
@ -916,6 +916,16 @@ let () =
|
||||
outputs "conditions" "programs/conditions.flan" conditions_out;
|
||||
outputs ~opt:"-O0" "conditions, -O0" "programs/conditions.flan" conditions_out;
|
||||
outputs ~dev:true "conditions, dev" "programs/conditions.flan" conditions_out;
|
||||
(* A clause that signals what it handles reaches the handlers outside its
|
||||
own handler-bind and not itself (CLHS 9.1.4.1), and its handler is in
|
||||
force again once it has declined. It used to recurse until the stack
|
||||
ran out. *)
|
||||
let reentry_out = "101\n1011\n" in
|
||||
outputs "handler re-entry" "programs/handler-reentry.flan" reentry_out;
|
||||
outputs ~dev:true "handler re-entry, dev" "programs/handler-reentry.flan"
|
||||
reentry_out;
|
||||
outputs ~x86:true "handler re-entry, --x86" "programs/handler-reentry.flan"
|
||||
reentry_out;
|
||||
(* restart-case and invoke-restart, §3 to §6: the transfer itself. A
|
||||
fall-through with nothing handling it, a clause reached from two frames
|
||||
down, the defer in between running on the way out, an inner frame
|
||||
|
||||
210
test/test_dev.ml
210
test/test_dev.ml
@ -6820,6 +6820,216 @@ let () =
|
||||
[ msock; mout ])
|
||||
[ "llvm"; "x86" ];
|
||||
|
||||
(* ── A signature change, against a running program ───────────────
|
||||
The whole of the feature end to end, on both backends, because each
|
||||
writes its own cells, its own call-site compare and its own installer.
|
||||
[scale] gains a parameter while [step] calls it every frame:
|
||||
|
||||
- the change installs, and the reply names the two callers compiled
|
||||
against the old signature, by line;
|
||||
- the running [step] reaches the new body through the cell and stops
|
||||
on StaleCall instead of calling it, naming both signatures;
|
||||
- recompiling [step] clears it from the list, and the restart the
|
||||
frame loop offers resumes a program that now calls [scale] the new
|
||||
way. *)
|
||||
List.iter
|
||||
(fun backend ->
|
||||
let ssock = tmp ("stale" ^ backend ^ ".sock")
|
||||
and sout = tmp ("stale" ^ backend ^ ".out") in
|
||||
(try Sys.remove ssock with Sys_error _ -> ());
|
||||
let sfd =
|
||||
Unix.openfile sout [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600
|
||||
in
|
||||
let spid =
|
||||
Unix.create_process flan
|
||||
[| flan; "dev"; "programs/dev-stale.flan"; "-s"; ssock;
|
||||
"--" ^ backend |]
|
||||
Unix.stdin sfd Unix.stderr
|
||||
in
|
||||
Unix.close sfd;
|
||||
if not (listening ~pid:spid ssock) then begin
|
||||
fail "the stale-caller daemon (--%s) %s" backend !listen_why;
|
||||
(try Unix.kill spid Sys.sigkill with Unix.Unix_error _ -> ())
|
||||
end
|
||||
else begin
|
||||
let c = connect ssock in
|
||||
let said r =
|
||||
Option.value ~default:(status r) (Wire.string_field r "message")
|
||||
in
|
||||
let stopped () =
|
||||
match Wire.field (request c "(:op \"describe\")") "stopped" with
|
||||
| Some { Form.v = Form.Sym "t"; _ } -> true
|
||||
| _ -> false
|
||||
in
|
||||
let value code =
|
||||
Wire.string_field
|
||||
(request c
|
||||
("(:op \"eval-expr\" :code " ^ Wire.quote code
|
||||
^ " :file \"programs/dev-stale.flan\")"))
|
||||
"value"
|
||||
in
|
||||
let eval code =
|
||||
request c
|
||||
("(:op \"eval\" :code " ^ Wire.quote code
|
||||
^ " :file \"programs/dev-stale.flan\")")
|
||||
in
|
||||
let stale_locs r =
|
||||
match Wire.field r "stale" with
|
||||
| Some { Form.v = Form.List l; _ } ->
|
||||
List.filter_map
|
||||
(fun (e : Form.t) -> Wire.string_field e "loc")
|
||||
l
|
||||
| _ -> []
|
||||
in
|
||||
let at line locs =
|
||||
List.exists
|
||||
(fun l -> contains_sub l (Printf.sprintf "dev-stale.flan:%d:" line))
|
||||
locs
|
||||
in
|
||||
if not (await ~ms:20000 (fun () -> value "(> seen 0)" = Some "true"))
|
||||
then fail "--%s: the stale fixture never ran step" backend
|
||||
else begin
|
||||
let r = eval "(defn scale [x i64 k i64] i64 (* x k))" in
|
||||
if status r <> "ok" then
|
||||
fail "--%s: a signature change was refused: %s" backend (said r)
|
||||
else begin
|
||||
let locs = stale_locs r in
|
||||
if not (at 23 locs && at 26 locs && at 45 locs && at 46 locs
|
||||
&& List.length locs = 4) then
|
||||
fail "--%s: the reply named the stale callers %s" backend
|
||||
(String.concat ", " locs);
|
||||
if not (await ~ms:20000 stopped) then
|
||||
fail "--%s: the stale call never stopped the program" backend
|
||||
else begin
|
||||
(match
|
||||
Wire.string_field (request c "(:op \"describe\")") "condition"
|
||||
with
|
||||
| Some "StaleCall" -> ()
|
||||
| c ->
|
||||
fail "--%s: the stale call stopped on %S" backend
|
||||
(Option.value ~default:"" c));
|
||||
(* Both signatures and the callee, as the break buffer shows
|
||||
them: the fields come out of flan_stale_cond, so this is
|
||||
also the C struct agreeing with the prelude's. *)
|
||||
let fields =
|
||||
match Wire.field (request c "(:op \"condition\")") "fields" with
|
||||
| Some f -> Form.to_string f
|
||||
| None -> ""
|
||||
in
|
||||
List.iter
|
||||
(fun want ->
|
||||
if not (contains_sub fields want) then
|
||||
fail "--%s: StaleCall's fields do not show %S: %s"
|
||||
backend want fields)
|
||||
[ "scale"; "[i64] i64"; "[i64 i64] i64" ];
|
||||
(match Wire.string_field (request c "(:op \"break\")") "site" with
|
||||
| Some site when contains_sub site "dev-stale.flan:23:" -> ()
|
||||
| Some site -> fail "--%s: the stale call's site is %s" backend site
|
||||
| None -> fail "--%s: the stale call carries no :site" backend);
|
||||
(* Recompile the caller, then resume. *)
|
||||
let r =
|
||||
eval
|
||||
"(defn step [] i64 (set ticks (+ ticks 1)) \
|
||||
(set seen (scale ticks 3)) seen)"
|
||||
in
|
||||
if status r <> "ok" then
|
||||
fail "--%s: recompiling the stale caller: %s" backend (said r)
|
||||
else begin
|
||||
let locs = stale_locs r in
|
||||
if not (at 26 locs && not (at 23 locs) && List.length locs = 3)
|
||||
then
|
||||
fail "--%s: after recompiling step the stale list is %s"
|
||||
backend (String.concat ", " locs)
|
||||
end;
|
||||
let r = request c "(:op \"restart\" :name \"skip-frame\")" in
|
||||
if status r <> "ok" then
|
||||
fail "--%s: resuming past the stale call: %s" backend (said r);
|
||||
if not (await ~ms:20000 (fun () -> not (stopped ()))) then
|
||||
fail "--%s: the program never resumed" backend
|
||||
else begin
|
||||
let before = value "ticks" in
|
||||
if
|
||||
not
|
||||
(await ~ms:20000 (fun () ->
|
||||
value "ticks" <> before
|
||||
&& value "(= seen (* ticks 3))" = Some "true"))
|
||||
then
|
||||
fail "--%s: the recompiled caller never ran: seen %s, \
|
||||
ticks %s"
|
||||
backend
|
||||
(Option.value ~default:"?" (value "seen"))
|
||||
(Option.value ~default:"?" (value "ticks"));
|
||||
(* [pick] is still stale, and it is the other kind of
|
||||
site: it takes [scale] as a value of the old type. The
|
||||
check is where the address is taken, so calling [pick]
|
||||
stops there rather than handing back a value whose
|
||||
type is a lie. *)
|
||||
let r =
|
||||
request c
|
||||
"(:op \"eval-expr\" :code \"((pick) 5)\" \
|
||||
:file \"programs/dev-stale.flan\")"
|
||||
in
|
||||
if status r <> "error" then
|
||||
fail "--%s: a stale function value was handed back: %s"
|
||||
backend
|
||||
(Option.value ~default:"" (Wire.string_field r "value"))
|
||||
else if not (await ~ms:20000 stopped) then
|
||||
fail "--%s: a stale function value never stopped" backend
|
||||
else begin
|
||||
(match
|
||||
Wire.string_field (request c "(:op \"break\")") "site"
|
||||
with
|
||||
| Some site when contains_sub site "dev-stale.flan:26:" -> ()
|
||||
| Some site ->
|
||||
fail "--%s: the stale value's site is %s" backend site
|
||||
| None -> fail "--%s: the stale value has no :site" backend);
|
||||
ignore
|
||||
(request c
|
||||
"(:op \"restart\" :name \"abandon-evaluation\")");
|
||||
if not (await ~ms:20000 (fun () -> not (stopped ()))) then
|
||||
fail "--%s: the abandoned evaluation never let go" backend
|
||||
end;
|
||||
(* A stale call inside a clause handling StaleCall. The
|
||||
clause's handler is not in force while the clause runs,
|
||||
so its own stale call reaches the break loop once,
|
||||
rather than the clause again until the stack runs out. *)
|
||||
let r =
|
||||
request c
|
||||
"(:op \"eval-expr\" :code \"(guarded)\" \
|
||||
:file \"programs/dev-stale.flan\")"
|
||||
in
|
||||
if status r <> "error" then
|
||||
fail "--%s: a stale call inside a handler answered: %s"
|
||||
backend (said r)
|
||||
else if not (await ~ms:20000 stopped) then
|
||||
fail "--%s: a stale call inside a handler never stopped" backend
|
||||
else begin
|
||||
(match
|
||||
Wire.string_field (request c "(:op \"break\")") "site"
|
||||
with
|
||||
| Some site when contains_sub site "dev-stale.flan:45:" -> ()
|
||||
| Some site ->
|
||||
fail "--%s: the stale call in the clause stopped at %s"
|
||||
backend site
|
||||
| None -> fail "--%s: the clause's stale call has no :site" backend);
|
||||
ignore
|
||||
(request c
|
||||
"(:op \"restart\" :name \"abandon-evaluation\")");
|
||||
if not (await ~ms:20000 (fun () -> not (stopped ()))) then
|
||||
fail "--%s: the abandoned clause never let go" backend
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
end;
|
||||
ignore (request c "(:op \"close\")");
|
||||
(try Unix.close c with Unix.Unix_error _ -> ());
|
||||
(try ignore (Unix.waitpid [] spid) with Unix.Unix_error _ -> ())
|
||||
end;
|
||||
List.iter (fun f -> try Sys.remove f with Sys_error _ -> ())
|
||||
[ ssock; sout ])
|
||||
[ "llvm"; "x86" ];
|
||||
|
||||
(* ── A daemon whose editor was killed ─────────────────────────────── *)
|
||||
|
||||
(* The defect TODO.org, "A session ends when no editor has held the socket
|
||||
|
||||
@ -124,7 +124,7 @@ let () =
|
||||
and the installer publishes the very function it is replacing. *)
|
||||
if not (has ir2 "define hidden i64 @\"flan.bump\"") then
|
||||
fail "redefinition's own body is interposable";
|
||||
if not (has ir2 "@\"flan.cell.helper\" = external global ptr") then
|
||||
if not (has ir2 "@\"flan.cell.helper\" = external global { ptr, i64, ptr }") then
|
||||
fail "redefinition defines a cell instead of using the host's";
|
||||
(* A def's lifted initialiser as the target, which is what [Session]'s
|
||||
[def_inits] hands in when the form is re-evaluated. [global/paint] is
|
||||
@ -137,7 +137,8 @@ let () =
|
||||
(let irdef =
|
||||
Emit.redefinition ~dev:true ~known p1 ~fns:[ "global/paint" ]
|
||||
in
|
||||
if not (has irdef "@\"flan.cell.global/paint\" = external global ptr")
|
||||
if not (has irdef
|
||||
"@\"flan.cell.global/paint\" = external global { ptr, i64, ptr }")
|
||||
then fail "a lifted def initialiser's cell is not declared";
|
||||
if not (has irdef "define hidden i64 @\"flan.global/paint\"") then
|
||||
fail "a lifted def initialiser's body is missing or interposable");
|
||||
@ -177,8 +178,11 @@ let () =
|
||||
(* A dev host's calls are indirect; a release host's are not. That is the
|
||||
only difference between the two, and the whole of C-c C-c rests on it. *)
|
||||
let host_ir = Emit.program ~dev:true p1 in
|
||||
if not (has host_ir "@\"flan.cell.bump\" = global ptr @\"flan.bump\"") then
|
||||
fail "dev build emitted no cell";
|
||||
(* Three words: the body, its signature word, and the signature as text.
|
||||
See [Emit.sig_text]. *)
|
||||
if not (has host_ir
|
||||
"@\"flan.cell.bump\" = global { ptr, i64, ptr } { ptr @\"flan.bump\", i64 ")
|
||||
then fail "dev build emitted no cell";
|
||||
if has (Emit.program p1) "flan.cell." then
|
||||
fail "release build emitted a cell";
|
||||
|
||||
|
||||
@ -44,35 +44,177 @@ let refuses ?(file = "programs/reload.flan") name src reason =
|
||||
fail "%s\n said: %S\n wanted it to mention: %S" name msg reason
|
||||
|
||||
let () =
|
||||
(* A cell carries no signature, so every call site compiled before the change
|
||||
still passes the old arguments through it. *)
|
||||
(* [outer] is called only from C, and [spare] is read by nothing, so the
|
||||
checker has no complaint about either change and the session is the only
|
||||
thing that can refuse them. A change something else in the program uses is
|
||||
an ordinary type error first, which is a different and louder failure. *)
|
||||
refuses "a changed parameter type"
|
||||
"(defn outer [x i64] i64 (bump))"
|
||||
"changes signature";
|
||||
refuses "a changed return type"
|
||||
"(defn outer [] i32 (i32 (bump)))"
|
||||
"changes signature";
|
||||
refuses "a changed arity"
|
||||
"(defn outer [a i64 b i64] i64 (bump))"
|
||||
"changes signature";
|
||||
(* Dyn-ness is part of a signature like anything else, and this falls out of
|
||||
[compatible] rather than being added to it: the comparison is
|
||||
[Types.equal] over the parameters and the return, and dyn is equal to
|
||||
itself and to nothing else. Pinned anyway, because it is the one place the
|
||||
word "signature" covers a change the source does not spell out — the
|
||||
return type here went from [i64] to [dyn] by being written differently,
|
||||
and a parameter can change the same way by a *type* being declared
|
||||
elsewhere in the program. *)
|
||||
refuses "a return type that became dyn"
|
||||
"(defn outer [] dyn (bump))"
|
||||
"changes signature";
|
||||
refuses "a parameter that became dyn"
|
||||
"(defn outer [x] i64 (bump))"
|
||||
"changes signature";
|
||||
(* ── A signature change installs ─────────────────────────────────
|
||||
A dev cell carries its body's signature word, and a call site compiled
|
||||
against another one stops on StaleCall rather than passing the old
|
||||
arguments — so a changed signature is accepted, and what the session owes
|
||||
is the list of callers left compiled against the old one.
|
||||
|
||||
[outer] is called only from C, so nothing in the program is left behind:
|
||||
each of these installs and names no stale caller. Dyn-ness is part of a
|
||||
signature like anything else; the last two are the changes the source
|
||||
does not spell out as a type. *)
|
||||
let installs name src =
|
||||
let t, _ = Session.create ~file:"programs/reload.flan" () in
|
||||
match Session.eval t src with
|
||||
| c ->
|
||||
if not (List.mem "outer" c.Session.fns) then
|
||||
fail "%s installed %s" name (String.concat " " c.Session.fns);
|
||||
if c.Session.stale <> [] then
|
||||
fail "%s left a caller behind that nothing has" name
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "%s was refused: %s" name m
|
||||
in
|
||||
installs "a changed parameter type" "(defn outer [x i64] i64 (bump))";
|
||||
installs "a changed return type" "(defn outer [] i32 (i32 (bump)))";
|
||||
installs "a changed arity" "(defn outer [a i64 b i64] i64 (bump))";
|
||||
installs "a return type that became dyn" "(defn outer [] dyn (bump))";
|
||||
installs "a parameter that became dyn" "(defn outer [x] i64 (bump))";
|
||||
(* [main] is the exception: the startup code calls it, and that call was
|
||||
compiled into the program when it started. *)
|
||||
refuses ~file:"programs/dev-stale.flan" "a changed main"
|
||||
"(defn main [] () (step))"
|
||||
"main changes signature, from [] i32 to [] ()";
|
||||
|
||||
(* The callers. [step] calls [scale] and [pick] takes it as a value, and
|
||||
neither is in the form — so both are named, at the line of the call and
|
||||
with both signatures. [step]'s source no longer checks against the new
|
||||
arity, and that is not a reason to refuse: it is not being recompiled. *)
|
||||
(let t, _ = Session.create ~file:"programs/dev-stale.flan" () in
|
||||
match Session.eval t "(defn scale [x i64 k i64] i64 (* x k))" with
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
fail "a signature change with compiled callers was refused: %s" m
|
||||
| c ->
|
||||
if not (List.mem "scale" c.Session.fns) then
|
||||
fail "the changed function was not installed";
|
||||
let named =
|
||||
List.map
|
||||
(fun (x : Session.stale) ->
|
||||
(x.Session.caller, x.Session.target, x.Session.compiled,
|
||||
x.Session.current, x.Session.at.Loc.line))
|
||||
c.Session.stale
|
||||
in
|
||||
let want =
|
||||
[ ("step", "scale", "[i64] i64", "[i64 i64] i64", 23);
|
||||
("pick", "scale", "[i64] i64", "[i64 i64] i64", 26);
|
||||
(* The clause's call is named for the function it is written in,
|
||||
not for the lifted function it became. *)
|
||||
("guarded", "scale", "[i64] i64", "[i64 i64] i64", 45);
|
||||
("guarded", "scale", "[i64] i64", "[i64 i64] i64", 46) ]
|
||||
in
|
||||
if named <> want then
|
||||
fail "the stale callers were %s"
|
||||
(String.concat "; "
|
||||
(List.map
|
||||
(fun (c, g, w, n, l) -> Printf.sprintf "%s->%s %s/%s @%d" c g w n l)
|
||||
named));
|
||||
(* Recompiling a stale caller clears it, and only it. *)
|
||||
(match
|
||||
Session.eval t
|
||||
"(defn step [] i64 (set ticks (+ ticks 1)) (set seen (scale ticks 3)) seen)"
|
||||
with
|
||||
| c ->
|
||||
(match c.Session.stale with
|
||||
| [ a; b; c ] when a.Session.caller = "pick"
|
||||
&& b.Session.caller = "guarded"
|
||||
&& c.Session.caller = "guarded" -> ()
|
||||
| l ->
|
||||
fail "after recompiling step the stale callers were %s"
|
||||
(String.concat ", "
|
||||
(List.map (fun (x : Session.stale) -> x.Session.caller) l)))
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
fail "recompiling a stale caller was refused: %s" m);
|
||||
(* A body that is kept is the one that was compiled: an unrelated
|
||||
evaluation still names [pick], and the session's program still holds
|
||||
the [pick] the process is running rather than refusing to check. *)
|
||||
(match Session.eval t "(defn lonely [x i64] i64 (+ x 1))" with
|
||||
| c ->
|
||||
if List.map (fun (x : Session.stale) -> x.Session.caller) c.Session.stale
|
||||
<> [ "pick"; "guarded"; "guarded" ]
|
||||
then fail "an unrelated evaluation lost track of the stale caller"
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
fail "an evaluation after a signature change was refused: %s" m);
|
||||
(* And the signature changed back is the one [pick] was compiled
|
||||
against: nothing is stale, because the word is the signature and not
|
||||
a count of changes. *)
|
||||
(match Session.eval t "(defn scale [x i64] i64 (* x 2))" with
|
||||
| c ->
|
||||
(match c.Session.stale with
|
||||
| [ x ] when x.Session.caller = "step" -> ()
|
||||
| l ->
|
||||
fail "after changing scale back the stale callers were %s"
|
||||
(String.concat ", "
|
||||
(List.map (fun (x : Session.stale) -> x.Session.caller) l)))
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
fail "changing a signature back was refused: %s" m));
|
||||
|
||||
(* A stale call in [main] is one that evaluating [main] again cannot fix
|
||||
while the program runs: its loop is the activation the call is in, and
|
||||
it never returns to be called again. So the site is flagged, and when
|
||||
[main] is compiled again the body the program started with stays on the
|
||||
list until a re-run. With the program parked, compiling [main] again is
|
||||
an ordinary fix. *)
|
||||
(let t, _ = Session.create ~file:"programs/dev-stale.flan" () in
|
||||
let mains (c : Session.change) =
|
||||
List.filter_map
|
||||
(fun (x : Session.stale) ->
|
||||
if x.Session.caller = "main" then Some x.Session.running else None)
|
||||
c.Session.stale
|
||||
in
|
||||
let main_src =
|
||||
"(defn main [] i32 (agent/start \"/tmp/x.sock\") \
|
||||
(dotimes [i 6000] (agent/wait 5) (restart-case (step 1) (skip-frame [] 0))) 0)"
|
||||
in
|
||||
(match Session.eval t "(defn step [x i64] i64 (set seen (scale x)) seen)" with
|
||||
| c ->
|
||||
if mains c <> [ true ] then fail "a stale call in main was not flagged as running"
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "changing step: %s" m);
|
||||
(match Session.eval t main_src with
|
||||
| c ->
|
||||
if mains c <> [ true ] then
|
||||
fail "recompiling main while it runs cleared its stale call"
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "recompiling main: %s" m);
|
||||
Session.rerun t;
|
||||
(match Session.eval t "(defn lonely [x i64] i64 (+ x 2))" with
|
||||
| c -> if mains c <> [] then fail "a re-run did not clear main's stale call"
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "after a re-run: %s" m));
|
||||
(let t, _ = Session.create ~file:"programs/dev-stale.flan" () in
|
||||
ignore
|
||||
(Session.eval ~running:false t "(defn step [x i64] i64 (set seen (scale x)) seen)");
|
||||
match
|
||||
Session.eval ~running:false t
|
||||
"(defn main [] i32 (dotimes [i 3] (restart-case (step 1) (skip-frame [] 0))) 0)"
|
||||
with
|
||||
| c ->
|
||||
if List.exists (fun (x : Session.stale) -> x.Session.caller = "main")
|
||||
c.Session.stale
|
||||
then fail "recompiling main while parked left it stale"
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } -> fail "recompiling a parked main: %s" m);
|
||||
|
||||
(* What a tolerated caller's failed check made is taken back, generic copies
|
||||
included, so a body in the same form that needs the same copy gets one
|
||||
generated for it rather than a cached name. *)
|
||||
(let t, _ = Session.create ~file:"programs/stale-generic.flan" () in
|
||||
match
|
||||
Session.eval t
|
||||
"(defn scale [x i64] f64 (f64 (* x 2))) (defn other [] f64 (same 2.5))"
|
||||
with
|
||||
| c ->
|
||||
if not (List.mem "same-f64" c.Session.fns) then
|
||||
fail "a copy a tolerated caller asked for was not generated again: %s"
|
||||
(String.concat " " c.Session.fns);
|
||||
if List.map (fun (x : Session.stale) -> x.Session.caller) c.Session.stale
|
||||
<> [ "through" ]
|
||||
then fail "the generic fixture named the wrong stale callers"
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
fail "a stale caller that instantiates a generic: %s" m);
|
||||
|
||||
(* A caller whose source fails for some other reason is still refused: the
|
||||
tolerance is for a body compiled against a signature that changed, and
|
||||
[twice] here is new, in the form, and wrong. *)
|
||||
refuses ~file:"programs/dev-stale.flan" "a form that is wrong on its own"
|
||||
"(defn scale [x i64 k i64] i64 (* x k)) (defn twice [] i64 (scale 1))"
|
||||
"scale";
|
||||
|
||||
(* The storage exists and has a shape: reusing it reads at the wrong offsets,
|
||||
and replacing it discards the state the reload exists to preserve. *)
|
||||
refuses "a retyped global"
|
||||
@ -104,7 +246,8 @@ let () =
|
||||
(* The prelude is in the checked program and in no accumulated AST, so a
|
||||
session that derived [known] from declarations would call rand-seed
|
||||
through a registry cell nobody ever publishes. *)
|
||||
if not (has c.Session.ir "@\"flan.cell.rand-seed\" = external global ptr") then
|
||||
if not (has c.Session.ir
|
||||
"@\"flan.cell.rand-seed\" = external global { ptr, i64, ptr }") then
|
||||
fail "the prelude was treated as new";
|
||||
if has c.Session.ir "flan_dev_cell" then
|
||||
fail "a name the host has went through the registry";
|
||||
@ -615,6 +758,63 @@ let () =
|
||||
| _ -> ()
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
fail "a defn- in the program's own file: %s" m);
|
||||
(* A package function whose signature changes names its callers outside the
|
||||
package, at their own file and line — and inside it: [mix] gaining a
|
||||
parameter leaves [combine] and [twice] in the package's two files, the
|
||||
value [via-value] takes, and the calls the package's macros wrote into
|
||||
[main]. Making it private in the same breath does
|
||||
not let a stale caller outside the package off: recompiling it is still
|
||||
refused by the privacy check. *)
|
||||
(let tp, _ = Session.create ~file:"programs/pkg-private.flan" () in
|
||||
match
|
||||
Session.eval ~origin:"programs/pkgs/secret/secret.flan" tp
|
||||
"(defn- combine [a i32 b i32 c i32] i32 (mix a (+ b c)))"
|
||||
with
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
fail "a package function's signature change was refused: %s" m
|
||||
| c ->
|
||||
let where =
|
||||
List.map
|
||||
(fun (x : Session.stale) ->
|
||||
(x.Session.caller, Filename.basename x.Session.at.Loc.file,
|
||||
x.Session.at.Loc.line))
|
||||
c.Session.stale
|
||||
in
|
||||
if where <> [ ("main", "pkg-private.flan", 8) ] then
|
||||
fail "the package's stale callers were %s"
|
||||
(String.concat ", "
|
||||
(List.map (fun (n, f, l) -> Printf.sprintf "%s %s:%d" n f l) where));
|
||||
(match
|
||||
Session.eval ~origin:"programs/pkg-private.flan" tp
|
||||
"(defn main [] i32 (print (secret/combine 1 2 3)) 0)"
|
||||
with
|
||||
| _ -> fail "a stale caller recompiled past a defn- was accepted"
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
if not (has m "secret/combine is private to its package") then
|
||||
fail "the recompiled stale caller was refused for another reason: %s" m));
|
||||
(let tp, _ = Session.create ~file:"programs/pkg-private.flan" () in
|
||||
match
|
||||
Session.eval ~origin:"programs/pkgs/secret/secret.flan" tp
|
||||
"(defn- mix [a i32 b i32 c i32] i32 (+ (* a 10) (+ b c)))"
|
||||
with
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
fail "a private package function's signature change was refused: %s" m
|
||||
| c ->
|
||||
let where =
|
||||
List.sort compare
|
||||
(List.map
|
||||
(fun (x : Session.stale) ->
|
||||
(x.Session.caller, Filename.basename x.Session.at.Loc.file))
|
||||
c.Session.stale)
|
||||
in
|
||||
(* [main] twice: the package's macros write calls to [mix] into it. *)
|
||||
if where
|
||||
<> [ ("main", "pkg-private.flan"); ("main", "pkg-private.flan");
|
||||
("secret/combine", "secret.flan"); ("secret/twice", "more.flan");
|
||||
("secret/via-value", "more.flan") ]
|
||||
then
|
||||
fail "mix's stale callers were %s"
|
||||
(String.concat ", " (List.map (fun (n, f) -> n ^ " " ^ f) where)));
|
||||
(* And a single-file package: redefined from its own file, it stays private
|
||||
to that file, so the file beside it that imports it is still refused. *)
|
||||
let tl, _ = Session.create ~file:"programs/loose/use.flan" () in
|
||||
@ -1195,32 +1395,26 @@ let () =
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
fail "a redefinition needing a new instantiation: %s" m);
|
||||
|
||||
(* 4. A signature change on a generic is refused, and the refusal is about a
|
||||
name the source does not contain: the mangling carries only the type
|
||||
variables, so every copy changes signature at once and under the same
|
||||
name. It has to say where that name came from. *)
|
||||
(* The change has to be one the *checker* accepts, which is the narrow case
|
||||
and worth saying why. A generic whose arity or variable positions move is
|
||||
refused at its call sites, in the checker, with the call site's own
|
||||
location — a better error than this one and the reason this path is
|
||||
reached less often than it looks. What reaches here is a change every
|
||||
call site still accepts and every *copy* does not: widening the index
|
||||
from i32 to i64 leaves [(put-at xs 0 v)] checking, because the literal
|
||||
adapts, and changes [put-at-i32]'s signature underneath every compiled
|
||||
caller. *)
|
||||
(* 4. A signature change on a generic installs, like any other, and the
|
||||
callers left behind are the callers of its *copies*: the mangling carries
|
||||
only the type variables, so every copy changes signature at once under
|
||||
the name it had. Widening the index from i32 to i64 leaves
|
||||
[(put-at xs 0 v)] checking, because the literal adapts — the source is
|
||||
fine and the compiled call is not, which is the case the signature word
|
||||
exists for. *)
|
||||
(match
|
||||
Session.eval (gen ())
|
||||
"(defn put-at [xs [$t] i i64 v $t] () \
|
||||
(set (at xs (i32 i)) v))"
|
||||
with
|
||||
| _ -> fail "a generic's changed parameter type was accepted"
|
||||
| c ->
|
||||
if not (List.exists (fun (x : Session.stale) ->
|
||||
String.starts_with ~prefix:"put-at-" x.Session.target
|
||||
&& x.Session.compiled <> x.Session.current)
|
||||
c.Session.stale)
|
||||
then fail "a generic's changed parameter type named no stale caller"
|
||||
| exception Loc.Error { Loc.dmsg = m; _ } ->
|
||||
if not (has m "changes signature") then
|
||||
fail "a generic's changed parameter type: %S" m;
|
||||
if not (has m "the copy of the generic put-at") then
|
||||
fail "the refusal did not say the name came from put-at: %S" m;
|
||||
if not (has m "every copy of it at once") then
|
||||
fail "the refusal did not say every copy changed together: %S" m);
|
||||
fail "a generic's changed parameter type was refused: %s" m);
|
||||
|
||||
(* And what is *not* refused, which the notes expected to be: adding a
|
||||
[where] clause changes no signature at all. What it changes is which call
|
||||
@ -1346,27 +1540,20 @@ let () =
|
||||
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. *)
|
||||
(* A compiled caller of the constructor does not stop the edit either: a
|
||||
constructor is a function, and a slot added is a parameter added. The
|
||||
caller is named, and a call through it would stop on StaleCall rather
|
||||
than leave the third slot holding a register. *)
|
||||
(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"
|
||||
| c ->
|
||||
if List.map (fun (x : Session.stale) -> (x.Session.caller, x.Session.target))
|
||||
c.Session.stale
|
||||
<> [ ("origin", "point") ]
|
||||
then fail "a class with a compiled caller named the wrong stale callers"
|
||||
| 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);
|
||||
fail "a class with a compiled caller was refused: %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
|
||||
|
||||
@ -1654,7 +1654,7 @@ a guard after each call.</p>
|
||||
<li><strong>wasm32 works with no exception proposal</strong>, and native and wasm
|
||||
builds of the same program agree.</li>
|
||||
<li><strong>Every function carries the channel, release builds included.</strong> A
|
||||
hot-reload cell holds a bare pointer, so the honest answer to "what can this call?" is
|
||||
hot-reload cell can be given any body, so the honest answer to "what can this call?" is
|
||||
"anything". A later optimisation may stop a function checking the channel; it may not
|
||||
drop the parameter.</li>
|
||||
<li><strong>A transfer cannot cross a foreign frame.</strong> A handler installed
|
||||
@ -2023,7 +2023,6 @@ a silent mismatch against memory the process has already laid out:</p>
|
||||
<div class="scroll">
|
||||
<table>
|
||||
<tr><th>Change</th><th>What it would have broken</th></tr>
|
||||
<tr><td>a function's signature</td><td>a cell is a bare pointer; every call site compiled before the change still passes the old arguments through it</td></tr>
|
||||
<tr><td>a global's type</td><td>the storage exists and has a shape — reuse reads at the wrong offsets, replacement discards the state the reload exists to preserve</td></tr>
|
||||
<tr><td>a struct's fields</td><td>the values the process is holding have the old layout</td></tr>
|
||||
<tr><td>a <code>defconst</code> the checker consumed</td><td>it is in the shape of the program — <code>(defconst rows (/ h c))</code> decides <code>grid</code>'s type before anything else resolves</td></tr>
|
||||
@ -2037,10 +2036,13 @@ the checker never consumed can be changed, so a colour table can be tuned live w
|
||||
array length stays refused. A dev build emits those as mutable globals, so LLVM cannot
|
||||
fold a read of one.</p>
|
||||
|
||||
<p>The signature row is a stopgap. The design is versioned functions with their own
|
||||
trampolines, so that new callers resolve the new version while existing ones keep the
|
||||
old. None of the three parts exists yet, and the alternative to refusing is a silent
|
||||
argument mismatch.</p>
|
||||
<p>A function's signature is not on the list either. A dev cell carries the signature
|
||||
its body was compiled with, and every call through it compares that against the
|
||||
signature the caller was compiled for. A changed signature installs, the reply names
|
||||
every caller compiled against the old one by file and line, and a stale caller that
|
||||
reaches the call stops on a <code>StaleCall</code> condition instead of passing the old
|
||||
arguments. Evaluating the caller again clears it. <code>main</code> is the exception:
|
||||
the startup code that calls it was built with the program.</p>
|
||||
|
||||
<h3>Evaluating an expression</h3>
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user