From 2fdb84995d1351d5b709633e2a024cb391064768 Mon Sep 17 00:00:00 2001 From: pyrex41 Date: Mon, 19 Oct 2026 07:42:32 -0500 Subject: [PATCH] fix: run deep non-tail recursion on fresh coroutine stacks (#93) LuaJIT's Lua stack is a fixed ~65500 slots per coroutine (LJ_STACK_MAX is a compile-time constant), so non-tail recursion overflowed after ~12k frames: user code, and the kernel's tree walkers (shen.curry, shen.find-types, shen.process-applications). Every coroutine has its own stack, so deep recursion now continues on a fresh one, generalising what #90 does for the Prolog engine. A compiled function that makes a non-tail call counts itself in SD[1] while it is on the stack: it opens with a check and an increment, and restores the count before every return. A tail call stays a tail call: its arguments are evaluated first (hoisted when they make counted calls), then the count is restored. Once 160 counted functions are open on one stack, the next one runs on a new coroutine (runtime.lua M.seg.run). Lambda bodies in a defun count themselves the same way; freeze bodies and code outside a defun use a vararg trampoline (one copy per defun); natives that call back (map, mapcan, the Prolog engine's import) count inline. Errors restore the count by assignment at every catch point (compiled trap-error, the runtime's pcalls, host entry points, the segment runner). The Prolog engine's segments go through the same runner, so one nesting cap (10000, a trappable error) covers the shared C stack. Co-Authored-By: Claude Opus 5.5 --- CHANGELOG.md | 13 ++ bin/shen | 2 +- boot.lua | 2 + compiler.lua | 300 ++++++++++++++++++++++++++++++----- lua_interop.lua | 3 +- prims.lua | 25 ++- prolog_engine.lua | 30 ++-- repl.lua | 3 +- runtime.lua | 98 ++++++++++++ scripts/run-tests.lua | 1 + shen.lua | 12 +- test/stack_segments_spec.lua | 152 ++++++++++++++++++ 12 files changed, 579 insertions(+), 62 deletions(-) create mode 100644 test/stack_segments_spec.lua diff --git a/CHANGELOG.md b/CHANGELOG.md index 1c3ea70..fffa654 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -39,6 +39,19 @@ Notable changes to shen-lua. Release notes for earlier versions are under ### Fixed +- Deep non-tail recursion no longer overflows the Lua stack, in user code + or in the kernel's own tree walkers. `(depth 12000)` for a plain + `(+ 1 (depth (- N 1)))` recursion failed with `stack overflow` (it reached + ~8000), as did typechecking a 3000-deep `[s N]` term or a 10000-element + `[list number]` (`shen.curry`) and reading a 4000-element list literal + (`shen.find-types`, `shen.process-applications`). LuaJIT's stack is a + fixed ~65500 slots per coroutine (`LJ_STACK_MAX`, a compile-time + constant), so a compiled function that makes a non-tail call now counts + itself while it is on the stack, and every 160 of them the next call runs + on a fresh coroutine stack. Tail calls are not counted, so constant-stack + loops are unchanged. Depth is bounded by memory (`(depth 100000)` works); + past 10000 nested segments, shared with the Prolog engine's, a call raises + the trappable `Lua stack depth limit exceeded` (pyrex41/shen-lua#93). - The native Prolog engine no longer overflows the Lua stack on deep proofs: a typecheck died with `stack overflow` at ~375 nested rule applications (`(shen.typecheck (mk 400) peano)`, an 800-element diff --git a/bin/shen b/bin/shen index d8ef539..0d33d39 100755 --- a/bin/shen +++ b/bin/shen @@ -83,7 +83,7 @@ if #actions == 0 then while not stin.eof do F["shen.initialise_environment"]() F["shen.prompt"]() - local okk, err = pcall(F["shen.read-evaluate-print"]) + local okk, err = R.seg.pcall(F["shen.read-evaluate-print"]) if not okk and not stin.eof then local e = getmetatable(err) == R.Excn and err or R.mkexcn(tostring(err)) pcall(F["shen.toplevel-display-exception"], e) diff --git a/boot.lua b/boot.lua index 3afab75..257abcd 100644 --- a/boot.lua +++ b/boot.lua @@ -3,6 +3,8 @@ -- ShenOSKernel 43.1 modules are pure defuns; initialise() below runs -- (shen.initialise), the extension initialisers and (stlib.initialise). local R = require("runtime") +-- restores the stack-segment count on a caught error (runtime.lua, #93) +local pcall = R.seg.pcall local C = require("compiler") local P = require("prims") diff --git a/compiler.lua b/compiler.lua index fbdd06f..443f83e 100644 --- a/compiler.lua +++ b/compiler.lua @@ -317,6 +317,85 @@ local cexpr, ctail -- forward -- a symbol used as a *value* (self-evaluating) -> intern at runtime local function symlit(name) return 'S(' .. qstr(name) .. ')' end +-- Counted non-tail calls (runtime.lua stack segments, #93). LuaJIT's Lua +-- stack is fixed per coroutine, so the runtime counts the calls that keep a +-- frame on the stack and continues on a fresh coroutine stack every +-- SEG_FRAMES of them: deep non-tail recursion is then bounded by memory. +-- +-- A defun whose body makes a non-tail call to anything that may run Shen +-- code counts ITSELF: impl opens with +-- local dN = SD[1]; if dN >= SEG_FRAMES then return SEG(impl, ...) end; +-- SD[1] = dN + 1 +-- and every `return` of impl restores SD[1] = dN first. A tail call stays a +-- tail call: its arguments are evaluated first (hoisted into locals when +-- they make counted calls themselves), then the count is restored, then the +-- call -- so a constant-stack loop never opens a segment. A lambda body in +-- a defun counts itself the same way (counted_body). Counting in the callee +-- costs no extra Lua frame: a trampoline around every non-tail call +-- measured 15-25% slower on capcov's c-untyped workload. +-- +-- The rest -- freeze bodies, TRMC step functions, lambdas outside a defun, +-- top-level chunks -- sends its non-tail calls through a vararg trampoline: +-- NT, one copy per defun (NT_SRC; a single shared one makes every nested +-- call look like recursion through one prototype to the trace recorder), +-- or the runtime's NTV outside a defun. KL primitives and system functions +-- that never call back into Shen code (LEAF) are not counted. +local SEG_FRAMES = 160 -- runtime.lua M.seg.FRAMES +C.SEG_FRAMES = SEG_FRAMES +local NT_SRC = "local NT = function(f, ...) " + .. "local d = SD[1]; if d < " .. SEG_FRAMES .. " then SD[1] = d + 1; " + .. "local r = f(...); SD[1] = d; return r end; return SEG(f, ...) end; " +-- NTCOUNT: counted non-tail calls compiled so far (to ask whether a piece of +-- code made any). CNT: nil where calls go through the trampoline; otherwise +-- { owner = , ret = } +-- (ret is false in a value-position control form's KC body, which runs +-- inside the defun's frame but returns to it). +local NTCOUNT = 0 +local CNT = nil +-- TCOUNT: tail calls compiled so far that may run Shen code. A KC body +-- making one is still a frame held by its caller (see the control-form case +-- of cexpr). +local TCOUNT = 0 +local LEAF = {} +for _, n in ipairs({ + "cons", "hd", "tl", "cons?", "+", "-", "*", "/", ">", "<", ">=", "<=", + "number?", "string?", "symbol?", "boolean?", "empty?", "absvector?", + "absvector", "<-address", "address->", "intern", "str", "cn", "pos", + "tlstr", "string->n", "n->string", "value", "set", "simple-error", + "error-to-string", "get-time", "@p", "@s", "@v", "fst", "snd", "tuple?", + "integer?", "vector", "variable?", "shen.incinfs", "=", + -- system functions (protected from redefinition) that take no function + -- argument; one that recurses deeply in KL counts its own frames + "hash", "<-vector", "vector->", "length", "append", "reverse", "element?", + "assoc", "explode", "concat", "nth", "sum", "head", "tail", "limit", + "difference", "union", "intersection", "occurrences", "subst", "==", + "fail", "get", "put", "unput", "hdstr", "string->symbol", "pr", +}) do LEAF[n] = true end +local function nt_call(fexpr, argstr, n) + NTCOUNT = NTCOUNT + 1 + if CNT then + CNT.owner.used = true + return fexpr .. "(" .. (n > 0 and argstr or "") .. ")" + end + local nt = "NTV(" + if CTX then CTX.nt = true; nt = "NT(" end + return nt .. fexpr .. (n > 0 and (", " .. argstr) or "") .. ")" +end + +-- `return EXPR` of the Lua function being compiled. In a counting defun the +-- count is restored first; `calls` (EXPR made counted calls) evaluates EXPR +-- before the restore. +local function ret(expr, calls) + if not (CNT and CNT.ret) then return "return " .. expr end + if calls then + return "do local r = " .. expr .. "; " .. CNT.owner.tok .. "return r end" + end + return CNT.owner.tok .. "return " .. expr +end + +-- set by ccall for a tail call whose arguments were hoisted (see ccall) +local TAILPRE = nil + -- A call (NAME a1..an) whose callee arity is unknown at compile time -- in -- practice a forward reference to a function defined later in the same file, -- since each toplevel `define` is compiled on its own. The generic form, @@ -330,11 +409,15 @@ local function symlit(name) return 'S(' .. qstr(name) .. ')' end -- partial / over-application, redefinition and "not a function" errors are -- unchanged. Fixed arity, no varargs: LuaJIT traces it. local MAX_CALLN = 8 -local function unknown_call(name, argstr, n) +local function unknown_call(name, argstr, n, tail) if n <= MAX_CALLN then + if not tail then + return nt_call("CALL" .. n, qstr(name) .. (n > 0 and (", " .. argstr) or ""), n + 1) + end if n == 0 then return "CALL0(" .. qstr(name) .. ")" end return "CALL" .. n .. "(" .. qstr(name) .. ", " .. argstr .. ")" end + if not tail then return nt_call("APP", symlit(name) .. ", " .. argstr, n + 1) end if n == 0 then return "APP(" .. symlit(name) .. ")" end return "APP(" .. symlit(name) .. ", " .. argstr .. ")" end @@ -773,11 +856,13 @@ local function try_flatten_call_chain(form, env) -- We don't actually need the AST; emit a direct F[...] call using ARITY. local ar = C.ARITY[hname] local call_str + -- not the outermost frame: a non-tail call (counted, see nt_call) if ar and #prev_strs + 1 == ar then - call_str = callee_ref(hname) .. "(" .. arg_list .. ")" + call_str = LEAF[hname] and (callee_ref(hname) .. "(" .. arg_list .. ")") + or nt_call(callee_ref(hname), arg_list, ar) else -- fall back to APP for mismatched arity; late-bound for unknown - call_str = ar and ("APP(" .. symlit(hname) .. ", " .. arg_list .. ")") + call_str = ar and nt_call("APP", symlit(hname) .. ", " .. arg_list, #prev_strs + 2) or unknown_call(hname, arg_list, #prev_strs + 1) end stmts[#stmts+1] = "local " .. next_name .. " = " .. call_str .. ";" @@ -796,9 +881,10 @@ local function try_flatten_call_chain(form, env) call_str = callee_ref(hname) .. "(" .. arg_list .. ")" else call_str = ar and ("APP(" .. symlit(hname) .. ", " .. arg_list .. ")") - or unknown_call(hname, arg_list, #prev_strs + 1) + or unknown_call(hname, arg_list, #prev_strs + 1, true) end - stmts[#stmts+1] = "return " .. call_str + TCOUNT = TCOUNT + 1 + stmts[#stmts+1] = ret(call_str) return table.concat(stmts, " ") end @@ -830,7 +916,7 @@ local function order_free(form, env) return true -- number/string/boolean/(), symbol literal or local variable end -local function curried_call(form, env) +local function curried_call(form, env, tail) local args = {} local cur = form while is_cons(cur) and is_cons(car(cur)) do @@ -856,16 +942,62 @@ local function curried_call(form, env) local fnref = callee_ref("fn") local cargs = {} for i = 1, n do cargs[i] = cexpr(args[i], env) end + if not tail then + return nt_call("CUR" .. n, fnref .. "(" .. symlit(sym.name) .. "), " + .. table.concat(cargs, ", "), n + 1) + end return "CUR" .. n .. "(" .. fnref .. "(" .. symlit(sym.name) .. "), " .. table.concat(cargs, ", ") .. ")" end --- compile a call (F a1..an) in expression position -local function ccall(form, env) +-- The form whose call cexpr_tail is compiling: the body of a lambda or +-- freeze, whose call is a Lua tail call and so is not counted (nt_call). +local TAIL_FORM = nil +local function cexpr_tail(form, env) + local saved = TAIL_FORM + TAIL_FORM = form + local s = cexpr(form, env) + TAIL_FORM = saved + return s +end + +-- compile a call (F a1..an) in expression position; `tail`: it is the +-- value of a Lua `return` (ctail), so it is not counted (nt_call) +local function ccall(form, env, tail) + -- a counting defun's own tail call: arguments that make counted calls are + -- hoisted into TAILPRE, to run before the count is restored (ret) + local hoist = tail and CNT and CNT.ret + tail = tail or form == TAIL_FORM + if tail and not (is_symbol(car(form)) and not env[car(form).name] + and LEAF[car(form).name]) then + TCOUNT = TCOUNT + 1 + end + local n0 = NTCOUNT local head = car(form) local args = to_array(cdr(form)) local cargs = {} for i=1,#args do cargs[i] = cexpr(args[i], env) end + local function hoist_args(hv) + local vs = {} + if hv then vs[1] = hv end + for i = 1, #cargs do vs[#vs + 1] = cargs[i] end + local ts = {} + if #vs > 40 then + -- one local, not one per argument (Lua's 200-locals cap) + local t = gen("t") + for i = 1, #vs do ts[i] = t .. "[" .. i .. "]" end + TAILPRE = "local " .. t .. " = {" .. table.concat(vs, ", ") .. "}; " + else + for i = 1, #vs do ts[i] = gen("t") end + TAILPRE = "local " .. table.concat(ts, ", ") .. " = " .. table.concat(vs, ", ") .. "; " + end + local k = hv and 1 or 0 + for i = 1, #cargs do cargs[i] = ts[i + k] end + return hv and ts[1] + end + if hoist and NTCOUNT ~= n0 and is_symbol(head) and not env[head.name] then + hoist_args(nil) + end local argstr = table.concat(cargs, ", ") -- Chain-hoist purity: this application runs after its args; anything the -- statement evaluates after it may no longer be hoisted ahead of it unless @@ -950,6 +1082,7 @@ local function ccall(form, env) return "TL(" .. argstr .. ")" end if name == "thaw" and ar == 1 then + if not tail then return nt_call("THAW", argstr, 1) end return "THAW(" .. argstr .. ")" end -- `(intern "foo")` is a compile-time intern (shen-scheme: quote). @@ -999,6 +1132,9 @@ local function ccall(form, env) if name == "absvector?" and ar == 1 then return "getmetatable(" .. argstr .. ")==VMT" end + if not tail and not LEAF[name] then + return nt_call(callee_ref(name), argstr, #args) + end return callee_ref(name) .. "(" .. argstr .. ")" else -- Arity mismatch at compile time: route through APP so dispatch uses @@ -1013,19 +1149,29 @@ local function ccall(form, env) -- redefining `depth` from 3 to 4 args). Baking the stale arity into -- PARTIAL / over-app expressions would silently produce wrong-arity -- residual closures. + if not tail then + return nt_call("APP", symlit(name) .. (#args > 0 and (", " .. argstr) or ""), #args + 1) + end if #args == 0 then return "APP(" .. symlit(name) .. ")" end return "APP(" .. symlit(name) .. ", " .. argstr .. ")" end else -- unknown arity (typically a forward reference: a function defined -- later in the same file) -> late-bound fixed-arity dispatch - return unknown_call(name, argstr, #args) + return unknown_call(name, argstr, #args, tail) end else - local cur = curried_call(form, env) - if cur then return cur end + local cur = curried_call(form, env, tail) + if cur and not (hoist and NTCOUNT ~= n0) then return cur end -- head is a bound variable or a compound expression -> generic apply local hv = cexpr(head, env) + if hoist and NTCOUNT ~= n0 then + hv = hoist_args(hv) + argstr = table.concat(cargs, ", ") + end + if not tail then + return nt_call("APP", hv .. (#args > 0 and (", " .. argstr) or ""), #args + 1) + end if #args == 0 then return "APP(" .. hv .. ")" end return "APP(" .. hv .. ", " .. argstr .. ")" end @@ -1602,6 +1748,29 @@ local function push_inline_cont() return saved end +-- The statements of a lambda body (`params`: its parameter list), compiled +-- as a function of its own that counts itself like a defun's impl (see +-- NT_SRC): a lambda called by a tail call holds no counted caller frame. +-- On the segment path it finds itself with debug.getinfo (SEGSELF). +local function counted_body(form, env, params) + local saved_self, saved_h, saved_cc, saved_fnl = SELF, HOIST, CCACHE, FNL + local saved_cont = push_inline_cont() + local saved_impl, saved_cnt = IN_IMPL, CNT + SELF = nil; HOIST = nil; CCACHE = {}; FNL = new_fnl(true); IN_IMPL = false + local owner = { used = false, tok = "\1" .. gen("k") .. "\1" } + CNT = { owner = owner, ret = true } + local body = ctail(form, env) + if FNL.pt then body = "local PT = {}; " .. body end + SELF = saved_self; HOIST = saved_h; CCACHE = saved_cc; FNL = saved_fnl + CONT = saved_cont; IN_IMPL = saved_impl; CNT = saved_cnt + if not owner.used then return (body:gsub(owner.tok, "")) end + CTX.sd = true + local dv = gen("d") + return "local " .. dv .. " = SD[1]; if " .. dv .. " >= " .. SEG_FRAMES + .. " then local r = SEGSELF(" .. params .. "); return r end; SD[1] = " + .. dv .. " + 1; " .. (body:gsub(owner.tok, "SD[1] = " .. dv .. "; ")) +end + -- ------------------------------------------------------------------ -- cexpr : value position (returns a Lua expression string) -- ------------------------------------------------------------------ @@ -1679,17 +1848,23 @@ function cexpr(form, env) local saved_self = SELF local saved_h, saved_cc, saved_fnl = HOIST, CCACHE, FNL local saved_cont = push_inline_cont() - local saved_impl = IN_IMPL + local saved_impl, saved_cnt = IN_IMPL, CNT SELF = nil; HOIST = nil; CCACHE = {}; FNL = new_fnl(true); IN_IMPL = false + -- runs inside the enclosing frame: its calls count for the defun + CNT = CNT and { owner = CNT.owner, ret = false } + local n0, t0 = NTCOUNT, TCOUNT local body_stmts = ctail(form, env) if FNL.pt then body_stmts = "local PT = {}; " .. body_stmts end SELF = saved_self; HOIST = saved_h; CCACHE = saved_cc; FNL = saved_fnl - CONT = saved_cont; IN_IMPL = saved_impl + CONT = saved_cont; IN_IMPL = saved_impl; CNT = saved_cnt local idx = #CTX.cbodies + 1 CTX.cbodies[idx] = "function(" .. params .. ") " .. body_stmts .. " end" -- The KC call itself may raise or side-effect: later siblings in the -- enclosing statement must not hoist chains ahead of it. if HOIST then HOIST.pure = false end + if (NTCOUNT ~= n0 or TCOUNT ~= t0) and form ~= TAIL_FORM then + return nt_call("KC[" .. idx .. "]", params, #lnames) + end return "KC[" .. idx .. "](" .. params .. ")" end -- No per-defun context (top-level eval chunk): fall back to the IIFE. @@ -1717,10 +1892,14 @@ function cexpr(form, env) local e2 = extend(env, v.name, ln) -- Deferred body: nothing inside may be hoisted to the creation site. -- Not impl-scope: `fN` locals live in impl, not this nested function. - local saved_h, saved_impl = HOIST, IN_IMPL - HOIST = nil; IN_IMPL = false - local bodyc = cexpr(body, e2) - HOIST = saved_h; IN_IMPL = saved_impl + if CTX then + -- a function of its own that counts itself, like a defun's impl + return "MKFUN(1, function(" .. ln .. ") " .. counted_body(body, e2, ln) .. " end)" + end + local saved_h, saved_impl, saved_cnt = HOIST, IN_IMPL, CNT + HOIST = nil; IN_IMPL = false; CNT = nil -- runs outside this frame + local bodyc = cexpr_tail(body, e2) + HOIST = saved_h; IN_IMPL = saved_impl; CNT = saved_cnt return "MKFUN(1, function(" .. ln .. ") return " .. bodyc .. " end)" elseif op == "freeze" then local body = car(cdr(form)) @@ -1737,20 +1916,20 @@ function cexpr(form, env) for kname in pairs(fv) do lnames[#lnames+1] = env[kname] end table.sort(lnames) -- stable order for caller / body -- Deferred body: nothing inside may be hoisted to the creation site. - local saved_h, saved_impl = HOIST, IN_IMPL - HOIST = nil; IN_IMPL = false - local body_str = cexpr(body, env) - HOIST = saved_h; IN_IMPL = saved_impl + local saved_h, saved_impl, saved_cnt = HOIST, IN_IMPL, CNT + HOIST = nil; IN_IMPL = false; CNT = nil -- runs outside this frame + local body_str = cexpr_tail(body, env) + HOIST = saved_h; IN_IMPL = saved_impl; CNT = saved_cnt local idx = #CTX.cbodies + 1 CTX.cbodies[idx] = "function(" .. table.concat(lnames, ", ") .. ") return " .. body_str .. " end" local call_args = (#lnames == 0) and "" or (", " .. table.concat(lnames, ", ")) return "BIND(KC[" .. idx .. "]" .. call_args .. ")" end - local saved_h, saved_impl = HOIST, IN_IMPL - HOIST = nil; IN_IMPL = false - local bodyc = cexpr(body, env) - HOIST = saved_h; IN_IMPL = saved_impl + local saved_h, saved_impl, saved_cnt = HOIST, IN_IMPL, CNT + HOIST = nil; IN_IMPL = false; CNT = nil -- runs outside this frame + local bodyc = cexpr_tail(body, env) + HOIST = saved_h; IN_IMPL = saved_impl; CNT = saved_cnt return "MKFUN(0, function() return " .. bodyc .. " end)" elseif op == "defun" then error("defun in expression position") @@ -1825,7 +2004,7 @@ end -- ------------------------------------------------------------------ function ctail(form, env) if not is_cons(form) then - return "return " .. (type(form)=="number" and cnum(form) or catom(form, env)) + return ret(type(form)=="number" and cnum(form) or catom(form, env)) end local head = car(form) if is_symbol(head) and not env[head.name] then @@ -1850,7 +2029,7 @@ function ctail(form, env) -- truthiness, which is what the old `if (test)` dispatched on) local saved_cc = CCACHE CCACHE = child_cache() - local els = el and ctail(el, env) or "return false" + local els = el and ctail(el, env) or ret("false") CCACHE = saved_cc return pre .. "if not (" .. testc .. ") then " .. els .. " end " .. ctail(th, env) @@ -1918,24 +2097,33 @@ function ctail(form, env) -- semantically identical and costs O(1) nesting per link. local a = car(cdr(form)); local b = car(cdr(cdr(form))) local pre, ac = cstmt_expr(a, env) - return pre .. "if not (" .. ac .. ") then return false end " .. ctail(b, env) + return pre .. "if not (" .. ac .. ") then " .. ret("false") .. " end " .. ctail(b, env) elseif op == "or" then local a = car(cdr(form)); local b = car(cdr(cdr(form))) local pre, ac = cstmt_expr(a, env) - return pre .. "if (" .. ac .. ") then return true end " .. ctail(b, env) + return pre .. "if (" .. ac .. ") then " .. ret("true") .. " end " .. ctail(b, env) elseif op == "trap-error" then + local n0 = NTCOUNT local opt = try_trap_opt(form, env) - if opt then return "return " .. opt end + if opt then return ret(opt, NTCOUNT ~= n0) end local expr = car(cdr(form)) local handler = car(cdr(cdr(form))) -- (trap-error E H): if E raises a Shen exception, apply H to it. + n0 = NTCOUNT local hc = cexpr(handler, env) + local apply + TCOUNT = TCOUNT + 1 + if NTCOUNT ~= n0 and CNT and CNT.ret then + apply = "do local h = " .. hc .. "; " .. ret("APP(h, TOEXCN(res))") .. " end" + else + apply = ret("APP(" .. hc .. ", TOEXCN(res))") + end return "local ok,res = pcall(function() return " .. cexpr(expr, env) - .. " end); if ok then return res else return APP(" .. hc .. ", TOEXCN(res)) end" + .. " end); if ok then " .. ret("res") .. " else " .. apply .. " end" elseif op == "type" then return ctail(car(cdr(form)), env) elseif op == "lambda" or op == "freeze" then - return "return " .. cexpr(form, env) + return ret(cexpr(form, env)) else local ct = try_cont_thaw(form, env, true) if ct then return ct end @@ -1965,10 +2153,15 @@ function ctail(form, env) HOIST = saved_h return pre .. selfjump end - local callc = ccall(form, env) + TAILPRE = nil + local callc = ccall(form, env, true) local pre = table.concat(HOIST.out) HOIST = saved_h - return pre .. "return " .. callc + if TAILPRE then + pre = pre .. "do " .. TAILPRE; TAILPRE = nil + return pre .. ret(callc) .. " end" + end + return pre .. ret(callc) end else local floated = try_let_float(form, env) @@ -1977,10 +2170,15 @@ function ctail(form, env) if flat then return flat end local saved_h = HOIST HOIST = { out = {}, pure = true } - local callc = ccall(form, env) + TAILPRE = nil + local callc = ccall(form, env, true) local pre = table.concat(HOIST.out) HOIST = saved_h - return pre .. "return " .. callc + if TAILPRE then + pre = pre .. "do " .. TAILPRE; TAILPRE = nil + return pre .. ret(callc) .. " end" + end + return pre .. ret(callc) end end @@ -2040,7 +2238,17 @@ local function cdefun(form) local saved_in, saved_dn = IN_IMPL, DEFUN_NAME local saved_fl, saved_fm = FREF_LIST, FREF_MAP IN_IMPL, DEFUN_NAME, FREF_LIST, FREF_MAP = true, name, {}, {} + -- counted non-tail calls (see NT_SRC): impl counts itself, except a TRMC + -- step function, whose calls go through the trampoline + local saved_cnt = CNT + local owner = nil + if trmc then CNT = nil + else + owner = { used = false, tok = "\1" .. gen("k") .. "\1" } + CNT = { owner = owner, ret = true } + end local body_src = ctail(body, env) + CNT = saved_cnt local fref_decls = {} for i, r in ipairs(FREF_LIST) do fref_decls[i] = "local " .. r.ln .. " = F[" .. qstr(r.name) .. "];" @@ -2067,6 +2275,15 @@ local function cdefun(form) -- "continue" idiom). body_src = "while true do do " .. body_src .. " end ::tco:: end" end + if owner and owner.used then + local dv = gen("d") + body_src = (body_src:gsub(owner.tok, "SD[1] = " .. dv .. "; ")) + body_src = "local " .. dv .. " = SD[1]; if " .. dv .. " >= " .. SEG_FRAMES + .. " then return SEG(impl" .. (#lnames > 0 and (", " .. table.concat(lnames, ", ")) or "") + .. ") end; SD[1] = " .. dv .. " + 1; " .. body_src + elseif owner then + body_src = (body_src:gsub(owner.tok, "")) + end -- chain-hoist spill table (only when the local budget was exceeded); -- declared outside the tco loop: every PT slot is written before it is read -- on every path of every iteration, so one table per call suffices. @@ -2094,6 +2311,10 @@ local function cdefun(form) parts[#parts+1] = "};" kc_init = table.concat(parts, " ") .. " " end + local nt_init = "" + if CTX.nt or CTX.sd or (owner and owner.used) then + nt_init = "local SD, SEG, SEGSELF = SD, SEG, SEGSELF; " .. (CTX.nt and NT_SRC or "") + end CTX = saved local plist = table.concat(lnames, ", ") local src @@ -2102,7 +2323,7 @@ local function cdefun(form) local tl = {} for i = 1, #lnames do tl[i] = "T" .. i end local tlist = table.concat(tl, ", ") - src = "do " .. kc_init + src = "do " .. nt_init .. kc_init .. "local impl, TSTEP, TLOOP, TH" .. cm .. tlist .. "; " .. "TSTEP = function(" .. trmc_mode .. cm .. plist .. ") " .. body_src .. " end; " .. "TLOOP = function(h" .. cm .. plist .. ") " @@ -2118,7 +2339,7 @@ local function cdefun(form) .. "impl = function(" .. plist .. ") return TSTEP(false" .. cm .. plist .. ") end; " .. "F[" .. qstr(name) .. "] = impl; FA[impl] = " .. #params .. " end" else - src = "do " .. kc_init + src = "do " .. nt_init .. kc_init .. "local function impl(" .. plist .. ") " .. body_src .. " end " .. "F[" .. qstr(name) .. "] = impl; FA[impl] = " .. #params .. " end" @@ -2143,7 +2364,8 @@ end C.cexpr = cexpr C.ctail = ctail function C.compile_expr_chunk(form) - return "return (" .. cexpr(form, {}) .. ")" + -- the chunk's one call is not counted (nt_call): a single frame + return "return (" .. cexpr_tail(form, {}) .. ")" end -- compile any top-level form to a Lua statement string diff --git a/lua_interop.lua b/lua_interop.lua index ad04a1f..9457485 100644 --- a/lua_interop.lua +++ b/lua_interop.lua @@ -629,7 +629,8 @@ function M.call(name, ...) local n = select("#", ...) local a = { ... } for i = 1, n do a[i] = to_shen(a[i]) end - return to_lua(P.APP(fn, unpack(a, 1, n))) + -- R.seg.call: a caught error leaves the stack-segment count intact (#93) + return to_lua(R.seg.call(P.APP, fn, unpack(a, 1, n))) end function M.fn(name) diff --git a/prims.lua b/prims.lua index 6996169..cfe007b 100644 --- a/prims.lua +++ b/prims.lua @@ -7,6 +7,11 @@ local cons, is_cons, NIL = R.cons, R.is_cons, R.NIL local Symbol, intern, is_symbol = R.Symbol, R.intern, R.is_symbol local Excn, mkexcn = R.Excn, R.mkexcn local Vmt = R.Vmt -- absvector metatable (pure-array layout; shared with runtime.lua) +-- counted non-tail calls (runtime.lua stack segments, #93), written inline +-- where a native calls back into Shen code (a shared trampoline would look +-- like recursion to the trace recorder) +local SD, SEGRUN, SEG_FRAMES = R.seg.SD, R.seg.run, R.seg.FRAMES +local pcall = R.seg.pcall -- restores the segment count on a caught error local P = {} @@ -1114,7 +1119,12 @@ function P.install_native_stdlib() while true do if lst == NIL then return reverse_help(acc, NIL) end if is_cons(lst) then - acc = cons(APP(f, lst[1]), acc); lst = lst[2] + -- a counted call: a walker that recurses through map nests here + local v + local d = SD[1] + if d < SEG_FRAMES then SD[1] = d + 1; v = APP(f, lst[1]); SD[1] = d + else v = SEGRUN(APP, f, lst[1]) end + acc = cons(v, acc); lst = lst[2] else return orig_maph(f, lst, acc) end @@ -1625,7 +1635,10 @@ function P.install_native_stdlib() if last then return head else return NIL end end if not is_cons(lst) then return orig_mapcan(f, orig) end - local chunk = APP(f, lst[1]) + local chunk + local d = SD[1] -- a counted call (see map_h) + if d < SEG_FRAMES then SD[1] = d + 1; chunk = APP(f, lst[1]); SD[1] = d + else chunk = SEGRUN(APP, f, lst[1]) end if chunk ~= NIL then -- append copies the left spine; copy each chunk so we don't mutate -- a list the mapper returned that might be shared. A non-list chunk @@ -2418,13 +2431,19 @@ local ENV = { ADSET = function(v, i, x) v[i + 2] = x; return v end, VMT = Vmt, -- allow compiled code to reach a few Lua builtins safely - pcall = pcall, select = select, error = error, + -- trap-error's pcall restores the stack-segment count (runtime.lua, #93) + pcall = R.seg.pcall, select = select, error = error, setmetatable = setmetatable, getmetatable = getmetatable, type = type, math = math, string = string, table = table, } P.ENV = ENV +-- counted non-tail calls (runtime.lua stack segments, #93): the count slot, +-- the segment runner and the trampoline for code outside a defun +ENV.SD, ENV.SEG, ENV.SEGSELF, ENV.NTV = R.seg.SD, R.seg.run, R.seg.runself, R.seg.NTV +R.seg.set_error(ERR) + -- CALL0..CALLn: late-bound fixed-arity calls to a function NAMED at compile -- time whose arity was not yet known (forward references; see unknown_call -- in compiler.lua). Generated from one template so each is a plain diff --git a/prolog_engine.lua b/prolog_engine.lua index a37f430..1da99ed 100644 --- a/prolog_engine.lua +++ b/prolog_engine.lua @@ -41,6 +41,7 @@ if not ok_ffi then return { install = function() end } end local R = require("runtime") +local SD, SEGRUN, SEG_FRAMES = R.seg.SD, R.seg.run, R.seg.FRAMES local loadstring = loadstring or load -- 5.2+ shim (module is FFI-gated anyway) @@ -236,10 +237,6 @@ local SEG_FRAMES = 96 -- counted frames per segment: a typecheck local SEG_MAX = 1000 -- nested segments per query before giving up local seg_depth, seg_count = 0, 0 local seg_total = 0 -- segments ever opened (M.segments, diagnostics) -local co_create, co_resume, co_status, co_yield = - coroutine.create, coroutine.resume, coroutine.status, coroutine.yield -local unpack = unpack or table.unpack -local function pack(...) return { n = select("#", ...), ... } end -- Thaw `cont` on a fresh coroutine stack and return its value. Errors are -- rethrown unchanged (Shen exception objects included); a yield from inside @@ -251,17 +248,13 @@ local function thaw_segment(cont) local saved, saved_count = seg_depth, seg_count seg_count = seg_count + 1; seg_depth = 0 seg_total = seg_total + 1 - local co = co_create(thawH) - local res = pack(co_resume(co, cont)) - while res[1] and co_status(co) ~= "dead" do - local up = pack(pcall(co_yield, unpack(res, 2, res.n))) - if not up[1] then res = up; break end -- no coroutine to yield to - res = pack(co_resume(co, unpack(up, 2, up.n))) - end + -- the runtime's segment runner (runtime.lua, #93): its nesting cap covers + -- both kinds of segment, which share one C stack + local ok, r = pcall(SEGRUN, thawH, cont) -- assign, not decrement: segments abandoned while suspended never return seg_count, seg_depth = saved_count, saved - if not res[1] then error(res[2], 0) end - return res[2] + if not ok then error(r, 0) end + return r end -- thawH for a non-tail site: counts the frame, or opens a segment. The @@ -621,7 +614,16 @@ local function import(x, varmap) end local tail = import(x, varmap) for i = sn, 1, -1 do - tail = mkcons(import(spine[i], varmap), tail) + local e = spine[i] + if getmt(e) == Cons then + -- car nesting recurses: count it (runtime.lua stack segments, #93) + local d = SD[1] + if d < SEG_FRAMES then SD[1] = d + 1; e = import(e, varmap); SD[1] = d + else e = SEGRUN(import, e, varmap) end + else + e = import(e, varmap) + end + tail = mkcons(e, tail) end return tail elseif getmt(x) == Vmt and x[2] == shen_pvar then diff --git a/repl.lua b/repl.lua index 80388c5..6e798da 100644 --- a/repl.lua +++ b/repl.lua @@ -324,7 +324,8 @@ function M.run(opts) end if buf:match("%S") then ed.remember(buf) - local ok, r = xpcall(function() return eval_input(buf) end, handler) + -- the runtime's xpcall restores the stack-segment count (#93) + local ok, r = require("runtime").seg.xpcall(function() return eval_input(buf) end, handler) if not ok then -- r is the handler capture, unless something threw inside the -- handler itself (then r is whatever Lua gives us). diff --git a/runtime.lua b/runtime.lua index 4621aaf..d8975f6 100644 --- a/runtime.lua +++ b/runtime.lua @@ -292,4 +292,102 @@ M.to_str = to_str M.shortest_float = shortest_float M.num_to_str = num_to_str +---------------------------------------------------------------------- +-- Lua stack segments (pyrex41/shen-lua#93) +---------------------------------------------------------------------- +-- LuaJIT's Lua stack is a fixed ~65500 slots per coroutine (LJ_STACK_MAX, +-- a compile-time constant), so non-tail recursion in compiled KL -- the +-- kernel's own tree walkers (shen.curry, shen.find-types, +-- shen.process-applications) and user code alike -- overflowed after about +-- 12k frames, where shen-go grows its stack. Every coroutine has its own +-- stack, so deep recursion continues on a fresh one (a segment), as the +-- Prolog engine already does for deep proofs (#85). +-- +-- SD[1] counts the compiled functions on the current stack that are waiting +-- on a non-tail call (compiler.lua NT_SRC: such a function counts itself on +-- entry and restores the count before it returns or tail-calls). Once +-- SEG_FRAMES of them are open, the next one runs on a new coroutine instead +-- (M.seg.run). Tail calls are never counted, so a loop that runs in constant +-- stack never opens a segment. NTV is the trampoline form for code outside +-- a defun; natives that call back into Shen code count inline. +-- +-- An error unwinds past the restores, so the catch points restore the count +-- by assignment: M.seg.pcall / .xpcall (the compiled trap-error and the +-- runtime's own pcalls use them), M.seg.call (host entry points, so an error +-- a host catches does not leak the count) and the segment runner itself. +do + local co_create, co_resume, co_status, co_yield = + coroutine.create, coroutine.resume, coroutine.status, coroutine.yield + local unpack = unpack or table.unpack + local SEG_FRAMES = 160 -- counted calls per segment (C.SEG_FRAMES) + local SEG_MAX = 10000 -- nested segments: each costs ~200 bytes of C stack + local SD = { 0 } -- counted calls open on the current stack + local nseg, total = 0, 0 + local ERR = function(msg) error(msg, 0) end + local function pack(...) return { n = select("#", ...), ... } end + local S = { SD = SD, FRAMES = SEG_FRAMES } + + -- Run f(...) on a fresh coroutine stack and return its value. Errors are + -- rethrown unchanged (Shen exception objects included); a yield from + -- inside (an embedding host's) is passed through to the enclosing + -- coroutine. + function S.run(f, ...) + if nseg >= SEG_MAX then + ERR("Lua stack depth limit exceeded (" .. SEG_MAX .. " stack segments)") + end + local saved, saved_n = SD[1], nseg + nseg = nseg + 1; SD[1] = 0 + total = total + 1 + local co = co_create(f) + local res = pack(co_resume(co, ...)) + while res[1] and co_status(co) ~= "dead" do + local up = pack(pcall(co_yield, unpack(res, 2, res.n))) + if not up[1] then res = up; break end -- no coroutine to yield to + res = pack(co_resume(co, unpack(up, 2, up.n))) + end + -- assign, not decrement: segments abandoned while suspended never return + SD[1], nseg = saved, saved_n + if not res[1] then error(res[2], 0) end + return res[2] + end + local run = S.run + -- S.run for the function that called it (a lambda has no name to pass) + local getinfo = debug and debug.getinfo + function S.runself(...) + return run(getinfo(2, "f").func, ...) + end + + -- the trampoline outside a defun (vararg: a FUNCV entry never starts a + -- root trace of its own) + function S.NTV(f, ...) + local d = SD[1] + if d < SEG_FRAMES then SD[1] = d + 1; local r = f(...); SD[1] = d; return r end + return run(f, ...) + end + + local function restore(d, ok, ...) + if not ok then SD[1] = d end + return ok, ... + end + local function rethrow(d, ok, ...) + if not ok then SD[1] = d; error((...), 0) end + return ... + end + function S.pcall(f, ...) return restore(SD[1], pcall(f, ...)) end + function S.xpcall(f, h) return restore(SD[1], xpcall(f, h)) end + -- f(...) for a host entry point + function S.call(f, ...) return rethrow(SD[1], pcall(f, ...)) end + + -- segments ever opened, nested now, counted calls open on this stack + function S.stats() return total, nseg, SD[1] end + -- set the nesting cap (tests); returns the previous value + function S.limit(max) + local m0 = SEG_MAX + SEG_MAX = max or m0 + return m0 + end + function S.set_error(fn) ERR = fn end + M.seg = S +end + return M diff --git a/scripts/run-tests.lua b/scripts/run-tests.lua index 29a9dcd..2230c09 100644 --- a/scripts/run-tests.lua +++ b/scripts/run-tests.lua @@ -47,6 +47,7 @@ local specs = { "test/prolog_semantics_spec.lua", "test/reader_spec.lua", "test/repl_spec.lua", + "test/stack_segments_spec.lua", "test/stdlib_spec.lua", "test/tailcall_spec.lua", "test/typecheck_api_spec.lua", diff --git a/shen.lua b/shen.lua index 3bbf0ab..5c5e135 100644 --- a/shen.lua +++ b/shen.lua @@ -12,6 +12,8 @@ -- machinery is reimplemented. local R = require("runtime") +-- restores the stack-segment count on a caught error (runtime.lua, #93) +local pcall = R.seg.pcall local P = require("boot") -- boot.lua returns the prims module P, fully wired local checked_integer = require("checked_integer") @@ -79,8 +81,7 @@ end -- with the kernel's own reader (read-from-string -> list of forms) and (eval) -- each form through the real macroexpand/shen->kl pipeline. Returns the value -- of the last form (a Shen value: number/string/boolean/symbol/cons/...). -function shen.eval(src) - ensure_boot() +local function eval_forms(src) local forms = P.F["read-from-string"](src) local last while R.is_cons(forms) do @@ -90,6 +91,11 @@ function shen.eval(src) return last end +function shen.eval(src) + ensure_boot() + return R.seg.call(eval_forms, src) +end + -- ---- call / fn ------------------------------------------------------------ -- Call the Shen function `name` with Lua values as arguments. Arity is -- handled by the existing P.APP machinery: fewer args than the function's @@ -99,7 +105,7 @@ function shen.call(name, ...) ensure_boot() local fn = P.F[name] if fn == nil then error("shen.call: undefined function: " .. tostring(name), 2) end - return P.APP(fn, ...) + return R.seg.call(P.APP, fn, ...) end -- A plain Lua callable for the Shen function `name`. The F-table lookup is diff --git a/test/stack_segments_spec.lua b/test/stack_segments_spec.lua new file mode 100644 index 0000000..3b7ddd7 --- /dev/null +++ b/test/stack_segments_spec.lua @@ -0,0 +1,152 @@ +-- test/stack_segments_spec.lua — deep non-tail recursion on fresh coroutine +-- stacks (runtime.lua M.seg, compiler.lua NT_SRC; pyrex41/shen-lua#93). +-- luajit test/stack_segments_spec.lua +-- Covers: recursion far past one LuaJIT stack through each kind of call site +-- (direct, mutual, APP, forward reference, native map callback, trap-error, +-- value-position control forms, freeze/thaw, lambdas), constant-stack loops +-- opening no segment, the count returning to its start after errors, Shen +-- errors crossing segments unchanged, and the trappable nesting limit. +package.path = (arg[0]:gsub("test/[^/]*$", "")) .. "?.lua;" .. package.path + +local shen = require("shen") +shen.boot{quiet = true} +local R = shen.runtime + +local npass, nfail = 0, 0 +local function check(cond, name) + if cond then npass = npass + 1 + else + nfail = nfail + 1 + io.write("FAIL: ", name, "\n") + end +end + +local ev = shen.eval + +-- evaluate; returns ok, value-or-message, segments opened, count afterwards +local function run(s) + local t0 = R.seg.stats() + local d0 = R.seg.SD[1] + local ok, v = R.seg.pcall(ev, s) + local t1, _, d1 = R.seg.stats() + if not ok then + v = getmetatable(v) == R.Excn and v.msg or tostring(v) + end + return ok, v, t1 - t0, d1 - d0 +end + +local DEEP = 100000 -- ~8x what one LuaJIT stack held + +local function deep(name, defs, call, want) + ev(defs) + local ok, v, segs, drift = run(call) + check(ok and v == want, name .. ": " .. tostring(v)) + check(segs > 0, name .. ": opened segments (" .. segs .. ")") + check(drift == 0, name .. ": count back to its start") +end + +deep("direct", "(define ss-d N -> (if (= N 0) 0 (+ 1 (ss-d (- N 1)))))", + "(ss-d " .. DEEP .. ")", DEEP) +deep("mutual", [[ + (define ss-ma N -> (if (= N 0) 0 (+ 1 (ss-mb (- N 1))))) + (define ss-mb N -> (if (= N 0) 0 (+ 1 (ss-ma (- N 1)))))]], + "(ss-ma " .. DEEP .. ")", DEEP) +deep("APP (function argument)", + "(define ss-h F N -> (if (= N 0) 0 (+ 1 (F F (- N 1)))))", + "(ss-h (function ss-h) " .. DEEP .. ")", DEEP) +-- ss-fa calls ss-fb before it is defined: a CALLn forward reference +deep("forward reference", [[ + (define ss-fa N -> (if (= N 0) 0 (+ 1 (ss-fb (- N 1))))) + (define ss-fb N -> (ss-fa N))]], + "(ss-fa " .. DEEP .. ")", DEEP) +deep("native map callback", + "(define ss-nest N -> (if (= N 0) [] [(ss-nest (- N 1))]))" + .. "(define ss-walk X -> (if (cons? X) (map (function ss-walk) X) X))" + .. "(define ss-depth X -> (if (cons? X) (+ 1 (ss-depth (hd X))) 0))", + "(ss-depth (ss-walk (ss-nest " .. DEEP .. ")))", DEEP) +deep("trap-error body", + "(define ss-t N -> (if (= N 0) 0 (+ 1 (trap-error (ss-t (- N 1)) (/. E -1)))))", + "(ss-t " .. DEEP .. ")", DEEP) +deep("value-position if", + "(define ss-v N -> (+ 1 (if (= N 0) -1 (ss-v (- N 1)))))", + "(ss-v " .. DEEP .. ")", DEEP) +deep("freeze/thaw", + "(define ss-z N -> (if (= N 0) 0 (+ 1 (thaw (freeze (ss-z (- N 1)))))))", + "(ss-z " .. DEEP .. ")", DEEP) +deep("lambda body", + "(define ss-l N -> (if (= N 0) 0 ((/. X (+ 1 (ss-l X))) (- N 1))))", + "(ss-l " .. DEEP .. ")", DEEP) +deep("list built non-tail", "(define ss-mk N -> (if (= N 0) [] [N (ss-mk (- N 1))]))" + .. "(define ss-len X -> (if (cons? X) (+ 1 (ss-len (hd (tl X)))) 0))", + "(ss-len (ss-mk " .. DEEP .. "))", DEEP) + +-- a let chain long enough that the compiler splits it into a function of +-- its own (wide_compile, #84): the split part counts itself +do + local binds = {} + for i = 1, 140 do + binds[i] = "A" .. i .. " (+ " .. (i == 1 and "N" or ("A" .. (i - 1))) .. " 1)" + end + deep("split let chain", + "(define ss-sl N -> (let " .. table.concat(binds, " ") + .. " (if (= N 0) 0 (+ 1 (ss-sl (- N 1))))))", + "(ss-sl " .. DEEP .. ")", DEEP) +end + +-- tail calls stay tail calls: a constant-stack loop opens no segment, even +-- when the looping function counts itself and its arguments make calls +do + ev([[(define ss-id X -> X) + (define ss-loop N Acc -> (if (= N 0) Acc (ss-loop (ss-id (- N 1)) (+ Acc (ss-id 1))))) + (define ss-pa N -> (if (= N 0) done (ss-pb (ss-id (- N 1))))) + (define ss-pb N -> (ss-pa N))]]) + local ok, v, segs, drift = run("(ss-loop 1000000 0)") + check(ok and v == 1000000 and segs == 0 and drift == 0, "self tail loop: no segment") + ok, v, segs, drift = run("(ss-pa 1000000)") + check(ok and v == R.intern("done") and segs == 0 and drift == 0, + "mutual tail loop: no segment") + -- continuations calling each other in tail position through lambdas + ev([[(define ss-cps N K -> (if (= N 0) (K 0) (ss-cps (- N 1) (/. X (K (ss-id X))))))]]) + ok, v, segs, drift = run("(ss-cps 300000 (/. X X))") + check(ok and v == 0 and segs == 0 and drift == 0, "lambda tail chain: no segment") +end + +-- a Shen error raised deep inside crosses every segment unchanged, and the +-- count is back at its start once it is caught +do + ev("(define ss-e N -> (if (= N 0) (simple-error \"bottom\") (+ 1 (ss-e (- N 1)))))") + local ok, v, segs, drift = run("(trap-error (ss-e " .. DEEP .. ") (/. E (error-to-string E)))") + check(ok and v == "bottom", "deep error caught by trap-error: " .. tostring(v)) + check(segs > 0 and drift == 0, "deep error: count restored") + ok, v, segs, drift = run("(ss-e " .. DEEP .. ")") + check(not ok and v == "bottom" and drift == 0, "deep error to the host: count restored") + -- many caught errors from a few calls down never leak the count: a + -- shallow call afterwards still opens no segment + ev("(define ss-e3 N -> (+ 1 (+ 1 (ss-e 3))))") + for _ = 1, 500 do run("(trap-error (ss-e3 0) (/. E 0))") end + ok, v, segs, drift = run("(ss-d 50)") + check(ok and v == 50 and segs == 0 and R.seg.SD[1] == 0, "no leak after 500 trapped errors") +end + +-- the nesting cap raises a trappable Shen error instead of exhausting the C +-- stack: at the default cap (10000 segments of 160) ... +do + local ok, v, _, drift = run("(trap-error (ss-d 2000000) (/. E (error-to-string E)))") + check(ok and type(v) == "string" and v:find("stack depth limit exceeded", 1, true) + and drift == 0, "default nesting cap is a trappable error: " .. tostring(v)) +end +-- ... and at a lowered one +do + local old = R.seg.limit(3) + local ok, v = run("(trap-error (ss-d " .. DEEP .. ") (/. E (error-to-string E)))") + R.seg.limit(old) + check(ok and type(v) == "string" and v:find("stack depth limit exceeded", 1, true), + "nesting cap is a trappable error: " .. tostring(v)) + local _, n = R.seg.stats() + check(n == 0 and R.seg.SD[1] == 0, "nesting cap: state restored") + ok, v = run("(ss-d " .. DEEP .. ")") + check(ok and v == DEEP, "deep recursion works again after the cap") +end + +io.write(string.format("stack_segments_spec: %d pass, %d fail\n", npass, nfail)) +os.exit(nfail == 0 and 0 or 1)