[Sbcl-commits] CVS: sbcl/src/code error.lisp, 1.36, 1.37 exhaust.lisp, 1.12, 1.13 interr.lisp, 1.53, 1.54

[Gabor M. <me...@us...>]

Update of /cvsroot/sbcl/sbcl/src/code
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv12824/src/code

Modified Files:
	error.lisp exhaust.lisp interr.lisp 
Log Message:
1.0.25.50: detect binding and alien stack exhaustion

Alien stack exhaustion machinery only works on x86oids.


Index: error.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/error.lisp,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -d -r1.36 -r1.37
--- error.lisp	16 Oct 2008 21:28:46 -0000	1.36
+++ error.lisp	16 Feb 2009 22:23:08 -0000	1.37
@@ -164,6 +164,28 @@
 
 PROCEED WITH CAUTION."))))
 
+(define-condition binding-stack-exhausted (storage-condition)
+  ()
+  (:report
+    (lambda (condition stream)
+      (declare (ignore condition))
+      (format stream
+              ;; no pretty-printing, because that would use a lot of stack.
+              "Binding stack exhausted.
+
+PROCEED WITH CAUTION."))))
+
+(define-condition alien-stack-exhausted (storage-condition)
+  ()
+  (:report
+    (lambda (condition stream)
+      (declare (ignore condition))
+      (format stream
+              ;; no pretty-printing, because that would use a lot of stack.
+              "Alien stack exhausted.
+
+PROCEED WITH CAUTION."))))
+
 (define-condition heap-exhausted-error (storage-condition)
   ()
   (:report

Index: exhaust.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/exhaust.lisp,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- exhaust.lisp	4 Oct 2005 17:31:26 -0000	1.12
+++ exhaust.lisp	16 Feb 2009 22:23:08 -0000	1.13
@@ -14,6 +14,7 @@
 (define-alien-routine ("protect_control_stack_guard_page"
                        %protect-control-stack-guard-page)
     sb!alien:void
-  (protect-p sb!alien:int))
+  (protect-p sb!alien:int)
+  (thread sb!alien:int))
 (defun protect-control-stack-guard-page (n)
-  (%protect-control-stack-guard-page (if n 1 0)))
+  (%protect-control-stack-guard-page (if n 1 0) 0))

Index: interr.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/interr.lisp,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -d -r1.53 -r1.54
--- interr.lisp	16 Feb 2009 21:39:59 -0000	1.53
+++ interr.lisp	16 Feb 2009 22:23:08 -0000	1.54
@@ -460,6 +460,20 @@
              "Control stack guard page temporarily disabled: proceed with caution~%")
      (error 'control-stack-exhausted))))
 
+(defun binding-stack-exhausted-error ()
+  (let ((sb!debug:*stack-top-hint* nil))
+    (infinite-error-protect
+     (format *error-output*
+             "Binding stack guard page temporarily disabled: proceed with caution~%")
+     (error 'binding-stack-exhausted))))
+
+(defun alien-stack-exhausted-error ()
+  (let ((sb!debug:*stack-top-hint* nil))
+    (infinite-error-protect
+     (format *error-output*
+             "Alien stack guard page temporarily disabled: proceed with caution~%")
+     (error 'alien-stack-exhausted))))
+
 ;;; KLUDGE: we keep a single HEAP-EXHAUSTED-ERROR object around, so
 ;;; that we don't need to allocate it when running out of
 ;;; memory. Similarly we pass the amounts in special variables as