1 ;;;; detecting and handling exhaustion of memory (stack or heap)
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!KERNEL")
14 ;;; A native address on a 4-byte boundary can be thought of (and
15 ;;; passed around in Lisp code as) a FIXNUM. This function converts
16 ;;; from a byte address represented as an unsigned integer to such
19 ;;; FIXME: There should be some better place for this definition to
20 ;;; go. (Or a redundant definition might already exist. Especially
21 ;;; since this is essentially just a type pun, so there might be some
22 ;;; VOP or something which'd do it for us.)
23 (eval-when (:compile-toplevel :load-toplevel :execute)
24 (defun native-address-encoded-as-fixnum (native-address)
25 (declare (type unsigned-byte native-address))
26 (aver (zerop (logand native-address 3)))
27 (let* (;; naive encoding
28 (first-try (ash native-address -2))
31 (if (<= first-try sb!vm:*target-most-positive-fixnum*)
34 ;; When the naive encoding fails to make a FIXNUM
35 ;; because the sign is wrong, subtracting *T-M-P-F*
37 (- first-try sb!vm:*target-most-positive-fixnum*))))
38 (aver (<= second-try sb!vm:*target-most-positive-fixnum*))
41 ;;; a FIXNUM, to be interpreted as a native pointer, which serves
42 ;;; as a boundary to catch stack overflow
44 ;;; When stack overflow is detected, this is to be bound to a new
45 ;;; value (allowing some more space for error handling) around the
48 ;;; FIXME: Maybe (probably?) this should be in SB!VM. And maybe the
49 ;;; size of the buffer zone should be set in src/compiler/cpu/parms.lisp
50 ;;; instead of constantly 1Mb for all CPU architectures?
51 (defvar *stack-exhaustion*
52 ;; (initialized in cold init)
54 (defun !exhaust-cold-init ()
55 (setf *stack-exhaustion*
56 #.(native-address-encoded-as-fixnum
57 #!+stack-grows-downward (+ sb!vm:control-stack-start (expt 2 20))
58 #!+stack-grows-upward (- sb!vm:control-stack-end (expt 2 20)))))
60 ;;; FIXME: Even though this is only called when (> SAFETY (MAX SPEED SPACE))
61 ;;; it's still annoyingly wasteful for it to be a full function call.
62 ;;; It should probably be a VOP calling an assembly routine or something
64 (defun %detect-stack-exhaustion ()
65 ;; FIXME: Check the stack pointer against *STACK-EXHAUSTION*, and if
66 ;; out of range signal an error (in a context where *S-E* has been
67 ;; rebound to give some space to let error handling code do its
68 ;; thing without new exhaustion problems).