A defvar's initialiser runs once, so its value survives a re-run

This commit is contained in:
Joseph Ferano 2026-09-20 11:16:37 +07:00
parent 3a9088604e
commit 931cf860c3
3 changed files with 166 additions and 24 deletions

View File

@ -3238,25 +3238,105 @@ let emit_global m ?(hidden = false) (g : Tast.global) =
link's. *) link's. *)
let startup_sym = fname ".init-globals" let startup_sym = fname ".init-globals"
let emit_startup m ?(hidden = false) (globals : Tast.global list) = (* The startup function runs once per *process* in a release build, because a
match release build's [main] is entered once. The dev daemon's re-run enters it
again: [flan_merged_park] waits for [program_asked] and the loop around it
calls [flan_program_main] from the top, so every line of [main] above runs a
second time, this call included.
What that must mean is decided by the defining form, not by the daemon. A
[defvar] is Common Lisp's [defvar]: its initialiser runs only if the
variable is not already initialised, so its value survives a re-run which
is what the daemon has always promised ("the globals are as it left them")
and what a plain zeroed [defvar] already got for free, since .bss is
untouched by a second call. A computed one used to be the exception, wiped
back to its initial value every re-run. A [defconst] is a constant and the
question does not arise for it: it is the linker's image on one backend and
a constructor's stores on the other, and neither is reached from here.
So each computed initialiser guards itself with a flag of its own. Per
global and not per startup function, because the rule belongs to the form:
a global whose initialiser is added by a later build, or a future form that
*does* recompute, decides its own case without the other globals' having to
agree.
Dev builds only. A release build has no re-run to guard against and pays
nothing the body below is then the bare store it always was, byte for
byte. The flag is a global of its own rather than a sentinel value in the
variable, because there is no value a [defvar] cannot hold.
Writing the flag *after* the store is safe rather than merely tidy:
[Check.no_transfer_in_init] refuses a signal or a restart out of an
initialiser, so nothing leaves the guarded branch between the two. *)
let init_flag n = ".init-once." ^ n
(* The computed globals, the flags that guard them, and the body of the
startup function built here so that the two backends cannot disagree
about any of the three. [flags] is empty in a release build. *)
let startup_plan m (globals : Tast.global list) =
let computed =
List.filter List.filter
(fun (g : Tast.global) -> not (Tast.const_init g.Tast.ginit)) (fun (g : Tast.global) -> not (Tast.const_init g.Tast.ginit))
globals globals
with in
| [] -> false let flags =
| computed -> if not m.dev then []
(* One store per global and nothing else: the initialiser itself was lifted else
into a function of its own, so this frame holds no slots and the [let] a
programmer wrote inside an initialiser has a frame of its own to live
in. *)
let body =
List.map List.map
(fun (g : Tast.global) -> (fun (g : Tast.global) ->
{ Tast.e = Tast.Set (Tast.Pglobal g.Tast.gname, g.Tast.ginit); { Tast.gname = init_flag g.Tast.gname; gty = Types.Bool;
ty = Types.Unit; loc = g.Tast.ginit.Tast.loc }) ginit =
{ Tast.e = Tast.Bool false; ty = Types.Bool;
loc = g.Tast.ginit.Tast.loc };
gconst = false; gfolded = false })
computed computed
in in
(* Registered so that [place] and the x86 backend's [lower] can find a
flag's type the same way they find any other global's. Not added to the
program's own [globals] list: nothing the programmer wrote names one, and
the daemon's [globals] op answers from the program. *)
List.iter
(fun (g : Tast.global) -> Hashtbl.replace m.globals g.Tast.gname g.Tast.gty)
flags;
let body =
List.map2
(fun (g : Tast.global) (flag : Tast.global option) ->
let loc = g.Tast.ginit.Tast.loc in
let store =
{ Tast.e = Tast.Set (Tast.Pglobal g.Tast.gname, g.Tast.ginit);
ty = Types.Unit; loc }
in
match flag with
| None -> store
| Some f ->
let mark =
{ Tast.e =
Tast.Set
(Tast.Pglobal f.Tast.gname,
{ Tast.e = Tast.Bool true; ty = Types.Bool; loc });
ty = Types.Unit; loc }
in
{ Tast.e =
Tast.If
({ Tast.e = Tast.Global f.Tast.gname; ty = Types.Bool; loc },
{ Tast.e = Tast.Unit; ty = Types.Unit; loc },
{ Tast.e = Tast.Do [ store; mark ]; ty = Types.Unit; loc });
ty = Types.Unit; loc })
computed
(if flags = [] then List.map (fun _ -> None) computed
else List.map (fun f -> Some f) flags)
in
(computed, flags, body)
let emit_startup m ?(hidden = false) (globals : Tast.global list) =
match startup_plan m globals with
| [], _, _ -> false
| computed, flags, body ->
(* One guarded store per global and nothing else: the initialiser itself
was lifted into a function of its own, so this frame holds no slots and
the [let] a programmer wrote inside an initialiser has a frame of its
own to live in. *)
List.iter (emit_global m ~hidden) flags;
emit_fn m ~hidden emit_fn m ~hidden
{ Tast.name = ".init-globals"; params = []; slots = [||]; snames = [||]; { Tast.name = ".init-globals"; params = []; slots = [||]; snames = [||];
ret = Types.Unit; body; fdefers = []; fparent = None; ret = Types.Unit; body; fdefers = []; fparent = None;

View File

@ -3964,7 +3964,7 @@ let emit_globals_data (md : Emit.m) (globals : Tast.global list) =
Buffer.contents out Buffer.contents out
let emit_globals_init ?(cfi = false) ?(ann = false) ~sym (md : Emit.m) ~externs ~fns let emit_globals_init ?(cfi = false) ?(ann = false) ?body ~sym (md : Emit.m) ~externs ~fns
(globals : Tast.global list) = (globals : Tast.global list) =
let b = create () in let b = create () in
let f = let f =
@ -3985,10 +3985,19 @@ let emit_globals_init ?(cfi = false) ?(ann = false) ~sym (md : Emit.m) ~externs
let cell = ptmp f in let cell = ptmp f in
f.xfer_off <- ptmp f; f.xfer_off <- ptmp f;
f.xfer_lbl <- new_label f "gxfer"; f.xfer_lbl <- new_label f "gxfer";
List.iter (* Two shapes, and the second is the computed initialisers in a dev build:
(fun (g : Tast.global) -> [Emit.startup_plan] builds their stores as expressions so that the guard
scoped f (fun () -> lower f g.Tast.ginit (Lg (gsym g.Tast.gname, 0)))) it wraps each one in see its own note, and [Emit.emit_startup] on the
globals; LLVM side is the same guard on both backends rather than two that have
to be kept in step. The constant image below is unguarded stores into
their symbols, exactly as it was. *)
(match body with
| Some es -> List.iter (fun (e : Tast.expr) -> scoped f (fun () -> lower f e sink)) es
| None ->
List.iter
(fun (g : Tast.global) ->
scoped f (fun () -> lower f g.Tast.ginit (Lg (gsym g.Tast.gname, 0))))
globals);
(* Nothing has established a handler or a restart by the time either of (* Nothing has established a handler or a restart by the time either of
these runs one of them is a constructor and the other is the first call these runs one of them is a constructor and the other is the first call
[main] makes so a transfer out of an initialiser has nowhere to go and [main] makes so a transfer out of an initialiser has nowhere to go and
@ -4372,11 +4381,11 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
function: see the two symbols' own note. The split is total function: see the two symbols' own note. The split is total
[Tast.const_init] is what [emit.ml] asks to decide which globals it can [Tast.const_init] is what [emit.ml] asks to decide which globals it can
write into the object so every global is written exactly once. *) write into the object so every global is written exactly once. *)
let constants, computed = let constants =
List.partition List.filter (fun (g : Tast.global) -> Tast.const_init g.Tast.ginit)
(fun (g : Tast.global) -> Tast.const_init g.Tast.ginit)
p.Tast.globals p.Tast.globals
in in
let computed, init_flags, init_body = Emit.startup_plan md p.Tast.globals in
let ginit, gr = let ginit, gr =
emit_globals_init ~cfi:debug ~ann:annotate ~sym:data_sym md ~externs ~fns emit_globals_init ~cfi:debug ~ann:annotate ~sym:data_sym md ~externs ~fns
constants constants
@ -4386,8 +4395,8 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
let startup = computed <> [] in let startup = computed <> [] in
if startup then begin if startup then begin
let t, r = let t, r =
emit_globals_init ~cfi:debug ~ann:annotate ~sym:init_sym md ~externs ~fns emit_globals_init ~cfi:debug ~ann:annotate ~body:init_body ~sym:init_sym
computed md ~externs ~fns computed
in in
Buffer.add_string text t; Buffer.add_string text t;
Buffer.add_string rodata r Buffer.add_string rodata r
@ -4446,7 +4455,11 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
(asm_sym abi_marker) (asm_sym abi_marker) (asm_sym abi_marker) (asm_sym abi_marker) (asm_sym abi_marker) (asm_sym abi_marker)
(asm_sym abi_marker)); (asm_sym abi_marker));
if dev then Buffer.add_string out (emit_cells p); if dev then Buffer.add_string out (emit_cells p);
Buffer.add_string out (emit_globals_data md p.Tast.globals); (* The program's globals, and then — in a dev build only — one zeroed byte
per computed initialiser, which is the flag [Emit.startup_plan] guards it
with. Zeroed is what "has not run yet" is, and .bss is what a re-run does
not touch. *)
Buffer.add_string out (emit_globals_data md (p.Tast.globals @ init_flags));
Buffer.add_string out "\n\t.section\t.rodata\n"; Buffer.add_string out "\n\t.section\t.rodata\n";
Buffer.add_buffer out rodata; Buffer.add_buffer out rodata;
(* The per-type dyn descriptors, as runtime/flan_dyn.h's [flan_desc] laid out (* The per-type dyn descriptors, as runtime/flan_dyn.h's [flan_desc] laid out

View File

@ -0,0 +1,49 @@
;;;; What a re-run does to a global, which is decided by the form that
;;;; defined it and not by the daemon.
;;;;
;;;; A [defvar] is Common Lisp's [defvar]: its initialiser runs only if the
;;;; variable is not already initialised, so its value survives a re-run. A
;;;; plain zeroed one always did — .bss is untouched by a second entry into
;;;; main — and a computed one did not, because the startup function [main]
;;;; calls ran again from the top and stored the initial value back over
;;;; whatever the last run had left. A [defconst] is a constant and the
;;;; question does not arise.
;;;;
;;;; So each line printed below is a claim about one of those cases, and the
;;;; run number is the first of them: [runs] is computed, so before the fix it
;;;; counted 1, 1, 1.
(import agent "vendor:agent")
(defconst base i64 40)
;; Computed, and the whole reproduction: the initialiser is a call, so it is
;; lifted into the startup function rather than written into the image.
(defn start [] i64 base)
(defvar counter i64 (start))
;; Zero-valued, which needs no startup at all and must keep needing none.
(defvar zeroed i64)
;; A computed dyn global: the map is built by a function, rooted before the
;; startup function runs, and mutated by every run. Its contents have to
;; survive a re-run for the same reason [counter]'s value does, and its root
;; has to survive collection either way.
(defn table [] dyn {:runs 0})
(defvar state dyn (table))
(defn main [] i32
(agent/start "/tmp/flan-dev-rerun-fallback.sock")
(set counter (+ counter 1))
(set zeroed (+ zeroed 2))
(put state :runs (+ (get state :runs) 1))
(print "counter ") (print counter) (println "")
(print "zeroed ") (print zeroed) (println "")
(print "runs ") (print (get state :runs)) (println "")
(print "base ") (print base) (println "")
;; Long enough for a client to be served, short enough to park well inside
;; any watchdog — dev-macro.flan's clock, for its reason.
(dotimes [i 200]
(agent/wait 5))
0)