From 495629f5f3edeb7c3a6ff0f2fed96e1f93eb5d78 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sat, 19 Sep 2026 04:22:39 +0700 Subject: [PATCH] A global's initialiser may be computed, and both backends run it the same way MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The x86 backend ran initialisers from .init_array and the LLVM one refused them by name, so (defvar frame Allocator (arena-new 262144)) — which the author kept writing — was a program on one backend and an error on the other. A rule that holds on one backend and not the other is not a rule. The checker lifts a computed initialiser into a function of its own and the global's initialiser becomes the call. That is what gives it a frame, which is the bug underneath the feature: a `let` or a `match` in an initialiser indexed a slot array of length zero and took the x86 emitter down with an uncaught Invalid_argument. Both backends call the lifted initialisers from main, after flan_rt_init and before a line of the program's own code — Odin's __$startup_runtime shape, not a constructor, so the runtime is up and the order is the compiler's to choose. x86 keeps .init_array for one thing only, and it is named: writing the constant image this backend has no folder for, which is standing in for the other backend's object image rather than for a program. The computed globals are sorted by what they read, transitively through the functions they call, so a global written above the one it reads works and a ring is refused with every name in it. A reload still re-runs nothing: a new global with a computed initialiser starts as ZII on both backends. The refusal that lived in x86.ml is now the checker's and is narrower. Nothing can escape an initialiser — the handler and restart stacks are empty and every frame it pushes it also pops — so what is refused is a signal or an invoke-restart with no handler-bind or restart-case around it, which is inert by construction. A restart-case inside one is ordinary code, which is what makes (defvar data (Vec u8) (slurp "level.edn")) an ordinary program. Three refusals go with the premise they rested on: a container global with a computed initialiser, a union member in a defvar, and a data type case in one. A defconst is untouched and keeps all three. One change here is not about any of that. sand.flan carried an unfinished line — (defvar game-data (embed (with-allocator frame ))), which parses as a declaration whose type is (embed ...) — so the checker refused the file and `dune test` was red at the tip of dev-loop before a line of this landed, verified by stashing this work and rebuilding. It is commented out rather than guessed at: the arena above it is the half that works, and what the global should read is the author's to decide. --- lib/check.ml | 383 ++++++++++++++++++++++++++++----- lib/emit.ml | 155 ++++++++++--- lib/js.ml | 12 +- lib/reach.ml | 87 +++----- lib/tast.ml | 65 ++++++ lib/x86.ml | 202 +++++++++-------- plan.org | 10 + sand.flan | 8 +- test/programs/global-init.flan | 75 +++++++ test/test_acceptance.ml | 63 +++++- test/test_flan.ml | 73 +++++-- test/test_session.ml | 12 ++ 12 files changed, 896 insertions(+), 249 deletions(-) create mode 100644 test/programs/global-init.flan diff --git a/lib/check.ml b/lib/check.ml index b8caf6f..9e49374 100644 --- a/lib/check.ml +++ b/lib/check.ml @@ -5682,34 +5682,39 @@ and check_generic env (fn : Ast.fn) = checking a function. *) let () = check_fn_ref := check_fn -(* A container's only compile-time constant is the zeroed one: a Vec's or a - Map's real value exists at run time, behind an allocator. That is a fact - about initialisers and it survived both repeals untouched — nothing here - is about copying or moving. +(* A container's only compile-time *constant* is the zeroed one: a Vec's or a + Map's real value exists at run time, behind an allocator. That fact has not + changed. What changed is what follows from it. - What this pass decides is how such a global may be *started*, and the - answer is zeroed and nothing else. A zeroed Vec is a real empty Vec — null - block, zero length, zero capacity — so the ZII value is the value a program - would have written anyway, and filling it is an ordinary (set g (slurp - "...")) in whichever function loads it. The alternative, a computed - initialiser, does not exist to be relaxed into: [Emit.const] says so in as - many words ("there is no init-at-startup path, by design"), and the backend - that does run initialisers at startup, [x86.ml], runs them from .init_array - before main and deliberately omits them from a reload module, because - re-running one would wipe the live state reloading exists to preserve. A - rule that held on one backend and not the other would not be a rule. + It used to follow that a container global could only ever start zeroed, and + the argument was that there was nowhere for a computed initialiser to run: + [Emit.const] said "there is no init-at-startup path, by design", and the + backend that did run initialisers at startup ran them out of .init_array, + which a reload module deliberately has none of. A rule that held on one + backend and not the other would not be a rule, so the language refused the + form on both. - That fits what a runtime-loaded global is for. The data is loaded by - whoever loads it, once, and it outlives main: a main that returns and is - entered again finds the global exactly as it left it, because nothing - between the two runs touches it. Assigning a second time overwrites the - first block and leaks it — there is no [drop] and no cross-function flow - analysis that could see the second assignment, so that is the manual-memory - answer and the language's own: free is a thing you write. + There is an init-at-startup path now, and it is the same one on both + backends: a computed initialiser is lifted into a function of its own and + the program calls it from [main], after the runtime is up and before any of + the program's own code runs. So the premise is gone and the refusal goes + with it. (defvar g (Vec u8) (slurp "level.edn")) is an ordinary program now, + and it is the shape the author kept writing. - A global *Allocator* is not any of this — an allocator is a copyable opaque - handle — which is what makes the handler-owns-the-arena shape in - exhausted.flan expressible. *) + What is still refused is [uninit] on one, and that is a different rule with + a reason of its own: a Vec's garbage pointer is not a garbage number. Every + operation on it dereferences a block address nobody wrote, where a zeroed + Vec is a real empty Vec — null block, zero length, zero capacity — and is + the value a program would have written anyway. + + What a runtime-loaded global is for has not changed either. The data is + loaded once and it outlives main: a main that returns and is entered again + finds the global exactly as it left it, because nothing between the two runs + touches it — and that now includes a reload, which does not re-run + initialisers. Assigning a second time overwrites the first block and leaks + it — there is no [drop] and no cross-function flow analysis that could see + the second assignment, so that is the manual-memory answer and the + language's own: free is a thing you write. *) let rec zero_only (t : Types.t) = match t with | Types.Vec _ | Types.Map _ -> true @@ -5719,18 +5724,14 @@ let rec zero_only (t : Types.t) = let container_global_init loc n (ty : Types.t) (init : Ast.init) = if zero_only ty then match init with - | Ast.Zeroed -> () - | _ -> + | Ast.Uninit -> fail loc - "the global %s is %s, and such a global starts zeroed: a global's \ - initialiser is a compile-time constant, %s is not one, and a \ - container's only constant value is the empty one. Write (defvar %s %s) with no initialiser — a zeroed \ - %s is an empty one, and that is a value, not a placeholder — then \ - load it with (set %s ...) in the function that loads it, which runs \ - once and whose result outlives every call to main" - n (Types.to_string ty) - (match init with Ast.Uninit -> "uninit" | _ -> "this initialiser") - n (Types.to_string ty) (Types.to_string ty) n + "the global %s is %s, and uninit on one is refused: its block pointer \ + steers every read of it, and garbage there is not a garbage number \ + the way it is for an f64. Write (defvar %s %s) with no initialiser — \ + a zeroed %s is an empty one, and that is a value, not a placeholder" + n (Types.to_string ty) n (Types.to_string ty) (Types.to_string ty) + | _ -> () (* A container global has to be a [defvar]. A [defconst] is not an assignable place — [check_place] refuses one by name — and a container's only constant @@ -5748,15 +5749,19 @@ let no_container_defconst loc n (ty : Types.t) = n (Types.to_string ty) (Types.to_string ty) (Types.to_string ty) n (Types.to_string ty) -(* A union member written into a global would have to be encoded into the blob - at link time, which is the byte-level encoder a data type case does not have - either — and a global's initialiser is a constant, while a union value is a +(* A union member written into a *constant* would have to be encoded into the + blob at link time, which is the byte-level encoder a data type case does not + have either: a constant is what the linker writes, and a union value is a store. Refused here, where the message can name the way through, rather than - at the emitter as "this one is computed", which is true and says nothing. A - zeroed union needs none of this and is the ordinary declaration. Both kinds - of global, because a defconst reaches the same emitter by a different - path. *) -let no_union_init env loc n what (v : Tast.expr) = + at the emitter as "this one is computed", which is true and says nothing. + + A defvar is no longer any of this and no longer asks. Its computed + initialiser is lifted into a function that runs at startup, so the member is + written by exactly the store that writes one anywhere else — the encoder was + only ever needed because there was nothing to run. + + A zeroed union needs none of this either and is the ordinary declaration. *) +let no_union_const env loc n (v : Tast.expr) = match v.Tast.ty, v.Tast.e with (* The all-bytes-zero value is a constant and needs none of this, so it is the one initialiser that goes through — which is what makes (U {}) and a @@ -5764,12 +5769,113 @@ let no_union_init env loc n what (v : Tast.expr) = | _, (Tast.Zero _ | Tast.Uninit _) -> () | Types.Named un, _ when Hashtbl.mem env.unions un -> fail loc - "the global %s is the union %s, and a union member cannot be written \ - into a %s: the initialiser is a constant and storing a member is a \ - store. Leave it zeroed and write the member in a function" - n un what + "the constant %s is the union %s, and a union member cannot be written \ + into a constant: a constant is what the linker writes into the image \ + and storing a member is a store. Leave it zeroed, or make it a defvar \ + and let its initialiser run at startup" + n un | _ -> () +(* A global's initialiser runs at startup: from [main], after the runtime is + up, before a line of the program's own code. Nothing has established a + handler or a restart by then, and nothing outside the initialiser can — the + program has not started. + + That used to be the reason all four of the condition forms were refused + inside one, and the refusal lived in [x86.ml] because that was the only + backend with an init-at-startup path. Its argument was that a transfer out + of an initialiser would return into the loader, which was true of a + .init_array constructor and is not true of a call from [main]. So the rule + is narrower now, and what is left of it is what is still true. + + A [handler-bind] or a [restart-case] *inside* an initialiser is ordinary + code: it pushes its frames, runs, and pops them, all before the initialiser + returns, and nothing it does is visible outside. Both backends run it + exactly as they run it in any other function — which is what makes (defvar + data (Vec u8) (slurp "level.edn")) an ordinary program, since [slurp] is a + restart-case with its own signal inside it, and that is the shape the author + kept reaching for. + + What is refused is a [signal] or an [invoke-restart] with no condition + machinery around it at all. Everywhere else in the language those two are + answered by a frame some *caller* established; in an initialiser there is no + caller, so one with nothing around it is inert by construction — a signal + nothing can hear, or an invoke-restart that can only fail at the invoke + site. Either form counts as enclosure, including a restart-case around a + signal: that pair is [slurp], and a restart-case says what the initialiser + wants to happen when nobody answers, which is the thing an unenclosed one + cannot say. + + A clause's body is not in this walk at all — a handler-bind clause is lifted + into a function of its own — so the [invoke-restart] a handler writes is + never the one refused here. *) +let no_transfer_in_init n (v : Tast.expr) = + (* The nodes that are under a handler or a restart within this initialiser, + by identity: [Tast.walk] visits nodes rather than paths, so the enclosure + is recorded in one pass and asked in the next. *) + let covered = ref [] in + Tast.walk + (fun (e : Tast.expr) -> + let cover body = List.iter (Tast.walk (fun x -> covered := x :: !covered)) body in + match e.Tast.e with + | Tast.Handled (_, body) -> cover body + | Tast.RestartCase (cs, body) -> + cover [ body ]; + List.iter (fun (c : Tast.rclause) -> cover c.Tast.rbody) cs + | _ -> ()) + v; + Tast.walk + (fun (e : Tast.expr) -> + let bad what can = + fail e.Tast.loc + "%s in the initialiser of the global %s, with no handler-bind or \ + restart-case around it: an initialiser runs at startup, before the \ + program has a caller that could have established one, so this can \ + only %s. Write one inside the initialiser — they run there like \ + anywhere else — or move the whole thing into a function the \ + program calls" + what n can + in + if List.memq e !covered then () + else + match e.Tast.e with + | Tast.Signal _ -> bad "signal" "go unheard" + | Tast.InvokeRestart _ -> bad "invoke-restart" "fail at the invoke site" + | _ -> ()) + v + +(* A computed initialiser, lifted into a function of its own that returns the + value. The global's initialiser becomes the call, which is the whole of what + the backends had to learn: one of them already lowers an initialiser as + ordinary code and now lowers a call, and the other emits the global zeroed + and stores the call's result at startup. + + A function rather than the expression left in place, for a reason that is + not tidiness: an initialiser can contain a [let], and a [let] needs a frame. + The slots were allocated on a context this function discarded, so what the + backend got was a slot index into a frame of size zero — [(defvar c i64 (let + [x (i64 5)] (+ x 1)))] crashed the x86 backend with an out-of-bounds index, + and there was no frame to give it without inventing one. This is that frame, + and it is the one every other body already has. + + [fparent] is the global rather than a function, which is a small widening of + what the field means: nobody wrote this name, so completing it or jumping to + it is meaningless, and the one reader that asks — [Dev]'s [defs] — wants + exactly that answer. The others are unaffected: a whole-program build emits + a cell for every function it emits, and a redefinition module reaches this + one through neither, because a reload does not run initialisers. *) +let lift_ginit ctx loc n ty (v : Tast.expr) = + no_transfer_in_init n v; + let fname = "global/" ^ n in + ctx.env.lifted <- + { Tast.name = fname; params = []; + slots = Array.of_list (List.rev ctx.slot_tys); + snames = Array.of_list (List.rev ctx.slot_names); + ret = ty; body = [ v ]; fdefers = ctx.defers; + fparent = Some n; floc = loc } + :: ctx.env.lifted; + { Tast.e = Tast.Call (fname, []); ty; loc } + let check_global env (d : Ast.decl) : Tast.global option = let ctx () = { env; ret = Types.Unit; slots = 0; slot_tys = []; slot_names = []; scope = []; defers = []; outer = []; outer_what = None; in_frames = None; loops = []; tail = false; in_defer = false; defer_ok = false; defer_block = "a nested form"; owner = "" } in @@ -5803,8 +5909,9 @@ let check_global env (d : Ast.decl) : Tast.global option = | _ -> ()); { Tast.e = Tast.Uninit ty; ty; loc = d.Ast.dloc } | Ast.Init v -> - let v = check (ctx ()) ~want:ty v in - no_union_init env d.Ast.dloc n "global" v; v + let c = ctx () in + let v = check c ~want:ty v in + if Tast.const_init v then v else lift_ginit c d.Ast.dloc n ty v in Some { Tast.gname = n; gty = ty; ginit; gconst = false; gfolded = false } | Ast.Defconst (n, _, v) -> @@ -5825,7 +5932,7 @@ let check_global env (d : Ast.decl) : Tast.global option = loc = d.Ast.dloc } | _ -> check (ctx ()) ~want:ty v in - no_union_init env d.Ast.dloc n "constant" ginit; + no_union_const env d.Ast.dloc n ginit; (* [env.consts] holds exactly the constants the folding pass consumed, so membership is the question "is this value in the program's shape?" *) Some { Tast.gname = n; gty = ty; ginit; gconst = true; @@ -5881,6 +5988,177 @@ let check_main env decls = for the reason [Parse] gives at the same fork: [Loc.Errors] is a second exception that the session and the daemon do not catch, so the guarantee that they never see one should be structural and not a default argument. *) +(* ── The order the initialisers run in ─────────────────────────────── *) + +(* Declaration order is the order a program's globals are started in, and it is + the wrong one as soon as one of them is computed from another: [(defvar b + i64 (+ a 10))] written above [(defvar a i64 (+ 1 2))] read a zero and + answered 10 without saying anything. So the computed ones are sorted + by what they need, which is what Odin does (src/checker.cpp, + [calculate_global_init_order]) and for the same reason — the alternative is + a rule about where in the file a global has to be written, which is a rule + about text rather than about meaning. + + Only the computed globals are sorted, and only against each other. A + constant initialiser cannot read a global at all — [Tast.const_init]'s + accepted set has no [Global] in it — so a constant is already there before + anything runs: it is in the object image on one backend and written from + .init_array before main on the other. That makes the partition total and the + sort small, and it is why a global initialised from a [defconst] needs no + edge. + + The dependency is transitive through calls, not just through what the + initialiser names: [(defvar a i64 (f))] where [f] reads [b] needs [b] + started first, and an analysis that only looked at the initialiser's own + text would order that pair by luck. Odin's graph is transitive for the same + reason. + + A cycle is refused rather than broken. Some global in it would have to be + started from another's zero, and which one that is cannot be read off the + program — the two spellings of the same cycle would differ only in which + line the compiler happened to reach first. *) +let init_order (globals : Tast.global list) (fns : Tast.fn list) = + let computed = + List.filter + (fun (g : Tast.global) -> not (Tast.const_init g.Tast.ginit)) + globals + in + if computed = [] then globals + else begin + let is_computed = Hashtbl.create 8 in + List.iter + (fun (g : Tast.global) -> Hashtbl.replace is_computed g.Tast.gname ()) + computed; + let ftbl = Hashtbl.create 64 in + List.iter (fun (f : Tast.fn) -> Hashtbl.replace ftbl f.Tast.name f) fns; + (* What each function reads, to a fixpoint over the call graph: its own + references, plus everything its callees read. A round that changes + nothing is the answer, which needs no special case for a recursive + function and no visited set to get wrong. *) + let reads = Hashtbl.create 64 in + let calls = Hashtbl.create 64 in + let add tbl k v = + let cur = try Hashtbl.find tbl k with Not_found -> [] in + if not (List.mem v cur) then Hashtbl.replace tbl k (v :: cur) + in + List.iter + (fun (f : Tast.fn) -> + let note n = + if Hashtbl.mem is_computed n then add reads f.Tast.name n + else if Hashtbl.mem ftbl n then add calls f.Tast.name n + in + List.iter (Reach.expr_refs note) f.Tast.body; + List.iter (Reach.expr_refs note) f.Tast.fdefers) + fns; + let changed = ref true in + while !changed do + changed := false; + Hashtbl.iter + (fun caller callees -> + List.iter + (fun callee -> + List.iter + (fun g -> + let cur = try Hashtbl.find reads caller with Not_found -> [] in + if not (List.mem g cur) then begin + Hashtbl.replace reads caller (g :: cur); + changed := true + end) + (try Hashtbl.find reads callee with Not_found -> [])) + callees) + (Hashtbl.copy calls) + done; + (* And what each computed global needs, which is the same walk over its + initialiser — whose one node is a call to the function the initialiser + was lifted into, so the answer is that function's reads. *) + let needs (g : Tast.global) = + let acc = ref [] in + let note n = + let put r = if not (List.mem r !acc) then acc := r :: !acc in + if Hashtbl.mem is_computed n then put n + else List.iter put (try Hashtbl.find reads n with Not_found -> []) + in + Reach.expr_refs note g.Tast.ginit; + if List.mem g.Tast.gname !acc then + fail g.Tast.ginit.Tast.loc + "the global %s is initialised from itself: its own value is what the \ + initialiser is producing, so there is nothing there to read but the \ + zero it starts as. Leave it zeroed and load it in a function" + g.Tast.gname; + !acc + in + let deps = List.map (fun (g : Tast.global) -> (g.Tast.gname, needs g)) computed in + let deps_of n = try List.assoc n deps with Not_found -> [] in + (* Kahn's, in declaration order: of the globals that are ready, the one + written first goes first, so the emitted order is the source's wherever + the source's order was possible at all. *) + let done_ = Hashtbl.create 8 in + let order = ref [] in + let progress = ref true in + while !progress do + progress := false; + List.iter + (fun (g : Tast.global) -> + if not (Hashtbl.mem done_ g.Tast.gname) + && List.for_all (fun d -> Hashtbl.mem done_ d) (deps_of g.Tast.gname) + then begin + Hashtbl.replace done_ g.Tast.gname (); + order := g :: !order; + progress := true + end) + computed + done; + (match + List.filter + (fun (g : Tast.global) -> not (Hashtbl.mem done_ g.Tast.gname)) + computed + with + | [] -> () + | (g : Tast.global) :: _ -> + (* The whole ring, not one name out of it. A cycle is a fact about a set + of globals and a message naming one of them leaves the reader to find + the rest; naming each edge says which read to break. *) + let stuck n = not (Hashtbl.mem done_ n) && List.mem_assoc n deps in + let rec ring path n = + if List.mem n path then + let rec cut = function + | [] -> [] + | x :: r -> if String.equal x n then x :: r else cut r + in + cut path + else + match List.find_opt stuck (deps_of n) with + | None -> path @ [ n ] + | Some d -> ring (path @ [ n ]) d + in + let r = ring [] g.Tast.gname in + let edges = + List.mapi + (fun i n -> + Printf.sprintf "%s needs %s's value" n + (List.nth r ((i + 1) mod List.length r))) + r + in + fail g.Tast.ginit.Tast.loc + "the globals %s initialise each other: %s. One of them has to start \ + without the other — leave it zeroed and load it in a function that \ + runs once, where the order is yours to write" + (String.concat " and " r) (String.concat ", " edges)); + (* The sorted sequence, dropped back into the slots the computed globals + already occupied. Everything else — a constant, a zeroed container — + stays exactly where it was declared, so a diff of the emitted image + shows the reordering and nothing else. *) + let seq = ref (List.rev !order) in + List.map + (fun (g : Tast.global) -> + if Hashtbl.mem is_computed g.Tast.gname then + match !seq with + | x :: rest -> seq := rest; x + | [] -> g + else g) + globals + end + let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env = let env = new_env () in let decls = Parse.program (Prelude.forms ()) @ decls in @@ -5946,6 +6224,9 @@ let build_program ~keep_going (decls : Ast.decl list) : Tast.program * env = they are reached *by name* from arbitrary call sites, so they carry no [fparent] and a dev build gives each its own cell. *) let fns = fns @ List.rev env.instances in + (* And the order the computed initialisers run in, which needs the whole + function list: what a global reads is transitive through what it calls. *) + let globals = init_order globals fns in (* Sorted, so the emitted IR is reproducible build to build: a Hashtbl's fold order is not. *) let values name tbl = diff --git a/lib/emit.ml b/lib/emit.ml index 083da71..bc82da5 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -2604,9 +2604,17 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) = (* ── Globals ───────────────────────────────────────────────────────── *) -(* A global's initialiser is a compile-time constant: literals live in - read-only memory and zeroed globals live in BSS and cost nothing to start - (plan.org, Data model). There is no init-at-startup path, by design. *) +(* The value the linker writes into the image: literals live in read-only + memory and zeroed globals live in BSS and cost nothing to start (plan.org, + Data model). + + This used to be the whole of what a global could be, and said so — "there is + no init-at-startup path, by design". There is one now, and it is a call: + [Check] lifts a computed initialiser into a function and [emit_startup] + below stores its result before [main] runs. So what reaches here is what + needs no code — every [defvar] whose initialiser [Tast.const_init] accepts, + and every [defconst], which is a different rule. A constant is what the + linker writes, and a value that has to be computed is not one. *) let rec const m (e : Tast.expr) = match e.Tast.e with | Tast.Int (n, _) -> Int64.to_string n @@ -2629,35 +2637,99 @@ let rec const m (e : Tast.expr) = would have to be the case's fields *serialised into those integers* — which is a byte-level encoder this compiler does not have, and which could not express a string field at all, since that is a pointer the linker has - to relocate and a byte array has nowhere to put a relocation. Refused by - name, here, where the rest of the same rule is. A zeroed global is fine - and needs none of this: it is the first declared case, all-bytes-zero. *) + to relocate and a byte array has nowhere to put a relocation. + + Only a [defconst] reaches this now. The same case in a [defvar] is a + computed initialiser like any other: it is lifted into a function and the + case is written by the same store that writes one in a body, which needs + no encoder at all. That is the way through, and it is what the message + names. *) | Tast.MakeCase (dname, case, _) -> fail e.Tast.loc - "a global cannot be initialised with %s.%s — a data type's payload is a \ - blob, and writing a case into one at link time needs a byte-level \ - encoder that does not exist (a string field could not be encoded at \ - all). Declare the global zeroed, which is %s.%s, and assign the case \ - you meant in a function" + "a constant cannot be %s.%s — a data type's payload is a blob, and \ + writing a case into one at link time needs a byte-level encoder that \ + does not exist (a string field could not be encoded at all). Make it a \ + defvar, whose initialiser runs at startup and stores the case, or \ + declare it zeroed, which is %s.%s" dname case dname (match Hashtbl.find_opt m.datas dname with | Some { Tast.cases = c :: _; _ } -> c.Tast.vname | _ -> "its first case") | _ -> fail e.Tast.loc - "a global's value must be a compile-time constant — this one is computed" + "a constant's value must be a compile-time constant — this one is \ + computed. A defvar may have a computed initialiser, because it runs at \ + startup and stores the result; a defconst is what the linker writes \ + into the image and has nowhere to run" (* A dev build emits a [defconst] as a mutable [global]. Two things follow, and both are wanted: LLVM can no longer fold a read of it, and a redefinition module can store a new value into it — so tuning a constant live works, which it cannot when its only copy is immutable in .rodata. A release build - emits [constant] and gets all the folding back. *) + emits [constant] and gets all the folding back. + + A computed initialiser starts the global zeroed and is stored by + [emit_startup]: Odin does exactly this, giving the ones that constant-fold a + real LLVM initialiser and zeroing the rest (src/llvm_backend.cpp). Zero and + not [poison], even though the store is the first thing that runs: BSS costs + nothing, and a program that dies between the loader and the store is easier + to read with zeroes in it than with whatever was there. *) let emit_global m ?(hidden = false) (g : Tast.global) = Buffer.add_string m.out (Printf.sprintf "%s = %s%s %s %s\n" (gname g.Tast.gname) (if hidden then "hidden " else "") (if g.Tast.gconst && not m.dev then "constant" else "global") - (ll g.Tast.gty) (const m g.Tast.ginit)) + (ll g.Tast.gty) + (* A [defconst] goes through [const] whatever its initialiser is, so a + computed one is refused there by name rather than quietly zeroed + here: a constant has nowhere to run. *) + (if g.Tast.gconst || Tast.const_init g.Tast.ginit then + const m g.Tast.ginit + else "zeroinitializer")) + +(* ── Startup ───────────────────────────────────────────────────────── *) + +(* The globals whose value has to be computed, stored before the program runs. + The same name on both backends, because it is the same function: a + whole-program build defines it, [main] calls it, and a redefinition module + has neither — a reload must not re-run an initialiser, since re-running one + would wipe the live state reloading exists to preserve. + + An explicit call from [main] rather than a constructor, which is Odin's + shape ([lb_create_startup_runtime] builds [__$startup_runtime] and + base/runtime/entry_unix.odin calls it; there is not one [llvm.global_ctors] + in the Odin tree). Two things follow from that and both are the point. The + runtime is up: [flan_rt_init] has run, so an initialiser that prints or asks + for [args] sees what every other line of the program sees, and sees the same + thing under [--x86], where the constructor that writes the constant image + still runs earlier. And the order is expressible — a constructor's is the + link's. *) +let startup_sym = fname ".init-globals" + +let emit_startup m ?(hidden = false) (globals : Tast.global list) = + match + 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 = + 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 }) + computed + in + emit_fn m ~hidden + { Tast.name = ".init-globals"; params = []; slots = [||]; snames = [||]; + ret = Types.Unit; body; fdefers = []; fparent = None; + floc = (List.hd computed).Tast.ginit.Tast.loc }; + true (* ── Program ───────────────────────────────────────────────────────── *) @@ -2809,7 +2881,7 @@ declare i8 @flan_slurp_into(ptr, ptr, i64, i64, ptr, i64) (* C's main, adapting to whichever of the four shapes Flan's main has: argv and the i32 status are each optional (plan.org, Milestone-2 primitives). *) -let emit_main m (fn : Tast.fn) = +let emit_main m ?(startup = false) (fn : Tast.fn) = let b = Buffer.create 256 in Buffer.add_string b (Printf.sprintf "\ndefine i32 @main(i32 %%argc, ptr %%argv)%s {\nentry:\n" @@ -2822,6 +2894,13 @@ let emit_main m (fn : Tast.fn) = Buffer.add_string b (Printf.sprintf " %s = alloca ptr\n" xfer_param); Buffer.add_string b (Printf.sprintf " store ptr null, ptr %s\n" xfer_param); + (* The computed globals, before anything the programmer wrote and after the + runtime is up. No guard after it: a transfer out of an initialiser is + refused in the checker, because nothing has established a handler or a + restart this early and there would be nowhere for one to land. *) + if startup then + Buffer.add_string b + (Printf.sprintf " call void %s(ptr %s)\n" startup_sym xfer_param); let args = if fn.Tast.params = [] then "" else begin @@ -3087,10 +3166,15 @@ let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = []) 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 - [main]: the notes are emitted into every function, a global that a - [defvar] initialiser allocates runs before main does, and a note that + [main]: the notes are emitted into every function, and a note that arrived before the flag was set would be a block the table never heard - of. Priority 65535 is the default slot; nothing here needs to beat + of. That used to be an argument about a [defvar] initialiser allocating + before [main] ran, which it no longer does — [emit_startup] is called + from [main] now. What survives is the weaker and sufficient version: + arming has to precede the first allocation, a constructor is the only + slot that precedes every one of them whatever the entry point is, and a + program linked into a C host has no [main] of ours to put a line at the + top of. Priority 65535 is the default slot; nothing here needs to beat another constructor, only to beat the program. *) Buffer.add_string m.out "@llvm.global_ctors = appending global [1 x { i32, ptr, ptr }] \ @@ -3105,8 +3189,13 @@ let program ?(checks = true) ?(dev = false) ?(debug = false) ?(pnames = []) | Some ns -> ns | None -> []) fn) p.Tast.fns; + let startup = emit_startup m ~hidden p.Tast.globals in (match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "main") p.Tast.fns with - | Some fn -> emit_main m fn + | Some fn -> emit_main m ~startup fn + (* A program with no [main] is linked into a C host that brings its own + entry point, and then nothing calls the startup function — which is why + the constant image is a constant image on both backends and not a + third thing this has to run. *) | None -> ()); List.iter (fun n -> @@ -3268,12 +3357,28 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false) (* Its declared initial value travels with it, as a constant the runtime copies on the allocation and ignores afterwards. Without this a new (defvar n i64 42) or a new defconst would silently be - zero — calloc is only the right answer for ZII. *) - let init = Printf.sprintf "@\".init.%d\"" m.nstr in - m.nstr <- m.nstr + 1; - Buffer.add_string m.strs - (Printf.sprintf "%s = private constant %s %s\n" init - (ll g.Tast.gty) (const m g.Tast.ginit)); + zero — calloc is only the right answer for ZII. + + A *computed* initialiser sends a null instead, and the allocation + keeps calloc's zeroes. That is the reload rule and not a gap in + this one: a global's initialiser runs at startup, once, and a + reload does not run initialisers — sand's grid is a global and + "edit the code, keep the sand" is the whole demo. A name the + program is meeting for the first time has no startup to have + missed, so it starts as ZII and the function that loads it loads + it. Both backends answer the same way, which is the only answer + that makes it a rule. *) + let init = + if not (Tast.const_init g.Tast.ginit) then "null" + else begin + let init = Printf.sprintf "@\".init.%d\"" m.nstr in + m.nstr <- m.nstr + 1; + Buffer.add_string m.strs + (Printf.sprintf "%s = private constant %s %s\n" init + (ll g.Tast.gty) (const m g.Tast.ginit)); + init + end + in 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), ptr %s)\n \ diff --git a/lib/js.ml b/lib/js.ml index 97a7b4f..d828e63 100644 --- a/lib/js.ml +++ b/lib/js.ml @@ -1465,8 +1465,12 @@ let program ?(checks = true) (p : Tast.program) : string = if p.Tast.cshim <> [] then unsupported "this program generates a C shim, and the JS dialect has no C boundary"; - (* Globals first: an initialiser is a compile-time constant in this IR, so - there is no ordering question and no init-at-startup path. *) + (* Globals first. A constant initialiser is a value this IR can spell, and it + is the only kind that gets here: the language runs a computed one from a + function [main] calls at startup, and this dialect has grown no equivalent + — so one is refused below rather than silently started as zero. The + ordering question the startup path answers is therefore not one this file + has. *) let gbuf = Buffer.create 256 in List.iter (fun (g : Tast.global) -> @@ -1478,8 +1482,8 @@ let program ?(checks = true) (p : Tast.program) : string = let v = value f g.Tast.ginit in if Buffer.length f.b > 0 then at g.Tast.ginit.Tast.loc - "the initialiser of %s is not a constant, which this IR does not \ - produce" + "the initialiser of %s is computed, and the JS dialect has no \ + init-at-startup path to run it from" g.Tast.gname; Buffer.add_string gbuf (Printf.sprintf "%s %s = %s;\n" diff --git a/lib/reach.ml b/lib/reach.ml index d9f0ec8..caf5ac0 100644 --- a/lib/reach.ml +++ b/lib/reach.ml @@ -28,65 +28,36 @@ running program has not called yet, so "not reached" there means "not reached *so far*", which is not the same claim. *) -(* The edges. [Call] and [Global] are the obvious ones; [Handled] is the one - worth naming, because a handler-bind clause was lifted into a function of - its own and is reached by *address* from the body that wrote it, never by a - call. Miss it and a program with a handler loses the handler. *) -let rec expr_refs f (e : Tast.expr) = - let go = expr_refs f in - let gos = List.iter go in - match e.Tast.e with - | Tast.Int _ | Tast.Float _ | Tast.Bool _ | Tast.Str _ | Tast.Unit - | Tast.Zero _ | Tast.Uninit _ | Tast.Local _ | Tast.None_ - | Tast.InvokeRestart _ -> () - | Tast.Global n -> f n - (* The other edge reached by address rather than by a call: a Map's hash and - equality pair. Same hazard as [Handled] below — miss it and a program with - a map loses the two functions its every lookup calls through. *) - | Tast.FnAddr (Tast.Flanfn n) -> f n - | Tast.FnAddr (Tast.Rtfn _) -> () - (* A function value, and the *only* thing that keeps it linked. A name used - as a value is never a [Call], so without this edge the one function a - program passes to [map] is the one function the link drops. *) - | Tast.FnAddr (Tast.Fnval n) -> f n - | Tast.Prim (_, es) -> gos es - | Tast.Call (n, es) -> f n; gos es - (* No name to root: whatever this calls was reached as a value, and the - [FnAddr] that produced it is somewhere in the callee expression. *) - | Tast.CallPtr (callee, es) -> go callee; gos es - | Tast.Do es -> gos es - | Tast.Let (bs, body) -> List.iter (fun (_, v) -> go v) bs; gos body - | Tast.If (c, t, e') -> go c; go t; go e' - | Tast.While (c, body, latch) -> go c; gos body; gos latch - | Tast.Break _ | Tast.Continue _ -> () - | Tast.Return v -> Option.iter go v - | Tast.Set (p, v) -> place_refs f p; go v - | Tast.Field (t, _) -> go t - | Tast.Addr p -> place_refs f p - | Tast.Deref t -> go t - | Tast.Make (_, es) | Tast.MakeCase (_, _, es) -> gos es - | Tast.CaseField (t, _, _) -> go t - | Tast.Arr es -> gos es - | Tast.Some_ v -> go v - | Tast.Match (sc, arms) -> - go sc; List.iter (fun (a : Tast.arm) -> gos a.Tast.abody) arms - | Tast.UnwrapSome v -> go v - | Tast.Signal (_, _, c) -> go c - | Tast.Handled (frames, body) -> - List.iter (fun (h : Tast.hframe) -> f h.Tast.hfn) frames; - gos body - | Tast.RestartCase (cs, body) -> - List.iter (fun (c : Tast.rclause) -> gos c.Tast.rbody) cs; - go body - | Tast.WithAlloc (a, body) -> go a; gos body +(* The edges, which is the whole of what this module has to say about the shape + of an expression: [Tast.walk] visits every node and this names the ones that + are a link-time reference. [Call] and [Global] are the obvious ones; + [Handled] is the one worth naming, because a handler-bind clause was lifted + into a function of its own and is reached by *address* from the body that + wrote it, never by a call. Miss it and a program with a handler loses the + handler. -and place_refs f (p : Tast.place) = - match p with - | Tast.Plocal _ -> () - | Tast.Pglobal n -> f n - | Tast.Pfield (t, _) -> expr_refs f t - | Tast.Pindex (t, idx) -> expr_refs f t; List.iter (expr_refs f) idx - | Tast.Pderef t -> expr_refs f t + A write to a global is a reference too — [Set] and [Addr] through a + [Pglobal] — which is how a program whose only mention of a global is the + (set g ...) that loads it keeps it. *) +let expr_refs f (e : Tast.expr) = + Tast.walk + (fun (e : Tast.expr) -> + match e.Tast.e with + | Tast.Global n -> f n + | Tast.Call (n, _) -> f n + (* The edges reached by address rather than by a call: a Map's hash and + equality pair, and a function *value* someone wrote the name of. A + name used as a value is never a [Call], so without the second one the + one function a program passes to [map] is the one function the link + drops. [Rtfn] is C in flan_rt.c and is linked whatever happens. *) + | Tast.FnAddr (Tast.Flanfn n) | Tast.FnAddr (Tast.Fnval n) -> f n + | Tast.Set (Tast.Pglobal n, _) | Tast.Addr (Tast.Pglobal n) -> f n + | Tast.Handled (frames, _) -> + List.iter (fun (h : Tast.hframe) -> f h.Tast.hfn) frames + (* A [CallPtr] roots no name: whatever it calls was reached as a value, + and the [FnAddr] that produced it is a node inside the callee. *) + | _ -> ()) + e (* ── What a body names, as one number ──────────────────────────────── *) diff --git a/lib/tast.ml b/lib/tast.ml index 5335f16..5b996d7 100644 --- a/lib/tast.ml +++ b/lib/tast.ml @@ -321,6 +321,71 @@ type program = { cshim : (string * string) list; } +(* ── Walking an expression ─────────────────────────────────────────── *) + +(* Every node of an expression, outermost first, the ones hanging off a [place] + included. One traversal in the IR's own file rather than one per reader: + three passes ask structural questions of a body — what names it refers to + ([Reach]), whether a global's initialiser can transfer, and which globals it + reads ([Check]) — and each of them that spelled the traversal out again was + a place a new constructor could be forgotten in. What differs between those + readers is the question, which is [f]. The shape of the IR is not theirs to + restate. + + A lifted clause's body is not in here: it is a function of its own, and this + walks one expression. A reader that wants it follows [hfn], the way [Reach] + does. *) +let rec walk (f : expr -> unit) (e : expr) = + f e; + let go = walk f in + let gos = List.iter go in + match e.e with + | Int _ | Float _ | Bool _ | Str _ | Unit | Zero _ | Uninit _ | Local _ + | Global _ | None_ | FnAddr _ | Break _ | Continue _ -> () + | Prim (_, es) | Call (_, es) | Do es | Make (_, es) | MakeCase (_, _, es) + | Arr es | InvokeRestart (_, _, es, _, _, _) -> gos es + | CallPtr (c, es) -> go c; gos es + | Let (bs, body) -> List.iter (fun (_, v) -> go v) bs; gos body + | If (a, b, c) -> go a; go b; go c + | While (c, body, latch) -> go c; gos body; gos latch + | Return v -> Option.iter go v + | Set (p, v) -> walk_place f p; go v + | Addr p -> walk_place f p + | Field (t, _) | Deref t | CaseField (t, _, _) | Some_ t | UnwrapSome t + | Signal (_, _, t) -> go t + | Match (sc, arms) -> go sc; List.iter (fun a -> gos a.abody) arms + | Handled (_, body) -> gos body + | RestartCase (cs, body) -> List.iter (fun c -> gos c.rbody) cs; go body + | WithAlloc (a, body) -> go a; gos body + +and walk_place f (p : place) = + match p with + | Plocal _ | Pglobal _ -> () + | Pfield (t, _) | Pderef t -> walk f t + | Pindex (t, idx) -> walk f t; List.iter (walk f) idx + +(* ── What the object image can hold ─────────────────────────────────── *) + +(* Whether an initialiser is a value a linker can write into the program's + image: a literal, a zero, an aggregate of those. It is [Emit.const]'s + accepted set asked as a question rather than answered as a string, and the + two have to stay the same set — [const] spells the value, this decides who + is allowed to ask it to. + + Everything else is *computed*, which used to be the end of the road and is + now a fork: [Check] lifts a computed initialiser into a function of its own + and the program calls it at startup. So this is no longer "what a global may + be", only "what needs no code" — which is why a [MakeCase] is false here + rather than an error. A data type case written into the image would need a + byte-level encoder that could not encode a string field at all; written as a + store at startup it needs nothing. *) +let rec const_init (e : expr) = + match e.e with + | Int _ | Float _ | Bool _ | Str _ | Unit | Zero _ | Uninit _ | None_ -> true + | Make (_, es) | Arr es -> List.for_all const_init es + | Some_ v -> const_init v + | _ -> false + (* The declared position of a case, which is its tag, and the case itself. Tags are declaration order from zero, so an all-bytes-zero data type is the first case with a zeroed payload — the same rule that makes an [Option]'s zero a diff --git a/lib/x86.ml b/lib/x86.ml index 923d591..1116b17 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -3333,6 +3333,32 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false) Buffer.add_string out (Printf.sprintf "\t.size\t%s, . - %s\n\n" sym sym); Buffer.contents out, Buffer.contents f.rodata +(* Two functions, because the two halves run at different times and have to. + + [data_sym] is the constant image: the values [emit.ml] writes into the + object and this backend has no folder for, so it writes them as stores. They + are data, they depend on nothing, and they have to be there even in a build + with no [main] — a C host that brings its own entry point still finds the + globals it was linked against — so this one stays a .init_array + constructor. That is the only thing .init_array is still used for here, and + it is the honest use of it: it is standing in for the other backend's + object image, not for a program. + + [init_sym] is the computed initialisers, and it is called from [main]. It + carries the same name as [emit.ml]'s startup function because it is the + same function, and it moved out of .init_array for the reason given there: + the runtime has to be up before an initialiser runs, or a global computed + from [args] would answer differently on the two backends, and a rule that + holds on one backend and not the other is not a rule. + + What used to be here beside them is the walk that refused a [signal] or a + restart inside an initialiser. It is [Check.no_transfer_in_init] now: it was + this backend's rule only while this was the only backend that ran + initialisers, and a refusal that is about the language belongs where both + backends meet it. *) +let data_sym = "\"flan..init-data\"" +let init_sym = "\"flan..init-globals\"" + (* ── C's main ────────────────────────────────────────────────────────── *) (* The same four shapes [emit.ml]'s [emit_main] adapts to, and the same order: @@ -3340,7 +3366,8 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false) the loader put them in, the program's own end of the transfer channel is a null cell on this frame, and the exit goes through [flan_exit] because stdout is a FILE* and something has to flush it. *) -let emit_main ?(cfi = false) ?(ann = false) (md : Emit.m) (fn : Tast.fn) = +let emit_main ?(cfi = false) ?(ann = false) ?(startup = false) (md : Emit.m) + (fn : Tast.fn) = let b = create () in bnote ann b "C's main, which is the whole of the adapter between the loader and a Flan program. \ @@ -3360,6 +3387,11 @@ let emit_main ?(cfi = false) ?(ann = false) (md : Emit.m) (fn : Tast.fn) = without an exception, which is worth more than the two bytes. *) xor_rr b ~dst:rax ~src:rax; call_sym b "flan_rt_init"; + (* The computed globals, after the runtime is up and before a line of the + program's own code — [emit.ml]'s [emit_startup] says why this is a call + from here rather than a second constructor. It takes no channel: no caller + can hand it one, so it owns a null cell of its own. *) + if startup then call_sym b init_sym; let xfer = -8 and argv = -32 in xor_rr b ~dst:rax ~src:rax; store_int b ~src:rax ~mm:(Frame xfer) ~size:8; @@ -3395,10 +3427,10 @@ let emit_main ?(cfi = false) ?(ann = false) (md : Emit.m) (fn : Tast.fn) = (* ── Globals ─────────────────────────────────────────────────────────── *) -(* Every global is a zeroed object and an initialiser that runs before [main] - does. [emit.ml] folds the initialiser into an LLVM constant instead, which - it can because it has a constant folder for the IR's own syntax; running the - same expression as code costs a few instructions once and needs no second +(* Every global is a zeroed object and a store that fills it in. [emit.ml] + folds a constant initialiser into an LLVM constant instead, which it can + because it has a constant folder for the IR's own syntax; running the same + expression as code costs a few instructions once and needs no second evaluator that could disagree with the first about what a struct literal means. *) let emit_globals_data (md : Emit.m) (globals : Tast.global list) = @@ -3415,9 +3447,8 @@ let emit_globals_data (md : Emit.m) (globals : Tast.global list) = globals; Buffer.contents out -let init_sym = "\"flan..init-globals\"" -let emit_globals_init ?(cfi = false) ?(ann = false) (md : Emit.m) ~externs ~fns +let emit_globals_init ?(cfi = false) ?(ann = false) ~sym (md : Emit.m) ~externs ~fns (globals : Tast.global list) = let b = create () in let f = @@ -3440,10 +3471,12 @@ let emit_globals_init ?(cfi = false) ?(ann = false) (md : Emit.m) ~externs ~fns (fun (g : Tast.global) -> scoped f (fun () -> lower f g.Tast.ginit (Lg (gsym g.Tast.gname, 0)))) globals; - (* Nothing establishes a handler or a restart before this runs, so a - transfer out of an initialiser has nowhere to go and cannot arise: a - bounds failure here finds no handler and dies inside the runtime. The - exit still exists because a guard names it. *) + (* 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 + the checker refuses one by name. A bounds failure here finds no handler + and dies inside the runtime. The exit still exists because a guard names + 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; @@ -3467,71 +3500,16 @@ let emit_globals_init ?(cfi = false) ?(ann = false) (md : Emit.m) ~externs ~fns flush pb; flush f.b; let out = Buffer.create 512 in Buffer.add_string out - (Printf.sprintf "\t.type\t%s, @function\n%s:\n" init_sym init_sym); + (Printf.sprintf "\t.type\t%s, @function\n%s:\n" sym sym); if cfi then Buffer.add_string out "\t.cfi_startproc\n"; Buffer.add_string out (Buffer.contents pb.out); Buffer.add_string out (Buffer.contents f.b.out); if cfi then Buffer.add_string out "\t.cfi_endproc\n"; - Buffer.add_string out (Printf.sprintf "\t.size\t%s, . - %s\n\n" init_sym init_sym); + Buffer.add_string out (Printf.sprintf "\t.size\t%s, . - %s\n\n" sym sym); Buffer.contents out, Buffer.contents f.rodata (* ── The program ─────────────────────────────────────────────────────── *) -(* What is left of the precondition that used to stand in for conditions. - - It was a whole-program argument: this backend emitted no guard after a call, - which is sound exactly when nothing in the reachable set can ever *write* - the channel, so the build refused by name the moment it found something that - could. Every call site is guarded now and the argument has retired — except - in one place, which is why the walk is still here. - - A global's initialiser runs from [flan..init-globals], before [main] and - before anything has established a handler or a restart. It owns its own - channel cell because no caller hands it one, so a transfer out of an - initialiser has nowhere to go: its exit would return to the loader. Refused - by name rather than compiled into a return into ld.so. *) -let check_no_transfer (p : Tast.program) = - let bad what = - unsupported "%s in a global's initialiser: it runs before main, before \ - anything can handle it, and a transfer out of it has nowhere \ - to go" what - in - let rec ex (e : Tast.expr) = - (match e.Tast.e with - | Tast.Signal _ -> bad "signal" - | Tast.InvokeRestart _ -> bad "invoke-restart" - | Tast.RestartCase _ -> bad "restart-case" - | Tast.Handled _ -> bad "handler-bind" - | _ -> ()); - iter_sub ex e - and iter_sub g (e : Tast.expr) = - match e.Tast.e with - | Tast.Prim (_, xs) | Tast.Call (_, xs) | Tast.Arr xs | Tast.Do xs - | Tast.Make (_, xs) | Tast.MakeCase (_, _, xs) -> List.iter g xs - | Tast.CallPtr (a, xs) -> g a; List.iter g xs - | Tast.Handled (_, xs) -> List.iter g xs - | Tast.Let (bs, body) -> List.iter (fun (_, x) -> g x) bs; List.iter g body - | Tast.If (a, b, c) -> g a; g b; g c - | Tast.While (a, b, l) -> g a; List.iter g b; List.iter g l - | Tast.Return (Some x) | Tast.Some_ x | Tast.Deref x | Tast.UnwrapSome x - | Tast.Field (x, _) | Tast.CaseField (x, _, _) | Tast.Signal (_, _, x) -> g x - | Tast.Set (pl, x) -> place_ g pl; g x - | Tast.Addr pl -> place_ g pl - | Tast.Match (x, arms) -> - g x; List.iter (fun (a : Tast.arm) -> List.iter g a.Tast.abody) arms - | Tast.RestartCase (cs, x) -> - List.iter (fun (c : Tast.rclause) -> List.iter g c.Tast.rbody) cs; g x - | Tast.WithAlloc (a, body) -> g a; List.iter g body - | Tast.InvokeRestart (_, _, xs, _, _, _) -> List.iter g xs - | _ -> () - and place_ g (pl : Tast.place) = - match pl with - | Tast.Pfield (x, _) | Tast.Pderef x -> g x - | Tast.Pindex (x, ys) -> g x; List.iter g ys - | _ -> () - in - List.iter (fun (g : Tast.global) -> ex g.Tast.ginit) p.Tast.globals - (* One cell per function, initialised to the body this build compiled, and [.globl] so that a redefinition module can bind to it. Nothing has been redefined yet when the program starts, so a dev build begins by behaving @@ -3764,7 +3742,6 @@ let emit_dwarf (dw : dwarf) ~cufile ~tbeg ~tend = (* A whole program as one assembly file. *) let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false) (p : Tast.program) : string = - check_no_transfer p; let md = layout_ctx ~checks ~dev p in let externs = Hashtbl.create 16 in List.iter @@ -3873,14 +3850,33 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false) Buffer.add_string text t; Buffer.add_string rodata r) p.Tast.fns; + (* The constant image, then the computed initialisers, each into its own + 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) + p.Tast.globals + in let ginit, gr = - emit_globals_init ~cfi:debug ~ann:annotate md ~externs ~fns p.Tast.globals + emit_globals_init ~cfi:debug ~ann:annotate ~sym:data_sym md ~externs ~fns + constants in Buffer.add_string text ginit; Buffer.add_string rodata gr; + 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 + in + Buffer.add_string text t; + Buffer.add_string rodata r + end; (match List.find_opt (fun (f : Tast.fn) -> f.Tast.name = "main") p.Tast.fns with | Some fn -> - Buffer.add_string text (emit_main ~cfi:debug ~ann:annotate md fn) + Buffer.add_string text (emit_main ~cfi:debug ~ann:annotate ~startup md fn) (* No [main] is not an error, and [emit.ml] treats it the same way: a program can be linked against a C host that brings its own entry point, which is what [reload_host.c] is. Refusing here made a --x86 host for the @@ -3897,16 +3893,19 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false) slot [emit.ml] uses to arm the allocation registry. *) (* [flan_dev_reg_enable] arms the allocation registry, and a dev build is the only build that has one. A constructor rather than a line in [main] for - [emit.ml]'s reason: a [defvar] initialiser allocates before [main] runs, - and a note that arrived before the flag was set would be a block the table - never heard of. It is ordered before [init_sym] here for the same reason. + [emit.ml]'s reason, which that file now states in its weaker and truer + form: arming has to precede the first allocation, and a constructor is the + only slot that precedes every one of them whatever the entry point is. It + is ordered before [data_sym] here because that one allocates too, and + before [init_sym] by construction: that one is called from [main], which + every constructor precedes. Leaving it out was the one visible difference between a `--x86 --dev` build and an LLVM one over the whole corpus: [registry.flan] asks [(live? ...)] and got four zeroes. *) Buffer.add_string out (Printf.sprintf "\t.section\t.init_array,\"aw\",@init_array\n\t.align\t8\n%s\ \t.quad\t%s\n\n" - (if dev then "\t.quad\tflan_dev_reg_enable\n" else "") init_sym); + (if dev then "\t.quad\tflan_dev_reg_enable\n" else "") data_sym); (* The ABI marker, and only in a dev build: it exists for redefinition modules to bind against, a release build has no cells to load one into, and gating it here is what keeps a release build's assembly byte-for-byte @@ -3953,10 +3952,12 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false) would be wrong in a module: - no [main]: this object is loaded, not started. - - no [.init_array] and in particular no [flan..init-globals]. Re-running a - global's initialiser would wipe the live state that reloading exists to - preserve -- sand's grid is a global and "edit the code, keep the sand" is - the whole demo. + - no [.init_array], so no [flan..init-data]; and no call to + [flan..init-globals], which is the other half of the same sentence now + that the computed initialisers are called from [main] instead. Rewriting a + global's storage from its initialiser would wipe the live state that + reloading exists to preserve -- sand's grid is a global and "edit the + code, keep the sand" is the whole demo. - no [flan_dev_reg_enable] constructor: the host armed the registry when it started. - no [.bss] for the globals and no [.data] for the cells. Both are the @@ -3978,7 +3979,7 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false) [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 + A new global's declared {e constant} 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 @@ -3988,6 +3989,13 @@ let program ~checks ?(dev = false) ?(debug = false) ?(annotate = false) as ordinary code. A few instructions once, and no second evaluator that could disagree with the first about what a struct literal means. + A computed initialiser sends no image at all and the allocation stays + zeroed. It is not that this module could not run one -- it could, and the + buffer above is the shape that would take. It is that an initialiser runs at + startup and a module is loaded rather than started, so a name the program is + meeting for the first time has no startup to have missed. [emit.ml] answers + it the same way. + {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. *) @@ -4102,13 +4110,25 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true) 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". *) + "resolve everything, then publish". + + A *computed* initialiser gets no buffer and no image: the pointer is null + and the allocation keeps calloc's zeroes. It runs at startup, and this + module is loaded rather than started -- there is no startup here to have + missed. [emit.ml] answers a new computed global the same way and for the + same reason; the value it would compute is not what a reload is for. *) 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))); + let l = + if not (Tast.const_init g.Tast.ginit) then None + else begin + let l = rodata_label f in + scoped f (fun () -> lower f g.Tast.ginit (Lg (l, 0))); + Some l + end + in (g, l, max 1 size, max 1 align)) new_globals in @@ -4130,7 +4150,9 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true) (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)); + (match l with + | Some l -> lea f.b ~dst:rdx ~mm:(Sym (l, 0)) + | None -> xor_rr f.b ~dst:rdx ~src:rdx); 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) @@ -4246,9 +4268,15 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true) 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)) + \t.size\t%s, 8\n%s:\n\t.zero\t8\n" + s s s); + (* No image where there is no initial value to copy: a computed + initialiser sends a null and the allocation stays zeroed. *) + match l with + | None -> () + | Some l -> + Buffer.add_string out + (Printf.sprintf "\t.align\t%d\n%s:\n\t.zero\t%d\n" align l size)) images end; (* The ABI marker this module requires of its host. A pointer-sized datum diff --git a/plan.org b/plan.org index dc66e7d..84c6f41 100644 --- a/plan.org +++ b/plan.org @@ -117,6 +117,16 @@ world. ~(clone x)~. Value structs are the snapshot / undo / replay story; they need no separate type. - Literals live in read-only memory. +- *A global's initialiser may be computed.* A value the linker can write goes + into the image and costs nothing to start; anything else is stored at + startup, by a function ~main~ calls before a line of the program's own code — + Odin's ~__$startup_runtime~ shape rather than a constructor, so the runtime is + up and the order is the compiler's to choose. The computed ones are sorted by + what they read, so ~(defvar b i64 (+ a 1))~ works above ~a~; a cycle between two + of them is a compile error naming both. A transfer out of an initialiser — + ~signal~, ~restart-case~ — is refused: nothing has established a handler that + early. A reload never re-runs an initialiser, which is what keeps the live + state a reload exists to preserve. - Struct literals name fields: ~(Cursor {.src src .pos 0})~. *Omitted fields are zeroed*, as in Odin — the same rule as a declaration with no initialiser, so ~(Cursor {.src src})~ is complete and means ~pos~ is 0. diff --git a/sand.flan b/sand.flan index e26c606..23c2e74 100644 --- a/sand.flan +++ b/sand.flan @@ -181,7 +181,13 @@ (rl/draw-fps 20 20)) (defvar frame Allocator (arena-new 262144)) -(defvar game-data (embed (with-allocator frame ))) +;; Where the evening stopped, and it did not parse: what was written is a +;; (defvar NAME TYPE) whose type is (embed ...), so the checker refused the +;; whole file and took `dune test` with it. Commented out rather than guessed +;; at — the arena above is the half that works, and a computed initialiser now +;; runs at startup on both backends, so +;; (defvar game-data edn/Value (with-allocator frame (edn/read ...))) +;; is a form the language will take when there is a file for it to read. (defn main [] () (rl/set-trace-log-level :warning) diff --git a/test/programs/global-init.flan b/test/programs/global-init.flan new file mode 100644 index 0000000..791f0e9 --- /dev/null +++ b/test/programs/global-init.flan @@ -0,0 +1,75 @@ +;;;; Computed global initialisers — plan.org, Data model. +;;;; +;;;; A global whose value is not something a linker can write into the image. +;;;; The initialiser is lifted into a function of its own and called at startup, +;;;; from main, after the runtime is up and before a line of the program's own +;;;; code — Odin's __$startup_runtime shape rather than a constructor. Both +;;;; backends do it the same way, which is what the x86 survey is comparing. +;;;; +;;;; What each half of this file is asserting: +;;;; +;;;; - an arena allocated at startup and used from main, which is the form +;;;; the author kept writing: (defvar frame Allocator (arena-new N)). +;;;; - the order. `derived` is written above the global it reads, so the +;;;; declaration order is the wrong one and the sort is what makes it 30. +;;;; - a dependency that runs through a call rather than through the text of +;;;; the initialiser: `via-fn` names no global at all, and the function it +;;;; calls reads one. +;;;; - control flow in an initialiser. Every one of these needs a frame, and +;;;; before the lift there was none — a `let` in an initialiser indexed a +;;;; slot array of length zero and took the compiler down with it. +;;;; - a container loaded by its own initialiser, and a data type case +;;;; written into a global. Both were refused while there was nowhere for +;;;; an initialiser to run. + +(defdata Shape [Nothing (Circle [r i32]) (Square [side i32])]) + +;; Written above `base`, and it reads it. +(defvar derived i64 (* base 10)) +(defvar base i64 (+ 1 2)) + +(defn twice-base [] i64 (* base 2)) +;; Names no global; the function it calls does. +(defvar via-fn i64 (+ (twice-base) 1)) + +;; The author's arena, and the Vec it is meant to hold. +(defvar frame Allocator (arena-new 262144)) + +;; Control flow, each shape in its own global. +(defn maybe [] (Option i32) (Some 3)) +(defvar matched i32 (match (maybe) (Some x) x None 0)) +(defvar branched i64 (if (> base 2) (let [k (+ base 1)] (* k 2)) 0)) +(defvar counted i64 (let [t (i64 0)] (while (< t 4) (set t (+ t 1))) t)) + +;; A data type case: a store at startup, where a constant would have needed a +;; byte-level encoder for the payload blob. +(defvar shape Shape (Shape.Circle {.r 7})) + +;; And a container whose real value only exists behind an allocator. +(defvar names (Vec i64) (vec-new i64)) + +(defn main [] i32 + (println derived) + (println base) + (println via-fn) + (println matched) + (println branched) + (println counted) + (match shape + (Circle r) (println r) + (Square s) (println s) + Nothing (println -1)) + ;; The Vec was made with the default allocator at startup and is still the + ;; program's when main runs. + (push names 11) + (push names 22) + (println (len (as-slice names))) + (println (at names 1)) + (free names) + ;; And the arena, used the way sand.flan means to use it. + (with-allocator frame + (let [v (vec-new i64)] + (push v 7) + (println (at v 0)))) + (free-all frame) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 993137e..4dc28f9 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -126,6 +126,19 @@ let () = clone is still the global's. *) outputs "a global Vec" "programs/vec-global.flan" "6\n131\n131\n7\n232\n232\n7\n7\n7\n"; + (* Computed global initialisers, both backends and both optimisation + levels. The numbers that matter are the first (a global written above + the one it reads, so declaration order is the wrong order and the sort + is what makes it 30), the third (a dependency that runs through a call + and appears nowhere in the initialiser's text), and the last (the + author's arena, allocated at startup and used from main). -O0 as well as + -O2 because the whole thing is a call and a store before main: an + optimiser that inlines it away and one that does not have to agree. *) + (let global_init_out = "30\n3\n7\n3\n8\n4\n7\n2\n22\n7\n" in + outputs "computed global initialisers" "programs/global-init.flan" + global_init_out; + outputs ~opt:"-O0" "computed global initialisers, -O0" + "programs/global-init.flan" global_init_out); (* (array COUNT TYPE). Every line of it is a [let] binding, which is the one position with no type slot and the whole reason the form exists. *) outputs "array constructor" "programs/array-ctor.flan" "4\n0\n7\n9\n4\n"; @@ -2992,15 +3005,14 @@ level "1" "(defdata U [A B])\n\ (defn f [m (Map U i32) k U] () (put m k 1))" "the payload past the case in hand is indeterminate"; - (* A global cannot hold a case, because writing one at link time means + (* A *constant* cannot hold a case, because writing one at link time means serialising the fields into the payload blob and a string field is a - relocation a byte array has nowhere to put. Zeroed is fine and is the - first declared case. Refused in the emitter, where the rest of the - same rule about a global's initialiser already lives, so the assertion - has to get that far rather than stopping at the checker. *) - (let name = "a global initialised with a data type case" in + relocation a byte array has nowhere to put. Refused in the emitter, + where the rest of the rule about what the image can hold lives, so the + assertion has to get that far rather than stopping at the checker. *) + (let name = "a constant initialised with a data type case" in let src = - "(defdata U [A (B [x i32])])\n(defvar g U (U.B {.x 1}))\n\ + "(defdata U [A (B [x i32])])\n(defconst g U (U.B {.x 1}))\n\ (defn main [] i32 0)" in match @@ -3016,6 +3028,43 @@ level "1" incr failures; Printf.printf "FAIL %s\n said: %S\n" name m end); + (* A defvar holding one is accepted, and that is the same rule seen from + the other side: its initialiser is computed, so it is lifted into a + function that runs at startup and the case is written by an ordinary + store. Nothing has to be encoded into anything. *) + (let name = "a global initialised with a data type case" in + let src = + "(defdata U [A (B [x i32])])\n(defvar g U (U.B {.x 1}))\n\ + (defn main [] i32 (match g A 0 (B x) x))" + in + match + Emit.program + (Check.program (Parse.program (Reader.read_all ~file:"" src))) + with + | _ -> () + | exception Loc.Error { Loc.dmsg = m; _ } -> + incr failures; + Printf.printf "FAIL %s\n refused: %S\n" name m); + (* And a computed initialiser on a defconst is refused by name, because a + constant is what the linker writes and there is nowhere for it to run. + The emitter again: the checker has no opinion about what folds. *) + (let name = "a defconst with a computed initialiser" in + let src = + "(defn two [] i64 2)\n(defconst c i64 (two))\n(defn main [] i32 0)" + in + match + Emit.program + (Check.program (Parse.program (Reader.read_all ~file:"" src))) + with + | _ -> + incr failures; + Printf.printf "FAIL %s\n it was accepted\n" name + | exception Loc.Error { Loc.dmsg = m; _ } -> + if not (contains m "a constant's value must be a compile-time constant") + then begin + incr failures; + Printf.printf "FAIL %s\n said: %S\n" name m + end); (* uninit is an opt-out from ZII everywhere else and the bytes are just bytes. On a data type they steer control flow: a tag no case names falls past every comparison in a match into the block LLVM is entitled to diff --git a/test/test_flan.ml b/test/test_flan.ml index 4c6c92d..6c66437 100644 --- a/test/test_flan.ml +++ b/test/test_flan.ml @@ -1067,18 +1067,59 @@ let () = type-check, and the process-long lifetime is the program's to keep. The accepted side is programs/vec-global.flan. What is still refused about one is declaration-shaped, below. *) - (* And the two declaration shapes. A computed initialiser would have to run - before main, which is a path [Emit.const] does not have and which - [x86.ml] deliberately leaves out of a reload module; a defconst could - never be assigned, so nothing could ever load it. Both name the (defvar g - (Vec u8)) that works, which is the point of refusing them here rather - than letting the backend say "this one is computed" three passes later. *) - rejects_check "a global Vec with a computed initialiser" - "(defvar g (Vec u8) (slurp \"game-data.edn\")) (defn f [] ())" - ~needle:"starts zeroed"; + (* And the two declaration shapes. The computed one is the half that changed: + there is an init-at-startup path now, on both backends, so a global Vec + loaded by its own initialiser is an ordinary program — which is what the + commented-out line in sand.flan was reaching for. The defconst is refused + as it always was, and for a reason the startup path does not touch: a + constant is not an assignable place, so nothing could ever load it. *) + accepts "a global Vec with a computed initialiser" + "(defvar g (Vec u8) (slurp \"game-data.edn\")) (defn f [] ())"; rejects_check "a move-only global as a defconst" "(defconst g (Vec u8) (slurp \"game-data.edn\")) (defn f [] ())" ~needle:"a defvar and not a defconst"; + (* uninit is the one initialiser a container still refuses, and it is a + different rule: a garbage block pointer is not a garbage number. *) + rejects_check "a global Vec declared uninit" + "(defvar g (Vec u8) uninit) (defn f [] ())" + ~needle:"steers every read of it"; + + (* ── Computed global initialisers ────────────────────────────────── + The order they run in is the compiler's to choose, so a global written + above the one it reads is fine... *) + accepts "a global initialised from another, written above it" + "(defvar b i64 (+ a 10)) (defvar a i64 (+ 1 2)) (defn f [] i64 b)"; + (* ...and a ring is refused with every name in it, because there is no + answer: whichever one started first would read the other's zero. *) + rejects_check "two globals that initialise each other" + "(defn fa [] i64 b) (defn fb [] i64 a)\n\ + (defvar a i64 (fa)) (defvar b i64 (fb))\n(defn f [] i64 (+ a b))" + ~needle:"initialise each other"; + rejects_check "a global initialised from itself" + "(defn fa [] i64 a) (defvar a i64 (fa)) (defn f [] i64 a)" + ~needle:"initialised from itself"; + (* The dependency is through the call, not only through what the initialiser + names: [fa] reads [b] and nothing in [a]'s text mentions it. *) + accepts "a global that reads another through a function it calls" + "(defn fa [] i64 (+ b 1)) (defvar a i64 (fa)) (defvar b i64 (+ 1 2))\n\ + (defn f [] i64 a)"; + (* Nothing outside an initialiser can establish a handler or a restart, so an + unanswered signal is a no-op and an unanswered invoke-restart fails at the + invoke site. Both are refused by name. *) + rejects_check "a signal in a global initialiser" + "(defstruct Oops [id i32])\n\ + (defvar w i64 (do (signal (Oops {.id 1})) 1))\n(defn f [] i64 w)" + ~needle:"with no handler-bind or restart-case around it"; + rejects_check "an invoke-restart in a global initialiser" + "(defvar w i64 (do (invoke-restart 'retry) 1))\n(defn f [] i64 w)" + ~needle:"an initialiser runs at startup"; + (* And what is *inside* one runs like any other code: the frames a + restart-case pushes it also pops, before the initialiser returns. This is + [slurp]'s shape, which is why a global loaded from a file works at all. *) + accepts "a restart-case inside a global initialiser" + "(defstruct Oops [id i32])\n\ + (defvar w i64 (restart-case (do (signal (Oops {.id 1})) 7) (use-zero [] 0)))\n\ + (defn f [] i64 w)"; (* The borrows, which are what is left once ownership is off the table: a global Vec is read, mutated in place, viewed and copied, and the copy is the one thing something else may own. *) @@ -1685,13 +1726,13 @@ let () = "(defunion U [i i32 f f32])\n\ (defn f [m (Map U i32) k U] () (put m k 1))" ~needle:"a union is not a map key"; - (* A global's initialiser is a constant and writing a member is a store. The - zeroed and uninit forms need none of that and are accepted below. *) - rejects_check "a global initialised with a union member" - "(defunion U [i i32])\n(defvar g U (U {.i 1}))\n(defn f [] i32 0)" - ~needle:"cannot be written into a global"; - (* A defconst reaches the same emitter by a different path, so it gets the - same refusal rather than coming back as "this one is computed". *) + (* A constant is what the linker writes into the image and a union member is + a store, so a defconst is refused rather than coming back from the emitter + as "this one is computed". A defvar is not refused any more: its computed + initialiser is lifted into a function that runs at startup, and the member + is written by the same store that writes one in a body. *) + accepts "a global initialised with a union member" + "(defunion U [i i32])\n(defvar g U (U {.i 1}))\n(defn f [] i32 0)"; rejects_check "a constant initialised with a union member" "(defunion U [i i32])\n(defconst c U (U {.i 1}))\n(defn f [] i32 0)" ~needle:"cannot be written into a constant"; diff --git a/test/test_session.ml b/test/test_session.ml index f9aefa5..fa8688a 100644 --- a/test/test_session.ml +++ b/test/test_session.ml @@ -272,6 +272,18 @@ let () = fail "a new global's initialiser was dropped"; if not c.Session.installs then fail "adding a global had nothing to install"; + (* A *computed* initialiser is the other half of the same rule and answers + the opposite way: it runs at startup, from main, and a module is loaded + rather than started — so a name the program is meeting for the first time + starts as ZII rather than re-running anything. The null is what says so, + and the absence of a second image is what proves the initialiser did not + travel as code. Re-running one is exactly what would wipe the state a + reload exists to preserve. *) + let c = Session.eval t "(defvar computed i64 (+ 20 2)) (defn read-computed [] i64 computed)" in + if not (has c.Session.ir "to i64), ptr null)") then + fail "a new computed global did not start zeroed"; + if not c.Session.installs then fail "adding a computed global had nothing to install"; + (* Names the process was never built with go through the registry instead of binding to a symbol, and adding one is allowed where retyping one is not. *) let c = Session.eval t "(defvar fresh i64) (defn use-fresh [] i64 (set fresh 3) fresh)" in