From d8a6338fc9a79492fcbbc464b7d7c10607c336a2 Mon Sep 17 00:00:00 2001 From: Reuben Brooks Date: Sun, 14 Jun 2026 10:04:35 -0500 Subject: [PATCH] fix(cl): pr writes to files under -q on all backends; cap absvector size Issue #2 (-q/*hush* silences pr to file streams on CLISP and ECL): The native |pr| override was guarded #+(or ccl sbcl), so CLISP and ECL fell back to the kernel's portable *hush*-gated KL pr, which returns early without writing whenever *hush* is true -- wrongly silencing pr to FILE streams under -q and producing zero-byte files. Extend the native override to ECL (its file streams are character streams, so the existing write-string path applies) and add a CLISP variant that dispatches on stream-element-type (CLISP opens files as 'unsigned-byte per shen.openh, so it uses a write-byte path). All backends now write to a non-stdout stream regardless of *hush*, matching SBCL/CCL. Issue #3 ((absvector ) -> uncatchable SBCL heap exhaustion): make-array with an oversized count triggers an uncatchable HEAP-EXHAUSTED-ERROR abort that trap-error cannot recover from, taking down the image. Add a sanity cap (2^24 slots, ~800x the largest vector the kernel ever allocates) so an excessive request raises a catchable Shen simple-error instead of crashing. Matches shen-go's intent. Verified before/after on SBCL, CLISP and ECL (all binaries installed): - pr -q to a file now writes 'payload' on all three backends. - (trap-error (absvector 100000000000) (lambda E E)) returns the error object instead of aborting. Canonical kernel suite 134/134 on SBCL and CLISP; port suite 126/126 on SBCL. Kernel (klambda/*.kl) untouched; fix lives in the runtime layer. Co-Authored-By: Claude Opus 4.8 (1M context) --- src/overwrite.lsp | 27 ++++++++++++++++++++++++++- src/primitives.lsp | 16 +++++++++++++++- 2 files changed, 41 insertions(+), 2 deletions(-) diff --git a/src/overwrite.lsp b/src/overwrite.lsp index cd8ac98..282b6af 100644 --- a/src/overwrite.lsp +++ b/src/overwrite.lsp @@ -280,13 +280,38 @@ -1 (char-int c)))) -#+(or ccl sbcl) +;; Native pr: write the string to the stream unconditionally, never +;; consulting *hush*. The kernel's KL pr (writer.kl) returns early without +;; writing whenever *hush* is true -- which wrongly silences pr to FILE +;; streams under -q (e.g. `eval -q -e "(pr ... FileStream)"`), producing a +;; zero-byte file. SBCL/CCL already bypassed the KL pr via this override; +;; ECL ran the KL pr and so silenced pr to files under -q. Its file streams +;; are character streams, so the same write-string override applies. +;; Extending the override to ECL makes SBCL/CCL/ECL agree: pr writes to its +;; target stream regardless of *hush* (Shen issue #2). +#+(or ccl sbcl ecl) (defun |pr| (x s) (write-string x s) (when (or (eq s |*stoutput*|) (eq s |*stinput*|)) (force-output s)) x) +;; CLisp file streams are opened with :element-type 'unsigned-byte (see +;; |shen.openh| in primitives.lsp), so write-string is illegal on them; the +;; kernel's KL pr dispatches such streams to a write-byte path. Mirror that +;; dispatch here but, like the SBCL/CCL/ECL override, ignore *hush* so pr to +;; a file stream is never silenced under -q (Shen issue #2). Character streams +;; (e.g. *stoutput*) still take write-string. +#+clisp +(defun |pr| (x s) + (if (subtypep (stream-element-type s) 'character) + (progn + (write-string x s) + (when (or (eq s |*stoutput*|) (eq s |*stinput*|)) + (force-output s))) + (loop for c across x do (write-byte (char-code c) s))) + x) + ;; file reading (defun |read-file-as-bytelist| (path) diff --git a/src/primitives.lsp b/src/primitives.lsp index a0c5668..836cfa5 100644 --- a/src/primitives.lsp +++ b/src/primitives.lsp @@ -137,12 +137,26 @@ (defmacro |freeze| (x) `(function (lambda () ,x))) +;; Sanity cap on absvector size (Shen issue #3). Without it, (absvector HUGE) +;; asks make-array for an array far larger than the heap, which SBCL reports as +;; an *uncatchable* "Heap exhausted" abort -- trap-error cannot recover from it, +;; so a single bad size takes down the whole image. The cap is ~16.7 million +;; slots (2^24), which is over 800x the largest vector the kernel itself ever +;; allocates (the 20000-slot property dictionary), so it cannot break any +;; legitimate kernel or program use; anything beyond it raises a catchable Shen +;; error instead of crashing. shen-go applies the same kind of cap. +(defconstant |shen-cl.max-absvector-size| (expt 2 24)) + ;; Elements start as the fail sentinel so that reading an unset slot via ;; <-vector signals "not found", matching the official S41.1 port and ;; Shen/Scheme. (|fail|) is kernel-defined and only called at runtime, ;; after the kernel has loaded. (defun |absvector| (n) - (make-array n :initial-element (|fail|))) + (if (and (integerp n) (>= n 0) (<= n |shen-cl.max-absvector-size|)) + (make-array n :initial-element (|fail|)) + (|simple-error| + (format nil "absvector size ~A out of range (0..~A)~%" + n |shen-cl.max-absvector-size|)))) (defun |absvector?| (x) (if (and (arrayp x) (not (stringp x)))