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

The runtime structs are one table, and the mangles one module

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-20 13:20:47 +07:00
commit b0ee9a3ce0
8 changed files with 397 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
FIX.org
View File

@ -823,9 +823,15 @@ globals at all.
what the daemon has always promised in its own words — "the globals are as
the last run left them" — and what a zeroed one already got for free, since
.bss is untouched by a second entry into main.
- [defconst] is a constant and the question does not arise: it is the linker's
image on one backend and a constructor's stores on the other, and a re-run
reaches neither.
- [defconst] with a compile-time-constant initialiser is written into the
image — the linker's on one backend, [flan..init-data]'s stores on the
other — and no startup code reaches it, so a re-run reaches neither. The
split is [Tast.const_init]'s and it is over the *initialiser*, not over the
form: a computed [defconst] would be guarded exactly like a computed
[defvar]. The x86 backend does guard one; the LLVM backend refuses the
program instead, because [Emit.const] has nowhere to run a computed value.
That divergence predates the re-run rule — the refusal landed in 495629f and
the flags in 931cf86 — and is noted here rather than fixed.
- If the language grows a [def]-style form that re-evaluates, that form
recomputes on every run. None exists today and none was invented for this;
the rule is written so that adding one is a new case and not a revision.
@ -838,6 +844,16 @@ because the rule belongs to the form; dev builds only, so a release build's
.ll and .s are byte for byte what they were, which was measured on both
backends rather than argued.
The flag's name is [.init~once.<global>]. It was [.init-once.<global>] until
2026-09-20, which a program could collide with: [.] and [-] are both ordinary
symbol constituents, so [(defvar .init-once.x i64 7)] beside a computed [x]
emitted the same symbol twice and the dev build died at the assembler on both
backends — and worse, the flag's Bool was registered over the user's global in
[Emit.globals], so the store to it came out as an [i1]. [~] is a terminator in
the reader, so no symbol a program can write contains one; [destructure~N]
uses the same trick. [test/programs/dev-rerun.flan] carries a global named
[.init-once.counter] to keep it pinned.
Verified against a live daemon on both backends with
[test/programs/dev-rerun.flan]: a computed i64 counts 41, 42, 43, 44 across
four runs where it counted 41, 41, 41, 41 before; a computed dyn map keeps the

2
lib/dev.ml
View File

