Names that did not exist when the process started

Editing a defvar or a defn is a symbol the host exports. Adding one is not:
there is nothing to bind to and ELF cannot grow a symbol. runtime/flan_dev.c is
the two lookups that cover it - flan_dev_cell for a new function's cell,
flan_dev_global for a new global's storage - both idempotent, so the second
module to mention a name gets what the first one got. That is the whole point:
two modules with their own copy of a new function would each call their own,
and redefining it would update one of them.

The compiler picks per name. A name the host has is a symbol and costs one load
at a call site; a name it lacks is a registry lookup cached at install time in
a module-local slot, and costs two. The common case pays nothing for the
general one.

The redefinition unit is now a list of top-level forms rather than one
function. It has to be: v3 of the fixture adds a var and uses it from a
redefined bump, and splitting that into two loads leaves a module referring to
storage that does not exist yet. C-c C-c passes one name, C-c C-k passes a
file's worth, one path either way.

Four rules, each silent if broken. Every lookup resolves before any body is
published, or a caller reaches a function whose slots are still null - asserted
on the emitted flan_reload_install, since it cannot be race-tested.
flan_dev_global refuses a size change, which is the layout-drift rule's first
enforcement point rather than another exception to it. Nothing is ever
dlclosed, because a cell holds an address inside a module's text. And the table
is fixed capacity, because a module holds a cell's address for as long as it is
loaded and a realloc would strand it.

The test that separates this from a plausible wrong version is v4, which
redefines a name v3 introduced at run time. v3's bump is already installed and
is not rebuilt, so it picks v4 up only if its call goes through a cell both
modules found by the same name. Had v3 cached the function's address instead,
every other assertion would still pass and the transcript would read 246
instead of 432.

Sizes are spelled LLVM's way, ptrtoint getelementptr null 1, rather than by a
layout calculator in OCaml that would have to agree with LLVM's on every
target.
This commit is contained in:
Joseph Ferano 2026-09-10 21:34:31 +07:00
parent bb90f6e65e
commit 22cc0bc1c2
9 changed files with 479 additions and 96 deletions

72
NEXT.md
View File

