session SQLite rewrite: FTS5 search, import migration, CLI resume-by-index
ober
92bab144fca72763d7a062040467f8df5ed4e9ac
--- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -12,6 +12,7 @@ current-provider-override current-model-override current-compact-agent-context + current-local-provider-prompt? current-do-it-mode? current-do-it-max-continuations do-it-terminal-response? @@ -56,10 +57,12 @@ (def current-provider-override (make-parameter #f)) (def current-model-override (make-parameter #f)) (def current-compact-agent-context (make-parameter #f)) +(def current-local-provider-prompt? (make-parameter #f)) (def current-do-it-mode? (make-parameter #f)) (def current-do-it-max-continuations (make-parameter #f)) (def *small-context-instruction-bytes* 3600) +(def *local-working-context-window* 32768) (def *do-it-done-marker* "[doit:done]") (def *do-it-blocked-marker* "[doit:blocked]") (def *do-it-continuation-prompt* @@ -95,14 +98,27 @@ (def (compact-agent-context?) (or (current-compact-agent-context) + (current-local-provider-prompt?) (small-context-model? (active-model-id)))) +(def (local-compaction-window model-id) + (let ((win (model-context-window model-id))) + (min (or win *local-working-context-window*) *local-working-context-window*))) + +(def (agent-compaction-window model-id) + (if (current-local-provider-prompt?) + (local-compaction-window model-id) + (model-context-window model-id))) + (def (with-provider-prompt-context provider thunk) - (let ((small? (small-context-provider? provider))) - (parameterize ((current-compact-agent-context small?) - (current-compact-tool-schemas small?) + (let* ((small? (small-context-provider? provider)) + (local? (provider-local? provider)) + (compact? (or small? local?))) + (parameterize ((current-compact-agent-context compact?) + (current-local-provider-prompt? local?) + (current-compact-tool-schemas compact?) (current-tool-allowlist - (if small? *small-context-tools* (current-tool-allowlist)))) + (if compact? *small-context-tools* (current-tool-allowlist)))) (thunk)))) ;; Forge guardrail policy. The guardrail layer (unknown-tool nudge + retry @@ -368,14 +384,15 @@ Be concise. Prefer edit over write for modifying existing files. ((equal? (message-role (car messages)) "system") (cons fresh (cdr messages))) (else (cons fresh messages)))) - (mdl (or (current-model-override) (config-ref "model") ""))) + (mdl (or (current-model-override) (config-ref "model") "")) + (budget (agent-compaction-window mdl))) (cond - ((should-compact? rebuilt mdl) - ;; Dispatch to the configured strategy (default Tiered). Small local - ;; models use an effective budget that reserves fixed tool-schema - ;; overhead outside the message list. + ((should-compact-for-budget? rebuilt mdl budget) + ;; Dispatch to the configured strategy (default Tiered). Local providers + ;; use an interactive working budget so large architectural windows do + ;; not permit multi-minute prompt prefill before compaction. (run-configured-compaction rebuilt - (effective-compaction-budget (model-context-window mdl)))) + (effective-compaction-budget budget))) (else rebuilt)))) (def (truncated-dir) --- a/src/jcode/core/compaction.ss +++ b/src/jcode/core/compaction.ss @@ -26,6 +26,7 @@ compaction-config effective-compaction-budget should-compact? + should-compact-for-budget? estimate-message-tokens) (import :std/misc/string @@ -87,10 +88,10 @@ ((and win (<= win 4096)) (max 512 (- win 2500))) (else win))) -(def (should-compact? messages model-id) +(def (should-compact-for-budget? messages model-id budget) (let* ((auto (compaction-config 'auto)) (pct (compaction-config 'trigger_pct)) - (win (effective-compaction-budget (model-context-window model-id))) + (win (effective-compaction-budget budget)) (est (estimate-message-tokens messages)) (yes? (and auto win pct (> est 0) (>= (* 100 est) (* pct win))))) @@ -102,6 +103,9 @@ (trigger_pct . ,pct)))) yes?)) +(def (should-compact? messages model-id) + (should-compact-for-budget? messages model-id (model-context-window model-id))) + (def (compact-messages messages) "Return a new message list with older bulky content stubbed out. Safe on any list — preserves system, user/assistant/tool ordering, and new file mode 100644 --- /dev/null +++ b/src/jcode/core/crashlog.ss @@ -0,0 +1,213 @@ +;;; jcode crash log — durable record of segfaults and other unrecoverable +;;; exceptions caught at top-level loops so a crash can be debugged offline. +;;; +;;; Chez Scheme delivers SIGSEGV (and other foreign-procedure faults) as +;;; R6RS conditions: typically (make-message-condition +;;; "~?. Some debugging context lost") displayed as +;;; "Exception: invalid memory reference. Some debugging context lost". +;;; `guard` and the jerboa `try`/`catch` both catch them. Without a top-level +;;; handler the process simply dies and the user sees the raw message on the +;;; TTY; with one, the loop can log and continue. +;;; +;;; The crash log is a single append-only file (default ~/.jcode/crash.log) +;;; kept separate from the trace log so it stays small and greppable even when +;;; tracing is off. Writes are serialized on the same raw mutex used by log.ss +;;; to avoid interleaving across the main TUI thread, worker threads, and any +;;; debug-REPL thread. + +(export open-crash-log! + close-crash-log! + crash-log-path + log-crash! + with-crash-recovery + with-crash-recovery* + current-crash-recovery-default) + +(import :std/misc/string + :jcode/core/config + ;; Use Chez's raw mutex directly so `with-mutex` works on it. + ;; The prelude shadows make-mutex with a Gerbil-wrapped variant + ;; that with-mutex (a Chez macro) cannot operate on. + (rename (only (chezscheme) make-mutex) + (make-mutex raw-make-mutex))) + +;; ---- State ---- + +(def *crash-port* #f) +(def *crash-path* #f) + +;; Serialize all crash-log writes. Shared with log.ss's *log-mutex* model: +;; concurrent fprintf from multiple threads can interleave inside the port +;; buffer and -- in some Chez builds -- deadlock when port-internal locks +;; are taken in different orders. +(def *crash-mutex* (raw-make-mutex)) + +;; Default value returned by with-crash-recovery when the guarded body +;; raises. (void) keeps existing call sites that ignore the result working +;; without change; callers can parameterize to a richer fallback +;; (e.g. (cons 'error "recovered")). Set via parameterize for tests or +;; scoped overrides. +(def *crash-recovery-default* (make-parameter (void))) + +(def (current-crash-recovery-default . args) + (if (null? args) + (*crash-recovery-default*) + (*crash-recovery-default* (car args)))) + +(def (crash-log-path) + "Path of the active crash log, or #f when no crash log is open." + *crash-path*) + +(def (pad3 n) + (cond ((>= n 100) (number->string n)) + ((>= n 10) (string-append "0" (number->string n))) + (else (string-append "00" (number->string n))))) + +(def (crash-timestamp) + (let ((t (current-time))) + (string-append + (number->string (time-second t)) + "." + (pad3 (quotient (time-nanosecond t) 1000000))))) + +(def (open-crash-log! . maybe-path) + "Open the crash log at MAYBE-PATH (or ~/.jcode/crash.log by default) + for append. Idempotent: calling again with a new path closes the old + one first. Line-buffered for crash safety. Never raises — if the path + cannot be opened, the crash log is silently disabled and log-crash! + becomes a no-op so a logging failure never takes down the agent." + (let ((path (if (pair? maybe-path) (car maybe-path) + (path-join (jcode-home) "crash.log")))) + (close-crash-log!) + (guard (e [else + (fprintf (current-error-port) + "[jcode] could not open crash log ~a: ~a~n" + path (err->string e)) + (set! *crash-port* #f) + (set! *crash-path* #f)]) + (let ((port (open-file-output-port + path + (file-options no-fail append) + (buffer-mode line) + (make-transcoder (utf-8-codec))))) + (set! *crash-port* port) + (set! *crash-path* path) + (fprintf port "~a ==== jcode crash log started ====~n" (crash-timestamp)) + (flush-output-port port))))) + +(def (close-crash-log!) + "Close the crash log if open. Never raises." + (when *crash-port* + (guard (e [else (void)]) + (fprintf *crash-port* "~a ==== jcode crash log ended ====~n" (crash-timestamp)) + (flush-output-port *crash-port*) + (close-port *crash-port*)) + (set! *crash-port* #f) + (set! *crash-path* #f))) + +(def (err->string e) + (with-output-to-string (lambda () (display-condition e)))) + +;; ---- Logging ---- + +(def (condition-message* e) + "Best-effort message extraction. Segfaults carry a message-condition + with text \"~?. Some debugging context lost\"; display-condition + renders the full \"Exception: invalid memory reference. Some debugging + context lost\" form, so we prefer that for the log line." + (cond + ((string? e) e) + ((and (condition? e) (message-condition? e)) (condition-message e)) + (else (format "~a" e)))) + +(def (looks-like-segfault? e) + "Heuristic: did this condition come from a Chez foreign-procedure fault? + The canonical text is \"invalid memory reference\" but Chez has a small + family of related fault messages (divide by zero, heap fault, etc.). + We flag anything matching the known family so the crash log can mark + these rows for triage." + (let ((msg (condition-message* e))) + (or (string-contains msg "invalid memory reference") + (string-contains msg "Some debugging context lost") + (string-contains msg "foreign-procedure") + (string-contains msg "is not a ") + (string-contains msg "heap overflow")))) + +(def (log-crash! context e . maybe-extra) + "Append a crash record to the crash log. CONTEXT is a short string + naming the loop/site (e.g. \"tui.event-loop\"). E is the raised + condition. MAYBE-EXTRA is an alist of extra key/value pairs to + include. Never raises; if the crash log is closed or the write + fails, the call is a no-op (and a one-line warning is emitted to + stderr the FIRST time a write fails, to avoid spamming on a dead + log). + + Captures as much diagnostic context as Chez exposes without + inspector support: the full condition display, the message text, + the irritants, the who (procedure name) when present, and any + caller-supplied EXTRA alist. The crash log is line-oriented so + `grep`, `awk`, and `tail -F` all work on it." + (when *crash-port* + (let ((extra (if (pair? maybe-extra) (car maybe-extra) '())) + (segfault? (looks-like-segfault? e)) + (full (err->string e))) + (with-mutex *crash-mutex* + (guard (w [else (void)]) + (fprintf *crash-port* "~a ~a~a crash=~a~n" + (crash-timestamp) + (if segfault? "SEGFAULT" "EXCEPTION") + (if (string=? context "") "" (string-append " ctx=" context)) + full) + ;; Structured fields — best-effort, every one of these is + ;; individually guarded so a missing field on a particular + ;; condition type does not abort the whole record. + (guard (w2 [else (void)]) + (when (and (condition? e) (who-condition? e)) + (fprintf *crash-port* " who=~a~n" (condition-who e)))) + (guard (w3 [else (void)]) + (when (and (condition? e) (irritants-condition? e)) + (fprintf *crash-port* " irritants=~a~n" + (with-output-to-string + (lambda () + (for-each (lambda (i) + (display " ") + (display i)) + (condition-irritants e))))))) + (when (pair? extra) + (fprintf *crash-port* " extra=~a~n" + (string-join + (map (lambda (p) + (format "~a=~a" (car p) (cdr p))) + extra) + " "))) + (flush-output-port *crash-port*)))))) + +;; ---- Recovery macro ---- + +;; with-crash-recovery wraps a body so any exception (including a Chez +;; SIGSEGV-as-condition) is logged to the crash log and the loop continues +;; with the current recovery default. It is intentionally permissive: a +;; top-level loop that swallows everything is a feature, not a bug, when the +;; alternative is killing the agent. The CONTEXT string is the diagnostic +;; breadcrumb that shows up in the log so a stack trace isn't required to +;; know which loop caught the crash. +;; +;; Usage: +;; (with-crash-recovery "tui.event-loop" +;; (do-rendering)) +;; (with-crash-recovery* "tool.bash" (cons 'error "segfault") +;; (run-bash-ffi ...)) +;; +;; with-crash-recovery returns the current-crash-recovery-default (void by +;; default). with-crash-recovery* takes an explicit FALLBACK value returned +;; directly to the caller. Avoid using a non-(void) default at sites that +;; ignore the result — existing code expects (void) from ignored guards. +(defrules with-crash-recovery () + [(_ ctx body ...) + (guard (e [else (log-crash! ctx e) (current-crash-recovery-default)]) + body ...)]) + +(defrules with-crash-recovery* () + [(_ ctx fallback body ...) + (guard (e [else (log-crash! ctx e) fallback]) + body ...)]) --- a/src/jcode/core/expert.ss +++ b/src/jcode/core/expert.ss @@ -11,8 +11,8 @@ ;;; "provider": "mlx", ;;; "model": "qwen3-coder-30b", ;;; "expert": { -;;; "provider": "openrouter", -;;; "model": "deepseek/deepseek-chat" +;;; "provider": "z-ai", +;;; "model": "glm-5.2" ;;; } ;;; } ;;; --- a/src/jcode/core/log.ss +++ b/src/jcode/core/log.ss @@ -85,21 +85,47 @@ ;; *log-mutex*; read from the TUI main thread. Entries are ;; (epoch-seconds . line). This is what makes "the harness is quietly ;; running git add -A on $HOME" visible without tailing a trace file. +;; +;; NOISE FILTER: the activity screen is for surfacing MCP calls, tool +;; invocations, provider traffic, and crashes — NOT per-tick TUI draw +;; debug spam. activity-interesting? drops the noisy categories so the +;; ring stays full of the signal the user actually wants to see. The +;; raw trace log (when --trace is on) still captures everything. (def *activity-cap* 300) (def *activity-ring* (make-vector 300 #f)) (def *activity-pos* (cons 0 #f)) +(def (activity-interesting? line) + "Return #t if LINE should appear on the /activity screen. + Drops per-tick TUI rendering noise (DRAW, event polling, dirty-flag + chatter, spinner updates). Keeps everything else: MCP, lsp, plugin, + provider, tool, session, debug-repl, crash, escalation, and any + WARN/ERROR." + (let ((lower (string-downcase line))) + (not + (or + ;; The single biggest spammer: every draw call logs a line per + ;; message block with role/tbw/aw/w/maw/... metrics that are + ;; only useful when debugging layout, never for the user. + (string-contains lower "[debug] tui: draw") + ;; Other per-tick TUI machinery that fires on idle ticks. + (string-contains lower "[debug] tui: event ") + (string-contains lower "[debug] tui: dirty") + (string-contains lower "[debug] tui: spinner") + (string-contains lower "[debug] tui: redraw"))))) + (def (activity-trunc s) (if (> (string-length s) 220) (string-append (substring s 0 219) "…") s)) (def (activity-push! line) - (let ((pos (car *activity-pos*))) - (vector-set! *activity-ring* pos - (cons (time-second (current-time)) (activity-trunc line))) - (set-car! *activity-pos* (modulo (+ pos 1) *activity-cap*)))) + (when (activity-interesting? line) + (let ((pos (car *activity-pos*))) + (vector-set! *activity-ring* pos + (cons (time-second (current-time)) (activity-trunc line))) + (set-car! *activity-pos* (modulo (+ pos 1) *activity-cap*))))) (def (activity-tail n) "Newest-last list of up to N (epoch-seconds . line) entries." --- a/src/jcode/core/models.ss +++ b/src/jcode/core/models.ss @@ -54,7 +54,8 @@ ;; "grok" is the Grok CLI session-token provider (~/.grok/auth.json), kept ;; distinct from "xai" (api.x.ai API-key) and "groq" (Groq Inc., separate). '("anthropic" "openai" "openrouter" "deepseek" "google" "ollama" "mlx" - "xai" "grok" "groq" "mistral" "together" "cerebras" "perplexity")) + "xai" "grok" "groq" "mistral" "together" "cerebras" "perplexity" + "z-ai")) (def *configured-providers* (make-parameter '())) @@ -111,6 +112,7 @@ ((together) "Together AI") ((cerebras) "Cerebras") ((perplexity) "Perplexity") + ((z-ai) "Z.AI") (else p)))) (if (equal? p kind) base (format "~a (~a)" base p)))) @@ -130,6 +132,7 @@ ((together) "meta-llama/Llama-3.3-70B-Instruct-Turbo") ((cerebras) "llama-3.3-70b") ((perplexity) "sonar-pro") + ((z-ai) "glm-5.2") (else "gpt-4o"))) ;; ---- Model lists per provider ---- @@ -177,6 +180,7 @@ ((together) together-models) ((cerebras) cerebras-models) ((perplexity) perplexity-models) + ((z-ai) z-ai-models) (else '()))) ;; ---- On-disk cache ---- @@ -352,6 +356,11 @@ ("sonar-reasoning-pro" . "Sonar Reasoning Pro") ("sonar-reasoning" . "Sonar Reasoning"))) +(def z-ai-models + '(("glm-5.2" . "Z.AI GLM-5.2") + ("glm-5.1" . "Z.AI GLM-5.1") + ("glm-5" . "Z.AI GLM-5"))) + ;; ---- Pricing ($/M-tokens) ---- ;; Tuple shape: (input output cache-read cache-write). Any field may be #f. ;; cache-read defaults to input rate when unknown; cache-write defaults to --- a/src/jcode/core/session.ss +++ b/src/jcode/core/session.ss @@ -4,6 +4,7 @@ session-create session-load session-list + session-list-in-cwd session-search session-add-message session-get-messages @@ -99,6 +100,13 @@ (hash-put! ht "title" title) (hash-put! ht "created" created) (hash-put! ht "updated" updated) + ;; Record the working directory at create/rename time so `-c` can + ;; resume the most recent session for THIS directory specifically, + ;; rather than the global most recent (which is usually a different + ;; project). Best-effort: if current-directory raises (dead cwd), + ;; fall back to #f and skip the field. + (guard (e [else (void)]) + (hash-put! ht "cwd" (current-directory))) ht)) (def (write-file-session-meta! id title created updated) @@ -240,6 +248,32 @@ (sorted (sort (lambda (a b) (string>? (car a) (car b))) pairs))) (map cdr sorted))) +(def (file-session-list-in-cwd cwd) + "Like file-session-list but filtered to sessions whose meta `cwd` + matches CWB. Returns sessions in newest-updated-first order, same as + file-session-list. A session with no recorded cwd (pre-`-c` sessions) + is excluded so `-c` from a clean directory does not pick up an old + global session." + (ensure-session-store!) + (let* ((dir (session-store-dir)) + (pairs + (filter-map + (lambda (entry) + (let* ((id (entry->string entry)) + (meta (and (safe-session-id? id) + (read-file-session-meta id)))) + (and meta + (equal? (hash-ref meta "cwd" #f) cwd) + (cons (hash-ref meta "updated" (hash-ref meta "created" "")) + (make-session + (hash-ref meta "id" id) + (hash-ref meta "title" "Untitled") + (hash-ref meta "created" "") + '()))))) + (directory-list dir))) + (sorted (sort (lambda (a b) (string>? (car a) (car b))) pairs))) + (map cdr sorted))) + (def (file-session-search term) (let ((matches '())) (for-each @@ -400,6 +434,12 @@ ;; image and wedge the interface. (with-session-db-lock file-session-list)) +(def (session-list-in-cwd cwd) + "Newest-first list of file-backed sessions whose recorded `cwd` + matches CWB. Used by `jcode -c` to resume the most recent session + for the current directory specifically." + (with-session-db-lock (lambda () (file-session-list-in-cwd cwd)))) + (def (legacy-session-list) (with-legacy-db (lambda (db) --- a/src/jcode/core/workflow-runner.ss +++ b/src/jcode/core/workflow-runner.ss @@ -37,6 +37,7 @@ :jcode/core/message :jcode/core/compaction :jcode/core/errors + :jcode/core/crashlog :jcode/guardrails/step-enforcer :jcode/guardrails/error-tracker :jcode/guardrails/nudge @@ -106,10 +107,26 @@ ;; (recoverable . text) — recoverable guidance (privileged: no error budget) ;; (error . text) — any other exception (counts against error budget) ;; The callable receives the args assoc as its single argument. +;; +;; All exceptions are also mirrored to ~/.jcode/crash.log via log-crash! +;; so a tool that segfaults (Chez delivers SIGSEGV as a condition from +;; foreign-procedure faults) leaves a durable breadcrumb even when the +;; tool result is later superseded by the error-budget bookkeeping. (def (run-one-tool fn args) - (guard (e [(tool-resolution-error? e) (cons 'resolution (condition->string e))] - [(recoverable-tool-error? e) (cons 'recoverable (condition->string e))] - [#t (cons 'error (condition->string e))]) + (guard (e [(tool-resolution-error? e) + (log-crash! "workflow.run-one-tool.resolution" e + `((tool . ,(if (procedure? fn) 'anonymous 'unknown)))) + (cons 'resolution (condition->string e))] + [(recoverable-tool-error? e) + (log-crash! "workflow.run-one-tool.recoverable" e + `((tool . ,(recoverable-tool-error-tool e)))) + (cons 'recoverable (condition->string e))] + [#t + (log-crash! "workflow.run-one-tool.error" e + `((tool . ,(if (tool-execution-error? e) + (tool-execution-error-tool e) + 'unknown)))) + (cons 'error (condition->string e))]) (cons 'ok (fn args)))) (def (disabled-shell-tool? name) --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -25,6 +25,10 @@ uuid-text-tool-call-candidate openai-usage->alist provider-retryable-error? + *stream-read-timeout-secs* + *http-read-timeout-secs* + stream-read-timeout-for-host + http-read-timeout-for-host ;; Grok Responses adapter (Phase 4) — exported so unit tests can drive ;; the pure helpers without making real HTTP calls. responses-parse-response @@ -204,6 +208,7 @@ ((together) "https://api.together.xyz/v1") ((cerebras) "https://api.cerebras.ai/v1") ((perplexity) "https://api.perplexity.ai") + ((z-ai) "https://api.z.ai/api/coding/paas/v4") (else (error 'provider-default-url "Unknown provider" name)))) (def (provider-chat provider messages tools) @@ -219,7 +224,7 @@ (api-call-with-retry (lambda () (case (string->symbol (provider-kind (provider-name provider))) - ((openai openrouter deepseek xai groq mistral together cerebras perplexity) + ((openai openrouter deepseek xai groq mistral together cerebras perplexity z-ai) (openai-chat provider messages tools)) ((anthropic) (anthropic-chat provider messages tools)) ((google) (google-chat provider messages tools)) @@ -250,7 +255,7 @@ (api-call-with-retry (lambda () (case (string->symbol (provider-kind (provider-name provider))) - ((openai openrouter deepseek xai groq mistral together cerebras perplexity mlx) + ((openai openrouter deepseek xai groq mistral together cerebras perplexity z-ai mlx) (openai-chat-with-stats provider messages tools)) ((grok) ;; If grok's api_backend is chat_completions we get logprobs/finish via @@ -686,15 +691,28 @@ (equal? host "localhost") (equal? host "::1"))) +(def (private-network-host? host) + (and (string? host) + (or (string-prefix? "10." host) + (string-prefix? "192.168." host) + (let loop ((octet 16)) + (and (<= octet 31) + (or (string-prefix? (format "172.~a." octet) host) + (loop (+ octet 1)))))))) + +(def (local-network-host? host) + (or (loopback-host? host) + (private-network-host? host))) + (def (stream-read-timeout-for-host host) (let ((base (*stream-read-timeout-secs*))) - (if (loopback-host? host) + (if (local-network-host? host) (max base *local-stream-read-timeout-floor-secs*) base))) (def (http-read-timeout-for-host host) (let ((base (*http-read-timeout-secs*))) - (if (loopback-host? host) + (if (local-network-host? host) (max base *local-http-read-timeout-floor-secs*) base))) @@ -717,7 +735,7 @@ (thread-sleep! *provider-wait-heartbeat-secs*) (unless (vector-ref done? 0) (log-info logger - (if (loopback-host? host) + (if (local-network-host? host) "waiting-for-local-provider" "waiting-for-provider") `((provider . ,(provider-name provider)) @@ -2839,9 +2857,18 @@ ;; returns a `stats` alist with finish_reason / mean_logprob / mean_entropy ;; (whatever the provider exposed). Used by the expert-escalation path. ;; Returns (values content-str tool-call-list usage-alist stats-alist). +;; +;; RETRY: the dispatch below is wrapped in a token-aware retry. The +;; inner token-cb is shimmed so we can tell whether ANY tokens made it +;; to the UI before a failure. If zero tokens were emitted (the server +;; hung before responding at all, or RST'd the connection before the +;; first SSE event), the failure is safe to retry up to 3x with the +;; same retryable-error? classification that the non-streaming path +;; uses. If tokens WERE emitted, we do NOT retry: a mid-stream replay +;; would duplicate output in the transcript and confuse the model. (def (provider-stream-chat-with-stats provider messages tools token-cb) (unless (or (provider-api-key provider) - (local-provider? (provider-name provider))) + (local-provider? (provider-name provider))) (error 'provider-stream-chat-with-stats (format "No API key configured for provider '~a'. Set the appropriate env var or add it to jcode.json." (provider-name provider)))) @@ -2849,8 +2876,31 @@ `((provider . ,(provider-name provider)) (model . ,(provider-model provider)) (messages . ,(length messages)))) + ;; tokens-emitted? is flipped to #t the first time the inner cb runs. + ;; The retry wrapper inspects it AFTER a failure: if #f, the failure + ;; happened before any output and replaying the identical request is + ;; safe; if #t, we must NOT retry and just re-raise. + (let ((tokens-emitted? (vector #f))) + (def (retryable-stream-error? e) + (and (retryable-error? e) + (not (vector-ref tokens-emitted? 0)))) + (def (shim-cb token) + (vector-set! tokens-emitted? 0 #t) + (token-cb token)) + (def (dispatch) + (stream-dispatch provider messages tools shim-cb)) + (retry/predicate dispatch retryable-stream-error? + *stream-retry-limit* *stream-retry-base-delay*))) + +(def *stream-retry-limit* 3) +(def *stream-retry-base-delay* 1.0) + +(def (stream-dispatch provider messages tools token-cb) + "Pure dispatch — no retry. Returns the same values as the provider's + underlying stream-chat. Kept separate so provider-stream-chat-with-stats + can retry the dispatch without re-running the token-emission guard." (case (string->symbol (provider-kind (provider-name provider))) - ((openai openrouter deepseek mlx xai groq mistral together cerebras perplexity) + ((openai openrouter deepseek mlx xai groq mistral together cerebras perplexity z-ai) (openai-stream-chat provider messages tools token-cb)) ((ollama) (ollama-stream-chat provider messages tools token-cb)) ((grok) @@ -3325,7 +3375,7 @@ (log-info logger "list-models" `((provider . ,(provider-name provider)))) (case (string->symbol (provider-kind (provider-name provider))) - ((openai openrouter deepseek) (openai-list-models provider)) + ((openai openrouter deepseek z-ai) (openai-list-models provider)) ((anthropic) (anthropic-list-models provider)) ((google) (google-list-models provider)) ((ollama) (ollama-list-models provider)) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -13,6 +13,7 @@ :jcode/core/secrets :jcode/core/secrets-import :jcode/core/log + :jcode/core/crashlog :jcode/core/session :jcode/core/message :jcode/core/agent @@ -108,6 +109,17 @@ (open-trace-log! trace-path) (current-log-level 'debug) (fprintf (current-error-port) "[trace] writing to ~a~n" trace-path))) + ;; Crash log: always on. Captures segfaults (Chez delivers SIGSEGV from + ;; foreign-procedure faults as conditions) and other unrecoverable + ;; exceptions caught by with-crash-recovery at the TUI event loop and + ;; workflow runner. Default location is ~/.jcode/crash.log; override + ;; with JCODE_CRASH_LOG for testing or other locations. Never raises + ;; — if the path cannot be opened, logging silently no-ops so a + ;; logging failure cannot take the agent down. + (let ((crash-path (getenv "JCODE_CRASH_LOG"))) + (if crash-path + (open-crash-log! crash-path) + (open-crash-log!))) (let ((rest (let ((r (assoc '-- opts))) (if r (cdr r) '())))) (load-config) (load-cli-themes!) @@ -133,10 +145,16 @@ (m-opt (assoc '--model opts))) (when p-opt (current-provider-override (cdr p-opt))) (when m-opt (current-model-override (cdr m-opt)))) - (cond - ;; TUI mode - ((assoc '--tui opts) - (tui-main args)) + (cond + ;; -c / --continue: resume the most recent session for THIS + ;; directory in the TUI. Looks up sessions whose recorded `cwd` + ;; matches (current-directory); if none, falls back to a fresh + ;; TUI session so the user is never left without an interface. + ((assoc '--continue opts) + (tui-main args)) + ;; TUI mode + ((assoc '--tui opts) + (tui-main args)) ;; Commands and REPL ((null? rest) (interactive-mode opts)) ((and (session-restore-command? rest) @@ -151,7 +169,8 @@ ((equal? (car rest) "relay") (relay-main (cdr rest))) ((equal? (car rest) "connect") (connect-main (cdr rest))) (else (one-shot-mode (string-join rest " ") opts))) - (close-trace-log!)))) + (close-trace-log!) + (close-crash-log!)))) (def (parse-args args) (let loop ((args args) (opts '())) @@ -168,6 +187,8 @@ ((equal? (car args) "--no-mcp") (loop (cdr args) (cons '(--no-mcp . #t) opts))) ((equal? (car args) "--no-expert") (loop (cdr args) (cons '(--no-expert . #t) opts))) ((equal? (car args) "--verbose") (loop (cdr args) (cons '(--verbose . #t) opts))) + ((equal? (car args) "-c") (loop (cdr args) (cons '(--continue . #t) opts))) + ((equal? (car args) "--continue") (loop (cdr args) (cons '(--continue . #t) opts))) ((and (equal? (car args) "--repl-port") (pair? (cdr args))) ;; A host may be written explicitly, but start-jcode-repl! refuses ;; anything outside 127.0.0.0/8. @@ -265,6 +286,8 @@ USAGE: OPTIONS: -h, --help Show this help message -v, --version Show version + -c, --continue Resume the most recent session for THIS directory + in the TUI (looks up sessions by recorded cwd) -d, --debug Enable debug logging -m, --model Model to use (default: claude-sonnet-4-20250514) --provider Provider to use (default: anthropic) @@ -323,6 +346,7 @@ COMMANDS: [--run-aliases] opt into legacy run/bash/shell inspection aliases. EXAMPLES: jcode Start interactive session + jcode -c Resume most recent session for this dir jcode \"Read main.ss\" One-shot query jcode session list List sessions jcode serve --port 8321 Start TCP server for Android app --- a/src/jcode/ui/tui.ss +++ b/src/jcode/ui/tui.ss @@ -30,6 +30,7 @@ :jcode/core/session :jcode/core/message :jcode/core/log + :jcode/core/crashlog :jcode/tool/registry :jcode/tool/file :jcode/tool/apply-patch @@ -299,6 +300,14 @@ (let loop ((args args)) (cond ((null? args) #f) + ;; -c / --continue: resolve to the most recent session whose + ;; recorded cwd matches (current-directory). If none, return #f + ;; and let tui-main fall through to a fresh session. + ((or (equal? (car args) "-c") + (equal? (car args) "--continue")) + (let ((sessions (session-list-in-cwd (current-directory)))) + (and (pair? sessions) + (session-id (car sessions))))) ((and (equal? (car args) "session") (pair? (cdr args)) (or (equal? (cadr args) "resume") @@ -354,79 +363,92 @@ (#t (loop (cdr args)))))) ;; ---- Event loop ---- +;; +;; The whole tick body is wrapped in a guard so a segfault (or any other +;; exception) raised from termbox FFI, a draw call, or the sysmon probe +;; is logged to ~/.jcode/crash.log and the loop continues to the next +;; 50ms tick instead of killing the agent. We use a plain guard rather +;; than with-crash-recovery* because the recovery needs to re-enter the +;; named-let loop, and the macro expansion would put that call in the +;; wrong position. (def (event-loop state) (let loop () - ;; Advance tick for animations - (app-state-tick-set! state (+ (app-state-tick state) 1)) - - ;; Sample system utilization roughly every second (event poll is 50ms) - (when (zero? (modulo (app-state-tick state) 20)) - (let ((mon (app-state-sysmon state))) - (when mon - (try (sysmon-update! mon) (catch (e) (void))) + (guard (e [else + (log-crash! "tui.event-loop" e) + (tui-log "event-loop: recovered from crash, continuing") + (unless (app-state-quit? state) + (loop))]) + ;; Advance tick for animations + (app-state-tick-set! state (+ (app-state-tick state) 1)) + + ;; Sample system utilization roughly every second (event poll is 50ms) + (when (zero? (modulo (app-state-tick state) 20)) + (let ((mon (app-state-sysmon state))) + (when mon + (try (sysmon-update! mon) (catch (e) (void))) + (app-state-dirty?-set! state #t))) + (let ((mem (app-state-memstats state))) + (when mem + (try (memstats-update! mem) (catch (e) (void)))))) + + ;; Drain pending events from agent worker thread and apply them. + ;; All state mutation happens here, on the main thread, not from + ;; the spawned worker — this prevents races on Chez hash tables. + (let ((n (drain-agent-events! state))) + (when (> n 0) + (tui-log "event-loop: drained ~a agent events" n) (app-state-dirty?-set! state #t))) - (let ((mem (app-state-memstats state))) - (when mem - (try (memstats-update! mem) (catch (e) (void)))))) - - ;; Drain pending events from agent worker thread and apply them. - ;; All state mutation happens here, on the main thread, not from - ;; the spawned worker — this prevents races on Chez hash tables. - (let ((n (drain-agent-events! state))) - (when (> n 0) - (tui-log "event-loop: drained ~a agent events" n) - (app-state-dirty?-set! state #t))) - - ;; If the visible tab's worker died without a terminal event making it - ;; through the mailbox, do not leave the UI permanently "thinking". - (cleanup-stale-agent-run! state) - - ;; Activity screen refreshes every tick: ages advance and background - ;; runs keep logging even when this tab's agent is idle. - (when (eq? (app-state-view state) 'activity) - (app-state-dirty?-set! state #t)) - - ;; Poll for terminal events (50ms timeout) - (let ((ev (tb-peek-event 50))) - (when ev - (tui-log "event: type=~a key=~a ch=~a(~a) mod=~a w=~a h=~a" - (tui-event-type ev) (tui-event-key ev) - (tui-event-ch ev) - (if (> (tui-event-ch ev) 31) - (string (integer->char (tui-event-ch ev))) - "") - (tui-event-mod ev) - (tui-event-w ev) (tui-event-h ev)) - (cond - ((tui-event-resize? ev) - (tui-log " -> resize ~ax~a" (tui-event-w ev) (tui-event-h ev)) - (handle-resize! state ev)) - ((tui-event-key? ev) - (handle-key! state ev)) - ((tui-event-mouse? ev) - (tui-log " -> mouse key=~a x=~a y=~a" (tui-event-key ev) (tui-event-x ev) (tui-event-y ev)) - (handle-mouse! state ev))))) - - ;; Redraw. Full repaint only when content actually changed; while - ;; the agent is busy an otherwise-clean frame repaints JUST the - ;; spinner row. The old behavior forced draw-all! (tb-clear + full - ;; transcript repaint) on every 50ms tick during streaming -- the - ;; main thread spent the whole turn painting and keystrokes queued - ;; behind it. Drained events still set dirty, so streamed text and - ;; tool updates repaint normally. - (cond - ((app-state-dirty? state) - (draw-all! state) - (tb-present!) - (app-state-dirty?-set! state #f)) - ((app-state-agent-busy? state) - (draw-spinner! state) - (tb-present!))) - ;; Continue unless quitting - (unless (app-state-quit? state) - (loop)))) + ;; If the visible tab's worker died without a terminal event making it + ;; through the mailbox, do not leave the UI permanently "thinking". + (cleanup-stale-agent-run! state) + + ;; Activity screen refreshes every tick: ages advance and background + ;; runs keep logging even when this tab's agent is idle. + (when (eq? (app-state-view state) 'activity) + (app-state-dirty?-set! state #t)) + + ;; Poll for terminal events (50ms timeout) + (let ((ev (tb-peek-event 50))) + (when ev + (tui-log "event: type=~a key=~a ch=~a(~a) mod=~a w=~a h=~a" + (tui-event-type ev) (tui-event-key ev) + (tui-event-ch ev) + (if (> (tui-event-ch ev) 31) + (string (integer->char (tui-event-ch ev))) + "") + (tui-event-mod ev) + (tui-event-w ev) (tui-event-h ev)) + (cond + ((tui-event-resize? ev) + (tui-log " -> resize ~ax~a" (tui-event-w ev) (tui-event-h ev)) + (handle-resize! state ev)) + ((tui-event-key? ev) + (handle-key! state ev)) + ((tui-event-mouse? ev) + (tui-log " -> mouse key=~a x=~a y=~a" (tui-event-key ev) (tui-event-x ev) (tui-event-y ev)) + (handle-mouse! state ev))))) + + ;; Redraw. Full repaint only when content actually changed; while + ;; the agent is busy an otherwise-clean frame repaints JUST the + ;; spinner row. The old behavior forced draw-all! (tb-clear + full + ;; transcript repaint) on every 50ms tick during streaming -- the + ;; main thread spent the whole turn painting and keystrokes queued + ;; behind it. Drained events still set dirty, so streamed text and + ;; tool updates repaint normally. + (cond + ((app-state-dirty? state) + (draw-all! state) + (tb-present!) + (app-state-dirty?-set! state #f)) + ((app-state-agent-busy? state) + (draw-spinner! state) + (tb-present!))) + + ;; Continue unless quitting + (unless (app-state-quit? state) + (loop))))) ;; ---- Event handlers ---- @@ -1632,13 +1654,17 @@ (list 'agent-done (- (time-second (current-time)) t0))) (tui-log "worker: agent-done sent, worker exiting normally")) (catch (e) - (let ((msg (err->string e))) - (tui-log "worker: CAUGHT exception: ~a" msg) - (cond - ((string-contains msg "stream-aborted") - (send-run-event! s-id gen (list 'agent-cancelled))) - (else - (send-run-event! s-id gen (list 'agent-error msg))))))))))) + (let ((msg (err->string e))) + ;; Mirror to the crash log so segfaults and other + ;; non-continuable conditions in the agent worker + ;; are durably recorded even when --verbose is off. + (log-crash! "tui.agent-worker" e) + (tui-log "worker: CAUGHT exception: ~a" msg) + (cond + ((string-contains msg "stream-aborted") + (send-run-event! s-id gen (list 'agent-cancelled))) + (else + (send-run-event! s-id gen (list 'agent-error msg))))))))))) (agent-run-worker-set-for! s-id gen worker))))) ;; ---- /ask-* second-opinion runners ---- --- a/test/run.ss +++ b/test/run.ss @@ -109,6 +109,16 @@ (provider-retryable-error? closed-tcp-port-error) #t) (check! "ordinary provider errors remain terminal" (provider-retryable-error? ordinary-error) #f)) +(parameterize ([*stream-read-timeout-secs* 45] + [*http-read-timeout-secs* 120]) + (check! "private DS4 host gets local stream timeout floor" + (stream-read-timeout-for-host "10.66.60.4") 300) + (check! "private DS4 host gets local HTTP timeout floor" + (http-read-timeout-for-host "10.66.60.4") 600) + (check! "public host keeps stream timeout base" + (stream-read-timeout-for-host "api.openai.com") 45) + (check! "public host keeps HTTP timeout base" + (http-read-timeout-for-host "api.openai.com") 120)) (define (section name) (printf "~n~a~n" name)) @@ -1126,6 +1136,14 @@ (make-tool-result "read-1" (make-string 768 #\r))) "/Users/user/models/qwen3-coder-next-mlx") #t)