X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fexhaust.lisp;h=7de2f007085623ee139b3a457b7c35ae4f4c4c55;hb=15d6e7c9a2c3234f95dfe278046fa2fee1b0c007;hp=50c5bdb8f9e8271c5d5d1d2daee543ae7a16cf2c;hpb=08671cc8f003e0b1f9879635fa950c78f7bf40fe;p=sbcl.git diff --git a/src/code/exhaust.lisp b/src/code/exhaust.lisp index 50c5bdb..7de2f00 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. @@ -10,14 +11,11 @@ ;;;; files for more information. (in-package "SB!KERNEL") +(define-alien-routine ("protect_control_stack_guard_page" + %protect-control-stack-guard-page) + sb!alien:int (thread-id sb!alien:int) (protect-p sb!alien:int)) +(defun protect-control-stack-guard-page (n) + (%protect-control-stack-guard-page + (sb!thread:current-thread-id) (if n 1 0))) + -;;; 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))