From 63d9b87b7af1d864a80c4f7e76c2a2dd741709c4 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 18:05:08 +0700 Subject: [PATCH 1/3] Conditions on the x86 backend, and bounds checks with them The transfer channel was the only thing between 41 programs and the corpus. It is there now: a guard after every Flan call, a landing pad per restart-case, handler-bind and with-allocator, a transfer exit per function that runs its fdefers, and check_at and check_slice, which could not exist until the guard did. Measured by what the programs print and what they exit with, never by reading bytes. spike/x86/survey.sh builds every program in test/programs both ways and diffs stdout and the exit status; it did not exist, so it is here too, and it is the progress meter. before 41 MATCH 1 DIFFER 41 refused by name after 83 MATCH 0 DIFFER 0 refused by name The one DIFFER was bounds.flan, and it was the honest answer to "--x86 is silently a --no-bounds-checks build". It is not one any more: check_at and check_slice signal through the channel exactly as emit.ml's do, so a bounds violation signals, a restart-case catches it, and an unhandled one exits 134 on both backends. The transitional refusal that would have said so retired before it was written. check_no_transfer is not removed, it is narrowed to the one place the argument still holds: a global's initialiser runs from flan..init-globals, before main and before anything can handle anything, so a transfer out of it has nowhere to go. Four bugs, and three of them are the shape item 16 predicted -- code that reads correctly and answers wrong, found by output and not by objdump: - The body fell through into the transfer exit, so every fdefer ran twice on a normal return. emit.ml cannot have this bug: its ret terminates the block. - A Vec crossed to the runtime as the address of a *copy*, so pushes grew the copy and an in-bounds (at v 1) signalled against a length of zero. - ucomis sets CF, ZF and PF together for a NaN, so sete answered true for (= x x) and the prelude's NaN test never fired: (/ 0.0 0.0) formatted as -9223372036854775808. Flan's comparisons are LLVM's ordered ones, so < and <= swap and =, != take a setnp beside them. - A union read field 0 through the struct table and was refused by name rather than laid out as a tag and a payload. And one that could not have been found later: emit_globals_init stored a null *into* the channel slot rather than a cell address into it, which is a null pointer for every callee to write through. Harmless while nothing could transfer; a fault the first time a guard loaded through it. --- bin/main.ml | 8 + lib/build.ml | 2 +- lib/x86.ml | 775 ++++++++++++++++++++++++++++++++++++++++---- spike/x86/survey.sh | 105 ++++++ 4 files changed, 834 insertions(+), 56 deletions(-) create mode 100755 spike/x86/survey.sh diff --git a/bin/main.ml b/bin/main.ml index 5958151..d045156 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -15,6 +15,14 @@ let with_errors path f = prerr_endline (Flan.Loc.report_all ds); ignore path; exit 1 + (* The dev backend's own refusal, which is not a program error: the program + is fine and this backend does not lower it. Its own exit status, so that + a sweep comparing the two backends can count "refused by name" apart from + "did not compile". *) + | Flan.X86.Unsupported m -> + prerr_endline ("x86: " ^ m); + ignore path; + exit 3 let summarise (d : Flan.Ast.decl) = let open Flan.Ast in diff --git a/lib/build.ml b/lib/build.ml index bd462ce..24bf682 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -748,7 +748,7 @@ let executable ?(opts = default) ?(csrcs = []) ?(lflags = []) ?(pnames = []) (Filename.basename out ^ if opts.x86 then ".s" else ".ll") in write ll - (if opts.x86 then X86.program p + (if opts.x86 then X86.program ~checks:opts.checks p else Emit.program ~checks:opts.checks ~dev:opts.dev ~debug:opts.debug ~pnames ~sanitize:opts.sanitize p); diff --git a/lib/x86.ml b/lib/x86.ml index fd5135d..f484184 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -319,14 +319,14 @@ let xorps b ~dst = rex b ~w:false ~r:dst ~x:0 ~m:dst; u8 b 0x0f; u8 b 0x57; modr (* [Emit.m] carries the struct and union tables [Emit.lay] reads. Built here rather than imported so that this module adds no line to [emit.ml]: the record has no signature hiding it and every field it needs is inert. *) -let layout_ctx (p : Tast.program) : Emit.m = +let layout_ctx ~checks (p : Tast.program) : Emit.m = let structs = Hashtbl.create 16 and unions = Hashtbl.create 16 in List.iter (fun (s : Tast.structure) -> Hashtbl.replace structs s.Tast.sname s) p.Tast.structs; List.iter (fun (u : Tast.union) -> Hashtbl.replace unions u.Tast.uname u) p.Tast.unions; { Emit.out = Buffer.create 1; strs = Buffer.create 1; structs; unions; - globals = Hashtbl.create 1; externs = Hashtbl.create 1; checks = false; + globals = Hashtbl.create 1; externs = Hashtbl.create 1; checks; dev = false; known = (fun _ -> true); dbg = None; sanitize = false; nstr = 0; nfi = 0 } @@ -386,9 +386,17 @@ type fnctx = { jumps to and the label a [continue] jumps to, which is the latch and not the head. *) mutable loops : (string * string) list; - (* The innermost landing pad a transfer found after a call should jump to. - Empty means the function's own transfer exit. *) - mutable pads : string list; + (* The innermost landing pad a transfer found after a call should jump to, + with a flag saying whether anything ever aimed at it: a pad nobody jumps + to must not be emitted, because its code would then be reached by falling + into it. Empty means the function's own transfer exit, [xfer_lbl]. *) + mutable pads : (string * bool ref) list; + (* The function's own transfer exit — spec-conditions.md §5 and §6. A + transfer that reached the top of this function without a restart-case to + catch it leaves the way a [return] does, which is what reuses the epilogue + and the defers for free. [unwound] says whether anything can reach it. *) + mutable xfer_lbl : string; + mutable unwound : bool; (* Collected while lowering: string literals and float constants both need a labelled constant in .rodata, and both are discovered mid-expression. *) rodata : Buffer.t; @@ -589,20 +597,6 @@ let imm_into f ~reg (n : int64) = movabs f.b ~dst:reg n (* ── Struct layout, through [Emit] ───────────────────────────────────── *) -let field_offsets f (sn : string) = - match Hashtbl.find_opt f.md.Emit.structs sn with - | Some (s : Tast.structure) -> - let _, _, offs = - Emit.lay_fields f.md - (List.map (fun (fl : Tast.field) -> fl.Tast.fty) s.Tast.fields) - in - offs - | None -> unsupported "no struct %s" sn - -(* A union is { i32 tag, [k x iA] payload }, the same two fields [Emit.lay] - measures it as — so the payload's offset is whatever [lay_fields] puts the - second one at, and not a rule spelled a second time here. A union whose - cases are all payload-less is a bare tag and has no second field. *) let union_payload_off f (u : Tast.union) = let size, align = Emit.payload_lay f.md u in if size = 0 then 0 @@ -615,6 +609,27 @@ let union_payload_off f (u : Tast.union) = in List.nth offs 1 +let field_offsets f (sn : string) = + match Hashtbl.find_opt f.md.Emit.structs sn with + | Some (s : Tast.structure) -> + let _, _, offs = + Emit.lay_fields f.md + (List.map (fun (fl : Tast.field) -> fl.Tast.fty) s.Tast.fields) + in + offs + | None -> + (* A union is a struct too, at this level: [emit.ml] lays it out as a tag + and a payload blob, and the structural printer reads the tag as field 0 + without unwrapping the value. *) + (match Hashtbl.find_opt f.md.Emit.unions sn with + | Some (u : Tast.union) -> [ 0; union_payload_off f u ] + | None -> unsupported "no struct %s" sn) + +(* A union is { i32 tag, [k x iA] payload }, the same two fields [Emit.lay] + measures it as — so the payload's offset is whatever [lay_fields] puts the + second one at, and not a rule spelled a second time here. A union whose + cases are all payload-less is a bare tag and has no second field. *) + let union_of f n = match Hashtbl.find_opt f.md.Emit.unions n with | Some u -> u @@ -651,20 +666,127 @@ let int_cc ~signed (p : Tast.prim) = | Tast.Ge, true -> cc_ge | Tast.Ge, false -> cc_ae | _ -> unsupported "not a comparison" +(* Parity, which on [ucomis] means "unordered": one of the operands was a NaN. + Nothing else in this file reads it. *) +let cc_np = 11 + (* [ucomis] sets the flags the *unsigned* codes read, whichever way the - operands are signed, so a float comparison never uses l/g. *) + operands are signed, so a float comparison never uses l/g — and it sets + CF, ZF and PF all at once when either operand is a NaN. + + That last part is why this is not simply the unsigned table. Every + comparison Flan has is LLVM's *ordered* one ([emit.ml]'s [fcmp_op]: oeq, + one, olt, ...), which answers false for a NaN, and [setb] after an + unordered compare answers true. So [<] and [<=] swap their operands and ask + for a/ae, which are the two codes a NaN makes false; [=] and [!=] cannot be + spelled by one code at all and take a second [setnp] beside them. + + [(not (= x x))] is how [format-f64] in the prelude detects a NaN, and it is + the whole of the difference: with [sete] alone, [(/ 0.0 0.0)] formatted as + -9223372036854775808. *) +let float_swaps (p : Tast.prim) = + match p with Tast.Lt | Tast.Le -> true | _ -> false + let float_cc (p : Tast.prim) = match p with | Tast.Eq -> cc_e | Tast.Ne -> cc_ne - | Tast.Lt -> cc_b | Tast.Le -> cc_be + | Tast.Lt -> cc_a | Tast.Le -> cc_ae | Tast.Gt -> cc_a | Tast.Ge -> cc_ae | _ -> unsupported "not a comparison" +let float_ordered (p : Tast.prim) = + match p with Tast.Eq | Tast.Ne -> true | _ -> false + let is_cmp (p : Tast.prim) = match p with | Tast.Eq | Tast.Ne | Tast.Lt | Tast.Le | Tast.Gt | Tast.Ge -> true | _ -> false +(* ── The transfer channel, spec-conditions.md §6 ──────────────── *) + +(* One indirection more than [emit.ml] has, and it is the whole trap in this + file. There [%xfer] is an alloca, so the target is one [load] away. Here + [xfer_off] is a frame slot *holding the caller's pointer*, so reading the + target is two loads — slot, then through it — and clearing the channel is a + store *through* the pointer and never a store to [xfer_off]. Getting that + wrong produces assembly that reads perfectly and a program that never sees + a transfer, which is exactly the failure item 15 warns about. *) + +let chan_into f ~reg = load_int f.b ~dst:reg ~mm:(Frame f.xfer_off) ~size:8 ~signed:false + +(* The transfer target, or null. *) +let xfer_load f ~reg = + chan_into f ~reg; + load_int f.b ~dst:reg ~mm:(Reg (reg, 0)) ~size:8 ~signed:false + +(* [reg] into the channel. [scratch] must not be [reg]. *) +let xfer_store f ~reg ~scratch = + chan_into f ~reg:scratch; + store_int f.b ~src:reg ~mm:(Reg (scratch, 0)) ~size:8 + +let xfer_clear f = + chan_into f ~reg:r11; + xor_rr f.b ~dst:rax ~src:rax; + store_int f.b ~src:rax ~mm:(Reg (r11, 0)) ~size:8 + +(* Where a transfer found after a call goes: the innermost restart-case, + handler-bind or with-allocator pad we are inside, or the function's own + transfer exit. Naming one marks it reached — nothing emits a pad that is + only ever fallen into. *) +let current_pad f = + match f.pads with + | (p, used) :: _ -> used := true; p + | [] -> f.unwound <- true; f.xfer_lbl + +(* The check after a call, which is the whole of §6's lowering at a call site: + two loads, a test and a branch. Only [r11] is touched, so it may be emitted + between the call and the store of the value in [rax] — which is where it + goes, because a transfer means the value is meaningless. + + A foreign call gets none: a transfer cannot cross a C frame, so there is + nothing a guard there could find. The exceptions are the runtime entry + points that take the channel themselves and signal through it. *) +let guard f = + xfer_load f ~reg:r11; + test_rr f.b ~a:r11 ~c:r11; + jcc_lbl f.b ~cc:cc_ne (current_pad f) + +(* Run [g] with a fresh pad on top of the stack, and answer the pad's label + beside whether anything aimed at it. *) +let with_pad f tag g = + let pad = new_label f tag and used = ref false in + f.pads <- (pad, used) :: f.pads; + let r = g () in + f.pads <- List.tl f.pads; + (pad, used, r) + +(* ── 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. *) + +(* { ptr prev, i32 type_id, ptr fn } *) +let h_size = 24 +let h_type = 8 +let h_fn = 16 + +(* { 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 + (* ── The calling convention, as the header states it ─────────────────── *) (* One argument as it will actually be handed over. [Aptr] is an aggregate, @@ -931,9 +1053,349 @@ and lower_at f (e : Tast.expr) (dst : loc) : unit = | Tast.CaseField (target, case, i) -> move f ~dst ~src:(case_field f target case i) t | Tast.Match (scrut, arms) -> emit_match f scrut arms dst t - | Tast.Signal _ | Tast.Handled _ | Tast.RestartCase _ - | Tast.InvokeRestart _ | Tast.WithAlloc _ -> - unsupported "conditions, in %s" f.fnname + (* The condition crosses as a pointer: a handler runs while the signalling + frame is still alive, so there is nothing to copy and nothing to own. *) + | Tast.Signal (Tast.Ssignal, id, c) -> + scoped f (fun () -> + let l = lvalue f c in + addr_into f ~reg:rsi l; + imm_into f ~reg:rdi (Int64.of_int id); + chan_into f ~reg:rdx; + xor_rr f.b ~dst:rax ~src:rax; + call_sym f.b "flan_signal"; + guard f) + (* §2's diverging variant. [flan_error] does not return unless a handler + transferred, so the guard is the only way out and the fall-through is + [ud2] — where [emit.ml] writes [unreachable]. *) + | Tast.Signal (Tast.Serror, id, c) -> + scoped f (fun () -> + let l = lvalue f c in + addr_into f ~reg:rsi l; + imm_into f ~reg:rdi (Int64.of_int id); + chan_into f ~reg:rdx; + let name = + match c.Tast.ty with Types.Named n -> n | _ -> "a condition" in + str_args f ~preg:rcx ~nreg:r8 name; + xor_rr f.b ~dst:rax ~src:rax; + call_sym f.b "flan_error"; + guard f; + ud2 f.b) + | Tast.Handled (frames, body) -> emit_handled f frames body dst t + | Tast.RestartCase (clauses, body) -> emit_restart_case f clauses body dst t + | Tast.WithAlloc (a, body) -> emit_with_alloc f a body dst t + | Tast.InvokeRestart (id, name, args, sg, sg_id, rloc) -> + emit_invoke_restart f id name args sg sg_id rloc + +(* ── Conditions ──────────────────────────────────────────────────────── *) + +(* A string constant handed to the runtime as ptr+len, in two registers. *) +and str_args f ~preg ~nreg s = + let l = string_const f s in + lea f.b ~dst:preg ~mm:(Sym (l, 0)); + imm_into f ~reg:nreg (Int64.of_int (String.length s)) + +(* One of the runtime's [_Noreturn] refusals. Everything is already in its + register; this is the call and the [ud2] that says the fall-through is not + a path. *) +and die f sym = + xor_rr f.b ~dst:rax ~src:rax; + call_sym f.b sym; + ud2 f.b + +(* (handler-bind ((C f) ...) BODY...) — §2. Two stores and a push per frame, + and the frames live on this function's own stack. Popping is by frame and + not by count, which is right even if something below got the stack out of + step. + + The body may not [return] — the checker rejects that — so the pop below and + the pop in the pad are between them the only paths out. *) +and emit_handled f frames body dst t = + let slots = + List.map + (fun (h : Tast.hframe) -> + let slot = alloc f h_size 8 in + imm_into f ~reg:rax (Int64.of_int h.Tast.htype); + store_int f.b ~src:rax ~mm:(Frame (slot + h_type)) ~size:4; + (* The clause's body address, deliberately, and not a cell load: a + handler frame is not a redefinable top-level value — nothing can + name it and it lives only for this body. *) + lea f.b ~dst:rax ~mm:(Sym (fsym h.Tast.hfn, 0)); + store_int f.b ~src:rax ~mm:(Frame (slot + h_fn)) ~size:8; + lea f.b ~dst:rdi ~mm:(Frame slot); + xor_rr f.b ~dst:rax ~src:rax; + call_sym f.b "flan_handler_push"; + slot) + frames + in + (* Innermost first, which is the order they were pushed in reverse. *) + let pop () = + List.iter + (fun slot -> + lea f.b ~dst:rdi ~mm:(Frame slot); + xor_rr f.b ~dst:rax ~src:rax; + call_sym f.b "flan_handler_pop") + (List.rev slots) + in + let ld = new_label f "endhandled" in + let pad, used, () = with_pad f "hxfer" (fun () -> block f body dst t) in + pop (); + jmp_lbl f.b ld; + (* A transfer passing through: these frames are on this function's stack and + must come off before it goes any further. Nothing here calls Flan, so the + channel can stay as it is. *) + if !used then begin + lbl f.b pad; + pop (); + jmp_lbl f.b (current_pad f) + end; + lbl f.b ld + +(* (with-allocator A BODY...) — spec-memory.md's "Allocators". Save, run, + restore, and restore *again at the pad*: a body that errors, or one a + handler transfers out of, leaves through [current_pad], and a context + allocator left pointing into a region nobody outside the body has heard of + would be wrong in the break loop — which is exactly where someone is about + to allocate to render a condition. *) +and emit_with_alloc f (a : Tast.expr) body dst t = + let prev = ptmp f in + scoped f (fun () -> + let av = eval f a in + load_loc f ~reg:rdi av a.Tast.ty); + xor_rr f.b ~dst:rax ~src:rax; + call_sym f.b "flan_context_set"; + store_int f.b ~src:rax ~mm:(Frame prev) ~size:8; + let restore () = + load_int f.b ~dst:rdi ~mm:(Frame prev) ~size:8 ~signed:false; + xor_rr f.b ~dst:rax ~src:rax; + call_sym f.b "flan_context_restore" + in + let ld = new_label f "endwith" in + let pad, used, () = with_pad f "wxfer" (fun () -> block f body dst t) in + restore (); + jmp_lbl f.b ld; + if !used then begin + lbl f.b pad; + restore (); + jmp_lbl f.b (current_pad f) + end; + lbl f.b ld + +(* A clause's parameters as one record: what the invoker stores into and what + the clause loads out of. The two ends never see each other, so the layout is + agreed by the signature hash they compare first — same types in the same + order is the same record, and both sides ask [Emit.lay_fields], which is the + one layout calculator in this compiler. *) +and args_layout f (tys : Types.t list) = + let size, align, offs = Emit.lay_fields f.md tys in + (max 1 size), (max 1 align), offs + +(* (restart-case BODY (name [p T] BODY-1) ...) — §3, §4 and §6 together. + + One frame per clause, so the frame a transfer names says which clause to + run. §4's "innermost offering the name" falls out of the runtime's stack + walk, and re-entering a restart-case works because each activation allocates + its own frames. + + §5's defers between here and the invoke have already run: each function on + the way out ran its own at its transfer exit before returning. What is left + is to take these frames off, copy §3's parameters out of the buffer the + invoker filled, and start the clause. *) +and emit_restart_case f clauses body dst t = + (* Everything the pad reads is allocated here, before any [scoped] the body + or a clause runs. The frame allocator is a bump pointer that reclaims at + the end of each statement, so a slot allocated inside the body would be + handed out again to the clause that has to read it — and the read would + be of whatever the clause's own temporaries put there. *) + let tgt = ptmp f in + let bufp = ptmp f in + let frames = + List.map + (fun (c : Tast.rclause) -> + let slot = alloc f r_size 8 in + let args = + if c.Tast.rparams = [] then None + else begin + let size, align, offs = + args_layout f (List.map snd c.Tast.rparams) in + Some (alloc f size align, offs) + end + in + (c, slot, args)) + clauses + in + List.iter + (fun ((c : Tast.rclause), slot, args) -> + imm_into f ~reg:rax (Int64.of_int c.Tast.rname_id); + store_int f.b ~src:rax ~mm:(Frame (slot + r_name_id)) ~size:4; + (* 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. *) + str_args f ~preg:rax ~nreg:rcx c.Tast.rname; + store_int f.b ~src:rax ~mm:(Frame (slot + r_name)) ~size:8; + store_int f.b ~src:rcx ~mm:(Frame (slot + r_namelen)) ~size:8; + (* §3's signature, which every frame carries whether it takes + parameters or not: a clause taking none has to be able to refuse + arguments as loudly as one taking two of the wrong type. *) + imm_into f ~reg:rax (Int64.of_int (List.length c.Tast.rparams)); + store_int f.b ~src:rax ~mm:(Frame (slot + r_arity)) ~size:4; + imm_into f ~reg:rax (Int64.of_int c.Tast.rsig_id); + store_int f.b ~src:rax ~mm:(Frame (slot + r_sig_id)) ~size:4; + str_args f ~preg:rax ~nreg:rcx c.Tast.rsig; + store_int f.b ~src:rax ~mm:(Frame (slot + r_sig)) ~size:8; + store_int f.b ~src:rcx ~mm:(Frame (slot + r_siglen)) ~size:8; + (match args with + | None -> () + | Some (buf, _) -> + lea f.b ~dst:rax ~mm:(Frame buf); + store_int f.b ~src:rax ~mm:(Frame (slot + r_args)) ~size:8; + (* 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 refuses rather than + running on values no one supplied. *) + xor_rr f.b ~dst:rax ~src:rax; + store_int f.b ~src:rax ~mm:(Frame (slot + r_armed)) ~size:4); + lea f.b ~dst:rdi ~mm:(Frame slot); + xor_rr f.b ~dst:rax ~src:rax; + call_sym f.b "flan_restart_push") + frames; + let pop () = + List.iter + (fun (_, slot, _) -> + lea f.b ~dst:rdi ~mm:(Frame slot); + xor_rr f.b ~dst:rax ~src:rax; + call_sym f.b "flan_restart_pop") + (List.rev frames) + in + let ld = new_label f "endrestart" in + let pad, used, () = with_pad f "rxfer" (fun () -> lower f body dst) in + pop (); + jmp_lbl f.b ld; + if !used then begin + lbl f.b pad; + xfer_load f ~reg:rax; + store_int f.b ~src:rax ~mm:(Frame tgt) ~size:8; + (* Cleared before a clause runs, and put back if this transfer turns out to + be aimed further out. A clause body is ordinary code and its calls are + guarded like any other; it must not start with the channel still set. *) + xfer_clear f; + pop (); + List.iter + (fun ((c : Tast.rclause), slot, args) -> + let next = new_label f "outer" in + load_int f.b ~dst:rax ~mm:(Frame tgt) ~size:8 ~signed:false; + lea f.b ~dst:rcx ~mm:(Frame slot); + cmp_rr f.b ~a:rax ~c:rcx; + jcc_lbl f.b ~cc:cc_ne next; + (match args with + | None -> () + | Some (buf, offs) -> + (* Aimed here by something that supplied no arguments. There is no + such path from an [invoke-restart], so this is a break loop + taking a restart it cannot yet fill in — refused with the + reason. *) + load_int f.b ~dst:rax ~mm:(Frame (slot + r_armed)) ~size:4 + ~signed:true; + let armed = new_label f "armed" in + test_rr f.b ~a:rax ~c:rax; + jcc_lbl f.b ~cc:cc_ne armed; + let l0 = List.hd c.Tast.rbody in + str_args f ~preg:rdi ~nreg:rsi (Loc.to_string l0.Tast.loc); + str_args f ~preg:rdx ~nreg:rcx c.Tast.rname; + str_args f ~preg:r8 ~nreg:r9 c.Tast.rsig; + die f "flan_restart_unarmed"; + lbl f.b armed; + (* The frame is still addressable — it is a temporary of *this* + function — and the buffer is whatever the invoker left there. *) + lea f.b ~dst:rax ~mm:(Frame buf); + store_int f.b ~src:rax ~mm:(Frame bufp) ~size:8; + List.iteri + (fun i (slot_i, ty) -> + move f ~dst:(Lf f.slots.(slot_i)) + ~src:(Lp (bufp, List.nth offs i)) ty) + c.Tast.rparams); + scoped f (fun () -> block f c.Tast.rbody dst t); + jmp_lbl f.b ld; + lbl f.b next) + frames; + (* Aimed further out than any of these. Back into the channel it goes. *) + load_int f.b ~dst:rax ~mm:(Frame tgt) ~size:8 ~signed:false; + xfer_store f ~reg:rax ~scratch:r11; + jmp_lbl f.b (current_pad f) + end; + lbl f.b ld + +(* §4's lookup, then the transfer itself: the frame that was found goes into + the channel and this function leaves through its landing pad. Type [Never], + so nothing follows. *) +and emit_invoke_restart f id name (args : Tast.expr list) sg sg_id rloc = + (* The arguments first, each into a frame temporary of its own, because the + lookup and its two failure paths clobber every register. *) + let vals = List.map (fun (a : Tast.expr) -> eval f a, a.Tast.ty) args in + let t = ptmp f in + let bufp = ptmp f in + imm_into f ~reg:rdi (Int64.of_int id); + xor_rr f.b ~dst:rax ~src:rax; + call_sym f.b "flan_find_restart"; + store_int f.b ~src:rax ~mm:(Frame t) ~size:8; + (* No frame offers the name. That is a runtime error at the invoke site — + not an unwind past everything — because there is nowhere to resume. *) + let found = new_label f "found" in + test_rr f.b ~a:rax ~c:rax; + jcc_lbl f.b ~cc:cc_ne found; + str_args f ~preg:rdi ~nreg:rsi (Loc.to_string rloc); + str_args f ~preg:rdx ~nreg:rcx name; + die f "flan_restart_fail"; + lbl f.b found; + (* §3's run-time check. A restart is found by name on a dynamic stack, so + what it takes is not knowable here: the frame carries its parameter count + and the hash of how they are spelled, and both are compared. The count is + not redundant with the hash — it is what makes a 32-bit collision between + two different signatures harmless in practice — and it is the cheaper + half. *) + let ok = new_label f "sigok" and bad = new_label f "signo" in + load_int f.b ~dst:r11 ~mm:(Frame t) ~size:8 ~signed:false; + load_int f.b ~dst:rax ~mm:(Reg (r11, r_arity)) ~size:4 ~signed:false; + cmp_imm f.b ~dst:rax (List.length args); + jcc_lbl f.b ~cc:cc_ne bad; + (* The hash is a full 32 bits and a [cmp] takes a signed imm32, so it goes + through a register rather than through the immediate. *) + load_int f.b ~dst:rax ~mm:(Reg (r11, r_sig_id)) ~size:4 ~signed:false; + imm_into f ~reg:rcx (Int64.of_int (sg_id land 0xffffffff)); + cmp_rr f.b ~a:rax ~c:rcx; + jcc_lbl f.b ~cc:cc_e ok; + lbl f.b bad; + (* Eight arguments, so two go on the stack — which is what [outgoing] is + for. 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. *) + if f.outgoing < 16 then f.outgoing <- 16; + str_args f ~preg:rax ~nreg:r11 sg; + store_int f.b ~src:rax ~mm:(Reg (rsp, 0)) ~size:8; + store_int f.b ~src:r11 ~mm:(Reg (rsp, 8)) ~size:8; + load_int f.b ~dst:r11 ~mm:(Frame t) ~size:8 ~signed:false; + load_int f.b ~dst:r8 ~mm:(Reg (r11, r_sig)) ~size:8 ~signed:false; + load_int f.b ~dst:r9 ~mm:(Reg (r11, r_siglen)) ~size:8 ~signed:true; + str_args f ~preg:rdi ~nreg:rsi (Loc.to_string rloc); + str_args f ~preg:rdx ~nreg:rcx name; + die f "flan_restart_args_fail"; + lbl f.b ok; + (* Into the buffer the target frame owns, field by field: this frame is about + to go, and the clause runs after it has. The layout is the one the + signature just agreed on. *) + if vals <> [] then begin + let _, _, offs = args_layout f (List.map snd vals) in + load_int f.b ~dst:r11 ~mm:(Frame t) ~size:8 ~signed:false; + load_int f.b ~dst:rax ~mm:(Reg (r11, r_args)) ~size:8 ~signed:false; + store_int f.b ~src:rax ~mm:(Frame bufp) ~size:8; + List.iteri + (fun i (l, ty) -> move f ~dst:(Lp (bufp, List.nth offs i)) ~src:l ty) + vals; + load_int f.b ~dst:r11 ~mm:(Frame t) ~size:8 ~signed:false; + imm_into f ~reg:rax 1L; + store_int f.b ~src:rax ~mm:(Reg (r11, r_armed)) ~size:4 + end; + load_int f.b ~dst:rax ~mm:(Frame t) ~size:8 ~signed:false; + xfer_store f ~reg:rax ~scratch:r11; + jmp_lbl f.b (current_pad f) and zero_value f (dst : loc) (ty : Types.t) = if is_agg ty then zero_loc f dst (sizeof f.md ty) @@ -1098,6 +1560,98 @@ and elements f (base : loc) (ty : Types.t) (is : Tast.expr list) : loc = in elements f (element f base ty i) elem rest +(* ── Bounds checks ───────────────────────────────────────────────────── *) + +(* [emit.ml]'s [check_at] and [check_slice], which could not exist here until + the guard did: the runtime's bounds error *signals*, so the call is an + ordinary one that returns when a handler or the break loop transferred, and + what makes it a check rather than a call is the guard after it. The + fall-through past the guard is what is unreachable — nothing answered, so + the runtime already died inside the call — and [ud2] is where [emit.ml] + writes [unreachable]. + + That is also the answer to "does a bounds trap run defers": an answered one + does, because it leaves through the innermost pad; an unanswered one still + does not, because it is a die inside C. Identical on both backends. *) +and bounds_call f sym (loc : Loc.t) (extra : int list) = + let s = Loc.to_string loc in + str_args f ~preg:rdi ~nreg:rsi s; + let regs = [| rdx; rcx; r8; r9 |] in + List.iteri + (fun k off -> + load_int f.b ~dst:regs.(k) ~mm:(Frame off) ~size:8 ~signed:true) + extra; + chan_into f ~reg:regs.(List.length extra); + xor_rr f.b ~dst:rax ~src:rax; + call_sym f.b sym; + guard f; + ud2 f.b + +(* The length an index is checked against, or [None] for the forms [emit.ml] + does not check either: a raw pointer, which has no length, and a string, + which its [element_addr] does not index at all. *) +and index_len _f (base : loc) (ty : Types.t) = + match ty with + | Types.Array (n, _) -> Some (`Const n) + | Types.Slice _ -> Some (`At (shift base 8)) + | _ -> None + +and load_len f = function + | `Const n -> imm_into f ~reg:rcx n + | `At l -> load_int f.b ~dst:rcx ~mm:(lmem f l ~scratch:r11) ~size:8 ~signed:true + +(* [at] is strict: the last valid index is len - 1, and one unsigned compare + catches a negative index as well as an oversized one. *) +and check_at f (base : loc) (ty : Types.t) (i : Tast.expr) (iv : loc) = + if f.md.Emit.checks then + match index_len f base ty with + | None -> () + | Some len -> + scoped f (fun () -> + let a = ptmp f and b = ptmp f in + load_loc f ~reg:rax iv i.Tast.ty; + store_int f.b ~src:rax ~mm:(Frame a) ~size:8; + load_len f len; + store_int f.b ~src:rcx ~mm:(Frame b) ~size:8; + cmp_rr f.b ~a:rax ~c:rcx; + let ok = new_label f "inb" in + jcc_lbl f.b ~cc:cc_b ok; + bounds_call f "flan_bounds_error" i.Tast.loc [ a; b ]; + lbl f.b ok) + +(* [slice] is not strict: a slice ending at len — or an empty one at lo = len — + is legal. [lo <= hi] is not redundant with [hi <= len], because a reversed + range would otherwise yield hi - lo as a huge unsigned length, which is a + worse hole than the missing check. *) +and check_slice f (base : loc) (ty : Types.t) (loc : Loc.t) (lo : Tast.expr) + (llo : loc) (hi : Tast.expr) (lhi : loc) = + if f.md.Emit.checks then + let len = + match ty with + | Types.Array (n, _) -> Some (`Const n) + | Types.Slice _ | Types.String -> Some (`At (shift base 8)) + | _ -> None + in + match len with + | None -> () + | Some len -> + scoped f (fun () -> + let a = ptmp f and b = ptmp f and c = ptmp f in + load_loc f ~reg:rax llo lo.Tast.ty; + store_int f.b ~src:rax ~mm:(Frame a) ~size:8; + load_loc f ~reg:rdx lhi hi.Tast.ty; + store_int f.b ~src:rdx ~mm:(Frame b) ~size:8; + load_len f len; + store_int f.b ~src:rcx ~mm:(Frame c) ~size:8; + let ok = new_label f "inb" and bad = new_label f "oob" in + cmp_rr f.b ~a:rax ~c:rdx; + jcc_lbl f.b ~cc:cc_a bad; + cmp_rr f.b ~a:rdx ~c:rcx; + jcc_lbl f.b ~cc:cc_be ok; + lbl f.b bad; + bounds_call f "flan_slice_error" loc [ a; b; c ]; + lbl f.b ok) + and element f (base : loc) (ty : Types.t) (i : Tast.expr) : loc = let elem = match ty with @@ -1106,6 +1660,7 @@ and element f (base : loc) (ty : Types.t) (i : Tast.expr) : loc = | t -> unsupported "index into %s" (Types.to_string t) in let iv = eval f i in + check_at f base ty i iv; (match ty with | Types.Array _ -> addr_into f ~reg:rax base | _ -> @@ -1168,6 +1723,13 @@ and call_flan f ~target ~args ~rty dst = | `Loc o -> load_int f.b ~dst:r11 ~mm:(Frame o) ~size:8 ~signed:false; call_r f.b r11); + (* §6 at a call site, and it is every call site: a callee that transferred + wrote a frame address through the channel, and the value in [rax] means + nothing. The guard touches only [r11], so it goes between the call and + the store rather than after it. A call by pointer is guarded by the same + guard — a transfer is carried by the channel whether the callee was + reached by name or by address. *) + guard f; if (not (is_void rty)) && not sret then store_loc f ~reg:(if is_float rty then xmm0 else rax) dst rty @@ -1177,16 +1739,42 @@ and call_flan f ~target ~args ~rty dst = and call_c f ~sym ~args ~rty dst = call_native f ~sym:(asm_sym sym) ~args ~rty dst -and call_rt f ~sym ~args ~rty dst = call_native f ~sym ~args ~rty dst +(* The two runtime entry points whose bounds check signals. They are the only + [Rt] symbols that can transfer, so they are the only ones that take the + channel and the only ones guarded — everything else in this family is + arithmetic over a container header and cannot reach a handler. A Vec is + checked inside the runtime rather than in emitted code (BUILT.md), so this + is where [(at v i)] gets what [(at arr i)] gets from [check_at]. *) +and rt_signals sym = + String.equal sym "flan_vec_at" || String.equal sym "flan_vec_as_slice" -and call_native f ~sym ~(args : Tast.expr list) ~rty dst = - let vals = List.map (fun (a : Tast.expr) -> eval f a, a.Tast.ty) args in +and call_rt f ~sym ~args ~rty dst = + call_native f ~sym ~chan:(rt_signals sym) ~args ~rty dst + +and call_native f ~sym ?(chan = false) ~(args : Tast.expr list) ~rty dst = + (* A Vec, a Map and a Pool are move-only and cross to the runtime as their + *address*, which is what lets an operation mutate the caller's container + in place. [eval] would hand over the address of a copy, and the runtime + would grow that and leave the caller's header at length zero — which is + how [bounds-condition.flan] failed, as an in-bounds (at v 1) signalling + against a length of 0. Every other aggregate is read-only across this + boundary, so a copy there is harmless. *) + let vals = + List.map + (fun (a : Tast.expr) -> + (match a.Tast.ty with + | Types.Vec _ | Types.Map _ | Types.Pool _ -> lvalue f a + | _ -> eval f a), a.Tast.ty) + args + in let flat = List.concat_map (fun (l, ty) -> classify_c l ty) vals in + let flat = if chan then flat @ [ Aint (Lf f.xfer_off, Types.Ptr Types.Unit) ] else flat in let nsse = emit_args f flat in (* [al] is how many SSE registers were used, which a variadic callee reads. Harmless on a fixed one, and a [declare] does not say which it is. *) imm_into f ~reg:rax (Int64.of_int nsse); call_sym f.b sym; + if chan then guard f; if not (is_void rty) then begin if is_agg rty then unsupported "aggregate return from %s" sym; store_loc f ~reg:(if is_float rty then xmm0 else rax) dst rty @@ -1240,10 +1828,17 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) dst = let lb = eval f b in if is_float a.Tast.ty then begin let f64 = f64_of a.Tast.ty in - fload f.b ~dst:xmm0 ~mm:(lmem f la ~scratch:r11) ~f64; - fload f.b ~dst:1 ~mm:(lmem f lb ~scratch:r11) ~f64; + let x, y = if float_swaps p then lb, la else la, lb in + fload f.b ~dst:xmm0 ~mm:(lmem f x ~scratch:r11) ~f64; + fload f.b ~dst:1 ~mm:(lmem f y ~scratch:r11) ~f64; ucomis f.b ~f64 ~a:xmm0 ~c:1; - setcc f.b ~cc:(float_cc p) ~dst:rax + setcc f.b ~cc:(float_cc p) ~dst:rax; + if float_ordered p then begin + movzx8 f.b ~dst:rax ~src:rax; + setcc f.b ~cc:cc_np ~dst:rcx; + movzx8 f.b ~dst:rcx ~src:rcx; + and_rr f.b ~dst:rax ~src:rcx + end end else begin load_loc f ~reg:rax la a.Tast.ty; load_loc f ~reg:rcx lb b.Tast.ty; @@ -1284,6 +1879,10 @@ and prim f (e : Tast.expr) (p : Tast.prim) (args : Tast.expr list) dst = let base = lvalue f a in let llo = eval f lo in let lhi = eval f hi in + (* The source is read once, and the check goes between reading it and the + arithmetic: the length it is checked against must be the one the + arithmetic uses. *) + check_slice f base a.Tast.ty e.Tast.loc lo llo hi lhi; (match a.Tast.ty with | Types.Array _ -> addr_into f ~reg:rax base | _ -> @@ -1436,7 +2035,8 @@ let emit_fn (md : Emit.m) ~externs ~fns (fn : Tast.fn) : string * string = fret = fn.Tast.ret; slots = Array.make nslots 0; xfer_off = 0; sret_off = 0; retval = 0; frame = 0; maxframe = 0; outgoing = 0; - loops = []; pads = []; rodata = Buffer.create 64; externs; fns } + loops = []; pads = []; xfer_lbl = ""; unwound = false; + rodata = Buffer.create 64; externs; fns } in (* The header's own frame model: every slot and every temporary is bump-allocated below rbp, and the high-water mark is what the prologue @@ -1447,6 +2047,7 @@ let emit_fn (md : Emit.m) ~externs ~fns (fn : Tast.fn) : string * string = if sret then f.sret_off <- ptmp f; if (not sret) && not (is_void fn.Tast.ret) then f.retval <- tmp f fn.Tast.ret; f.retlbl <- new_label f "ret"; + f.xfer_lbl <- new_label f "xfer"; let sret_at, param_at, xfer_at = incoming_of ~sret fn.Tast.params in (* An aggregate parameter arrives as a pointer to the caller's copy and has to be copied into its slot before anything else runs — and [rep movsb] @@ -1476,11 +2077,55 @@ let emit_fn (md : Emit.m) ~externs ~fns (fn : Tast.fn) : string * string = scoped f (fun () -> lower f e (ret_loc f)) | Some e -> scoped f (fun () -> lower f e sink) | None -> ()); - (* The transfer exit is not built, and nothing can reach it: no node in this - program signals or invokes a restart (checked before any of this runs), so - [fdefers] has no second path to run on. *) - if fn.Tast.fdefers <> [] then - unsupported "%s has defers on the transfer path" fn.Tast.name; + (* The transfer exit, spec-conditions.md §5 and §6. A transfer that reached + the top of this function without a restart-case to catch it leaves the + same way a [return] does — which is what reuses the existing return path, + and with it the defers, for free. The value returned is meaningless: the + caller's guard sees the channel set and never looks at it. + + Emitted here, *before* the prologue buffer is made, because [frame_bytes] + is read when the prologue is built and everything below allocates + temporaries and makes calls that move the high-water mark. *) + if f.unwound then begin + (* The body falls through to the epilogue, so it has to be sent there + explicitly before this: otherwise the last statement runs straight into + the transfer exit and the defers run a second time. [emit.ml] cannot + have this bug — its [ret] terminates the block. *) + jmp_lbl f.b f.retlbl; + lbl f.b f.xfer_lbl; + if fn.Tast.fdefers <> [] then begin + (* The channel is cleared while the defers run and put back after. A + defer makes ordinary calls and each one is guarded; with the channel + still set the first of them would branch straight back here. *) + let saved = ptmp f in + xfer_load f ~reg:rax; + store_int f.b ~src:rax ~mm:(Frame saved) ~size:8; + xfer_clear f; + let cleanup = new_label f "cleanup" and used = ref false in + f.pads <- [ (cleanup, used) ]; + List.iter (fun e -> scoped f (fun () -> lower f e sink)) fn.Tast.fdefers; + f.pads <- []; + load_int f.b ~dst:rax ~mm:(Frame saved) ~size:8 ~signed:false; + xfer_store f ~reg:rax ~scratch:r11; + jmp_lbl f.b f.retlbl; + (* A defer that starts a *second* transfer while the first is unwinding. + §6's per-frame slot nests, but nothing here does: the first + transfer's target is in hand and the defers are half run. Refused + loudly rather than resolved to one of them. *) + if !used then begin + lbl f.b cleanup; + str_args f ~preg:rdi ~nreg:rsi (Loc.to_string fn.Tast.floc); + die f "flan_transfer_fail" + end + end + else jmp_lbl f.b f.retlbl + end + else if fn.Tast.fdefers <> [] then + (* Nothing in this function can transfer, so the second exit has no path + to it and the defers on it are dead. Left as a refusal rather than + quietly dropped: if that reasoning is ever wrong, this says so. *) + unsupported "%s has defers on a transfer path nothing reaches" + fn.Tast.name; (* The prologue, now that the frame size is known. *) let pb = create () in @@ -1634,20 +2279,38 @@ let emit_globals_init (md : Emit.m) ~externs ~fns (globals : Tast.global list) = { b; md; fnname = ""; retlbl = new_label () "ginit"; fret = Types.Unit; slots = [||]; xfer_off = 0; sret_off = 0; retval = 0; frame = 0; maxframe = 0; outgoing = 0; loops = []; pads = []; + xfer_lbl = ""; unwound = false; rodata = Buffer.create 64; externs; fns } in + (* Two slots, not one: [xfer_off] holds the *pointer* every call passes on, + and [cell] is what it points at. Storing a null into [xfer_off] itself — + which is what this did while nothing could transfer — hands every callee + a null channel to write through. No caller gives this function one, so it + owns the cell. *) + let cell = ptmp f in f.xfer_off <- ptmp f; + f.xfer_lbl <- new_label f "gxfer"; List.iter (fun (g : Tast.global) -> scoped f (fun () -> lower f g.Tast.ginit (Lg (gsym g.Tast.gname, 0)))) globals; + (* Nothing establishes a handler or a restart before this runs, so a + transfer out of an initialiser has nowhere to go and cannot arise: a + bounds failure here finds no handler and dies inside the runtime. The + exit still exists because a guard names it. *) + if f.unwound then begin + jmp_lbl f.b f.retlbl; lbl f.b f.xfer_lbl; jmp_lbl f.b f.retlbl + end; let pb = create () in push_r pb rbp; mov_rr pb ~dst:rbp ~src:rsp; let n = frame_bytes f in if n > 0 then sub_imm pb ~dst:rsp n; - (* No caller hands this one a channel, so it gets a null one of its own. *) + (* No caller hands this one a channel, so it gets a null cell of its own and + passes that cell's address on. *) xor_rr pb ~dst:rax ~src:rax; + store_int pb ~src:rax ~mm:(Frame cell) ~size:8; + lea pb ~dst:rax ~mm:(Frame cell); store_int pb ~src:rax ~mm:(Frame f.xfer_off) ~size:8; lbl f.b f.retlbl; leave f.b; @@ -1663,26 +2326,31 @@ let emit_globals_init (md : Emit.m) ~externs ~fns (globals : Tast.global list) = (* ── The program ─────────────────────────────────────────────────────── *) -(* The guard that makes the missing transfer guard sound. [emit.ml] emits a - check of the channel after every call; this backend emits none, and the - reason it may is a whole-program one: if nothing in the reachable set can - ever *write* the channel, no call can ever come back with it set. That is a - property of the program and not of the backend, so it is checked here rather - than assumed — and when it fails the build stops with the node that broke - it rather than running with a guard that is not there. *) +(* What is left of the precondition that used to stand in for conditions. + + It was a whole-program argument: this backend emitted no guard after a call, + which is sound exactly when nothing in the reachable set can ever *write* + the channel, so the build refused by name the moment it found something that + could. Every call site is guarded now and the argument has retired — except + in one place, which is why the walk is still here. + + A global's initialiser runs from [flan..init-globals], before [main] and + before anything has established a handler or a restart. It owns its own + channel cell because no caller hands it one, so a transfer out of an + initialiser has nowhere to go: its exit would return to the loader. Refused + by name rather than compiled into a return into ld.so. *) let check_no_transfer (p : Tast.program) = - let bad what = unsupported "%s needs the transfer channel, which this \ - backend does not emit a guard for" what in + let bad what = + unsupported "%s in a global's initialiser: it runs before main, before \ + anything can handle it, and a transfer out of it has nowhere \ + to go" what + in let rec ex (e : Tast.expr) = (match e.Tast.e with | Tast.Signal _ -> bad "signal" | Tast.InvokeRestart _ -> bad "invoke-restart" | Tast.RestartCase _ -> bad "restart-case" | Tast.Handled _ -> bad "handler-bind" - | Tast.WithAlloc _ -> bad "with-allocator" - | Tast.Prim (Tast.Rt s, _) - when String.equal s "flan_vec_at" || String.equal s "flan_vec_as_slice" -> - bad ("(" ^ s ^ ")") | _ -> ()); iter_sub ex e and iter_sub g (e : Tast.expr) = @@ -1711,15 +2379,12 @@ let check_no_transfer (p : Tast.program) = | Tast.Pindex (x, ys) -> g x; List.iter g ys | _ -> () in - List.iter - (fun (fn : Tast.fn) -> List.iter ex fn.Tast.body; List.iter ex fn.Tast.fdefers) - p.Tast.fns; List.iter (fun (g : Tast.global) -> ex g.Tast.ginit) p.Tast.globals (* A whole program as one assembly file. *) -let program (p : Tast.program) : string = +let program ~checks (p : Tast.program) : string = check_no_transfer p; - let md = layout_ctx p in + let md = layout_ctx ~checks p in let externs = Hashtbl.create 16 in List.iter (fun (e : Tast.extern) -> Hashtbl.replace externs e.Tast.ename e.Tast.esym) diff --git a/spike/x86/survey.sh b/spike/x86/survey.sh new file mode 100755 index 0000000..4e89ec5 --- /dev/null +++ b/spike/x86/survey.sh @@ -0,0 +1,105 @@ +#!/usr/bin/env bash +# Does the hand-written backend agree with LLVM? +# +# The only honest test of a hand-encoded backend is what the program prints and +# what it exits with -- DISCUSS.md item 15 and item 16 both say so, and both +# say it after a disassembly that read perfectly beside a wrong answer. So this +# builds every program in test/programs twice, runs both, and diffs stdout and +# the exit status. objdump is for after a program already has the wrong answer. +# +# Both sides get the same bounds-check setting (the default: on). A sweep that +# compared a checked build against an unchecked one would say nothing about +# bounds.flan, which is the one program the two backends disagreed about. +# +# Five outcomes, and the third is the progress meter: +# +# MATCH built both ways, same stdout, same exit status +# DIFFER built both ways, and disagreed +# REFUSED X86.Unsupported -- a node this backend does not lower (exit 3) +# NOX86 failed to build through --x86 for some other reason +# SKIP no main, does not compile at all, or does not terminate +# +# Usage: spike/x86/survey.sh [name-substring ...] +set -u +here=$(cd "$(dirname "$0")" && pwd) +root=$(cd "$here/../.." && pwd) +cd "$root" || exit 1 + +dune build --root . bin/main.exe 2>&1 | head -30 +flan=$root/_build/default/bin/main.exe +test -x "$flan" || { echo "build failed"; exit 1; } + +out=$(mktemp -d); trap 'rm -rf "$out"' EXIT + +# The two that run until something stops them. Not a failure and not a match; +# they are excluded by name because a timeout cannot tell them apart from a +# backend that hung. +forever="dev-loop dev-watch" + +TIMEOUT=${TIMEOUT:-20} + +declare -a match=() differ=() refused=() nox86=() skip=() + +for src in "$root"/test/programs/*.flan; do + name=$(basename "$src" .flan) + if [ $# -gt 0 ]; then + want=0 + for pat in "$@"; do case "$name" in *"$pat"*) want=1;; esac; done + [ $want = 1 ] || continue + fi + case " $forever " in *" $name "*) skip+=("$name:runs-forever"); continue;; esac + + # LLVM first. A program that does not compile at all, or has no main, is not + # this backend's business -- the frontend refused it either way. + if ! "$flan" build "$src" -o "$out/$name.llvm" >"$out/$name.llvm.err" 2>&1; then + if grep -q "in function \`_start\|undefined reference to \`main\|crt1.o" "$out/$name.llvm.err"; then + skip+=("$name:no-main") + else + skip+=("$name:does-not-compile") + fi + continue + fi + + "$flan" build "$src" --x86 -o "$out/$name.x86" >"$out/$name.x86.err" 2>&1 + rc=$? + if [ $rc = 3 ]; then + why=$(head -1 "$out/$name.x86.err" | sed 's/^x86: //') + refused+=("$name:$why") + continue + fi + if [ $rc != 0 ]; then + nox86+=("$name:$(head -1 "$out/$name.x86.err")") + continue + fi + + ( cd "$out" && timeout "$TIMEOUT" "$out/$name.llvm" >"$out/$name.llvm.out" 2>/dev/null ) + a=$? + ( cd "$out" && timeout "$TIMEOUT" "$out/$name.x86" >"$out/$name.x86.out" 2>/dev/null ) + b=$? + if [ "$a" = "$b" ] && cmp -s "$out/$name.llvm.out" "$out/$name.x86.out"; then + match+=("$name") + else + differ+=("$name:llvm=$a/x86=$b") + if [ "${SURVEY_SHOW:-}" = 1 ]; then + echo "--- $name: llvm exit $a, x86 exit $b" + diff "$out/$name.llvm.out" "$out/$name.x86.out" | head -20 + fi + fi +done + +echo +echo "MATCH ${#match[@]}" +echo "DIFFER ${#differ[@]}" +[ "${#differ[@]}" = 0 ] || printf ' %s\n' "${differ[@]}" +echo "REFUSED ${#refused[@]}" +if [ "${#refused[@]}" != 0 ] && [ "${SURVEY_QUIET:-}" != 1 ]; then + printf '%s\n' "${refused[@]}" | sed 's/^[^:]*://' | sort | uniq -c | sort -rn \ + | sed 's/^/ /' +fi +echo "NOX86 ${#nox86[@]}" +[ "${#nox86[@]}" = 0 ] || printf ' %s\n' "${nox86[@]}" +echo "SKIP ${#skip[@]}" +if [ "${#skip[@]}" != 0 ] && [ "${SURVEY_QUIET:-}" != 1 ]; then + printf '%s\n' "${skip[@]}" | sed 's/^[^:]*://' | sort | uniq -c \ + | sed 's/^/ /' +fi From e0e5c1e645f7e32d278b72c6beb318c1bb599547 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 18:41:13 +0700 Subject: [PATCH 2/3] The whole corpus goes through the hand-written backend The transfer exit returned whatever the return temporary held where emit.ml returns zero. Meaningless to a caller -- its guard sees the channel set and never looks -- but main is a caller with no guard, and what it finds in rax is the process exit status. The survey compares stderr as well now, which is where every message the new machinery produces goes: the bounds and slice errors, the three restart refusals, the transfer failure. Each carries a location this backend emits by hand as a .rodata label and a length in a register, and an exit status of 134 with the wrong text beside it is exactly the failure that reads as a match. It also walks spike/x86's own probes. p6-transfer.flan is the two re-propagation branches the corpus does not reach. Every transfer in restarts.flan stops at a restart-case inside the handler-bind's extent, so the handler frames never come off on the transfer path; and in nested and shadowed the inner frame offers the name, so a restart-case the transfer is not aimed at never has to put the target back. allocators.flan already covers the third. 89 MATCH 0 DIFFER 0 refused, over test/programs and spike/x86, comparing stdout, stderr and the exit status. DISCUSS.md item 17 is the report. --- DISCUSS.md | 153 +++++++++++++++++++++++++++++++++++++ lib/x86.ml | 11 ++- spike/x86/p6-transfer.flan | 72 +++++++++++++++++ spike/x86/survey.sh | 29 +++++-- 4 files changed, 257 insertions(+), 8 deletions(-) create mode 100644 spike/x86/p6-transfer.flan diff --git a/DISCUSS.md b/DISCUSS.md index cb37870..92753e5 100644 --- a/DISCUSS.md +++ b/DISCUSS.md @@ -1096,3 +1096,156 @@ Two things are worth doing before that, and both are cheap. Decide what a bounds handler — because "no check" is what it means today and nothing says so. And take item 15's question 4 seriously now that there are two backends to disagree: `(uninit)` and `unreachable` already differ, deliberately, and the difference is currently documented only in a comment in `x86.ml`. + +## 17. Conditions on the x86 backend, and with them bounds checks: the corpus, not 41 programs + +Item 16's verdict was that conditions were the only obstacle left and that a bounds check was made of the same parts. +Both halves held. The transfer channel's guard, the landing pads, the per-function transfer exit, `fdefers` on it, +`emit_restart_case`, `emit_with_alloc`, `signal`, `error`, `handler-bind`, `invoke-restart`, `check_at` and +`check_slice` are all in `lib/x86.ml` now, written from `spec-conditions.md` and `emit.ml`'s semantics rather than +ported. **`dune test --root .` is green, LLVM is untouched and still the default and the release backend, and `--x86` +is still off by default and still refused with `--dev`, `--debug`, `--sanitize` and every wasm target.** + +### Question 1 — the counts, and what was compared + +`spike/x86/survey.sh`. Item 16 describes a script that builds every program both ways and diffs the output; it was +never committed, so this one is. It builds each program in `test/programs` and each probe in `spike/x86` twice — once +default, once `--x86`, **with the same bounds-check setting on both sides**, because a checked build compared against +an unchecked one says nothing about `bounds.flan` — runs both, and compares **stdout, stderr and the exit status**. + +stderr is not a detail. Every message the new machinery produces goes there — the bounds and slice errors, the three +restart refusals, the transfer failure — and each carries a `Loc.to_string` string this backend emits by hand as a +`.rodata` label and a length in a register. An exit status of 134 with the wrong text beside it is exactly the failure +that reads as a match. + +| | before | after | +|---|---|---| +| **MATCH** — same stdout, same stderr, same exit status | **41** | **89** | +| **DIFFER** | 1 (`bounds.flan`) | **0** | +| **refused by name** — a node this backend does not lower | 41 | **0** | +| skipped: does not compile (checker-error fixtures) | 25 | 25 | +| skipped: no `main` (package and library fixtures) | 6 | 6 | +| skipped: never terminates (`dev-loop`, `dev-watch`) | 2 | 2 | + +The "before" row is measured, not quoted from item 16 — it is the same corpus seven files larger, and the 41 refusals +split as 26 `restart-case`, 7 `signal`, 4 `handler-bind`, 1 `with-allocator`, 1 `fdefers`, and one each for +`flan_vec_at` and `flan_vec_as_slice`. + +**Every program in `test/programs` that compiles, has a `main` and terminates now goes through the hand-written backend +and agrees with the LLVM build.** That is the whole corpus: `restarts.flan`, `conditions.flan`, `bounds.flan`, +`bounds-condition.flan`, `allocators.flan`, `defers.flan`, the `Vec` and `Map` programs, `edn.flan`, `format.flan`. +The programs that only trap when given an argument — `restarts.flan`'s four signature-mismatch cases, `bounds.flan`'s +three — were run by hand with their arguments and agree on stderr and on exit 134 as well. + +### Question 2 — what a bounds violation means in a build with no handler + +**The same thing it means on the LLVM path, and that is the answer rather than a decision.** `check_at` and +`check_slice` here are `emit.ml`'s: a compare, a branch, a call to `flan_bounds_error` or `flan_slice_error` with the +transfer channel, and then **the guard** — which is why they could not exist before. The call is an ordinary one that +returns only when a handler or the break loop transferred, so the guard is the way out and the fall-through past it is +`ud2` where `emit.ml` writes `unreachable`. + +So: a bounds violation signals `BoundsError`; a `handler-bind` can answer it; a `restart-case` catches the transfer +and its clause's value stands; an unanswered one dies inside the runtime and the program exits 134 with the location +and the index. `--no-bounds-checks` omits the check on both backends and both then exit 139. **`bounds.flan` has +stopped being a DIFFER**, and the row of item 16's question-4 table that said "no check at all" is gone rather than +documented. + +The transitional refusal item 16 asked for — a build that says out loud that its behaviour differs — was not written, +because `check_at` landed in the same pass and the refusal would have been created and retired inside one commit. +There is nothing left to be loud about. + +Item 16's other two divergences are unchanged and still deliberate: `(uninit)` reads whatever the slot held rather +than LLVM's `poison`, and an exhausted `match` is `ud2` rather than `unreachable`. Both are still documented only in +`x86.ml`. + +### Question 3 — `check_no_transfer` narrowed, not removed + +It was a whole-program argument: this backend emitted no guard, which is sound exactly when nothing reachable can +write the channel, so the build refused by name the moment it found something that could. Every call site is guarded +now and the argument has retired — **in every function.** It still stands in one place, so the walk is still there and +now walks only global initialisers: + +A global's initialiser runs from `flan..init-globals`, before `main` and before anything has established a handler or +a restart. It owns its own channel cell because no caller hands it one, so a transfer out of it has nowhere to go — +its exit would return into the loader. `signal`, `error`, `restart-case` and `handler-bind` in a `defvar` initialiser +are refused by name. A bounds check there is *not* refused: it signals into a cell nothing is listening on, finds no +handler, and dies, which is the right answer. + +### Question 4 — five bugs, and four are item 16's shape exactly + +Found by what the programs printed, never by reading bytes. Two of them existed before this work and only became +reachable once the guard let the programs that expose them compile. + +**The body fell through into the transfer exit.** Every `fdefer` ran twice on a normal return, so `restarts.flan`'s +`log` was one too high at every checkpoint and nothing else was wrong. `emit.ml` cannot have this bug: its `ret` +terminates the block, and there is no fall-through to forget. This is the same class as item 16's "a discarded value +was stored over the return address" — a construct this backend has that LLVM does not. + +**A `Vec` crossed to the runtime as the address of a copy.** `eval` copies an aggregate into a temporary, so +`flan_vec_push` grew the temporary and the caller's header stayed at length zero — and an *in-bounds* `(at v 1)` then +signalled against a length of 0. `emit.ml` says so in a comment beside its own `addr`; this had no such case. Pre- +existing, and invisible until a program using a `Vec` could build. + +**`ucomis` sets CF, ZF and PF together for a NaN**, so `sete` answered *true* for `(= x x)`. Flan's comparisons are +LLVM's *ordered* ones (`oeq`, `olt`, ...), which are false for a NaN; the unsigned table is not those. `<` and `<=` +now swap their operands and ask for a/ae, and `=` and `!=` take a `setnp` beside them. The symptom was +`(/ 0.0 0.0)` formatting as `-9223372036854775808`, because the prelude's NaN test is `(not (= x x))` and nothing +else. Pre-existing; `format.flan` could not build before. + +**A union read field 0 through the struct table** and was refused by name. A union is a tag and a payload blob, which +is a two-field struct at that level, and the structural printer reads the tag without unwrapping the value. + +**And one that could not have been found later:** `emit_globals_init` stored a null *into* the channel slot rather +than a cell's address into it, so every callee of a global initialiser was handed a null pointer to write a transfer +through. Harmless while nothing could transfer; a fault the first time a guard loaded through it. `emit_main` had it +right and was the model. + +Against those: nothing went wrong with the frame, the stack alignment, or the pads' nesting. The one place worth +naming is the one item 16 could not have: **the channel is one indirection deeper here than in `emit.ml`.** There +`%xfer` is an alloca and the target is one `load` away; here `xfer_off` is a frame slot *holding the caller's +pointer*, so reading the target is two loads and clearing the channel is a store *through* the pointer and never a +store to the slot. `chan_into`, `xfer_load`, `xfer_store` and `xfer_clear` exist so that no call site has to remember +which. + +### Question 5 — what the corpus does not walk, and the probe that does + +Every pad has two halves: the one a body reaches by finishing, and the one a transfer reaches by passing through. The +corpus walks the first everywhere and the second in one place only — `allocators.flan`'s last case aims an +`invoke-restart` out of a `with-allocator` body at a `restart-case` outside it, which is the `wxfer` re-propagation. + +The other two it never reaches. In `restarts.flan` every transfer stops at a `restart-case` *inside* the +`handler-bind`'s extent, so the handler frames never come off on the transfer path; and in `nested` and `shadowed` the +*inner* restart frame offers the name, so a restart-case that the transfer is not aimed at never has to put the target +back. `spike/x86/p6-transfer.flan` is those two, beside a defer and a clause parameter, and it agrees with the LLVM +build. It is in the survey, and it is why the count is 89 rather than 83. + +The branch nothing exercises is `flan_transfer_fail` — a defer that starts a *second* transfer while the first is +unwinding. It is emitted and refused loudly, and it is untested. + +### The honest no-plan bucket + +- **`Rt` with an aggregate return.** Still refused by name. `flan_vec_as_slice` returns a slice by value, and + `bounds-condition.flan` exercises it both in and out of bounds through a `restart-case` and matches — so it does not + reach the refusal, and **nobody traced why.** That is a loose end, not a result. +- **`Fnval`'s indirection cell.** `FnAddr (Fnval n)` still emits the symbol. Correct for a whole-program build, wrong + the instant anything is redefined into it; there are no cells here and no `--dev`, deliberately. +- **`f64` → `i64` out of range**, and **`INT64_MIN / -1`**. Unchanged from items 15 and 16: `idiv` raises `SIGFPE` + where LLVM says undefined. A language decision, not a backend one. +- **`(uninit)` and `unreachable`** still differ from LLVM on purpose and are still written down only in a comment. +- **The `flan_transfer_fail` branch**, above. +- **`"defers on a transfer path nothing reaches"`** — the refusal that replaced the old `fdefers` one. No program in + the corpus hits it; it exists so that if the reasoning behind it is ever wrong, it says so. +- **Debug information.** None. `--x86` and `--debug` together are still refused. +- **Code size and speed.** Still not measured, and now there is more to measure: a guard after every call, two loads + and a branch each, and a bounds check that spends three frame temporaries. Nobody has put a number on any of it. + +### The verdict + +**The row with no plan is gone.** What item 15 called the last obstacle and item 16 called the only one is written, +and the measurement that made it the only one is the measurement that says it is finished: every program in the corpus +that can run, runs, and prints what LLVM's build prints — down to stderr. + +What is left in `x86.ml` is not conditions. It is a container return convention, a redefinition cell, two arithmetic +edge cases the language has not decided, and no debug info. None of those is the shape conditions were: each is a +known thing in a known place, and the guard is not underneath any of them. diff --git a/lib/x86.ml b/lib/x86.ml index f484184..3ca87bf 100644 --- a/lib/x86.ml +++ b/lib/x86.ml @@ -2086,6 +2086,9 @@ let emit_fn (md : Emit.m) ~externs ~fns (fn : Tast.fn) : string * string = Emitted here, *before* the prologue buffer is made, because [frame_bytes] is read when the prologue is built and everything below allocates temporaries and makes calls that move the high-water mark. *) + let zero_return () = + if not (is_void fn.Tast.ret) then zero_value f (ret_loc f) fn.Tast.ret + in if f.unwound then begin (* The body falls through to the epilogue, so it has to be sent there explicitly before this: otherwise the last statement runs straight into @@ -2093,6 +2096,11 @@ let emit_fn (md : Emit.m) ~externs ~fns (fn : Tast.fn) : string * string = have this bug — its [ret] terminates the block. *) jmp_lbl f.b f.retlbl; lbl f.b f.xfer_lbl; + (* [emit.ml] leaves here with [ret zeroinitializer]. The value is + meaningless to a caller — its guard sees the channel set and never looks + at it — but [main] is a caller with no guard, and what it finds in [rax] + is the process exit status. Zero rather than whatever the return + temporary held. *) if fn.Tast.fdefers <> [] then begin (* The channel is cleared while the defers run and put back after. A defer makes ordinary calls and each one is guarded; with the channel @@ -2107,6 +2115,7 @@ let emit_fn (md : Emit.m) ~externs ~fns (fn : Tast.fn) : string * string = f.pads <- []; load_int f.b ~dst:rax ~mm:(Frame saved) ~size:8 ~signed:false; xfer_store f ~reg:rax ~scratch:r11; + zero_return (); jmp_lbl f.b f.retlbl; (* A defer that starts a *second* transfer while the first is unwinding. §6's per-frame slot nests, but nothing here does: the first @@ -2118,7 +2127,7 @@ let emit_fn (md : Emit.m) ~externs ~fns (fn : Tast.fn) : string * string = die f "flan_transfer_fail" end end - else jmp_lbl f.b f.retlbl + else begin zero_return (); jmp_lbl f.b f.retlbl end end else if fn.Tast.fdefers <> [] then (* Nothing in this function can transfer, so the second exit has no path diff --git a/spike/x86/p6-transfer.flan b/spike/x86/p6-transfer.flan new file mode 100644 index 0000000..b1951ab --- /dev/null +++ b/spike/x86/p6-transfer.flan @@ -0,0 +1,72 @@ +;;;; The re-propagation branches, which the corpus walks past. +;;;; +;;;; Every landing pad this backend emits has two halves: the one a body +;;;; reaches by finishing, and the one a transfer reaches by passing through. +;;;; `test/programs` exercises the first everywhere and the second only for +;;;; with-allocator (allocators.flan's last case aims an invoke-restart out of +;;;; a with-allocator body at a restart-case outside it). The two below it does +;;;; not reach at all, so they are here: +;;;; +;;;; hxfer a transfer crossing a handler-bind, which has to take the handler +;;;; frames off before it goes any further -- in restarts.flan every +;;;; transfer stops at a restart-case *inside* the handler-bind's +;;;; extent, so that pop never runs on the transfer path +;;;; +;;;; rxfer's last branch +;;;; a restart-case the transfer is not aimed at: it puts the target +;;;; back in the channel and re-propagates. restarts.flan's `nested` +;;;; and `shadowed` both have the *inner* frame offering the name, so +;;;; the inner one always wins and this branch is never taken. +;;;; +;;;; Proved the way everything else here is: built both ways, and compared by +;;;; what it prints. + +(defstruct Blip [n i32]) + +(defvar log i64) + +;;; Two frames down, with a defer between, so the transfer crosses a function +;;; boundary and a transfer exit that has work to do. +(defn deep [n i32] i32 + (signal (Blip {.n n})) + 0) + +(defn middle [n i32] i32 + (defer (set log (+ log 1))) + (deep n)) + +;;; The handler frames come off on the transfer path. The restart-case is +;;; outside the handler-bind, so the pad pops and re-propagates rather than +;;; the body's own pop running. +(defn crosses-handler [n i32] i32 + (restart-case + (handler-bind [(Blip [c] (invoke-restart 'outer-one))] + (middle n)) + (outer-one [] 11))) + +;;; An inner restart-case that does not offer the name. Its pad clears the +;;; channel, pops its frames, matches nothing, and puts the target back. +(defn crosses-restart [n i32] i32 + (restart-case + (handler-bind [(Blip [c] (invoke-restart 'outer-two))] + (restart-case (middle n) + (inner-only [] 22))) + (outer-two [] 33))) + +;;; Both at once, and a parameter as well, so the buffer the outer frame owns +;;; is written by an invoke two pads and one function away from it. +(defn crosses-both [n i32] i32 + (restart-case + (handler-bind [(Blip [c] (invoke-restart 'outer-three 7)) ] + (restart-case (middle n) + (inner-only [] 44))) + (outer-three [v i32] (* v 100)))) + +(defn main [] i32 + (print (crosses-handler 1)) (println "") ; 11 + (print log) (println "") ; 1 — the defer ran + (print (crosses-restart 2)) (println "") ; 33 + (print log) (println "") ; 2 + (print (crosses-both 3)) (println "") ; 700 + (print log) (println "") ; 3 + 0) diff --git a/spike/x86/survey.sh b/spike/x86/survey.sh index 4e89ec5..785b1c0 100755 --- a/spike/x86/survey.sh +++ b/spike/x86/survey.sh @@ -4,8 +4,16 @@ # The only honest test of a hand-encoded backend is what the program prints and # what it exits with -- DISCUSS.md item 15 and item 16 both say so, and both # say it after a disassembly that read perfectly beside a wrong answer. So this -# builds every program in test/programs twice, runs both, and diffs stdout and -# the exit status. objdump is for after a program already has the wrong answer. +# builds every program in test/programs twice, runs both, and diffs stdout, +# stderr and the exit status. objdump is for after a program already has the +# wrong answer. +# +# stderr is not an afterthought: every message the condition machinery produces +# goes there -- the bounds and slice errors, the three restart refusals, the +# transfer failure -- and each carries a location string this backend emits by +# hand as a .rodata label and a length in a register. An exit status of 134 +# with the wrong text beside it is exactly the failure that looks like a +# match. # # Both sides get the same bounds-check setting (the default: on). A sweep that # compared a checked build against an unchecked one would say nothing about @@ -13,12 +21,15 @@ # # Five outcomes, and the third is the progress meter: # -# MATCH built both ways, same stdout, same exit status +# MATCH built both ways, same stdout, same stderr, same exit status # DIFFER built both ways, and disagreed # REFUSED X86.Unsupported -- a node this backend does not lower (exit 3) # NOX86 failed to build through --x86 for some other reason # SKIP no main, does not compile at all, or does not terminate # +# Over test/programs, and over spike/x86's own probes, which are here for the +# paths the corpus does not walk. +# # Usage: spike/x86/survey.sh [name-substring ...] set -u here=$(cd "$(dirname "$0")" && pwd) @@ -40,7 +51,7 @@ TIMEOUT=${TIMEOUT:-20} declare -a match=() differ=() refused=() nox86=() skip=() -for src in "$root"/test/programs/*.flan; do +for src in "$root"/test/programs/*.flan "$root"/spike/x86/*.flan; do name=$(basename "$src" .flan) if [ $# -gt 0 ]; then want=0 @@ -72,17 +83,21 @@ for src in "$root"/test/programs/*.flan; do continue fi - ( cd "$out" && timeout "$TIMEOUT" "$out/$name.llvm" >"$out/$name.llvm.out" 2>/dev/null ) + ( cd "$out" && timeout "$TIMEOUT" "$out/$name.llvm" \ + >"$out/$name.llvm.out" 2>"$out/$name.llvm.diag" ) a=$? - ( cd "$out" && timeout "$TIMEOUT" "$out/$name.x86" >"$out/$name.x86.out" 2>/dev/null ) + ( cd "$out" && timeout "$TIMEOUT" "$out/$name.x86" \ + >"$out/$name.x86.out" 2>"$out/$name.x86.diag" ) b=$? - if [ "$a" = "$b" ] && cmp -s "$out/$name.llvm.out" "$out/$name.x86.out"; then + if [ "$a" = "$b" ] && cmp -s "$out/$name.llvm.out" "$out/$name.x86.out" \ + && cmp -s "$out/$name.llvm.diag" "$out/$name.x86.diag"; then match+=("$name") else differ+=("$name:llvm=$a/x86=$b") if [ "${SURVEY_SHOW:-}" = 1 ]; then echo "--- $name: llvm exit $a, x86 exit $b" diff "$out/$name.llvm.out" "$out/$name.x86.out" | head -20 + diff "$out/$name.llvm.diag" "$out/$name.x86.diag" | head -20 fi fi done From 801b374c3cb4eaa250ea917c38a4feb2094c9106 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 18:43:00 +0700 Subject: [PATCH 3/3] What dune test actually says right now, and why Four raylib fixtures fail, the same four on two consecutive runs: images and audio, each at -O2 and -O0. They export to a hardcoded /tmp path and get "Failed to export wave data" because /tmp is full, and /tmp is full because of a runaway llc in another lane writing a 5.8 GB m4.o out of a 13 KB m4.ll. Nothing here writes to /tmp by a fixed name and TMPDIR does not reach those fixtures, so item 17 says that rather than claiming an unqualified green. --- DISCUSS.md | 10 ++++++++-- spike/x86/p6-transfer.flan | 2 +- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/DISCUSS.md b/DISCUSS.md index 92753e5..6363d31 100644 --- a/DISCUSS.md +++ b/DISCUSS.md @@ -1103,8 +1103,14 @@ Item 16's verdict was that conditions were the only obstacle left and that a bou Both halves held. The transfer channel's guard, the landing pads, the per-function transfer exit, `fdefers` on it, `emit_restart_case`, `emit_with_alloc`, `signal`, `error`, `handler-bind`, `invoke-restart`, `check_at` and `check_slice` are all in `lib/x86.ml` now, written from `spec-conditions.md` and `emit.ml`'s semantics rather than -ported. **`dune test --root .` is green, LLVM is untouched and still the default and the release backend, and `--x86` -is still off by default and still refused with `--dev`, `--debug`, `--sanitize` and every wasm target.** +ported. **LLVM is untouched and still the default and the release backend, and `--x86` is still off by default and +still refused with `--dev`, `--debug`, `--sanitize` and every wasm target.** + +`dune test --root .` was green twice on this work, and is green now apart from four raylib fixtures — `images` and +`audio`, each at `-O2` and `-O0` — which export to a *hardcoded* `/tmp` path and fail with +`Failed to export wave data` because `/tmp` is full. It is full because of a runaway `llc` in another lane writing a +5.8 GB `m4.o` out of a 13 KB `m4.ll`; the same four fail on two consecutive runs and nothing else does. Nothing in +this lane writes to `/tmp` by a fixed name, and `TMPDIR` does not reach those fixtures. ### Question 1 — the counts, and what was compared diff --git a/spike/x86/p6-transfer.flan b/spike/x86/p6-transfer.flan index b1951ab..d34c3eb 100644 --- a/spike/x86/p6-transfer.flan +++ b/spike/x86/p6-transfer.flan @@ -57,7 +57,7 @@ ;;; is written by an invoke two pads and one function away from it. (defn crosses-both [n i32] i32 (restart-case - (handler-bind [(Blip [c] (invoke-restart 'outer-three 7)) ] + (handler-bind [(Blip [c] (invoke-restart 'outer-three 7))] (restart-case (middle n) (inner-only [] 44))) (outer-three [v i32] (* v 100))))