diff --git a/runtime/flan_dev.c b/runtime/flan_dev.c index a7d99675..332da73e 100644 --- a/runtime/flan_dev.c +++ b/runtime/flan_dev.c @@ -2255,8 +2255,95 @@ void flan_dev_crash_enable(void) {} #include #include #include +#if defined(__linux__) && (defined(__x86_64__) || defined(__aarch64__)) +#include +#include +#define FLAN_PARK_STACKS 1 +#endif extern void (*flan_trap_hook)(const uint8_t *name, int64_t namelen); + +#ifdef FLAN_PARK_STACKS +/* Where a fault's break loop runs. Not the signal stack: the loop evaluates + * whatever is typed at it, and a runaway recursion there ran off the end of a + * 1 MiB malloc'd block with nothing below it, into the heap. And a fault taken + * while already on the signal stack has no stack to be delivered on, so the + * kernel kills the process. + * + * So the handler moves to one of these before calling the hook: 8 MiB each, + * mapped on first use, with a guard page at the low end. An overflow on one + * faults on its guard, the fault is delivered on the signal stack (the + * interrupted code was not on it), and its break loop gets the next stack up. + * Which stack is next is read off the interrupted stack pointer: a fault in + * code running on stack k parks on k + 1, and every stack above k is free, + * because a break loop is only ever left by a jump down to its caller. */ +#define PARK_COUNT 10 +#define PARK_SIZE ((size_t)8 << 20) +static char *park_lo[PARK_COUNT]; +static ucontext_t park_uc[PARK_COUNT]; +static const uint8_t *park_name; +static int64_t park_namelen; + +/* The guard page counts as the stack's: an overflow's stack pointer is in it + * when the fault is taken, and reading it as some other stack's would park the + * overflow's break loop on the very stack it overflowed. */ +static int park_index_of(uintptr_t sp) { + uintptr_t pg = (uintptr_t)sysconf(_SC_PAGESIZE); + for (int i = 0; i < PARK_COUNT; i++) + if (park_lo[i] != NULL && sp >= (uintptr_t)park_lo[i] - pg + && sp <= (uintptr_t)park_lo[i] + PARK_SIZE) + return i; + return -1; +} + +static char *park_stack(int i) { + if (park_lo[i] == NULL) { + size_t pg = (size_t)sysconf(_SC_PAGESIZE); + char *m = mmap(NULL, PARK_SIZE + pg, PROT_READ | PROT_WRITE, + MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE, -1, 0); + if (m == MAP_FAILED) return NULL; + if (mprotect(m, pg, PROT_NONE) != 0) { + munmap(m, PARK_SIZE + pg); + return NULL; + } + park_lo[i] = m + pg; + } + return park_lo[i]; +} + +static uintptr_t park_interrupted_sp(void *uc) { + const ucontext_t *u = (const ucontext_t *)uc; +#if defined(__x86_64__) + return (uintptr_t)u->uc_mcontext.gregs[15]; /* REG_RSP */ +#else + return (uintptr_t)u->uc_mcontext.sp; +#endif +} + +static void park_run(void) { + flan_trap_hook(park_name, park_namelen); + /* The hook parks and is left only by a jump; reaching here is dying. */ + signal(SIGSEGV, SIG_DFL); + raise(SIGSEGV); +} + +/* Calls the hook on the next park stack, or returns 0 when there is none to + * be had and the caller should call it where it stands. */ +static int park_elsewhere(void *uc, const uint8_t *name, int64_t namelen) { + int k = park_index_of(park_interrupted_sp(uc)) + 1; + char *st = k < PARK_COUNT ? park_stack(k) : NULL; + if (st == NULL) return 0; + park_name = name; + park_namelen = namelen; + if (getcontext(&park_uc[k]) != 0) return 0; + park_uc[k].uc_stack.ss_sp = st; + park_uc[k].uc_stack.ss_size = PARK_SIZE; + park_uc[k].uc_link = NULL; + makecontext(&park_uc[k], park_run, 0); + setcontext(&park_uc[k]); + return 0; +} +#endif extern void __asan_init(void) __attribute__((weak)); static volatile sig_atomic_t flan_crash_entered; @@ -2347,6 +2434,12 @@ static void crash_handler(int sig, siginfo_t *si, void *uc) { /* Parks for good, exactly like NullAllocator and the other no-channel * traps: there is no address to resume *at* — the faulting instruction * would fault again — so this is a place to stand and read. */ +#ifdef FLAN_PARK_STACKS + if (sig == SIGBUS) + park_elsewhere(uc, (const uint8_t *)"BusError", 8); + else + park_elsewhere(uc, (const uint8_t *)"SegFault", 8); +#endif if (sig == SIGBUS) flan_trap_hook((const uint8_t *)"BusError", 8); else diff --git a/runtime/flan_rt.c b/runtime/flan_rt.c index 40495be1..5e6bb186 100644 --- a/runtime/flan_rt.c +++ b/runtime/flan_rt.c @@ -1561,6 +1561,20 @@ void flan_context_restore(flan_allocator *a) { if (a) flan_ctx_alloc = a; } +/* The context as it stands, and putting it back: the agent's way out of an + * evaluation that trapped jumps past the [with-allocator] that would have + * restored it. Two words, which is room for whatever the context grows into; + * the agent only carries them. */ +void flan_context_save(uint64_t m[2]) { + m[0] = (uint64_t)(uintptr_t)flan_ctx_alloc; + m[1] = 0; +} + +void flan_context_load(const uint64_t m[2]) { + flan_allocator *a = (flan_allocator *)(uintptr_t)m[0]; + flan_ctx_alloc = a ? a : &flan_heap; +} + /* Allocator headers [flan_arena_destroy] retired, linked through [data]. See * there for why a header is never freed; this is why that does not grow. */ static flan_allocator *flan_retired; diff --git a/test/test_dev.ml b/test/test_dev.ml index 8eba3fdc..5a92bb29 100644 --- a/test/test_dev.ml +++ b/test/test_dev.ml @@ -7785,6 +7785,7 @@ let () = let r = request tc "(:op \"eval\" :code \"(defonce nowhere Allocator)\n\ + (defonce frame Allocator)\n\ (defn deep [n i64] i64 (+ 1 (deep (+ n 1))))\" \ :file \"programs/dev-nomain.flan\")" in @@ -7820,6 +7821,55 @@ let () = fail "aborting %s (%s) ended the session: %s" code shape (Printexc.to_string e))) [ "(free-all nowhere)"; "(deep 0)" ]; + let stopped () = + await (fun () -> + match Wire.field (request tc "(:op \"describe\")") "stopped" with + | Some { Form.v = Form.Sym "t"; _ } -> true + | _ -> false) + in + let eval_expr code = + request tc + (Printf.sprintf "(:op \"eval-expr\" :code %S :file \"\")" code) + in + let answers code want what = + match Wire.string_field (eval_expr code) "value" with + | Some v when v = want -> () + | v -> + fail "%s (%s): %s" what shape (Option.value ~default:"no value" v) + | exception e -> + fail "%s (%s) ended the session: %s" what shape (Printexc.to_string e) + in + (* The context allocator a trapped [with-allocator] had bound is put + back: a push through the context afterwards goes to the heap, not + to the 4 KiB arena, which would run out. *) + ignore (eval_expr "(do (set frame (arena-new 4096)) 0)"); + ignore (eval_expr "(with-allocator frame (deep 0))"); + if not (stopped ()) then fail "a trap inside with-allocator (%s) did not stop" shape + else begin + ignore (request tc "(:op \"abort\")"); + answers + "(let [v (vec-new i64)] (dotimes [i 100000] (push v i)) (length v))" + "100000" "the context allocator after a trap inside with-allocator" + end; + (* A runaway recursion evaluated in the break loop of a fault: the + loop runs on a stack of its own with a guard page, so the second + overflow is a second break, and both abort. *) + ignore (eval_expr "(deep 0)"); + if not (stopped ()) then fail "the first overflow (%s) did not stop" shape + else begin + ignore (eval_expr "(deep 0)"); + (match request tc "(:op \"abort\")" with + | r when status r = "ok" -> () + | r -> fail "aborting a nested overflow (%s): %s" shape (said r) + | exception e -> + fail "a nested overflow (%s) ended the session: %s" shape + (Printexc.to_string e)); + (* The inner break unwinds on the program's thread; the second + abort is for the outer one, so it waits for that. *) + Unix.sleepf 0.5; + ignore (request tc "(:op \"abort\")"); + answers "(helper)" "1" "the session after a nested overflow" + end; (try ignore (Wire.send tc "(:op \"close\")"); ignore (Wire.recv tc) diff --git a/vendor/agent/flan_agent.c b/vendor/agent/flan_agent.c index 7945a954..d151ca7d 100644 --- a/vendor/agent/flan_agent.c +++ b/vendor/agent/flan_agent.c @@ -410,7 +410,8 @@ static const uint8_t abandon_name[] = "abandon-evaluation"; * restart is a return that unwinds frame by frame, and a trap has nothing to * return through, so abandoning the evaluation from one is a jump straight * back to the poll that called it ([flan_agent_poll]), which puts the - * condition, frame and root chains back where they stood. The defers of the + * condition, frame and root chains and the context allocator back where + * they stood. The defers of the * frames jumped over do not run. NULL when no evaluation is in progress; * saved and restored around the call like [eval_boundary]. */ static sigjmp_buf *eval_escape; @@ -426,6 +427,8 @@ extern void *flan_dev_frames_mark(void) __attribute__((weak)); extern void flan_dev_frames_restore(void *head) __attribute__((weak)); extern int64_t flan_dyn_root_mark(void) __attribute__((weak)); extern void flan_dyn_root_restore(int64_t n) __attribute__((weak)); +extern void flan_context_save(uint64_t m[2]) __attribute__((weak)); +extern void flan_context_load(const uint64_t m[2]) __attribute__((weak)); /* -- update-instance-for-redefined-class ------------------------------ */ @@ -1153,6 +1156,8 @@ int32_t flan_agent_poll(void) { if (flan_condition_stacks_mark) flan_condition_stacks_mark(&mh, &mr, &md); if (flan_dev_frames_mark) mf = flan_dev_frames_mark(); if (flan_dyn_root_mark) mroots = flan_dyn_root_mark(); + uint64_t mctx[2] = { 0, 0 }; + if (flan_context_save) flan_context_save(mctx); if (sigsetjmp(escape, 1) == 0) { eval_escape = &escape; j.call(); @@ -1160,6 +1165,7 @@ int32_t flan_agent_poll(void) { if (flan_condition_stacks_restore) flan_condition_stacks_restore(mh, mr, md); if (flan_dev_frames_restore) flan_dev_frames_restore(mf); if (flan_dyn_root_restore) flan_dyn_root_restore(mroots); + if (flan_context_load) flan_context_load(mctx); } eval_escape = oescape; /* Popped whichever way the thunk left — returning with a value, or