@ -1,9 +1,10 @@
# Where this is
**Dev loop steps 1 and 2 are done** — see *The reload primitive* below.
A function can be recompiled and installed into a running process, and call
sites compiled before it existed follow it. That is `C-c C-c` on a `defn`,
without an editor attached to it yet.
**Dev loop steps 1 and 2 are done** — see *The reload primitive* below. A list
of top-level forms can be recompiled and installed into a running process; call
sites compiled before they existed follow them, and a `defn` or `defvar` the
process was never built with can be added and then redefined again. That is the
whole of `C-c C-c`, minus an editor and a frame boundary.
Milestone 4 is done: **sand.flan builds, links raylib and runs**, and its
simulation has a headless acceptance case that runs on the `dune test` path at
@ -29,6 +30,7 @@ reader ✅ → parse ✅ → load ✅ → check ✅ → emit ✅ → clang ✅
| `lib/emit.ml` | typed IR → LLVM IR text |
| `lib/build.ml` | `.ll` + the shim + the packages' C → clang → executable |
| `runtime/flan_rt.c` | the host ABI: argv, stdout, exit, 4 conversions |
| `runtime/flan_dev.c` | **dev only: the by-name registry a run-time-new name needs** |
| `vendor/raylib/` | **the raylib package: `raylib.flan`, `shim.c`, `link`** |
| `sand-sim/` | **the falling-sand simulation, with no raylib in it** |
| `bin/main.ml` | `flan read \| parse \| check \| emit \| build \| run` |
@ -401,13 +403,59 @@ acceptance table now runs `values`, `machine` and `sand-headless` as dev builds
as well; the sand hash is the case that matters, since it is the one result
that would notice a call reaching the wrong function.
### Names that did not exist when the process started
Editing a `defvar` or a `defn` is a symbol the host exports. *Adding* one is
not: there is no symbol to bind to and ELF cannot grow one. Those go through
`runtime/flan_dev.c`, which is two lookups and nothing else:
```
void **flan_dev_cell(const char *name); /* a new function's cell */
void *flan_dev_global(const char *name, uint64_t); /* a new global's storage */
```
Both are idempotent, so the second module to mention a name gets what the first
one got — which is the entire point. The compiler picks per name: a name the
host has is a symbol (one load at a call site), a name it lacks is a registry
lookup cached at install time in a module-local slot (two loads). So the common
case pays nothing for the general one.
**The unit is a list of top-level forms**, not one function — `Emit.redefinition
~fns`. `C-c C-c` passes one name, `C-c C-k` passes a file's worth, one code
path either way. It has to be: v3 of the fixture adds `extra` and uses it from
a redefined `bump`, and splitting that into two loads would leave a module
referring to storage that does not exist yet.
Four rules, each of which is a silent failure if broken:
- **Every lookup resolves before any body is published.** Publish first and a
caller reaches a function whose slots are still null. Not race-testable, so
it is asserted on the emitted `flan_reload_install`.
- **`flan_dev_global` refuses a size change.** The running process has already
laid that memory out; handing back the old allocation for a differently
shaped type means the new body reads fields at the wrong offsets and nothing
says so. This is the layout-drift rule's first enforcement point. Retyping a
var needs a restart.
- **Nothing is ever `dlclose`d.** A cell holds an address inside a module's
text; unloading it leaves every call site pointing at unmapped memory. That
is a constraint on the agent too.
- **The registry never moves.** A module holds a cell's address for as long as
it is loaded, so the table is fixed capacity with a loud failure rather than
growable.
The test that separates this from a plausible wrong version is **v4**, which
redefines `added` — a name v3 introduced at run time. v3's `bump` is already
installed and is not rebuilt, so it picks v4 up only if its call goes through a
*cell* both modules found by the same name. Had v3 cached the function's
address instead, every other assertion would still 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.
### Still missing for `C-c C-c`
- **A new `defvar` has nowhere to live.** Editing one works — a redefinition
module declares it `external`, so the storage stays the host's. *Adding* one
needs storage the host never laid out, which needs a runtime registry
(`flan_dev_cell(name)` handing out stable cell addresses, allocating on
first use) and globals reached through cells too. That is the next commit.
- **The agent**, so the install happens at a frame boundary in a real process
rather than in a C test harness. Step 3.
- **A session that holds the checker environment.** `Check.program` builds a
@ -468,9 +516,9 @@ primitive works.
1. ~~**The reload primitive, measured.**~~ **Done**`Emit.redefinition`,
`Build.shared`, `test/reload_host.c`, ~19ms. See the section above.
2. ~~**Indirection cells.**~~ **Done**`Build.opts.dev` / `flan build --dev`,
`flan_reload_install`, and a fixture whose untouched call site follows the
swap. See the section above. Still to do here: a *new* `defvar`, which needs
a runtime cell registry.
`flan_reload_install`, `runtime/flan_dev.c` for names introduced at run
time, and a fixture where an untouched call site follows the swap and a
run-time-added function is itself redefined. See the section above.
3. **The agent, in C.** A socket listener in the game process, `dlopen` off the
game thread with `RTLD_NOW`, and the staged cell publish at a frame
boundary. It lives next to `flan_rt.c` — no OCaml runtime in the game

View File

@ -122,7 +122,10 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = [])
write ll (Emit.program ~checks:opts.checks ~dev:opts.dev p);
let objs =
compile_c ~opts ~src:Runtime_src.source ~name:"flan_rt.c"
:: List.map
:: (if opts.dev then
[ compile_c ~opts ~src:Runtime_src.dev_source ~name:"flan_dev.c" ]
else [])
@ List.map
(fun c ->
compile_c ~opts ~src:(read_file c) ~name:(Filename.basename c))
csrcs

View File

@ -3,15 +3,21 @@
(libraries unix))
; The host shim is Flan's, not the user's, so the compiler carries it rather
; than looking for it in an install directory. Generated from the real .c file
; so there is only ever one copy to edit.
; than looking for it in an install directory. Generated from the real .c files
; so there is only ever one copy to edit. flan_dev.c goes into a dev build
; only — it is the run-time name lookup a REPL needs and a release build has
; no use for.
(rule
(target runtime_src.ml)
(deps %{workspace_root}/runtime/flan_rt.c)
(deps
%{workspace_root}/runtime/flan_rt.c
%{workspace_root}/runtime/flan_dev.c)
(action
(with-stdout-to
runtime_src.ml
(progn
(echo "let source = {c|\n")
(cat %{workspace_root}/runtime/flan_rt.c)
(echo "|c}\n\nlet dev_source = {c|\n")
(cat %{workspace_root}/runtime/flan_dev.c)
(echo "|c}\n")))))

View File