@ -2773,7 +2773,7 @@ let render_listing ~sym insns =
Buffer.contents b
let asm_of ~obj name =
let sym = "flan." ^ name in
let sym = Mangle.sym name in
let code, text =
run_capture
(String.concat " "

314
lib/emit.ml
View File

@ -47,10 +47,12 @@ let rec map_lr f = function
(* ── Names ─────────────────────────────────────────────────────────── *)
(* Flan names contain -, ?, > and /, so every emitted name is quoted. The
[flan.] prefix keeps the Flan [main] from colliding with C's. *)
prefix each of these applies is [Mangle]'s, spelled there once for both
backends and for the macro loader; the [@] and the quotes are LLVM's and
are applied here. *)
let quoted s = "\"" ^ s ^ "\""
let fname n = "@" ^ quoted ("flan." ^ n)
let gname n = "@" ^ quoted ("flan." ^ n)
let fname n = "@" ^ quoted (Mangle.sym n)
let gname n = "@" ^ quoted (Mangle.sym n)
let sname n = "%" ^ quoted n
(* A dev build's redefinable calls go through a cell: a mutable global holding
@ -58,7 +60,7 @@ let sname n = "%" ^ quoted n
and every existing call site follows it — which is the whole point, since a
call bound at link time cannot be made to notice a new body. Release builds
have no cells and call the symbol directly. *)
let cellname n = "@" ^ quoted ("flan.cell." ^ n)
let cellname n = "@" ^ quoted (Mangle.cell n)
(* A name the host was never built with — a defn or a defvar typed in after the
process started — has no symbol to bind to, so it is keyed by string through
@ -75,8 +77,8 @@ let xfer_param = "%xfer"
let struct_name_of (t : Types.t) =
match t with Types.Named n -> n | _ -> "a condition"
let cellptr n = "@" ^ quoted ("flan.cellp." ^ n)
let globalptr n = "@" ^ quoted ("flan.gp." ^ n)
let cellptr n = "@" ^ quoted (Mangle.cellptr n)
let globalptr n = "@" ^ quoted (Mangle.globalptr n)
(* Which backend built this image. A dev build defines its own marker and a
redefinition module emits a data relocation against the one it was built
@ -89,6 +91,130 @@ let globalptr n = "@" ^ quoted ("flan.gp." ^ n)
let abi_marker = "flan.abi.llvm"
let abi_marker_sym = "@" ^ quoted abi_marker
(* ── The runtime's own structs ───────────────────────────────────────── *)
(* Four structs that are not Flan types: they are declared in C, in
runtime/flan_rt.c and runtime/flan_dev.c, and both backends have to agree
with that C and with each other about every field. This backend needs the
LLVM type string and the field *index* a [getelementptr] takes; [x86.ml]
needs the byte *offset* and the total size. All four are derived here from
one list per struct, so that adding a field to [flan_restart] in the C is
one edit on this side rather than three.
The rules are C's, which is what makes the derivation legal at all: fields
in declaration order, each at the next offset its own alignment allows, the
whole rounded up to the strictest alignment in it. The general case of that
is [lay_fields] below, over Flan types; these four hold only pointers and
fixed-width integers, so they are measured here without a module context —
which is what lets [x86.ml] ask for an offset before it has one. *)
module Rt = struct
(* Every field any of them has. A pointer is 8 bytes on the one target both
backends emit for; [i32] and [i64] are what the C spells. *)
type kind = Ptr | I32 | I64
type t = { sname : string; fields : (string * kind) list }
let ll_of = function Ptr -> "ptr" | I32 -> "i32" | I64 -> "i64"
let size_of = function Ptr | I64 -> 8 | I32 -> 4
(* A handler frame: the one it displaced, the condition type it matches, and
the lifted function that runs. *)
let handler =
{ sname = "handler"; fields = [ "prev", Ptr; "type", I32; "fn", Ptr ] }
(* A restart frame. The first four fields are what the runtime's own
[flan_restart] declares and their offsets do not move; the rest are §3's
parameter passing, described where the type is written into the header. *)
let restart =
{ sname = "restart";
fields =
[ "prev", Ptr; "name_id", I32; "name", Ptr; "namelen", I64;
"args", Ptr; "arity", I32; "sig_id", I32; "armed", I32;
"sig", Ptr; "siglen", I64 ] }
(* The static description of a function, and the shadow-stack frame that
points at one. Dev builds only (runtime/flan_dev.c). *)
let fninfo =
{ sname = "fninfo";
fields =
[ "name", Ptr; "namelen", I64; "loc", Ptr; "loclen", I64;
"nslots", I32; "slots_fp", I32; "refs_fp", I32 ] }
let flanframe =
{ sname = "flanframe"; fields = [ "prev", Ptr; "info", Ptr; "slots", Ptr ] }
let align_up n a = (n + a - 1) / a * a
(* Size, and the offset of every field, by C's rules. *)
let layout s =
let off = ref 0 and al = ref 1 and rev = ref [] in
List.iter
(fun (n, k) ->
let sz = size_of k in
off := align_up !off sz;
rev := (n, !off) :: !rev;
off := !off + sz;
if sz > !al then al := sz)
s.fields;
align_up !off !al, List.rev !rev
let size s = fst (layout s)
let field s n =
match List.assoc_opt n (snd (layout s)) with
| Some o -> o
| None -> failwith (Printf.sprintf "no field %s in %%%s" n s.sname)
(* The [getelementptr] index of a field, which is this backend's handle on
it — LLVM counts fields where the assembler counts bytes. *)
let index s n =
let rec go i = function
| [] -> failwith (Printf.sprintf "no field %s in %%%s" n s.sname)
| (f, _) :: rest -> if String.equal f n then i else go (i + 1) rest
in
go 0 s.fields
(* The type declaration this file's header carries. *)
let ll_type s =
Printf.sprintf "%%%s = type { %s }" s.sname
(String.concat ", " (List.map (fun (_, k) -> ll_of k) s.fields))
(* An initialised constant of one of them, given one operand per field in
declaration order. Both backends build the same [%fninfo] this way, which
is the whole point: the field list decides the order and the widths, and
neither spelling can be updated without the other. *)
let ll_init s vals =
Printf.sprintf "%%%s { %s }" s.sname
(String.concat ", "
(List.map2 (fun (_, k) v -> ll_of k ^ " " ^ v) s.fields vals))
(* The same constant as assembler directives. All padding is explicit,
inside and at the end, because the assembler adds none: a [.align] before
the label says where the object starts, not how the fields sit in it nor
how long it is, and the next object would otherwise begin inside this
one's tail. Every field is 4 or 8 bytes wide, so a trailing gap is always
a whole number of [.long]s; an interior one is whatever C's rule leaves
and is written as bytes. *)
let asm_init s vals =
let b = Buffer.create 128 in
let gap n = if n > 0 then Buffer.add_string b (Printf.sprintf "\t.zero\t%d\n" n) in
let raw =
List.fold_left2
(fun off (_, k) v ->
let sz = size_of k in
let at = align_up off sz in
gap (at - off);
Buffer.add_string b
(Printf.sprintf "\t%s\t%s\n" (if sz = 8 then ".quad" else ".long") v);
at + sz)
0 s.fields vals
in
for _ = 1 to (size s - raw) / 4 do
Buffer.add_string b "\t.long\t0\n"
done;
Buffer.contents b
end
(* ── Types ─────────────────────────────────────────────────────────── *)
let rec ll (t : Types.t) =
@ -1124,10 +1250,12 @@ let fninfo m (fn : Tast.fn) ~nslots =
let id = Printf.sprintf "@\".fi.%d\"" m.nfi in
m.nfi <- m.nfi + 1;
Buffer.add_string m.strs
(Printf.sprintf
"%s = private unnamed_addr constant %%fninfo { ptr %s, i64 %d, ptr %s, i64 %d, i32 %d, i32 %d, i32 %d }\n"
id nid nlen lid llen nslots (slot_fingerprint fn)
(Reach.ref_fingerprint ~is_global:(Hashtbl.mem m.globals) fn));
(Printf.sprintf "%s = private unnamed_addr constant %s\n" id
(Rt.ll_init Rt.fninfo
[ nid; string_of_int nlen; lid; string_of_int llen;
string_of_int nslots; string_of_int (slot_fingerprint fn);
string_of_int
(Reach.ref_fingerprint ~is_global:(Hashtbl.mem m.globals) fn) ]));
id
(* ── Bounds checks ───────────────────────────────────────────────────── *)
@ -1224,6 +1352,47 @@ let widen f (k : Types.ikind) v =
(* The most negative value of a signed kind, as the decimal LLVM wants. *)
let int_min k = Int64.neg (Int64.shift_left 1L (Types.bits k - 1))
(* Which of the two arithmetic guards a division actually needs. This is a
decision about the language and not about either instruction set, so both
backends ask it here: a divisor that is a literal the test cannot fire on
carries no test at all, and (/ x 2) — the common case — is then exactly the
divide it reads as. The overflow test exists only for signed kinds, where
[min / -1] is the one pair whose quotient does not fit.
A literal the checker folded is what [lit] carries; [None] is anything else,
including a constant the folder could not see, and pays both tests. *)
let div_checks ~lit (k : Types.ikind) =
let need_zero = match lit with Some n -> Int64.equal n 0L | None -> true in
let need_ovf =
Types.signed k
&& (match lit with Some n -> Int64.equal n (-1L) | None -> true)
in
need_zero, need_ovf
(* The bounds a float-to-integer cast is checked against, for both backends.
The pair of floats is the open interval the source value has to be in, and
both ends are exact in a double: a power of two is, and [ldexp] of it is
the only spelling that cannot round. The high end is the first value
*above* the range rather than the last one in it, because 2^63 - 1 is not
representable and 2^63 is — so the test is [< hi] and never [<= hi].
The pair of integers is the range the failure message reports, which is the
integer range itself: what a programmer wants told is "u8 holds 0 to 255",
not the two floats the guard compared. *)
let cast_range (k : Types.ikind) =
let n = Types.bits k in
let signed = Types.signed k in
let lo_f = if signed then ldexp (-1.0) (n - 1) else 0.0 in
let hi_f = if signed then ldexp 1.0 (n - 1) else ldexp 1.0 n in
let lo_i = if signed then int_min k else 0L in
let hi_i =
if signed then Int64.sub (Int64.shift_left 1L (n - 1)) 1L
else if n = 64 then -1L
else Int64.sub (Int64.shift_left 1L n) 1L
in
lo_f, hi_f, lo_i, hi_i
(* A divide or a remainder. [is_rem] only picks which pair of codes is used;
the tests are identical, because `srem` overflows on exactly the operands
`sdiv` does — the intermediate quotient is the thing that does not fit.
@ -1234,11 +1403,7 @@ let int_min k = Int64.neg (Int64.shift_left 1L (Types.bits k - 1))
let check_div f ~guard loc ~is_rem (k : Types.ikind) ~lit a b =
if f.md.checks then begin
let ty = ll (Types.Int k) in
let need_zero = match lit with Some n -> Int64.equal n 0L | None -> true in
let need_ovf =
Types.signed k
&& (match lit with Some n -> Int64.equal n (-1L) | None -> true)
in
let need_zero, need_ovf = div_checks ~lit k in
if need_zero || need_ovf then begin
(* [false] rather than an emitted instruction when a test is elided: an
LLVM operand may be a constant, and the [or] and the [select] below
@ -1310,18 +1475,7 @@ let check_cast f ~guard loc (src : Types.fkind) (k : Types.ikind) v =
ins f "%s = fpext float %s to double" t v;
t
in
let n = Types.bits k in
let signed = Types.signed k in
(* The first value below the range and the first value above it, and then
the range the condition reports, which is the last value *in* it. *)
let lo_f = if signed then ldexp (-1.0) (n - 1) else 0.0 in
let hi_f = if signed then ldexp 1.0 (n - 1) else ldexp 1.0 n in
let lo_i = if signed then int_min k else 0L in
let hi_i =
if signed then Int64.sub (Int64.shift_left 1L (n - 1)) 1L
else if n = 64 then -1L
else Int64.sub (Int64.shift_left 1L n) 1L
in
let lo_f, hi_f, lo_i, hi_i = cast_range k in
(* LLVM takes a double constant as the hex of its bits, which is the only
spelling that cannot lose anything on the way through. *)
let dbl x = Printf.sprintf "0x%016Lx" (Int64.bits_of_float x) in
@ -1579,11 +1733,11 @@ and value_at f (e : Tast.expr) : string =
collision between two different signatures harmless in practice — and
it is also the cheaper half. *)
let arity = fresh f in
ins f "%s = load i32, ptr %s" arity (restart_field f t 5);
ins f "%s = load i32, ptr %s" arity (restart_field f t "arity");
let a_ok = fresh f in
ins f "%s = icmp eq i32 %s, %d" a_ok arity (List.length args);
let want = fresh f in
ins f "%s = load i32, ptr %s" want (restart_field f t 6);
ins f "%s = load i32, ptr %s" want (restart_field f t "sig_id");
let s_ok = fresh f in
ins f "%s = icmp eq i32 %s, %d" s_ok want sg_id;
let both = fresh f in
@ -1593,9 +1747,9 @@ and value_at f (e : Tast.expr) : string =
(* What the frame says it takes is read off the frame, because only the
frame knows; what was given is this call site's own spelling. *)
let wp = fresh f in
ins f "%s = load ptr, ptr %s" wp (restart_field f t 8);
ins f "%s = load ptr, ptr %s" wp (restart_field f t "sig");
let wl = fresh f in
ins f "%s = load i64, ptr %s" wl (restart_field f t 9);
ins f "%s = load i64, ptr %s" wl (restart_field f t "siglen");
let gid, gn = string_bytes f.md sg in
ins f
"call void @flan_restart_args_fail(ptr %s, i64 %d, ptr %s, i64 %d, \
@ -1605,7 +1759,7 @@ and value_at f (e : Tast.expr) : string =
signature just agreed on. *)
if vals <> [] then begin
let buf = fresh f in
ins f "%s = load ptr, ptr %s" buf (restart_field f t 4);
ins f "%s = load ptr, ptr %s" buf (restart_field f t "args");
let sty =
"{ " ^ String.concat ", " (List.map (fun (_, ty) -> ll ty) vals) ^ " }"
in
@ -1616,7 +1770,7 @@ and value_at f (e : Tast.expr) : string =
p sty buf i;
ins f "store %s %s, ptr %s" (ll ty) v p)
vals;
ins f "store i32 1, ptr %s" (restart_field f t 7)
ins f "store i32 1, ptr %s" (restart_field f t "armed")
end;
ins f "store ptr %s, ptr %s" t xfer_param;
term f "br label %%%s" (current_pad f);
@ -1947,12 +2101,12 @@ and emit_handled f frames body =
(fun (h : Tast.hframe) ->
let slot = alloca_raw f "%handler" in
let ty = fresh f in
ins f "%s = getelementptr inbounds %%handler, ptr %s, i32 0, i32 1"
ty slot;
ins f "%s = getelementptr inbounds %%handler, ptr %s, i32 0, i32 %d"
ty slot (Rt.index Rt.handler "type");
ins f "store i32 %d, ptr %s" h.Tast.htype ty;
let fp = fresh f in
ins f "%s = getelementptr inbounds %%handler, ptr %s, i32 0, i32 2"
fp slot;
ins f "%s = getelementptr inbounds %%handler, ptr %s, i32 0, i32 %d"
fp slot (Rt.index Rt.handler "fn");
(* The clause's body address, deliberately, and not a cell load:
plan.org makes a top-level function value a stable trampoline over
its cell, but a handler frame is not one — nothing can name it, and
@ -2008,9 +2162,10 @@ and emit_handled f frames body =
and args_type (c : Tast.rclause) =
"{ " ^ String.concat ", " (List.map (fun (_, t) -> ll t) c.Tast.rparams) ^ " }"
and restart_field f slot i =
and restart_field f slot name =
let p = fresh f in
ins f "%s = getelementptr inbounds %%restart, ptr %s, i32 0, i32 %d" p slot i;
ins f "%s = getelementptr inbounds %%restart, ptr %s, i32 0, i32 %d" p slot
(Rt.index Rt.restart name);
p
(* (with-allocator A BODY...) — spec-memory.md's "Allocators".
@ -2076,33 +2231,33 @@ and emit_restart_case f ty clauses body =
map_lr
(fun (c : Tast.rclause) ->
let slot = alloca_raw f "%restart" in
ins f "store i32 %d, ptr %s" c.Tast.rname_id (restart_field f slot 1);
ins f "store i32 %d, ptr %s" c.Tast.rname_id (restart_field f slot "name_id");
(* The name itself, beside the hash. A hash is all that matching
needs, but a break loop has to *show* someone their choices, and
nothing at run time can turn a hash back into a name. *)
let sid, slen = string_bytes f.md c.Tast.rname in
ins f "store ptr %s, ptr %s" sid (restart_field f slot 2);
ins f "store i64 %d, ptr %s" slen (restart_field f slot 3);
ins f "store ptr %s, ptr %s" sid (restart_field f slot "name");
ins f "store i64 %d, ptr %s" slen (restart_field f slot "namelen");
(* §3's signature, which every frame carries whether it takes
parameters or not: an [invoke-restart] compares against whatever
frame the name found, and a clause taking none has to be able to
refuse arguments as loudly as one taking two of the wrong type. *)
ins f "store i32 %d, ptr %s"
(List.length c.Tast.rparams) (restart_field f slot 5);
ins f "store i32 %d, ptr %s" c.Tast.rsig_id (restart_field f slot 6);
(List.length c.Tast.rparams) (restart_field f slot "arity");
ins f "store i32 %d, ptr %s" c.Tast.rsig_id (restart_field f slot "sig_id");
let gid, glen = string_bytes f.md c.Tast.rsig in
ins f "store ptr %s, ptr %s" gid (restart_field f slot 8);
ins f "store i64 %d, ptr %s" glen (restart_field f slot 9);
ins f "store ptr %s, ptr %s" gid (restart_field f slot "sig");
ins f "store i64 %d, ptr %s" glen (restart_field f slot "siglen");
let args =
if c.Tast.rparams = [] then None
else begin
let buf = alloca_raw f (args_type c) in
ins f "store ptr %s, ptr %s" buf (restart_field f slot 4);
ins f "store ptr %s, ptr %s" buf (restart_field f slot "args");
(* Nothing has filled it in yet. Whoever aims a transfer at this
frame without going through an [invoke-restart] — the break
loop, today — leaves this zero, and the clause traps rather
than running on values no one supplied. *)
ins f "store i32 0, ptr %s" (restart_field f slot 7);
ins f "store i32 0, ptr %s" (restart_field f slot "armed");
Some buf
end
in
@ -2151,7 +2306,7 @@ and emit_restart_case f ty clauses body =
| None -> ()
| Some buf ->
let armed = fresh f in
ins f "%s = load i32, ptr %s" armed (restart_field f slot 7);
ins f "%s = load i32, ptr %s" armed (restart_field f slot "armed");
let ok = fresh f in
ins f "%s = icmp ne i32 %s, 0" ok armed;
(* Aimed here by something that supplied no arguments — there is no such
@ -3021,9 +3176,13 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
" prev);
List.iter
(fun line -> Buffer.add_string f.allocas (" " ^ line ^ "\n"))
[ "%frame.i = getelementptr inbounds %flanframe, ptr %frame, i32 0, i32 1";
[ Printf.sprintf
"%%frame.i = getelementptr inbounds %%flanframe, ptr %%frame, i32 0, i32 %d"
(Rt.index Rt.flanframe "info");
Printf.sprintf "store ptr %s, ptr %%frame.i" info;
"%frame.s = getelementptr inbounds %flanframe, ptr %frame, i32 0, i32 2";
Printf.sprintf
"%%frame.s = getelementptr inbounds %%flanframe, ptr %%frame, i32 0, i32 %d"
(Rt.index Rt.flanframe "slots");
Printf.sprintf "store ptr %s, ptr %%frame.s"
(match f.slotv with Some v -> v | None -> "null");
"store ptr %frame, ptr @flan_frame_head" ];
@ -3093,8 +3252,8 @@ let emit_fn m ?(hidden = false) ?(pnames = []) (fn : Tast.fn) =
in
dput d sub
(Printf.sprintf
"distinct !DISubprogram(name: \"%s\", linkageName: \"flan.%s\", scope: !%d, file: !%d, line: %d, type: !%d, scopeLine: %d, spFlags: DISPFlagDefinition, flags: DIFlagPrototyped, unit: !%d, retainedNodes: !{%s})"
(dstr fn.Tast.name) (dstr fn.Tast.name) file file f.dline sty f.dline
"distinct !DISubprogram(name: \"%s\", linkageName: \"%s\", scope: !%d, file: !%d, line: %d, type: !%d, scopeLine: %d, spFlags: DISPFlagDefinition, flags: DIFlagPrototyped, unit: !%d, retainedNodes: !{%s})"
(dstr fn.Tast.name) (dstr (Mangle.sym fn.Tast.name)) file file f.dline sty f.dline
d.dcu
(String.concat ", " (List.map (fun v -> Printf.sprintf "!%d" v) vars)));
at_loc f fn.Tast.floc
@ -3259,9 +3418,18 @@ let startup_sym = fname ".init-globals"
is what the daemon has always promised ("the globals are as it left them")
and what a plain zeroed [defvar] already got for free, since .bss is
untouched by a second call. A computed one used to be the exception, wiped
back to its initial value every re-run. A [defconst] is a constant and the
question does not arise for it: it is the linker's image on one backend and
a constructor's stores on the other, and neither is reached from here.
back to its initial value every re-run. A [defconst] whose initialiser is a
compile-time constant is not reached from here at all: it is the linker's
image on one backend and [.init-data]'s stores on the other, and a re-run
reaches neither.
The split is [Tast.const_init]'s, and it is over the *initialiser* and not
over the form — nothing below asks [gconst]. A [defconst] with a computed
initialiser would therefore be guarded here like any [defvar], and on the
x86 backend it is. On this one it never arrives: [const] refuses a computed
[defconst] by name, because a constant has nowhere to run. So the two
backends disagree about that one program, and the disagreement is older
than this rule.
So each computed initialiser guards itself with a flag of its own. Per
global and not per startup function, because the rule belongs to the form:
@ -3274,10 +3442,23 @@ let startup_sym = fname ".init-globals"
byte. The flag is a global of its own rather than a sentinel value in the
variable, because there is no value a [defvar] cannot hold.
Writing the flag *after* the store is safe rather than merely tidy:
[Check.no_transfer_in_init] refuses a signal or a restart out of an
initialiser, so nothing leaves the guarded branch between the two. *)
let init_flag n = ".init-once." ^ n
Writing the flag *after* the store is what makes a failed initialiser retry
rather than be skipped. [Check.no_transfer_in_init] refuses a [signal] or an
[invoke-restart] written *in* the initialiser, but it is syntactic and over
that expression only: the initialiser is lifted into a function of its own,
and a callee of that function can signal unhandled and transfer. The guarded
branch then leaves through the call's transfer edge with the store not done
and the flag still false — which is the behaviour to want, because the next
run will try the initialiser again instead of proceeding with a global that
was never given its value.
The flag's name is mangled with a [~], which the reader treats as a
terminator and so cannot appear in any symbol a program can write — the same
trick [destructure~N] uses. A [.]-separated name would not do: [.] is an
ordinary symbol constituent, so [(defvar .init-once.x ...)] beside a
computed [x] used to emit the same symbol twice and the dev build died at
the assembler. *)
let init_flag n = ".init~once." ^ n
(* The computed globals, the flags that guard them, and the body of the
startup function — built here so that the two backends cannot disagree
@ -3367,7 +3548,7 @@ let header = {|; Generated by flan. The layout is C's: no object headers anywher
%map = type { ptr, i64, i64, ptr, i64 }
; A handler frame: the one it displaced, the condition type it matches, and
; the lifted function that runs. Allocated on the establishing frame's stack.
%handler = type { ptr, i32, ptr }
|} ^ Rt.ll_type Rt.handler ^ {|
; A restart frame: the one it displaced and the name it offers. There is no
; target field, because the frame's own address *is* the target — which makes
; a transfer's aim exact, and makes re-entering a restart-case work with
@ -3379,13 +3560,12 @@ let header = {|; Generated by flan. The layout is C's: no object headers anywher
; filled the buffer in, and that spelling itself for the message when the two
; ends disagree. The first four fields are what the runtime's own
; [flan_restart] declares and their offsets do not move.
%restart = type { ptr, i32, ptr, i64, ptr, i32, i32, i32, ptr, i64 }
|} ^ Rt.ll_type Rt.restart ^ {|
; A shadow-stack frame and the static description of the function that pushed
; it (runtime/flan_dev.c). Dev builds only: [emit_fn] pushes one on entry and
; every [ret] restores the head, the transfer path included. A release build
; emits neither, and the head below is then a symbol nothing in the .ll names.
%fninfo = type { ptr, i64, ptr, i64, i32, i32, i32 }
%flanframe = type { ptr, ptr, ptr }
|} ^ Rt.ll_type Rt.fninfo ^ "\n" ^ Rt.ll_type Rt.flanframe ^ {|
@flan_frame_head = external global ptr
declare void @llvm.memset.p0.i64(ptr nocapture writeonly, i8, i64, i1 immarg)
@ -3908,7 +4088,7 @@ let macro_thunk m (fn : Tast.fn) =
\ store %s %%r, ptr %%out\n\
\ ret void\n\
}\n\n"
(quoted ("flan.macro." ^ name))
(quoted (Mangle.macro name))
ret (fname name) ret)
(* [checks] is on by default: a dev build traps on an out-of-bounds [at] or
@ -4167,7 +4347,7 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
let t = fresh () in
Buffer.add_string b
(Printf.sprintf " %s = call ptr @flan_dev_cell(ptr %s)\n store ptr %s, ptr %s\n"
t (cstring m ("flan." ^ f.Tast.name)) t (cellptr f.Tast.name)))
t (cstring m (Mangle.sym f.Tast.name)) t (cellptr f.Tast.name)))
new_fns;
List.iter
(fun (g : Tast.global) ->
@ -4204,7 +4384,7 @@ let redefinition ?(checks = true) ?(dev = false) ?(debug = false)
(Printf.sprintf
" %s = call ptr @flan_dev_global(ptr %s, i64 ptrtoint (ptr getelementptr (%s, ptr null, i32 1) to i64), ptr %s)\n \
store ptr %s, ptr %s\n"
t (cstring m ("flan." ^ g.Tast.gname)) (ll g.Tast.gty) init t
t (cstring m (Mangle.sym g.Tast.gname)) (ll g.Tast.gty) init t
(globalptr g.Tast.gname)))
new_globals;
(* A constant whose value the checker never consumed is just bytes in the

2
lib/macro.ml
View File

@ -294,7 +294,7 @@ let compile (names : string list) (extra : Form.t list) : loaded =
end;
let handle = Dynload.dl_open out in
{ handle;
fns = List.map (fun n -> (n, Dynload.dl_sym handle ("flan.macro." ^ n))) names }
fns = List.map (fun n -> (n, Dynload.dl_sym handle (Mangle.macro n))) names }
(* ── Where the call site is ────────────────────────────────────────
The one thing a macro cannot find out for itself and the one it needs to

42
lib/mangle.ml Normal file
View File

@ -0,0 +1,42 @@
(* The symbol names a Flan build puts into an object, spelled once.
Both backends emit the same names — that is not a nicety, it is the link:
an [--x86] host and a redefinition module built by LLVM bind against each
other, so [@"flan.cell.<n>"] has to be byte-for-byte the same string on
both sides or the dlopen fails and the piece served nothing. The macro
loader and the daemon's disassembler look up the same names from outside
the backends entirely.
So the prefixes live here, unquoted and without a sigil. Quoting is each
backend's own — LLVM writes [@"..."], the assembler writes ["..."] — and a
Flan name holds -, ?, > and /, which is why every emitted name is quoted
at all. This module only decides *which string* is quoted.
Not here: the ABI marker. [Emit.abi_marker] is ["flan.abi.llvm"] and
[X86.abi_marker] is ["flan.abi.x86"], and the two must stay distinct —
a crossed pair is refused at [dlopen] precisely because the marker one
image defines is not the one the other references. Sharing that string
would delete the mechanism. *)
(* The prefix itself. It keeps the Flan [main] from colliding with C's, and
it is what makes every Flan symbol recognisable in a disassembly. *)
let prefix = "flan."
(* A function or a global. One namespace, because the language has one: a
[defn] and a [defvar] cannot share a name, so nothing here has to keep
them apart. The compiler's own names go through this too — [.init-globals]
and [.init-data] start with a dot no reader token can produce. *)
let sym n = prefix ^ n
(* A dev build's indirection cell: a mutable global holding the address of the
function that is currently this name's body. *)
let cell n = prefix ^ "cell." ^ n
(* The two module-local caches a name the host was never built with is reached
through — one for a function, one for a global. *)
let cellptr n = prefix ^ "cellp." ^ n
let globalptr n = prefix ^ "gp." ^ n
(* A compiled macro's entry point, which the expander dlsyms by this name out
of the module [Build.macro_module] wrote. *)
let macro n = prefix ^ "macro." ^ n

126
lib/x86.ml
View File

@ -510,11 +510,13 @@ let signed_of (t : Types.t) =
(* ── Mangling ────────────────────────────────────────────────────────── *)
(* The same names [emit.ml] gives, so a build made here links against the same
runtime and a disassembly reads with the same symbols. A Flan name can hold
characters an assembler will not take bare, so every symbol is quoted. *)
runtime and a disassembly reads with the same symbols. That agreement is
[Mangle]'s, which holds the prefixes for both backends; the quotes are this
one's, because a Flan name can hold characters an assembler will not take
bare. *)
let asm_sym s = "\"" ^ s ^ "\""
let fsym n = asm_sym ("flan." ^ n)
let gsym n = asm_sym ("flan." ^ n)
let fsym n = asm_sym (Mangle.sym n)
let gsym n = asm_sym (Mangle.sym n)
(* The indirection cell: a mutable global holding the address of the function
that is currently this name's body. Spelled exactly as [Emit.cellname]
@ -522,7 +524,7 @@ let gsym n = asm_sym ("flan." ^ n)
redefinition module is still built by LLVM, and it binds
[@"flan.cell.<n>" = external global ptr] against whatever built the host.
Byte-for-byte or the link fails and the piece served nothing. *)
let csym n = asm_sym ("flan.cell." ^ n)
let csym n = asm_sym (Mangle.cell n)
(* The marker that says which backend built an image, and it is the whole of
the answer to the one way these two backends can be mixed and be wrong.
@ -1043,12 +1045,15 @@ let fninfo f (fn : Tast.fn) ~nslots =
let l = rodata_label f in
Buffer.add_string f.rodata
(Printf.sprintf
"\t.section\t.data.rel.ro,\"aw\"\n\t.align 8\n%s:\n\
\t.quad\t%s\n\t.quad\t%d\n\t.quad\t%s\n\t.quad\t%d\n\
\t.long\t%d\n\t.long\t%d\n\t.long\t%d\n\t.long\t0\n\
\t.section\t.rodata\n"
l nlbl nlen llbl llen nslots (Emit.slot_fingerprint fn)
(Reach.ref_fingerprint ~is_global:(Hashtbl.mem f.md.Emit.globals) fn));
"\t.section\t.data.rel.ro,\"aw\"\n\t.align 8\n%s:\n%s\t.section\t.rodata\n"
l
(Emit.Rt.asm_init Emit.Rt.fninfo
[ nlbl; string_of_int nlen; llbl; string_of_int llen;
string_of_int nslots;
string_of_int (Emit.slot_fingerprint fn);
string_of_int
(Reach.ref_fingerprint ~is_global:(Hashtbl.mem f.md.Emit.globals)
fn) ]));
l
(* The store that says "this slot is bound now", and it is the address rather
@ -1415,30 +1420,32 @@ let agg_tmp f (ty : Types.t) =
(* ── The runtime's two dynamic stacks ────────────────────────────────── *)
(* [emit.ml]'s [%handler] and [%restart] types, laid out by the C rules — the
same rules the runtime's own structs get, and the same [Emit.lay] applies to
everything else. Both live as frame temporaries of the function that
establishes them, which is the point: the *address* of a frame is the
identity a transfer carries, so re-entering the same restart-case gets a
different one and a module loaded later cannot collide with it. *)
(* [emit.ml]'s [%handler] and [%restart] types, measured in bytes rather than
in fields, which is the only difference between what that backend needs of
them and what this one does. The field lists are [Emit.Rt]'s, shared so
that a field added to [flan_restart] in the C moves the offsets here
without anyone's remembering to retype them; the rules are C's, the same
ones [Emit.lay] applies to everything else.
(* { ptr prev, i32 type_id, ptr fn } *)
let h_size = 24
let h_type = 8
let h_fn = 16
Both live as frame temporaries of the function that establishes them, which
is the point: the *address* of a frame is the identity a transfer carries,
so re-entering the same restart-case gets a different one and a module
loaded later cannot collide with it. *)
let h_size = Emit.Rt.size Emit.Rt.handler
let h_type = Emit.Rt.field Emit.Rt.handler "type"
let h_fn = Emit.Rt.field Emit.Rt.handler "fn"
(* { ptr prev, i32 name_id, ptr name, i64 namelen, ptr args,
i32 arity, i32 sig_id, i32 armed, ptr sig, i64 siglen } *)
let r_size = 72
let r_name_id = 8
let r_name = 16
let r_namelen = 24
let r_args = 32
let r_arity = 40
let r_sig_id = 44
let r_armed = 48
let r_sig = 56
let r_siglen = 64
let r_size = Emit.Rt.size Emit.Rt.restart
let r_field = Emit.Rt.field Emit.Rt.restart
let r_name_id = r_field "name_id"
let r_name = r_field "name"
let r_namelen = r_field "namelen"
let r_args = r_field "args"
let r_arity = r_field "arity"
let r_sig_id = r_field "sig_id"
let r_armed = r_field "armed"
let r_sig = r_field "sig"
let r_siglen = r_field "siglen"
(* ── The calling convention, as the header states it ─────────────────── *)
@ -2522,16 +2529,10 @@ and check_cast f (loc : Loc.t) (src : Types.fkind) (k : Types.ikind) =
"The range check on a float-to-integer cast. Two compares, written in the \
directions that make a NaN fail both of them.";
let f64 = (src = Types.F64) in
let n = Types.bits k in
let signed = Types.signed k in
let lo_f = if signed then ldexp (-1.0) (n - 1) else 0.0 in
let hi_f = if signed then ldexp 1.0 (n - 1) else ldexp 1.0 n in
let lo_i = if signed then Int64.neg (Int64.shift_left 1L (n - 1)) else 0L in
let hi_i =
if signed then Int64.sub (Int64.shift_left 1L (n - 1)) 1L
else if n = 64 then -1L
else Int64.sub (Int64.shift_left 1L n) 1L
in
(* The same four bounds [emit.ml] compares against, from the same place:
the interval is the type's and both backends have to refuse the same
values of it. Only the instructions below are this file's. *)
let lo_f, hi_f, lo_i, hi_i = Emit.cast_range k in
let klo = float_const f lo_f ~f64 and khi = float_const f hi_f ~f64 in
scoped f (fun () ->
let so = ptmp f and sa = ptmp f and sb = ptmp f in
@ -2777,18 +2778,21 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) dst =
globals — a folded answer is evidence about the folder.
Calling the same function is what makes the two backends agree by
construction
rather than by a hand-written identity that would have to get every
rounding, every sign of zero and every infinity right on its own.
The prelude already declares both symbols ([fmod-f32],
construction rather than by a hand-written identity that would have
to get every rounding, every sign of zero and every infinity right
on its own. The prelude already declares both symbols ([fmod-f32],
[fmod-f64]) and every link passes -lm, so nothing new has to be
arranged for the call to resolve.
The two operands are already in xmm0 and xmm1, which are exactly
where SysV wants the arguments of [double fmod(double, double)],
and the result comes back in xmm0, which is where the store below
reads it. [rax] carries the count of SSE argument registers, the
same thing [call_c] puts there: a fixed-arity callee ignores it. *)
reads it. The [rax] below carries the count of SSE argument
registers, and [fmod] is fixed-arity and ignores it: it is dead, and
it is kept deliberately so that every call this backend makes into C
is preceded by the same instruction [call_c] emits. Deleting it
would save one [movabs] and make this the one call site that reads
differently in a disassembly. *)
| Tast.Rem ->
imm_into f ~reg:rax 2L;
call_sym f.b (if f64 then "fmod" else "fmodf")
@ -3493,7 +3497,7 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
if md.Emit.dev then begin
if nslots > 0 && Array.exists (fun n -> n <> None) fn.Tast.snames then
f.dslotv <- Some (alloc f (8 * nslots) 8);
f.dframe <- Some (alloc f 24 8)
f.dframe <- Some (alloc f (Emit.Rt.size Emit.Rt.flanframe) 8)
end;
f.retlbl <- new_label f "ret";
f.xfer_lbl <- new_label f "xfer";
@ -3599,11 +3603,15 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
load_int f.b ~dst:rax ~mm:(lmem f head ~scratch:r11) ~size:8 ~signed:false;
store_int f.b ~src:rax ~mm:(Frame fr) ~size:8;
addr_into f ~reg:rax (Lg (fninfo f fn ~nslots:(if f.dslotv = None then 0 else nslots), 0));
store_int f.b ~src:rax ~mm:(Frame (fr + 8)) ~size:8;
store_int f.b
~src:rax ~mm:(Frame (fr + Emit.Rt.field Emit.Rt.flanframe "info"))
~size:8;
(match f.dslotv with
| Some sv -> lea f.b ~dst:rax ~mm:(Frame sv)
| None -> xor_rr f.b ~dst:rax ~src:rax);
store_int f.b ~src:rax ~mm:(Frame (fr + 16)) ~size:8;
store_int f.b
~src:rax ~mm:(Frame (fr + Emit.Rt.field Emit.Rt.flanframe "slots"))
~size:8;
lea f.b ~dst:rax ~mm:(Frame fr);
store_int f.b ~src:rax ~mm:(lmem f head ~scratch:r11) ~size:8;
(* The parameters are bound before the body starts, so they are recorded
@ -3869,8 +3877,8 @@ let emit_fn (md : Emit.m) ~externs ~fns ?(ext = fun _ -> false)
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\""
let data_sym = asm_sym (Mangle.sym ".init-data")
let init_sym = asm_sym (Mangle.sym ".init-globals")
(* ── C's main ────────────────────────────────────────────────────────── *)
@ -4275,7 +4283,7 @@ let emit_dwarf (dw : dwarf) ~cufile ~tbeg ~tend =
"\t.uleb128 2\n\t.asciz\t\"%s\"\n\t.asciz\t\"%s\"\n\
\t.uleb128 %d\n\t.uleb128 %d\n\t.quad\t%s\n\t.quad\t%s - %s\n"
(asm_str s.sname)
(asm_str ("flan." ^ s.sname))
(asm_str (Mangle.sym s.sname))
s.sfile s.sline s.ssym s.send s.ssym))
(List.rev dw.dsubs);
Buffer.add_string out "\t.byte\t0\n.Ldwinfo_end:\n";
@ -4658,8 +4666,8 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
the key is [csym]; a global is reached by its own name, so it is [gsym].
The two can never collide, because a function and a global cannot share a
name and [gsym] and [fsym] are the same string. *)
let cellp n = asm_sym ("flan.cellp." ^ n)
and gp n = asm_sym ("flan.gp." ^ n) in
let cellp n = asm_sym (Mangle.cellptr n)
and gp n = asm_sym (Mangle.globalptr n) in
let slots = Hashtbl.create 8 in
List.iter (fun (f : Tast.fn) ->
Hashtbl.replace slots (csym f.Tast.name) (cellp f.Tast.name)) new_fns;
@ -4736,14 +4744,14 @@ let redefinition ~checks ?(dev = true) ?(known = fun _ -> true)
let cstr sym = let l = string_const f sym in lea f.b ~dst:rdi ~mm:(Sym (l, 0)) in
List.iter
(fun (fn : Tast.fn) ->
cstr ("flan." ^ fn.Tast.name);
cstr (Mangle.sym fn.Tast.name);
xor_rr f.b ~dst:rax ~src:rax;
call_sym f.b "flan_dev_cell";
store_int f.b ~src:rax ~mm:(Sym (cellp fn.Tast.name, 0)) ~size:8)
new_fns;
List.iter
(fun ((g : Tast.global), l, size, _) ->
cstr ("flan." ^ g.Tast.gname);
cstr (Mangle.sym g.Tast.gname);
movabs f.b ~dst:rsi (Int64.of_int size);
(match l with
| Some l -> lea f.b ~dst:rdx ~mm:(Sym (l, 0))

17
test/programs/dev-rerun.flan
View File

@ -6,8 +6,11 @@
;;;; plain zeroed one always did — .bss is untouched by a second entry into
;;;; main — and a computed one did not, because the startup function [main]
;;;; calls ran again from the top and stored the initial value back over
;;;; whatever the last run had left. A [defconst] is a constant and the
;;;; question does not arise.
;;;; whatever the last run had left. A [defconst] whose initialiser is a
;;;; compile-time constant is written into the image and no startup code
;;;; reaches it at all, so the question does not arise for it. The split is
;;;; over the initialiser and not over the form — a computed [defconst] would
;;;; be guarded like a [defvar], and the LLVM backend refuses one outright.
;;;;
;;;; So each line printed below is a claim about one of those cases, and the
;;;; run number is the first of them: [runs] is computed, so before the fix it
@ -33,10 +36,20 @@
(defvar state dyn (table))
;; The guard flags the fix adds are the compiler's own globals, and they used
;; to be spelled [.init-once.<name>] — a name a program can write, since [.]
;; is an ordinary symbol constituent. This one is exactly the old spelling of
;; [counter]'s flag. It compiles only because the flag is mangled with a [~]
;; now; before that the dev build died at the assembler with the symbol
;; defined twice, and the flag's Bool retyped this i64 on the way. It stays
;; unprinted on purpose — the expected output is what it was.
(defvar .init-once.counter i64 7)
(defn main [] i32
(agent/start "/tmp/flan-dev-rerun-fallback.sock")
(set counter (+ counter 1))
(set zeroed (+ zeroed 2))
(set .init-once.counter (+ .init-once.counter 1))
(put state :runs (+ (get state :runs) 1))
(print "counter ") (print counter) (println "")
(print "zeroed ") (print zeroed) (println "")

10
test/programs/math3.flan
View File

@ -111,11 +111,11 @@
;; and the folded answer would be evidence about the constant folder and
;; not about the lowering.
;;
;; The four signs are the first line, because that is where a modulo
;; written in place of a remainder disagrees: the sign follows the
;; dividend. The second line is the two answers IEEE defines where an
;; integer % would have died — a zero divisor and a NaN dividend are both
;; NaN, not a signal.
;; Six values on the first line: the four sign combinations, where a modulo
;; written in place of a remainder disagrees — the sign follows the dividend
;; — and then the f32 pair, asking fmodf the same. The second line is the
;; two answers IEEE defines where an integer % would have died: a zero
;; divisor and a NaN dividend are both NaN, not a signal.
(show64 (% rem-a rem-b)) ; 1.5
(show64 (% rem-na rem-b)) ; -1.5
(show64 (% rem-a rem-nb)) ; 1.5