X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Finterr.lisp;h=9014b56ae65333cfd681521e2f69c85ef633ef88;hb=f12b298a4ce9090470000360b49523e56475a680;hp=7a48c43b3416613b48b5c3cb006458cf36345f7f;hpb=10b242aeb4e031f02a1f32ec0aea79bbe92fa1d0;p=sbcl.git diff --git a/src/code/interr.lisp b/src/code/interr.lisp index 7a48c43..9014b56 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -260,12 +260,7 @@ :format-arguments (list key-name))) (deferr invalid-array-index-error (array bound index) - (error 'simple-type-error - :format-control - "invalid array index ~W for ~S (should be nonnegative and <~W)" - :format-arguments (list index array bound) - :datum index - :expected-type `(integer 0 (,bound)))) + (invalid-array-index-error array bound index)) (deferr object-not-simple-array-error (object) (error 'type-error @@ -431,14 +426,6 @@ (multiple-value-bind (name sb!debug:*stack-top-hint*) (find-interrupted-name-and-frame) (/show0 "back from FIND-INTERRUPTED-NAME") - ;; Unblock trap signal here, we unwound the stack and can't return. - ;; FIXME: Should we not reset the _entire_ mask, but just - ;; restore it to the state before we got the condition? - ;; FIXME 2: Signals are currently unblocked in - ;; interrupt.c:internal_error before we do stack unwinding, can this - ;; introduce a race condition? - #!+(and linux mips) - (sb!unix::reset-signal-mask) (let ((fp (int-sap (sb!vm:context-register alien-context sb!vm::cfp-offset))) (handler (and (< -1 error-number (length *internal-errors*)) @@ -473,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 @@ -495,7 +496,7 @@ (error 'undefined-alien-function-error)) #!-win32 -(define-alien-variable current-memory-fault-address long) +(define-alien-variable current-memory-fault-address unsigned-long) #!-win32 (defun memory-fault-error ()