@ -60,6 +60,14 @@ let sname n = "%" ^ quoted n
have no cells and call the symbol directly. *)
let cellname n = "@" ^ quoted ("flan.cell." ^ n)
(* A name the host was never built with — a defn or a defvar 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
module-local slots. One indirection more than a name the host has, which is
why the compiler picks per name rather than routing everything this way. *)
let cellptr n = "@" ^ quoted ("flan.cellp." ^ n)
let globalptr n = "@" ^ quoted ("flan.gp." ^ n)
(* ── Types ─────────────────────────────────────────────────────────── *)
let rec ll (t : Types.t) =
@ -94,6 +102,9 @@ type m = {
externs : (string, string) Hashtbl.t;
checks : bool; (* emit bounds checks *)
dev : bool; (* call through cells (below) *)
(* Was this name in the build the running process came from? False only in a
redefinition module, and only for a name introduced since. *)
known : string -> bool;
mutable nstr : int;
}
@ -170,6 +181,16 @@ let string_const m s =
(* The value alone: LLVM takes the type from the operand's context. *)
Printf.sprintf "{ ptr %s, i64 %d }" id n
(* A NUL-terminated copy, for the two dev lookups that take a C string. Flan
strings are ptr+len and never NUL-terminated, so this is its own constant. *)
let cstring m s =
let id = Printf.sprintf "@\".name.%d\"" m.nstr in
m.nstr <- m.nstr + 1;
Buffer.add_string m.strs
(Printf.sprintf "%s = private unnamed_addr constant [%d x i8] c\"%s\\00\"\n"
id (String.length s + 1) (escape s));
id
(* ── Bounds checks ───────────────────────────────────────────────────── *)
(* A failure is a branch to a [noreturn] call and then [unreachable] — the same
@ -284,6 +305,16 @@ let rec value f (e : Tast.expr) : string =
| Tast.Match (s, arms) -> emit_match f e.Tast.ty s arms
| Tast.UnwrapSome v -> emit_unwrap f e.Tast.ty v
(* Where a global's storage is. A global the host was built with is a symbol;
one introduced since lives wherever [flan_dev_global] put it. *)
and global_addr f n =
if (not f.md.dev) || f.md.known n then gname n
else begin
let p = fresh f in
ins f "%s = load ptr, ptr %s" p (globalptr n);
p
end
and load f ptr ty =
let t = fresh f in
ins f "%s = load %s, ptr %s" t (ll ty) ptr;
@ -294,7 +325,7 @@ and load f ptr ty =
and addr f (e : Tast.expr) : string =
match e.Tast.e with
| Tast.Local i -> f.slots.(i)
| Tast.Global n -> gname n
| Tast.Global n -> global_addr f n
| Tast.Deref p -> value f p
| Tast.Field (target, i) -> field_addr f target i
| Tast.Prim (Tast.At, target :: idx) -> fst (element_addr f target idx)
@ -349,7 +380,7 @@ and element_addr f (target : Tast.expr) idx =
and place f (p : Tast.place) : string * Types.t =
match p with
| Tast.Plocal i -> f.slots.(i), f.slot_tys.(i)
| Tast.Pglobal n -> gname n, Hashtbl.find f.md.globals n
| Tast.Pglobal n -> global_addr f n, Hashtbl.find f.md.globals n
| Tast.Pfield (target, i) ->
let sn = match target.Tast.ty with
| Types.Named n -> n | t -> failwith ("field of " ^ Types.to_string t)
@ -393,10 +424,18 @@ and call f ret flan args =
between two calls still cannot land in the middle of one. *)
let callee =
if not f.md.dev then fname flan
else begin
else if f.md.known flan then begin
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;
p
end
in
let t = fresh f in
@ -862,12 +901,12 @@ let emit_main m (fn : Tast.fn) =
emitters look names up in, the struct types, and the foreign [declare]s.
Both entry points below start here, so a redefinition module cannot drift
from the whole-program one in how it names or lays out a type. *)
let new_module ~checks ~dev (p : Tast.program) =
let new_module ~checks ~dev ~known (p : Tast.program) =
let m = {
out = Buffer.create 8192; strs = Buffer.create 512;
structs = Hashtbl.create 16; globals = Hashtbl.create 16;
externs = Hashtbl.create 32;
checks; dev; nstr = 0;
checks; dev; known; nstr = 0;
} in
List.iter (fun (s : Tast.structure) -> Hashtbl.replace m.structs s.Tast.sname s)
p.Tast.structs;
@ -907,7 +946,7 @@ let finish m = header ^ Buffer.contents m.strs ^ "\n" ^ Buffer.contents m.out
(* [checks] is on by default: a dev build traps on an out-of-bounds [at] or
[slice], a release build is told to drop them. *)
let program ?(checks = true) ?(dev = false) (p : Tast.program) : string =
let m = new_module ~checks ~dev p in
let m = new_module ~checks ~dev ~known:(fun _ -> true) p in
(* One cell per function, initialised to the function this build compiled.
Nothing has been redefined yet, so a dev build starts out behaving exactly
like a release one the indirection is the only difference. *)
@ -927,61 +966,131 @@ let program ?(checks = true) ?(dev = false) (p : Tast.program) : string =
| None -> ());
finish m
(* One function, compiled into its own module against a host that is already
running the reload primitive (NEXT.md, step 1). The difference from
[program] is entirely in what this module *does not* define:
(* A list of top-level forms, compiled into their own module against a host
that is already running the redefinition unit (NEXT.md, the dev loop).
[C-c C-c] passes one name, [C-c C-k] passes a file's worth; there is one
code path either way.
- a global is [external]. Defining it would give the loaded object a second
copy, and the whole point of reloading into a live process is that the
state survives: sand's grid is a global, and "edit the code, keep the
sand" is the demo. So a redefinition can change a function's body and can
never re-initialise the program's data.
- every other function is a [declare], resolved back to the host at load
time, so a redefined [settle] calls the host's [move-grain] rather than
carrying a private copy of it.
The difference from [program] is almost entirely in what this module *does
not* define:
- a global the host has is [external]. Defining it would give the loaded
object a second copy, and the whole point of reloading into a live process
is that the state survives: sand's grid is a global, and "edit the code,
keep the sand" is the demo. So a redefinition can change a function's body
and can never re-initialise the program's data.
- a function the host has is reached through its cell, which is the host's
symbol, so a redefined [settle] calls whatever [move-grain] is current
rather than carrying a private copy of it.
- there is no [main]; this module is loaded, not started.
A name the host does *not* have is the case ELF cannot express, since there
is no symbol to bind to and no way to grow one. Those go through
[flan_dev_cell] / [flan_dev_global], keyed by string, resolved once at
install time into a module-local slot. See runtime/flan_dev.c.
String literals still have to come along: they are this module's own
constants, and omitting them is an undefined [@.str.N] at link time. *)
let redefinition ?(checks = true) ?(dev = false) (p : Tast.program) ~fn : string =
let target =
match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = fn) p.Tast.fns with
let redefinition ?(checks = true) ?(dev = false) ?(known = fun _ -> true)
(p : Tast.program) ~fns : string =
let target name =
match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = name) p.Tast.fns with
| Some f -> f
| None -> failwith (Printf.sprintf "no such function: %s" fn)
| None -> failwith (Printf.sprintf "no such function: %s" name)
in
let targets = List.map target fns in
let m = new_module ~checks ~dev ~known p in
let new_fns =
List.filter (fun (f : Tast.fn) -> not (known f.Tast.name)) p.Tast.fns
and new_globals =
List.filter (fun (g : Tast.global) -> not (known g.Tast.gname)) p.Tast.globals
in
let m = new_module ~checks ~dev p in
List.iter
(fun (g : Tast.global) ->
Buffer.add_string m.out
(Printf.sprintf "%s = external %s %s\n" (gname g.Tast.gname)
(if g.Tast.gconst then "constant" else "global") (ll g.Tast.gty)))
(if known g.Tast.gname then
Printf.sprintf "%s = external %s %s\n" (gname g.Tast.gname)
(if g.Tast.gconst then "constant" else "global") (ll g.Tast.gty)
else
Printf.sprintf "%s = internal global ptr null\n"
(globalptr g.Tast.gname)))
p.Tast.globals;
List.iter
(fun (f : Tast.fn) ->
if not (String.equal f.Tast.name fn) then
Buffer.add_string m.out
(Printf.sprintf "declare %s\n" (signature ~named:false f)))
p.Tast.fns;
if dev then begin
(* The cells are the host's, like the globals. Referencing one is how a
redefined function reaches its siblings, and storing into one is how it
replaces itself. *)
replaces itself. A name the host lacks gets a slot instead, filled by
the installer below. *)
List.iter
(fun (f : Tast.fn) ->
Buffer.add_string m.out
(Printf.sprintf "%s = external global ptr\n" (cellname f.Tast.name)))
(if known f.Tast.name then
Printf.sprintf "%s = external global ptr\n" (cellname f.Tast.name)
else
Printf.sprintf "%s = internal global ptr null\n"
(cellptr f.Tast.name)))
p.Tast.fns;
if new_fns <> [] || new_globals <> [] then
Buffer.add_string m.out
"\ndeclare ptr @flan_dev_cell(ptr)\ndeclare ptr @flan_dev_global(ptr, i64)\n";
Buffer.add_char m.out '\n'
end;
emit_fn m ~hidden:dev target;
if dev then
end
else
(* Without cells there is nothing to route a call through, so the siblings
are named directly and every one of them needs a declaration. *)
List.iter
(fun (f : Tast.fn) ->
if not (List.exists (String.equal f.Tast.name) fns) then
Buffer.add_string m.out
(Printf.sprintf "declare %s\n" (signature ~named:false f)))
p.Tast.fns;
List.iter (fun f -> emit_fn m ~hidden:dev f) targets;
if dev then begin
(* Publishing is a separate, named function rather than a constructor: the
agent has to choose *when* the swap happens at a frame boundary, on
the game thread and a loader-run ctor would do it during dlopen, on
whatever thread called it, in the middle of a frame. *)
whatever thread called it, in the middle of a frame.
Order inside it is load-bearing. Every lookup is resolved before any
body is published, because publishing first exposes a function whose
slots are still null to anything that calls it. *)
let b = Buffer.create 512 in
let n = ref 0 in
let fresh () = incr n; Printf.sprintf "%%d%d" !n in
List.iter
(fun (f : Tast.fn) ->
let t = fresh () in
Buffer.add_string b
(Printf.sprintf " %s = call ptr @flan_dev_cell(ptr %s)\n store ptr %s, ptr %s\n"
t (cstring m ("flan." ^ f.Tast.name)) t (cellptr f.Tast.name)))
new_fns;
List.iter
(fun (g : Tast.global) ->
let t = fresh () in
(* sizeof, spelled the way LLVM spells it: the offset of element one
of a null pointer. Cheaper than a layout calculator in OCaml that
would have to agree with LLVM's on every target. *)
Buffer.add_string b
(Printf.sprintf
" %s = call ptr @flan_dev_global(ptr %s, i64 ptrtoint (ptr getelementptr (%s, ptr null, i32 1) to i64))\n \
store ptr %s, ptr %s\n"
t (cstring m ("flan." ^ g.Tast.gname)) (ll g.Tast.gty) t
(globalptr g.Tast.gname)))
new_globals;
List.iter
(fun (f : Tast.fn) ->
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 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)
end)
targets;
Buffer.add_string m.out
(Printf.sprintf
"\ndefine void @flan_reload_install() {\nentry:\n \
store ptr %s, ptr %s\n ret void\n}\n"
(fname fn) (cellname fn));
(Printf.sprintf "\ndefine void @flan_reload_install() {\nentry:\n%s ret void\n}\n"
(Buffer.contents b))
end;
finish m

