JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A name the host was never built with, compiled by the x86 backend

Browse Source 
The first of the three things HANDOFF-x86-redef.md left: a function or a
defvar the running process has no symbol for. ELF cannot grow one, so the
address is asked for by string at install time -- flan_dev_cell for a cell,
flan_dev_global for a global's storage -- and parked in a slot this module
defines.

The reference side is one new [loc] case and nothing else. [Lslot] loads the
slot and answers [Reg (scratch, d)], which is exactly what [Lgot] already did
with [Got] where this has [Sym]; every site that reaches a cell already
double-loads, so no call site, no place expression and no [sym_loc] caller had
to learn a third case. [fnctx.slot] is a second predicate rather than a widened
[ext] because they answer different questions -- [ext] says "the host's, reach
it through the GOT", [slot] says "nobody's yet, reach it through a slot I
filled". It defaults to [fun _ -> None], so the whole-program path emits
byte-identical output and the survey goes on being a structural check.

flan_reload_install is now a function with a frame rather than a run of loads
and stores, because it makes calls and a call on an unaligned stack faults
inside glibc's movaps rather than anywhere a reader would look. Its shape is
emit_globals_init's, down to owning the null transfer cell no caller hands it.

A new global's declared value travels with it: flan_dev_global copies the image
onto the allocation the first time the name is interned and ignores it after,
which is where "a reload must not reset the state" lives. emit.ml folds that
value into an LLVM constant and this file has no folder, so the image is a
module-local buffer written by the initialiser lowered as ordinary code -- the
same bargain emit_globals_data already documents.

Republishing a defconst came free once the rest was there: one store of the new
constant into the host's global, which is what emit.ml does.

reload-v6.flan is new. v3's [extra] is declared zero, which calloc also gives,
so a run-time-new global whose initial value never arrived would still pass;
v6's [tuning] is 42 and the host prints 88.

test_reload.ml's x86 section now runs all four modules against the same
transcript the LLVM path is held to, and the refusal it used to assert is gone.
This commit is contained in:
Joseph Ferano 2026-09-14 10:16:42 +07:00
parent 9ad886abe5
commit 5a67cf458a
3 changed files with 274 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

266
lib/x86.ml
View File

