From 1829cd43b63985827087d7c8820f931048a71033 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 20 Sep 2026 13:00:52 +0700 Subject: [PATCH 1/3] One field list per runtime struct, one spelling per symbol prefix MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The %handler, %restart, %fninfo and %flanframe shapes were written twice: as LLVM type strings in emit.ml and as hand-computed byte offsets in x86.ml, with the two %fninfo initialisers spelled a third and fourth time. Emit.Rt now holds one field list per struct and derives all four — the type string and the getelementptr index for LLVM, the offset and the size for x86, and the initialiser for both. The derived numbers were checked against every old constant before the call sites moved. The flan. prefixes were spelled in four files, including both backends hand-writing "flan." ^ name for a DWARF linkage name instead of calling their own helper. Mangle now holds them unquoted; each backend adds its own sigil. The ABI markers stay apart on purpose: flan.abi.llvm and flan.abi.x86 differing is what makes the loader refuse a crossed pair. The float-to-integer cast bounds and the division-check elision policy are Emit.cast_range and Emit.div_checks. The second is a language decision and had been byte-identical in both files; the first had drifted cosmetically. emit and emit --x86 output for all 166 test/programs, at -O0 release, --dev, --debug and --dev --debug, stdout and stderr, is byte-identical to the pre-change compiler. --- lib/dev.ml | 2 +- lib/emit.ml | 278 +++++++++++++++++++++++++++++++++++++++----------- lib/macro.ml | 2 +- lib/mangle.ml | 42 ++++++++ lib/x86.ml | 111 ++++++++++---------- 5 files changed, 320 insertions(+), 115 deletions(-) create mode 100644 lib/mangle.ml diff --git a/lib/dev.ml b/lib/dev.ml index 06e9f73..422ec88 100644 --- a/lib/dev.ml +++ b/lib/dev.ml @@ -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 " " diff --git a/lib/emit.ml b/lib/emit.ml index fa64ebd..020d9cd 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -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 @@ -3367,7 +3526,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 +3538,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 +4066,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 +4325,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 +4362,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 diff --git a/lib/macro.ml b/lib/macro.ml index 1580231..d636183 100644 --- a/lib/macro.ml +++ b/lib/macro.ml @@ -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 diff --git a/lib/mangle.ml b/lib/mangle.ml new file mode 100644 index 0000000..3300e2c --- /dev/null +++ b/lib/mangle.ml @@ -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."] 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 diff --git a/lib/x86.ml b/lib/x86.ml index ab12671..90dc357 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -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." = 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 @@ -3493,7 +3494,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 +3600,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 +3874,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 +4280,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 +4663,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 +4741,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)) From 5b39730f07f582812dd107bf7ee6602684985fae Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 20 Sep 2026 13:07:09 +0700 Subject: [PATCH 2/3] The init-once flag moves out of the namespace a program can write MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The guard flag was named .init-once., and . and - are ordinary symbol constituents, so (defvar .init-once.x i64 7) beside a computed x emitted the same symbol twice: the dev build died at the assembler on both backends, and the flag's Bool was registered over the user's global in Emit.globals so the store came out as an i1. It is .init~once. now; ~ terminates a symbol in the reader, the same trick destructure~N uses. test/programs/dev-rerun.flan carries such a global and no new printed line. Three places said a defconst is the linker's image on one backend and a constructor's stores on the other and a re-run reaches neither. Tast.const_init splits on the initialiser and not on the form, so that holds only for a constant initialiser; a computed defconst is guarded like a defvar on x86 and refused outright by emit.ml's const. The sentences now say that, including the divergence. emit.ml also claimed Check.no_transfer_in_init made it impossible to leave the guarded branch between the store and the flag. It is syntactic over the written initialiser only: a callee can signal unhandled and take the call's transfer edge out, leaving the flag false — which is what should happen, since the next run retries. Read off the emitted IR for such a program. The x86 float-Rem comment says why the dead movabs before fmod is kept, and its mid-sentence line break is gone; math3.flan's first float-% line prints six values, not four. --- FIX.org | 21 ++++++++++++++++++--- lib/emit.ml | 35 ++++++++++++++++++++++++++++------- lib/x86.ml | 15 +++++++++------ test/programs/dev-rerun.flan | 17 +++++++++++++++-- test/programs/math3.flan | 10 +++++----- 5 files changed, 75 insertions(+), 23 deletions(-) diff --git a/FIX.org b/FIX.org index 6804dfd..52a4bd4 100644 --- a/FIX.org +++ b/FIX.org @@ -823,9 +823,14 @@ 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 is older than this rule 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 +843,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.]. It was [.init-once.] 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 diff --git a/lib/emit.ml b/lib/emit.ml index 020d9cd..49f294f 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -3418,9 +3418,17 @@ 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. The two backends + disagree about that program and only about that program. 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: @@ -3433,10 +3441,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 diff --git a/lib/x86.ml b/lib/x86.ml index 90dc357..f32b12b 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -2778,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") diff --git a/test/programs/dev-rerun.flan b/test/programs/dev-rerun.flan index 8ce6091..1e8fb59 100644 --- a/test/programs/dev-rerun.flan +++ b/test/programs/dev-rerun.flan @@ -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.] — 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 "") diff --git a/test/programs/math3.flan b/test/programs/math3.flan index 3b8e8ac..fca8255 100644 --- a/test/programs/math3.flan +++ b/test/programs/math3.flan @@ -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 From 811c37dca47110194c6135be16b05f55dc798973 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 20 Sep 2026 13:09:04 +0700 Subject: [PATCH 3/3] Two sentences said more than was checked MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The defconst divergence is dated from the history rather than asserted, and the claim that it is the backends' only disagreement is gone — x86.ml has unsupported paths of its own. --- FIX.org | 3 ++- lib/emit.ml | 5 +++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/FIX.org b/FIX.org index 52a4bd4..29d454b 100644 --- a/FIX.org +++ b/FIX.org @@ -830,7 +830,8 @@ globals at all. 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 is older than this rule and is noted here rather than fixed. + 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. diff --git a/lib/emit.ml b/lib/emit.ml index 49f294f..fbb9525 100644 --- a/lib/emit.ml +++ b/lib/emit.ml @@ -3427,8 +3427,9 @@ let startup_sym = fname ".init-globals" 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. The two backends - disagree about that program and only about that program. + [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: