From 2481b0d0f223640c43032f75b689608f8fa332db Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Thu, 14 Mar 2002 15:10:44 +0000 Subject: [PATCH] 0.7.1.38: catching stack overflow, part III... ...redid *STACK-EXHAUSTION* value as SAP, because although FIXNUM is cute and should be implementable efficiently, it seems to be awfully annoying to work with ...made %DETECT-STACK-EXHAUSTION actually check for the problem ...set up machinery to try to handle the problem reasonably gracefully ...added basic regression test moved EXPORT of '*SHEBANG-BACKEND-SUBFEATURES* alongside EXPORT of '*SHEBANG-FEATURES* so that chill.lisp works again --- TODO | 2 -- doc/sbcl.1 | 23 ++++++------ package-data-list.lisp-expr | 2 +- src/code/exhaust.lisp | 82 ++++++++++++++++++++----------------------- src/cold/shared.lisp | 1 - src/cold/shebang.lisp | 11 ++++++ tests/exhaust.impure.lisp | 26 ++++++++++++++ tests/foreign.test.sh | 15 +++++++- version.lisp-expr | 2 +- 9 files changed, 103 insertions(+), 61 deletions(-) create mode 100644 tests/exhaust.impure.lisp diff --git a/TODO b/TODO index 8d87d77..fb776be 100644 --- a/TODO +++ b/TODO @@ -62,8 +62,6 @@ for early 0.7.x: package-data.lisp-expr (i.e. those symbols not bound, fbound, defined as types, or whatever), and used them to remove dead symbols -* made system handle stack overflow safely unless SAFETY is dominated - by SPEED or SPACE * Either get rid of or at least rework the fdefinition/encapsulation system so that (SYMBOL-FUNCTION 'FOO) is identically equal to (FDEFINITION 'FOO). diff --git a/doc/sbcl.1 b/doc/sbcl.1 index 5524b86..8a91b16 100644 --- a/doc/sbcl.1 +++ b/doc/sbcl.1 @@ -385,17 +385,13 @@ This section attempts to list the most serious and long-standing bugs. For more detailed and current information on bugs, see the BUGS file in the distribution. -It is possible to get in deep trouble by exhausting +It is possible to get in deep trouble by exhausting memory. To plagiarize a sadly apt description of a language not renowned for the production of bulletproof software, "[The current SBCL implementation of] Common Lisp makes it harder for you to shoot yourself in the foot, but when you do, the entire universe explodes." .TP 3 \-- -The system doesn't deal well with stack overflow. (It tends to cause -a segmentation fault instead of being caught cleanly.) -.TP 3 -\-- Like CMU CL, the SBCL system overcommits memory at startup. On typical Unix-alikes like Linux and FreeBSD, this means that if the SBCL system turns out to use more virtual memory than the system has available for @@ -417,7 +413,7 @@ Some things are implemented very inefficiently. .TP 3 \-- Multidimensional arrays are inefficient, especially -multidimensional arrays of floating point numbers +multidimensional arrays of floating point numbers. .TP 3 \-- The DYNAMIC-EXTENT declaration isn't implemented at all, not even @@ -431,18 +427,21 @@ SBCL implementation of CLOS doesn't do some important known optimizations.) .TP 3 \-- -SBCL, like most implementations of Common Lisp, has trouble -passing floating point numbers around efficiently, because -they're larger than a machine word. (Thus, they get "boxed" in +SBCL, like most (maybe all?) implementations of Common Lisp on +stock hardware, has trouble +passing floating point numbers around efficiently, because a floating +point number, plus a few extra bits to identify its type, +is larger than a machine word. (Thus, they get "boxed" in heap-allocated storage, causing GC overhead.) Within a single compilation unit, or when doing built-in operations like SQRT and AREF, or some special operations like structure slot accesses, this is avoidable: see the user manual for some efficiency hints. But for general function calls across -the boundaries of compilation units, passing a floating point -number as a function argument (or returning a floating point -number as a function value) is a fundamentally slow operation. +the boundaries of compilation units, passing the result of +a floating point calculation +as a function argument (or returning a floating point +result as a function value) is a fundamentally slow operation. .PP There are still some nagging pre-ANSIisms, notably diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 7100849..c0398b6 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -952,7 +952,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "*CURRENT-LEVEL-IN-PRINT*" "*EMPTY-TYPE*" "*GC-INHIBIT*" "*NEED-TO-COLLECT-GARBAGE*" - "*PRETTY-PRINTER*" "*STACK-EXHAUSTION*" "*UNIVERSAL-TYPE*" + "*PRETTY-PRINTER*" "*STACK-EXHAUSTION-SAP*" "*UNIVERSAL-TYPE*" "*UNIVERSAL-FUN-TYPE*" "*UNPARSE-FUN-TYPE-SIMPLIFY*" "*WILD-TYPE*" "32BIT-LOGICAL-AND" "32BIT-LOGICAL-ANDC1" diff --git a/src/code/exhaust.lisp b/src/code/exhaust.lisp index 1879245..218843a 100644 --- a/src/code/exhaust.lisp +++ b/src/code/exhaust.lisp @@ -1,4 +1,5 @@ -;;;; detecting and handling exhaustion of memory (stack or heap) +;;;; detecting and handling exhaustion of fundamental system resources +;;;; (stack or heap) ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -11,59 +12,54 @@ (in-package "SB!KERNEL") -;;; A native address on a 4-byte boundary can be thought of (and -;;; passed around in Lisp code as) a FIXNUM. This function converts -;;; from a byte address represented as an unsigned integer to such -;;; a FIXNUM. +;;; a soft limit on stack overflow; the boundary beyond which the +;;; control stack will be considered to've overflowed ;;; -;;; FIXME: There should be some better place for this definition to -;;; go. (Or a redundant definition might already exist. Especially -;;; since this is essentially just a type pun, so there might be some -;;; VOP or something which'd do it for us.) -(eval-when (:compile-toplevel :load-toplevel :execute) - (defun native-address-encoded-as-fixnum (native-address) - (declare (type unsigned-byte native-address)) - (aver (zerop (logand native-address 3))) - (let* (;; naive encoding - (first-try (ash native-address -2)) - ;; final encoding - (second-try - (if (<= first-try sb!xc:most-positive-fixnum) - ;; looks good - first-try - ;; When the naive encoding fails to make a FIXNUM - ;; because the sign is wrong, subtracting *T-M-P-F* - ;; should fix it. - (- first-try sb!xc:most-positive-fixnum)))) - (aver (<= second-try sb!xc:most-positive-fixnum)) - second-try))) - -;;; a FIXNUM, to be interpreted as a native pointer, which serves -;;; as a boundary to catch stack overflow -;;; -;;; When stack overflow is detected, this is to be bound to a new -;;; value (allowing some more space for error handling) around the -;;; call to ERROR. +;;; When stack overflow is detected, this soft limit is to be bound to +;;; a new value closer to the hard limit (allowing some more space for +;;; error handling) around the call to ERROR. ;;; ;;; FIXME: Maybe (probably?) this should be in SB!VM. And maybe the ;;; size of the buffer zone should be set in src/compiler/cpu/parms.lisp ;;; instead of constantly 1Mb for all CPU architectures? -(defvar *stack-exhaustion* +(defvar *stack-exhaustion-sap* ;; (initialized in cold init) ) (defun !exhaust-cold-init () - (setf *stack-exhaustion* - #.(native-address-encoded-as-fixnum - #!+stack-grows-downward (+ sb!vm:control-stack-start (expt 2 20)) - #!+stack-grows-upward (- sb!vm:control-stack-end (expt 2 20))))) + (let (;; initial difference between soft limit and hard limit + (initial-slack (expt 2 20))) + (setf *stack-exhaustion-sap* + (int-sap #!+stack-grows-downward (+ sb!vm:control-stack-start + initial-slack) + #!+stack-grows-upward (- sb!vm:control-stack-end + initial-slack))))) ;;; FIXME: Even though this is only called when (> SAFETY (MAX SPEED SPACE)) ;;; it's still annoyingly wasteful for it to be a full function call. ;;; It should probably be a VOP calling an assembly routine or something ;;; like that. (defun %detect-stack-exhaustion () - ;; FIXME: Check the stack pointer against *STACK-EXHAUSTION*, and if - ;; out of range signal an error (in a context where *S-E* has been - ;; rebound to give some space to let error handling code do its - ;; thing without new exhaustion problems). - (values)) + (when (#!+stack-grows-upward sap>= + #!+stack-grows-downward sap<= + (current-sp) + *stack-exhaustion-sap*) + (let ((*stack-exhaustion-sap* (revised-stack-exhaustion-sap))) + (warn "~@") + (error "The system control stack was exhausted.")))) + +;;; Return a revised value for the *STACK-EXHAUSTION-SAP* soft limit, +;;; allocating half the remaining space up to the hard limit in order +;;; to allow interactive debugging to be used around the point of a +;;; stack overflow failure without immediately failing again from the +;;; (continuing) stack overflow. +(defun revised-stack-exhaustion-sap () + (let* ((old-slack + #!+stack-grows-upward (- sb!vm:control-stack-end + (sap-int *stack-exhaustion-sap*)) + #!+stack-grows-downward (- (sap-int *stack-exhaustion-sap*) + sb!vm:control-stack-start)) + (new-slack (ash old-slack -1))) + (int-sap + #!+stack-grows-upward (- sb!vm:control-stack-end new-slack) + #!+stack-grows-downward (+ sb!vm:control-stack-start new-slack)))) diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp index a55036c..1dd3ddd 100644 --- a/src/cold/shared.lisp +++ b/src/cold/shared.lisp @@ -236,7 +236,6 @@ (read-from-file customizer-file-name)) #'identity))) (funcall customizer default-subfeatures))) -(export '*shebang-backend-subfeatures*) (let ((*print-length* nil) (*print-level* nil)) (format t diff --git a/src/cold/shebang.lisp b/src/cold/shebang.lisp index 95b4480..626a382 100644 --- a/src/cold/shebang.lisp +++ b/src/cold/shebang.lisp @@ -62,6 +62,17 @@ (set-dispatch-macro-character #\# #\! #'shebang-reader) +;;;; variables like *SHEBANG-FEATURES* but different + +;;; This variable is declared here (like *SHEBANG-FEATURES*) so that +;;; things like chill.lisp work (because the variable has properties +;;; similar to *SHEBANG-FEATURES*, and chill.lisp was set up to work +;;; for that). For an explanation of what it really does, look +;;; elsewhere. +(export '*shebang-backend-subfeatures*) +(declaim (type list *shebang-features*)) +(defvar *shebang-backend-subfeatures*) + ;;;; FIXME: Would it be worth implementing this? #| ;;;; readmacro syntax to remove spaces from FORMAT strings at compile time diff --git a/tests/exhaust.impure.lisp b/tests/exhaust.impure.lisp new file mode 100644 index 0000000..54bd7e7 --- /dev/null +++ b/tests/exhaust.impure.lisp @@ -0,0 +1,26 @@ +;;;; tests of the system's ability to catch resource exhaustion errors + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; While most of SBCL is derived from the CMU CL system, the test +;;;; files (like this one) were written from scratch after the fork +;;;; from CMU CL. +;;;; +;;;; This software is in the public domain and is provided with +;;;; absolutely no warranty. See the COPYING and CREDITS files for +;;;; more information. + +(cl:in-package :cl-user) + +;;; Prior to sbcl-0.7.1.38, doing something like (RECURSE), even in +;;; safe code, would crash the entire Lisp process. Now it should +;;; signal an error in a context where the soft stack limit has been +;;; relaxed enough that the error can be handled. +(locally + (declare (optimize safety)) + (defun recurse () (recurse) (recurse)) + (ignore-errors (recurse))) + +;;; success +(quit :unix-status 104) diff --git a/tests/foreign.test.sh b/tests/foreign.test.sh index 47f4344..eaa3b4b 100644 --- a/tests/foreign.test.sh +++ b/tests/foreign.test.sh @@ -13,8 +13,20 @@ # absolutely no warranty. See the COPYING and CREDITS files for # more information. +echo //entering foreign.test.sh + testfilestem=${TMPDIR:-/tmp}/sbcl-foreign-test-$$ +# FIXME: At least on OpenBSD, the "make $testfilestem.o" puts the +# output file into the current directory, instead of the +# target directory. E.g. "make /tmp/foo.o" causes "./foo.o" to be +# created (!). Since OpenBSD doesn't support LOAD-FOREIGN, this +# doesn't matter much, since it punts with UNSUPPORTED-OPERATOR +# instead of not finding the file. But it'd be nice to straighten +# this out, if only so that sbcl-foreign-test-*.o clutter +# doesn't pile up in this directory. Maybe some time when I have +# several test machines at hand to check the behavior of different +# versions of "make"... echo 'int summish(int x, int y) { return 1 + x + y; }' > $testfilestem.c make $testfilestem.o ld -shared -o $testfilestem.so $testfilestem.o @@ -42,7 +54,8 @@ fi # rolling over in his grave.:-) It would be good to make a test case # for it.. +echo //cleanup: removing $testfilestem.* rm $testfilestem.* # success convention for script -exit 104 +exit 104 diff --git a/version.lisp-expr b/version.lisp-expr index 3bd2fb4..089bc2d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.1.37a" +"0.7.1.38" -- 1.7.10.4