@ -557,6 +557,17 @@ type fnctx = {
module answers true for the host's cells, globals and bodies, and those
go through the GOT -- see [modrm_got]. *)
ext : string -> bool;
(* [Some slot] of a symbol that does not exist anywhere: a function or a
global the host was never built with, introduced by a redefinition module
while the process was running. There is no symbol to bind to and ELF has
no way to grow one, so the address is looked up by string at install time
and parked in [slot], which is this module's own object. Always [None] for
a whole program, where [known] is true of everything -- so the
whole-program path emits byte-identical output and the survey goes on
being a structural check on all of this. [ext] and this are two questions
and not one: [ext] says "the host's, reach it through the GOT", this says
"nobody's yet, reach it through a slot I filled". *)
slot : string -> string option;
(* The line table under construction, in a [--debug] build. [None] is every
other build, and then [dwline] below is the only thing that looks at it
and does nothing — so a release build's output is byte-identical to what
@ -716,6 +727,13 @@ type loc =
| Lf of int (* rbp + d *)
| Lg of string * int (* rip-relative symbol + d *)
| Lgot of string * int (* a symbol this object does not define; + d *)
(* A name that did not exist when the host was built, so there is no symbol
anywhere to bind to. The address lives in a slot this module defines and
[flan_reload_install] fills by asking the runtime's registry for it by
string. The slot is this object's own, so naming it is pc-relative and
never goes through the GOT; reading it is the one extra load, which is
exactly [Lgot]'s shape with [Sym] where it has [Got]. *)
| Lslot of string * int (* a module-local slot holds the address; + d *)
| Lp of int * int (* [rbp + p] is a pointer; + d *)
let shift l d =
@ -723,6 +741,7 @@ let shift l d =
| Lf o -> Lf (o + d)
| Lg (s, a) -> Lg (s, a + d)
| Lgot (s, a) -> Lgot (s, a + d)
| Lslot (s, a) -> Lslot (s, a + d)
| Lp (p, a) -> Lp (p, a + d)
(* [scratch] is only touched by the [Lp] case, and every caller passes r11 —
@ -737,6 +756,9 @@ let lmem f (l : loc) ~scratch : mem =
| Lgot (s, a) ->
load_int f.b ~dst:scratch ~mm:(Got s) ~size:8 ~signed:false;
Reg (scratch, a)
| Lslot (s, a) ->
load_int f.b ~dst:scratch ~mm:(Sym (s, 0)) ~size:8 ~signed:false;
Reg (scratch, a)
| Lp (p, a) ->
load_int f.b ~dst:scratch ~mm:(Frame p) ~size:8 ~signed:false;
Reg (scratch, a)
@ -748,13 +770,19 @@ let addr_into f ~reg (l : loc) =
| Lgot (s, a) ->
load_int f.b ~dst:reg ~mm:(Got s) ~size:8 ~signed:false;
if a <> 0 then add_imm f.b ~dst:reg a
| Lslot (s, a) ->
load_int f.b ~dst:reg ~mm:(Sym (s, 0)) ~size:8 ~signed:false;
if a <> 0 then add_imm f.b ~dst:reg a
| Lp (p, a) ->
load_int f.b ~dst:reg ~mm:(Frame p) ~size:8 ~signed:false;
if a <> 0 then add_imm f.b ~dst:reg a
(* The spellings of "name a symbol", each picking the pc-relative form
for a symbol this object defines and the GOT form for one it does not. *)
let sym_loc f s = if f.ext s then Lgot (s, 0) else Lg (s, 0)
let sym_loc f s =
match f.slot s with
| Some sl -> Lslot (sl, 0)
| None -> if f.ext s then Lgot (s, 0) else Lg (s, 0)
(* [lea] of a symbol is an address; out of the GOT the address is already
there, so the [lea] becomes a load. *)
@ -769,11 +797,20 @@ let addr_sym f ~dst s =
beside [call *%r11] reads as "call through the cell" and in fact calls the
cell. docs/DISCUSS.md item 15 said this is how hand-encoding fails. *)
let load_sym f ~dst s =
if f.ext s then begin
load_int f.b ~dst ~mm:(Got s) ~size:8 ~signed:false;
match f.slot s with
(* The slot holds the cell's address, just as the GOT entry below does, so
this is the same two loads with one relocation swapped. Which is the point
of spelling a run-time-new name this way: every site that reaches a cell
already double-loads, and none of them had to learn a third case. *)
| Some sl ->
load_int f.b ~dst ~mm:(Sym (sl, 0)) ~size:8 ~signed:false;
load_int f.b ~dst ~mm:(Reg (dst, 0)) ~size:8 ~signed:false
end
else load_int f.b ~dst ~mm:(Sym (s, 0)) ~size:8 ~signed:false
| None ->
if f.ext s then begin
load_int f.b ~dst ~mm:(Got s) ~size:8 ~signed:false;
load_int f.b ~dst ~mm:(Reg (dst, 0)) ~size:8 ~signed:false
end
else load_int f.b ~dst ~mm:(Sym (s, 0)) ~size:8 ~signed:false
let scalar_size f (t : Types.t) =
match t with Types.Bool -> 1 | _ -> max 1 (sizeof f.md t)
@ -2542,7 +2579,8 @@ let incoming_of ~sret (params : Types.t list) =
sret_at, ps, next_int ()
let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
?(hidden = false) ?dw (fn : Tast.fn) : string * string =
?(slot = fun _ -> None) ?(hidden = false) ?dw (fn : Tast.fn)
: string * string =
let b = create () in
let nslots = Array.length fn.Tast.slots in
let f =
@ -2551,7 +2589,7 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
xfer_off = 0; sret_off = 0; retval = 0;
frame = 0; maxframe = 0; outgoing = 0;
loops = []; pads = []; xfer_lbl = ""; unwound = false;
rodata = Buffer.create 64; externs; fns; ext; dw }
rodata = Buffer.create 64; externs; fns; ext; slot; dw }
in
(* The subprogram this function's rows hang off. Its first row is the
function symbol itself, at the line the [defn] was written on, so the
@ -2874,7 +2912,7 @@ let emit_globals_init ?(cfi = false) (md : Emit.m) ~externs ~fns
frame = 0; maxframe = 0; outgoing = 0; loops = []; pads = [];
xfer_lbl = ""; unwound = false;
rodata = Buffer.create 64; externs; fns; ext = (fun _ -> false);
dw = None }
slot = (fun _ -> None); dw = None }
in
(* Two slots, not one: [xfer_off] holds the *pointer* every call passes on,
and [cell] is what it points at. Storing a null into [xfer_off] itself —
@ -3350,21 +3388,34 @@ let program ~checks ?(dev = false) ?(debug = false) (p : Tast.program) : string
frame boundary, on the game thread. [reload_host.c] and
[vendor/agent/flan_agent.c] both [dlsym] exactly that spelling.
{b The scope, and it is narrower than [Emit.redefinition]'s.} Only names the
host already has. A name introduced since has no symbol to bind to, and
[Emit.redefinition] answers that with [flan_dev_cell] / [flan_dev_global] and
[Emit.cellptr]'s deeper spelling -- a module-local slot resolved by string at
install time. That is not built here, and neither is the [consts] republish
nor the transient [flan_reload_call] thunk. Each is refused by name, which is
this file's idiom for a case it has not earned the right to compile. *)
{b A name the host was never built with.} There is no symbol to bind to and
ELF has no way to grow one, so the address is asked for by string at install
time -- [flan_dev_cell] for a function's cell, [flan_dev_global] for a
global's storage -- and parked in a slot this module defines. [Lslot] is how
every later reference reads it, and it is [Lgot]'s shape with the relocation
swapped, so no call site and no place expression had to learn a third case.
[Emit.cellptr] and [Emit.globalptr] are the same two slots on the LLVM side,
spelled the same way here so the two are readable against each other.
A new global's declared initial value travels with it, because
[flan_dev_global] copies it onto the allocation the first time the name is
seen and ignores it afterwards -- which is where "a reload must not reset the
program's state" lives. [emit.ml] folds that value into an LLVM constant; it
has a folder for the IR's own syntax and this file does not. So the image is
built the way [emit_globals_init] builds a global's storage in a whole
program: a module-local buffer, written by the initialiser expression lowered
as ordinary code. A few instructions once, and no second evaluator that could
disagree with the first about what a struct literal means.
{b The scope, and it is still narrower than [Emit.redefinition]'s.} The
transient [flan_reload_call] thunk is not built here, and is refused by name
-- this file's idiom for a case it has not earned the right to compile. *)
let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
?(consts = []) ?call (p : Tast.program) ~fns : string =
if not dev then
unsupported
"x86 redefinition without cells: there is nothing to publish a body \
into, and this backend's release build has no indirection";
if consts <> [] then
unsupported "x86 redefinition: republishing a defconst is not built yet";
(match call with
| Some _ ->
unsupported
@ -3390,24 +3441,15 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
let siblings =
List.filter (fun (f : Tast.fn) -> f.Tast.fparent = None) p.Tast.fns
in
List.iter
(fun (f : Tast.fn) ->
if not (known f.Tast.name) then
unsupported
"x86 redefinition: %s is new to this session, and a name the host \
was not built with needs the flan_dev_cell lookup and \
Emit.cellptr's second spelling, which are not built here yet"
f.Tast.name)
siblings;
List.iter
(fun (g : Tast.global) ->
if not (known g.Tast.gname) then
unsupported
"x86 redefinition: the global %s is new to this session, and a new \
global needs the flan_dev_global lookup, which is not built here \
yet"
g.Tast.gname)
p.Tast.globals;
(* The names this module introduces, each of which gets a slot below. A
function's slot holds its cell's address and a global's holds its
storage's, so the two are the same eight bytes and differ only in what
fills them. *)
let new_fns = List.filter (fun (f : Tast.fn) -> not (known f.Tast.name)) siblings
and new_globals =
List.filter (fun (g : Tast.global) -> not (known g.Tast.gname))
p.Tast.globals
in
let md = layout_ctx ~checks ~dev p in
let externs = Hashtbl.create 16 in
List.iter
@ -3424,6 +3466,19 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
List.iter (fun (f : Tast.fn) -> Hashtbl.replace mine (fsym f.Tast.name) ())
(targets @ lifted);
let ext s = not (Hashtbl.mem mine s) in
(* And the third answer: a name that is nobody's symbol yet. Keyed by the
spelling the reference uses -- a function is reached through its cell, so
the key is [csym]; a global is reached by its own name, so it is [gsym].
The two can never collide, because a function and a global cannot share a
name and [gsym] and [fsym] are the same string. *)
let cellp n = asm_sym ("flan.cellp." ^ n)
and gp n = asm_sym ("flan.gp." ^ n) in
let slots = Hashtbl.create 8 in
List.iter (fun (f : Tast.fn) ->
Hashtbl.replace slots (csym f.Tast.name) (cellp f.Tast.name)) new_fns;
List.iter (fun (g : Tast.global) ->
Hashtbl.replace slots (gsym g.Tast.gname) (gp g.Tast.gname)) new_globals;
let slot s = Hashtbl.find_opt slots s in
let text = Buffer.create 8192 and rodata = Buffer.create 1024 in
Buffer.add_string text
"# Generated by flan's x86-64 backend: one or more functions, recompiled\n\
@ -3432,32 +3487,147 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
\t.text\n\n";
List.iter
(fun (f : Tast.fn) ->
let t, r = emit_fn md ~externs ~fns:fnstbl ~ext ~hidden:true f in
let t, r = emit_fn md ~externs ~fns:fnstbl ~ext ~slot ~hidden:true f in
Buffer.add_string text t;
Buffer.add_string rodata r)
(lifted @ targets);
(* Publishing: one store per target, and the cell's address has to be read
out of the GOT first because the cell itself lives in the host. The body
is this module's own and hidden, so its address is an ordinary
pc-relative [lea]. *)
let b = create () in
(* [flan_reload_install] is a function with a frame, not a run of loads and
stores, and it has to be: it calls into the runtime, and a [call] made on
an unaligned stack faults inside glibc's own [movaps] rather than anywhere
a reader would look. A prologue is what makes rsp 16-aligned at every call
below, since [frame_bytes] rounds. Its shape is [emit_globals_init]'s and
for the same reasons, down to owning a null transfer cell that no caller
hands it. *)
let ib = create () in
let f =
{ b = ib; md; fnname = "<install>"; retlbl = new_label () "install";
fret = Types.Unit; slots = [||]; xfer_off = 0; sret_off = 0; retval = 0;
frame = 0; maxframe = 0; outgoing = 0; loops = []; pads = [];
xfer_lbl = ""; unwound = false;
rodata = Buffer.create 256; externs; fns = fnstbl; ext; slot; dw = None }
in
let chan = ptmp f in
f.xfer_off <- ptmp f;
f.xfer_lbl <- new_label f "ixfer";
(* A new global's initial value, written into a buffer of this module's own.
[flan_dev_global] copies it the first time the name is interned and
ignores it on every call after, so a second module mentioning the same
name cannot reset the state the reload exists to preserve. Doing it before
any lookup is deliberate: nothing outside this module can see these
buffers, so they are not a publication and the order below is still
"resolve everything, then publish". *)
let images =
List.map
(fun (g : Tast.global) ->
let size, align = Emit.lay md g.Tast.gty in
let l = rodata_label f in
scoped f (fun () -> lower f g.Tast.ginit (Lg (l, 0)));
(g, l, max 1 size, max 1 align))
new_globals
in
(* The lookups, all of them, before a single body is published. Publishing
first would expose a function whose slots are still null to anything that
called it, and here that means every call site in the host. [emit.ml] says
the same and [test_reload.ml] checks it there by grepping the IR text;
there is no text to grep on this side, so the guarantee is this loop
order and this comment. *)
let cstr sym = let l = string_const f sym in lea f.b ~dst:rdi ~mm:(Sym (l, 0)) in
List.iter
(fun (f : Tast.fn) ->
load_int b ~dst:rax ~mm:(Got (csym f.Tast.name)) ~size:8 ~signed:false;
lea b ~dst:r11 ~mm:(Sym (fsym f.Tast.name, 0));
store_int b ~src:r11 ~mm:(Reg (rax, 0)) ~size:8)
(fun (fn : Tast.fn) ->
cstr ("flan." ^ fn.Tast.name);
xor_rr f.b ~dst:rax ~src:rax;
call_sym f.b "flan_dev_cell";
store_int f.b ~src:rax ~mm:(Sym (cellp fn.Tast.name, 0)) ~size:8)
new_fns;
List.iter
(fun ((g : Tast.global), l, size, _) ->
cstr ("flan." ^ g.Tast.gname);
movabs f.b ~dst:rsi (Int64.of_int size);
lea f.b ~dst:rdx ~mm:(Sym (l, 0));
xor_rr f.b ~dst:rax ~src:rax;
call_sym f.b "flan_dev_global";
store_int f.b ~src:rax ~mm:(Sym (gp g.Tast.gname, 0)) ~size:8)
images;
(* A [defconst] whose value the checker never folded is just bytes in the
program's memory, so a new value is published the same way a new body is:
one store, at the frame boundary the agent chose. One the checker did fold
is in the shape of the program and never gets here -- the session refuses
it before it asks for a module. *)
List.iter
(fun (g : Tast.global) ->
if List.exists (String.equal g.Tast.gname) consts then
scoped f (fun () -> lower f g.Tast.ginit (sym_loc f (gsym g.Tast.gname))))
p.Tast.globals;
(* And now the bodies. A name the host has is published into its cell, whose
address comes out of the GOT because the cell lives in the host; a name it
does not is published through the slot the lookup above filled. Either way
the body is this module's own and hidden, so its address is an ordinary
pc-relative [lea]. *)
List.iter
(fun (fn : Tast.fn) ->
if known fn.Tast.name then
load_int f.b ~dst:rax ~mm:(Got (csym fn.Tast.name)) ~size:8 ~signed:false
else
load_int f.b ~dst:rax ~mm:(Sym (cellp fn.Tast.name, 0)) ~size:8
~signed:false;
lea f.b ~dst:r11 ~mm:(Sym (fsym fn.Tast.name, 0));
store_int f.b ~src:r11 ~mm:(Reg (rax, 0)) ~size:8)
targets;
ret b;
flush b;
(* Nothing a constant initialiser can do transfers, so this exit is
unreachable and is emitted only when something claims to aim at it. *)
if f.unwound then begin
jmp_lbl f.b f.retlbl; lbl f.b f.xfer_lbl; jmp_lbl f.b f.retlbl
end;
let pb = create () in
push_r pb rbp;
mov_rr pb ~dst:rbp ~src:rsp;
let n = frame_bytes f in
if n > 0 then sub_imm pb ~dst:rsp n;
xor_rr pb ~dst:rax ~src:rax;
store_int pb ~src:rax ~mm:(Frame chan) ~size:8;
lea pb ~dst:rax ~mm:(Frame chan);
store_int pb ~src:rax ~mm:(Frame f.xfer_off) ~size:8;
lbl f.b f.retlbl;
leave f.b;
ret f.b;
flush pb;
flush f.b;
Buffer.add_string text
"\t.globl\tflan_reload_install\n\
\t.type\tflan_reload_install, @function\n\
flan_reload_install:\n";
Buffer.add_buffer text b.out;
Buffer.add_buffer text pb.out;
Buffer.add_buffer text f.b.out;
Buffer.add_string text
"\t.size\tflan_reload_install, . - flan_reload_install\n\n";
Buffer.add_buffer rodata f.rodata;
let out = Buffer.create 8192 in
Buffer.add_buffer out text;
(* The slots, and the buffers holding a new global's initial value. Both are
this module's own and neither is [.globl]: a second module introducing the
same name gets its own slot and fills it from the registry with the same
answer, which is exactly what makes two modules agree about a name that
has no symbol. [.bss], because every one of them is written before it is
read -- the slots by the lookups above, the images by the initialisers. *)
if new_fns <> [] || new_globals <> [] then begin
Buffer.add_string out "\n\t.bss\n";
List.iter
(fun (fn : Tast.fn) ->
Buffer.add_string out
(Printf.sprintf "\t.align\t8\n\t.type\t%s, @object\n\
\t.size\t%s, 8\n%s:\n\t.zero\t8\n"
(cellp fn.Tast.name) (cellp fn.Tast.name) (cellp fn.Tast.name)))
new_fns;
List.iter
(fun ((g : Tast.global), l, size, align) ->
let s = gp g.Tast.gname in
Buffer.add_string out
(Printf.sprintf "\t.align\t8\n\t.type\t%s, @object\n\
\t.size\t%s, 8\n%s:\n\t.zero\t8\n\
\t.align\t%d\n%s:\n\t.zero\t%d\n"
s s s align l size))
images
end;
(* The ABI marker this module requires of its host. A pointer-sized datum
holding the host's marker is a relocation the loader has to resolve while
it maps the object, whatever it does about lazy binding of calls, so a

17
test/programs/reload-v6.flan Normal file
View File

@ -0,0 +1,17 @@
;;;; A run-time-new global with a value of its own, which is the half of the
;;;; new-name path that a zeroed defvar cannot measure: [flan_dev_global]
;;;; allocates with calloc, so a global declared zero looks right whether or
;;;; not its initial value travelled with the module. [tuning] is 42, and the
;;;; transcript is the number the host prints, so an image that never arrived
;;;; prints 4 rather than 88.
(defvar counter i64)
(defvar tuning i64 42)
(defn helper [x i64] i64 (* x 2))
(defn bump [] i64
(println "v6")
(set counter (+ counter tuning 1))
(helper counter))
(defn outer [] i64 (bump))

56
test/test_reload.ml
View File

@ -207,10 +207,12 @@ let () =
be correct until the first redefined function took or returned a struct.
So an --x86 host gets --x86 modules and the two never meet.
Only v1 and v2, which is the whole of what X86.redefinition compiles:
every name they touch is one the host was built with. v3 and v4
introduce a function and a global at run time, and the flan_dev_cell /
flan_dev_global lookups that needs are refused there by name.
All four modules, and the same expected string as the LLVM path above:
v3 introduces a defvar and a defn the host was never built with, and v4
redefines the one v3 introduced. Neither has a symbol anywhere, so both
go through flan_dev.c's by-name registry into a slot the module defines
and [flan_reload_install] fills -- [X86.Lslot], which is the GOT path
with the relocation swapped.
Read by running, not by reading. A disassembly reads correctly beside a
wrong answer often enough (docs/DISCUSS.md item 15) that only the printed
@ -231,26 +233,46 @@ let () =
in
let xso1 = xmodule p1 [ "bump" ] "xv1.so" in
let xso2 = xmodule p2 [ "bump" ] "xv2.so" in
let xso3 = xmodule p3 [ "bump"; "added" ] "xv3.so" in
let xso4 = xmodule p4 [ "added" ] "xv4.so" in
let xout = tmp "xout" in
let xcode =
Sys.command
(Printf.sprintf "%s %s %s > %s 2> %s" (Filename.quote xhost)
(Filename.quote xso1) (Filename.quote xso2) (Filename.quote xout)
(Printf.sprintf "%s %s %s %s %s > %s 2> %s" (Filename.quote xhost)
(Filename.quote xso1) (Filename.quote xso2) (Filename.quote xso3)
(Filename.quote xso4) (Filename.quote xout)
(Filename.quote (tmp "xerr")))
in
let xtext = In_channel.with_open_bin xout In_channel.input_all in
let xwant =
"v1\nhost 2\nv1\nafter1 4\n" ^ v2s ^ "after2 1204\ncounter 102\n"
in
if xcode <> 0 || xtext <> xwant then
if xcode <> 0 || xtext <> want then
fail "x86 reload\n got: %S (exit %d)\n wanted: %S" xtext xcode
xwant;
(* A name the host was never built with has no symbol to bind to, and the
registry path is not built here. It has to refuse rather than emit
something that links and then stores through a null. *)
(match X86.redefinition ~checks:true ~dev:true ~known p3 ~fns:[ "added" ] with
| _ -> fail "x86 redefinition accepted a name the host does not have"
| exception X86.Unsupported _ -> ());
want;
(* [extra] is a defvar the host has no storage for, so its declared value
has to travel with it: [flan_dev_global] copies the module's image onto
the allocation the first time the name is interned and ignores it every
time after. [extra] is declared zero here, which calloc would also give,
so the case is asserted where it is visible -- a run-time-new global
with a value of its own. *)
let p6 = checked "programs/reload-v6.flan" in
let xso6 = xmodule p6 [ "bump" ] "xv6.so" in
let xhost6 = tmp "xhost6" in
ignore
(Build.executable ~opts:x86 ~csrcs:[ "reload_host.c" ]
~lflags:[ "-ldl" ] p1 ~out:xhost6);
let xout6 = tmp "xout6" in
let xcode6 =
Sys.command
(Printf.sprintf "%s %s > %s 2> %s" (Filename.quote xhost6)
(Filename.quote xso6) (Filename.quote xout6)
(Filename.quote (tmp "xerr6")))
in
let xtext6 = In_channel.with_open_bin xout6 In_channel.input_all in
let xwant6 = "v1\nhost 2\nv6\nafter1 88\ncounter 44\n" in
if xcode6 <> 0 || xtext6 <> xwant6 then
fail "x86 reload of a new global with a value\n \
got: %S (exit %d)\n wanted: %S" xtext6 xcode6 xwant6;
List.iter (fun p -> try Sys.remove p with Sys_error _ -> ())
[ xso1; xso2; xso3; xso4; xso6; xhost; xhost6; xout; xout6 ];
(* The aggregate case, which is the whole reason X86.redefinition exists
rather than an --x86 host dlopening what Emit.redefinition made.