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)))