A defvar's initialiser runs once, so its value survives a re-run
This commit is contained in:
parent
3a9088604e
commit
931cf860c3
104
lib/emit.ml
104
lib/emit.ml
@ -3238,25 +3238,105 @@ let emit_global m ?(hidden = false) (g : Tast.global) =
|
||||
link's. *)
|
||||
let startup_sym = fname ".init-globals"
|
||||
|
||||
let emit_startup m ?(hidden = false) (globals : Tast.global list) =
|
||||
match
|
||||
(* The startup function runs once per *process* in a release build, because a
|
||||
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
|
||||
(fun (g : Tast.global) -> not (Tast.const_init g.Tast.ginit))
|
||||
globals
|
||||
with
|
||||
| [] -> false
|
||||
| computed ->
|
||||
(* One 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. *)
|
||||
let body =
|
||||
in
|
||||
let flags =
|
||||
if not m.dev then []
|
||||
else
|
||||
List.map
|
||||
(fun (g : Tast.global) ->
|
||||
{ Tast.e = Tast.Set (Tast.Pglobal g.Tast.gname, g.Tast.ginit);
|
||||
ty = Types.Unit; loc = g.Tast.ginit.Tast.loc })
|
||||
{ Tast.gname = init_flag g.Tast.gname; gty = Types.Bool;
|
||||
ginit =
|
||||
{ Tast.e = Tast.Bool false; ty = Types.Bool;
|
||||
loc = g.Tast.ginit.Tast.loc };
|
||||
gconst = false; gfolded = false })
|
||||
computed
|
||||
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
|
||||
{ Tast.name = ".init-globals"; params = []; slots = [||]; snames = [||];
|
||||
ret = Types.Unit; body; fdefers = []; fparent = None;
|
||||
|
||||
29
lib/x86.ml
29
lib/x86.ml
@ -3964,7 +3964,7 @@ let emit_globals_data (md : Emit.m) (globals : Tast.global list) =
|
||||
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) =
|
||||
let b = create () in
|
||||
let f =
|
||||
@ -3985,10 +3985,19 @@ let emit_globals_init ?(cfi = false) ?(ann = false) ~sym (md : Emit.m) ~externs
|
||||
let cell = ptmp f in
|
||||
f.xfer_off <- ptmp f;
|
||||
f.xfer_lbl <- new_label f "gxfer";
|
||||
(* Two shapes, and the second is the computed initialisers in a dev build:
|
||||
[Emit.startup_plan] builds their stores as expressions so that the guard
|
||||
it wraps each one in — see its own note, and [Emit.emit_startup] on the
|
||||
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;
|
||||
globals);
|
||||
(* 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
|
||||
[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 —
|
||||
[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. *)
|
||||
let constants, computed =
|
||||
List.partition
|
||||
(fun (g : Tast.global) -> Tast.const_init g.Tast.ginit)
|
||||
let constants =
|
||||
List.filter (fun (g : Tast.global) -> Tast.const_init g.Tast.ginit)
|
||||
p.Tast.globals
|
||||
in
|
||||
let computed, init_flags, init_body = Emit.startup_plan md p.Tast.globals in
|
||||
let ginit, gr =
|
||||
emit_globals_init ~cfi:debug ~ann:annotate ~sym:data_sym md ~externs ~fns
|
||||
constants
|
||||
@ -4386,8 +4395,8 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false)
|
||||
let startup = computed <> [] in
|
||||
if startup then begin
|
||||
let t, r =
|
||||
emit_globals_init ~cfi:debug ~ann:annotate ~sym:init_sym md ~externs ~fns
|
||||
computed
|
||||
emit_globals_init ~cfi:debug ~ann:annotate ~body:init_body ~sym:init_sym
|
||||
md ~externs ~fns computed
|
||||
in
|
||||
Buffer.add_string text t;
|
||||
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));
|
||||
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_buffer out rodata;
|
||||
(* The per-type dyn descriptors, as runtime/flan_dyn.h's [flan_desc] laid out
|
||||
|
||||
49
test/programs/dev-rerun.flan
Normal file
49
test/programs/dev-rerun.flan
Normal 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)
|
||||
Loading…
x
Reference in New Issue
Block a user