1.1.13: will be tagged as "sbcl-1.1.13"

[sbcl.git] / src / code / exhaust.lisp

diff --git a/src/code/exhaust.lisp b/src/code/exhaust.lisp
index 1879245..f35ac45 100644 (file)
--- 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.
@@ -10,60 +11,4 @@
 ;;;; files for more information.
 
 (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.
-;;;
-;;; 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.
-;;;
-;;; 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*
-  ;; (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)))))
-  
-;;; 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))
+(define-alien-routine reset-control-stack-guard-page sb!alien:void)