95
runtime/flan_dev.c Normal file
View File

@ -0,0 +1,95 @@
/* flan_dev — the part of the host ABI that only a dev build has.
*
* A redefinition module reaches the host's functions and globals through
* symbols the host already exports: a cell for each function, the storage for
* each global. That covers everything the program was *built* with. It does
* not cover a name the module introduces a defn or a defvar typed into the
* REPL after the process started because there is no symbol in the host to
* bind to and ELF cannot grow one.
*
* So a name that is new at run time is keyed by string instead. This file is
* the two lookups that make that work, and deliberately nothing else:
*
* flan_dev_cell(name) the cell a new function lives in
* flan_dev_global(name, size) the storage a new global lives in
*
* Both are idempotent: the second module to mention a name gets what the first
* one got. That is the whole point. Two modules that each define their own
* copy of a new function would each call their own, and redefining it would
* update one of them.
*
* The table never moves. A module holds the address of a cell for as long as
* it is loaded, so a growable table would leave those addresses pointing into
* a freed allocation. Fixed capacity and a loud failure instead.
*
* Never dlclose a module. A cell holds an address inside that module's text,
* and unloading it leaves every call site pointing at unmapped memory. There
* is no unload path here on purpose.
*/
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define FLAN_DEV_MAX 4096
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 */
size_t size; /* a global's size; 0 for a function */
} entry;
static entry table[FLAN_DEV_MAX];
static size_t used;
static void die(const char *what, const char *name) {
fprintf(stderr, "flan_dev: %s: %s\n", what, name);
fflush(stderr);
abort();
}
static entry *find(const char *name) {
for (size_t i = 0; i < used; i++)
if (strcmp(table[i].name, name) == 0) return &table[i];
return NULL;
}
static entry *intern(const char *name) {
if (used == FLAN_DEV_MAX) die("out of dev name slots", name);
entry *e = &table[used++];
e->name = strdup(name);
if (e->name == NULL) die("out of memory", name);
e->cell = NULL;
e->size = 0;
return e;
}
/* The cell a run-time-introduced function is called through. One indirection
* more than a function the host was built with, whose cell is a symbol the
* module can name directly the compiler picks per name, so the common case
* stays a single load. */
void **flan_dev_cell(const char *name) {
entry *e = find(name);
if (e == NULL) e = intern(name);
return &e->cell;
}
/* Zeroed storage for a run-time-introduced global, allocated once.
*
* A size mismatch is the layout-drift failure, caught at its first chance: the
* running process has already laid this memory out, and handing back the old
* allocation for a differently shaped type means the new body reads fields at
* the wrong offsets and nothing ever says so. Retyping a var needs a restart. */
void *flan_dev_global(const char *name, uint64_t size) {
entry *e = find(name);
if (e == NULL) {
e = intern(name);
e->cell = calloc(1, size ? (size_t)size : 1);
if (e->cell == NULL) die("out of memory", name);
e->size = (size_t)size;
return e->cell;
}
if (e->size != (size_t)size) die("size changed; restart to retype", name);
return e->cell;
}

