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

Merge: a global's initialiser may compute, and main runs it first

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-19 04:25:54 +07:00
commit 617440aee6
11 changed files with 889 additions and 248 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

383
lib/check.ml
View File

@ -5968,34 +5968,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
@ -6005,18 +6010,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
@ -6034,15 +6035,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
@ -6050,12 +6055,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 = "<none>" } in
@ -6089,8 +6195,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) ->
@ -6111,7 +6218,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;
@ -6167,6 +6274,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
@ -6232,6 +6510,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 =

155
lib/emit.ml
View File

@ -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 \

12
lib/js.ml
View File

@ -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"

87
lib/reach.ml
View File

@ -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 ──────────────────────────────── *)

65
lib/tast.ml
View File

@ -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

202
lib/x86.ml
View File

@ -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

10
plan.org
View File

@ -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.

75
test/programs/global-init.flan Normal file
View File

@ -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)

63
test/test_acceptance.ml
View File

@ -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:"<defdata>" 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:"<defconst>" 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

73
test/test_flan.ml
View File

@ -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";

12
test/test_session.ml
View File

@ -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