diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 578bb3ce..07405aa0 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -1639,6 +1639,9 @@ static flan_allocator *flan_ctx_tmp = NULL; /* The agent's scratch temp arenas; see flan_temp_scratch_begin. */ #define FLAN_SCRATCH_LEVELS 16 static flan_allocator *flan_scratch[FLAN_SCRATCH_LEVELS]; +/* The incarnation of the temp arena each level displaced, so the end puts it + * back only if the expression did not destroy it. */ +static uint64_t flan_scratch_prev_inc[FLAN_SCRATCH_LEVELS]; static int flan_scratch_depth; flan_allocator *flan_arena_new(int64_t cap); @@ -1713,6 +1716,7 @@ void *flan_temp_scratch_begin(void) { flan_scratch[d] = flan_arena_new(FLAN_TEMP_DEFAULT); if (flan_scratch[d]) ((flan_arena *)flan_scratch[d]->data)->grow = 1; } + flan_scratch_prev_inc[d] = prev ? prev->incarnation : 0; flan_scratch_depth++; if (flan_scratch[d]) flan_ctx_tmp = flan_scratch[d]; return prev; @@ -1727,7 +1731,15 @@ void flan_temp_scratch_end(void *prev) { flan_scratch[d]->proc(flan_scratch[d], FLAN_ALLOC_FREE_ALL, NULL, 0, 0, 0); flan_scratch[d]->epoch++; } - flan_ctx_tmp = (flan_allocator *)prev; + /* An expression that destroyed the program's temp arena through an + * Allocator value it kept has retired its record, and a later arena-new may + * have taken it; putting it back would make context/temp that other arena. + * The context is then left without one, as the destroy left it, and the + * next use makes a new one. */ + { + flan_allocator *p = (flan_allocator *)prev; + flan_ctx_tmp = p && p->incarnation == flan_scratch_prev_inc[d] ? p : NULL; + } } /* with-allocator hands in two values in its own frame: [0] the one to install diff --git a/test/programs/dev-temp-destroy.flan b/test/programs/dev-temp-destroy.flan new file mode 100644 index 00000000..c6e30af7 --- /dev/null +++ b/test/programs/dev-temp-destroy.flan @@ -0,0 +1,36 @@ +;;;; A program that keeps its own temp arena as an Allocator value and stops. +;;;; test_dev.ml destroys that arena from an expression at the stop, makes a +;;;; new arena — which takes the destroyed one's record — and a Vec in it, then +;;;; resumes. The expression's scratch temp arena must not put the destroyed +;;;; record back as context/temp, or the next frame boundary would wipe the new +;;;; arena as the temp one and the Vec made there would trap. +(import agent "vendor:agent") + +(defstruct Missing [id i32]) + +(defonce ar Allocator) +(defonce tv Allocator) +(defonce av (Vec u8)) + +(defn fetch [] i32 + (restart-case + (do (error (Missing {.id 1})) 0) + (retry [] 7))) + +(defn hold [] i32 + (set tv context/temp) + (let [r (fetch)] + (println (string (i64->bytes 31))) + r)) + +(defn main [] i32 + (agent/start) + (println (hold)) + ;; A frame boundary, which in a dev build wipes context/temp — the new + ;; arena, had the destroyed record been put back as it. + (agent/poll) + (println (length av)) + (println (at av 0)) + (dotimes [i 4000] + (agent/wait 5)) + 0) diff --git a/test/test_dev.ml b/test/test_dev.ml index ac65c9e8..57c84d12 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -7532,6 +7532,72 @@ let () = (try Sys.remove tsock with Sys_error _ -> ())) [ ("--llvm", 20); ("--x86", 20); ("--llvm", 3000000); ("--x86", 3000000) ]; + (* ── The program's temp arena destroyed from a stop ──────────── + The scratch arena's end must not put back a temp arena the expression + destroyed: a later arena-new takes its record, and context/temp would + then be that other arena. *) + List.iter + (fun mode -> + let dsock = tmp ("tdestroy" ^ mode ^ ".sock") in + (try Sys.remove dsock with Sys_error _ -> ()); + let dpid = + Unix.create_process flan + [| flan; "dev"; "programs/dev-temp-destroy.flan"; "-s"; dsock; mode |] + Unix.stdin Unix.stdout Unix.stderr + in + if not (listening ~pid:dpid dsock) then begin + fail "the %s temp-destroy daemon %s" mode !listen_why; + (try Unix.kill dpid Sys.sigkill with Unix.Unix_error _ -> ()) + end + else begin + let c = connect dsock in + let out = Buffer.create 64 in + let ask sexp = + let r = Wire.parse (Wire.send c sexp; Wire.recv c) in + (match Wire.string_field r "output" with + | Some t -> Buffer.add_string out t + | None -> ()); + r + in + let stopped r = + match Wire.field r "stopped" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false + in + let eval code = + ask + (Printf.sprintf + "(:op \"eval-expr\" :code %S :file \"programs/dev-temp-destroy.flan\")" + code) + in + if not (await (fun () -> stopped (ask "(:op \"describe\")"))) then + fail "%s: the temp-destroy program never stopped" mode + else begin + List.iter + (fun code -> + let r = eval code in + if status r <> "ok" then + fail "%s: %s at the stop: %s" mode code + (Option.value ~default:(status r) + (Wire.string_field r "message"))) + [ "(arena-destroy tv)"; "(set ar (arena-new 4096))"; + "(set av (vec-new u8 ar))"; "(push av (u8 7))" ]; + ignore (ask "(:op \"restart\" :name \"retry\")"); + if not + (await (fun () -> + (try ignore (ask "(:op \"describe\")") with _ -> ()); + contains_sub (Buffer.contents out) "31\n7\n1\n7\n")) + then + fail "%s: after destroying the temp arena at a stop: %S" mode + (Buffer.contents out) + end; + (try Unix.close c with Unix.Unix_error _ -> ()); + (try Unix.kill dpid Sys.sigkill with Unix.Unix_error _ -> ()); + (try ignore (Unix.waitpid [] dpid) with Unix.Unix_error _ -> ()) + end; + (try Sys.remove dsock with Sys_error _ -> ())) + [ "--llvm"; "--x86" ]; + (* ══ The agent socket is not the editor protocol ══════════════════ Two daemons of their own, both about what a session owes an editor