View File

@ -0,0 +1,24 @@
;;;; v3 introduces names the host was never built with: a defvar [extra] and a
;;;; defn [added]. There is no symbol in the running process to bind either to
;;;; and ELF cannot grow one, so both are keyed by string through
;;;; runtime/flan_dev.c and resolved once when the module is installed.
;;;;
;;;; [bump] is redefined in the same module, which is the point of the unit
;;;; being a list of forms rather than one function: C-c C-k on a file that
;;;; adds a var and uses it has to work in one load, or the intermediate state
;;;; is a module referring to storage that does not exist yet.
(defvar counter i64)
(defvar extra i64)
(defn helper [x i64] i64 (* x 2))
(defn added [] i64
(set extra (+ extra 7))
extra)
(defn bump [] i64
(print-line "v3")
(set counter (+ counter (added)))
(helper counter))
(defn outer [] i64 (bump))

View File

@ -0,0 +1,24 @@
;;;; v4 redefines only [added] — itself introduced at run time by v3, so it
;;;; lives in the registry and not in any symbol table.
;;;;
;;;; This is the case that separates a real implementation from a plausible
;;;; one. v3's [bump] is already installed and is not rebuilt here, so it picks
;;;; this up only if its call to [added] goes through a *cell* that both
;;;; modules found by name. Had v3 cached the address of the function instead
;;;; of the address of its cell, everything else would still pass and this
;;;; would silently keep running v3's [added].
(defvar counter i64)
(defvar extra i64)
(defn helper [x i64] i64 (* x 2))
(defn added [] i64
(set extra (+ extra 100))
extra)
(defn bump [] i64
(print-line "v3")
(set counter (+ counter (added)))
(helper counter))
(defn outer [] i64 (bump))

View File

@ -16,12 +16,19 @@
* - the loaded copy writes the *host's* [counter] and calls the host's
* [helper], because a redefinition module declares both rather than
* defining them;
* - the state carries across two reloads untouched.
* - the state carries across every reload untouched;
* - a name the host was never built with v3's [extra] and [added] can be
* introduced, and then itself redefined by v4 while v3's already-installed
* [bump] keeps calling it. That last one is what separates a cell found by
* name from a function address cached by name; everything else passes
* either way.
*
* The two versions are separate files rather than one path rewritten in
* place: dlopen keys its cache on the path, so re-opening the same name can
* hand back the handle it already has and the test would then "pass" on the
* code it loaded the first time.
* Each version is its own file rather than one path rewritten in place:
* dlopen keys its cache on the path, so re-opening the same name can hand back
* the handle it already has and the test would then "pass" on the code it
* loaded the first time. Nothing is ever dlclosed a cell holds an address
* inside a module's text, and unloading it would leave call sites pointing at
* unmapped memory.
*/
#include <dlfcn.h>
@ -72,15 +79,15 @@ static int install(const char *path) {
int main(int argc, char **argv) {
flan_rt_init(argc, argv);
if (argc != 3) {
fprintf(stderr, "usage: %s <v1.so> <v2.so>\n", argv[0]);
if (argc < 2) {
fprintf(stderr, "usage: %s <module.so>...\n", argv[0]);
return 2;
}
printf("host %lld\n", (long long)flan_outer());
if (!install(argv[1])) return 1;
printf("v1 %lld\n", (long long)flan_outer());
if (!install(argv[2])) return 1;
printf("v2 %lld\n", (long long)flan_outer());
for (int i = 1; i < argc; i++) {
if (!install(argv[i])) return 1;
printf("after%d %lld\n", i, (long long)flan_outer());
}
printf("counter %lld\n", (long long)flan_counter);
return 0;
}

View File

@ -9,8 +9,9 @@
The parts, all of them new here:
Emit.program ~dev a cell per function; every call goes through one
Emit.redefinition one [define], everything else [declare]/[external],
Emit.redefinition a form list defined, everything else [external],
plus [flan_reload_install] to publish it into its cell
flan_dev.c the by-name registry a run-time-new name needs
Build.shared that IR text through llc + ld -shared, timed
reload_host.c dlopen, install, call twice, in one process
@ -40,6 +41,17 @@ let () =
| 0 ->
let p1 = checked "programs/reload.flan" in
let p2 = checked "programs/reload-v2.flan" in
let p3 = checked "programs/reload-v3.flan" in
let p4 = checked "programs/reload-v4.flan" in
(* What the running process was built with. Everything else — v3's [extra]
and [added] has no symbol to bind to and goes through the registry.
A session would keep this set and grow it; the test states it. *)
let host_names =
List.map (fun (f : Tast.fn) -> f.Tast.name) p1.Tast.fns
@ List.map (fun (g : Tast.global) -> g.Tast.gname) p1.Tast.globals
in
let known n = List.exists (String.equal n) host_names in
(* [dev] is the two halves of a reloadable build together: cells, so a
call site can be made to follow a redefinition, and [-rdynamic], so the
@ -53,11 +65,19 @@ let () =
(* Two paths, not one rewritten in place: dlopen caches by path and would
hand back the first handle, so the swap would silently not happen. *)
let so1 = tmp "v1.so" and so2 = tmp "v2.so" in
let ir1, emit_ms = ms (fun () -> Emit.redefinition ~dev:true p1 ~fn:"bump") in
let t1 = Build.shared ~opts:dev ~ir:ir1 ~out:so1 () in
let ir2, emit2_ms = ms (fun () -> Emit.redefinition ~dev:true p2 ~fn:"bump") in
let t2 = Build.shared ~opts:dev ~ir:ir2 ~out:so2 () in
let module_of p fns name =
let out = tmp name in
let ir, emit_ms = ms (fun () -> Emit.redefinition ~dev:true ~known p ~fns) in
let t = Build.shared ~opts:dev ~ir ~out () in
(out, ir, emit_ms, t)
in
let so1, _ir1, emit_ms, t1 = module_of p1 [ "bump" ] "v1.so" in
let so2, ir2, emit2_ms, t2 = module_of p2 [ "bump" ] "v2.so" in
(* One module, two forms: the var and the function that uses it have to
arrive together or the intermediate state refers to storage that does
not exist. This is the C-c C-k unit. *)
let so3, ir3, _, _ = module_of p3 [ "bump"; "added" ] "v3.so" in
let so4, ir4, _, _ = module_of p4 [ "added" ] "v4.so" in
(* A redefinition module must not define what the host already owns:
defining [counter] would give the loaded object a private copy and the
@ -68,10 +88,25 @@ let () =
let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
go 0
in
(* No Str, for the same reason the reader is hand-written. [`First] and
[`Last] are which occurrence; the pair shape keeps the match below
readable. *)
let find hay needle which =
let n = String.length needle and h = String.length hay in
let rec go i acc =
if i + n > h then acc
else if String.sub hay i n = needle then
match which with `First -> Some i | `Last -> go (i + 1) (Some i)
else go (i + 1) acc
in
go 0 None
in
if not (has ir2 "@\"flan.counter\" = external global i64") then
fail "redefinition defines the global instead of declaring it";
if not (has ir2 "declare i64 @\"flan.helper\"(i64)") then
fail "redefinition defines a sibling function instead of declaring it";
(* In a dev module a sibling is reached only through its cell, so there is
nothing to declare and a [define] would be a private copy. *)
if has ir2 "declare i64 @\"flan.helper\"" then
fail "dev redefinition declares a sibling it should reach by cell";
if has ir2 "define i64 @\"flan.helper\"" then
fail "redefinition emitted a second body for a function it does not own";
if has ir2 "define i32 @main" then fail "redefinition emitted an entry point";
@ -81,6 +116,30 @@ let () =
fail "redefinition's own body is interposable";
if not (has ir2 "@\"flan.cell.helper\" = external global ptr") then
fail "redefinition defines a cell instead of using the host's";
(* A name the host has is a symbol; a name it lacks is a registry lookup
cached in a module-local slot. Getting this backwards either fails to
link or silently gives each module its own copy. *)
if not (has ir3 "@\"flan.cellp.added\" = internal global ptr null") then
fail "a run-time-new function did not get a slot";
if not (has ir3 "@\"flan.gp.extra\" = internal global ptr null") then
fail "a run-time-new global did not get a slot";
if has ir3 "@\"flan.extra\" = " then
fail "a run-time-new global was given storage in the module";
(* Every lookup is resolved before any body is published: publishing first
exposes a function whose module-local slots are still null to anything
that calls it. Not race-testable, so it is asserted on the text. *)
(* v4 redefines a name that exists only in the registry, so it publishes
through the cell it looked up rather than into a symbol there is no
[@"flan.cell.added"] anywhere to store into. *)
if has ir4 "@\"flan.cell.added\"" then
fail "a run-time-new function was published into a symbol";
if not (has ir4 "call ptr @flan_dev_cell") then
fail "v4 did not look its target up by name";
(match find ir3 "store ptr @\"flan." `First, find ir3 "@flan_dev_(" `Last with
| Some publish, Some resolve when resolve > publish ->
fail "flan_reload_install publishes a body before resolving a lookup"
| None, _ -> fail "flan_reload_install publishes nothing"
| _ -> ());
(* 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
@ -93,34 +152,42 @@ let () =
let cmd =
(* stderr kept apart from stdout: the host times its own dlopen there,
and stdout is what the expected transcript is compared against. *)
Printf.sprintf "%s %s %s > %s 2> %s" (Filename.quote host)
(Filename.quote so1) (Filename.quote so2) (Filename.quote out)
Printf.sprintf "%s %s %s %s %s > %s 2> %s" (Filename.quote host)
(Filename.quote so1) (Filename.quote so2) (Filename.quote so3)
(Filename.quote so4) (Filename.quote out)
(Filename.quote (tmp "err"))
in
let (code, dlopen_ms) = ms (fun () -> Sys.command cmd) in
let text = In_channel.with_open_bin out In_channel.input_all in
let timings =
In_channel.with_open_bin (tmp "err") In_channel.input_all in
let timings = In_channel.with_open_bin (tmp "err") In_channel.input_all in
(* host: counter 0 -> 1, helper 1 = 2. v1: 1 -> 2, helper 2 = 4.
v2: the changed body, +10 and +1000, over the counter v1 left behind
so 2 -> 12, helper 12 = 24, 1024. Two things are being read here. The
last line is the state: it is the host's, and two reloads did not touch
it. And 1024 rather than 1036 is the call: v2's own text for [helper]
multiplies by three, so the host's copy is demonstrably the one that
ran. The bare "v1"/"v2" lines come from inside each [bump] and are what
exercise a redefinition module's string constants.
(* Every call is [outer], compiled once into the host and never rebuilt, so
a changed answer can only mean its call site followed the redefinition.
The arithmetic, in order:
Two things are load-bearing about the shape of this transcript. Every
call is [outer], compiled once into the host and never rebuilt so a
changed answer can only mean its call site followed the redefinition.
And v2's [bump] recurses until the counter passes 100, through the cell:
2 -> 12 -> ... -> 102, ten "v2" lines, helper 102 = 204, 1204. An
interposed self-call would reach the host's v1 body instead, print "v1"
on the second line of that run, and land nowhere near 1204. *)
host counter 0 -> 1, helper 1 = 2
v1 counter 1 -> 2, helper 2 = 4 (a rebuild of the same)
v2 +10 and +1000, recursing through its own cell until the
counter passes 100: 2 -> 12 -> ... -> 102, ten "v2" lines,
helper 102 = 204, so 1204. An interposed self-call would reach
the host's v1 body, print "v1", and land nowhere near it.
v3 extra 0 -> 7, counter 102 -> 109, helper 109 = 218. [extra]
and [added] are new names, so both came from the registry.
v4 redefines [added] only. v3's [bump] is still the installed one
and is not rebuilt here, so it reaches v4 only through a cell
the two modules found by the same name: extra 7 -> 107,
counter 109 -> 216, helper 216 = 432. Had v3 cached the
function's address rather than its cell's, this would be 246.
The "v1"/"v2"/"v3" lines come from inside each [bump] and are what
exercise a redefinition module's own string constants. 1204 rather than
1236 is [helper]: v2's text for it multiplies by three, and the module
declares it rather than defining it, so the host's copy is the one that
ran. *)
let v2s = String.concat "" (List.init 10 (fun _ -> "v2\n")) in
let want =
"v1\nhost 2\nv1\nv1 4\n" ^ v2s ^ "v2 1204\ncounter 102\n"
"v1\nhost 2\nv1\nafter1 4\n" ^ v2s ^ "after2 1204\n\
v3\nafter3 218\nv3\nafter4 432\ncounter 216\n"
in
if code <> 0 || text <> want then
fail "reload\n got: %S (exit %d)\n wanted: %S" text code want;
@ -132,7 +199,7 @@ let () =
print_string timings;
List.iter (fun p -> try Sys.remove p with Sys_error _ -> ())
[ host; so1; so2; out; tmp "err" ];
[ host; so1; so2; so3; so4; out; tmp "err" ];
if !failures = 0 then print_endline "reload: all tests passed"
else begin
Printf.printf "\n%d failure(s)\n" !failures;