/[cmucl]/src/code/interr.lisp
ViewVC logotype

Diff of /src/code/interr.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.47 by rtoy, Fri Aug 17 14:02:12 2007 UTC revision 1.47.24.2 by rtoy, Tue Feb 9 20:23:02 2010 UTC
# Line 17  Line 17 
17    
18  (in-package "KERNEL")  (in-package "KERNEL")
19    
20    (intl:textdomain "cmucl")
21    
22  (export '(infinite-error-protect find-caller-name *maximum-error-depth*  (export '(infinite-error-protect find-caller-name *maximum-error-depth*
23            #+stack-checking red-zone-hit #+stack-checking yellow-zone-hit            #+stack-checking red-zone-hit #+stack-checking yellow-zone-hit
24            #+heap-overflow-check dynamic-space-overflow-error-hit            #+heap-overflow-check dynamic-space-overflow-error-hit
# Line 274  Line 276 
276    (error 'simple-control-error    (error 'simple-control-error
277           :function-name name           :function-name name
278           :format-control           :format-control
279           "Attempt to RETURN-FROM a block or GO to a tag that no longer exists"))           _"Attempt to RETURN-FROM a block or GO to a tag that no longer exists"))
280    
281  (deferr unseen-throw-tag-error (tag)  (deferr unseen-throw-tag-error (tag)
282    (error 'simple-control-error    (error 'simple-control-error
283           :function-name name           :function-name name
284           :format-control "Attempt to THROW to a tag that does not exist: ~S"           :format-control _"Attempt to THROW to a tag that does not exist: ~S"
285           :format-arguments (list tag)))           :format-arguments (list tag)))
286    
287  (deferr nil-function-returned-error (function)  (deferr nil-function-returned-error (function)
288    (error 'simple-control-error    (error 'simple-control-error
289           :function-name name           :function-name name
290           :format-control           :format-control
291           "Function with declared result type NIL returned:~%  ~S"           _"Function with declared result type NIL returned:~%  ~S"
292           :format-arguments (list function)))           :format-arguments (list function)))
293    
294  (deferr division-by-zero-error (this that)  (deferr division-by-zero-error (this that)
# Line 313  Line 315 
315  (deferr odd-keyword-arguments-error ()  (deferr odd-keyword-arguments-error ()
316    (error 'simple-program-error    (error 'simple-program-error
317           :function-name name           :function-name name
318           :format-control "Odd number of keyword arguments."))           :format-control _"Odd number of keyword arguments."))
319    
320  (deferr unknown-keyword-argument-error (key)  (deferr unknown-keyword-argument-error (key)
321    (error 'simple-program-error    (error 'simple-program-error
322           :function-name name           :function-name name
323           :format-control "Unknown keyword: ~S"           :format-control _"Unknown keyword: ~S"
324           :format-arguments (list key)))           :format-arguments (list key)))
325    
326  (deferr invalid-array-index-error (array bound index)  (deferr invalid-array-index-error (array bound index)
# Line 506  Line 508 
508  (deferr undefined-foreign-symbol-error (symbol)  (deferr undefined-foreign-symbol-error (symbol)
509    (error 'simple-program-error    (error 'simple-program-error
510           :function-name name           :function-name name
511           :format-control "Undefined foreign symbol: ~S"           :format-control _"Undefined foreign symbol: ~S"
512           :format-arguments (list symbol)))           :format-arguments (list symbol)))
513    
514    
# Line 518  Line 520 
520              (numberp *current-error-depth*))              (numberp *current-error-depth*))
521         (let ((*current-error-depth* (1+ *current-error-depth*)))         (let ((*current-error-depth* (1+ *current-error-depth*)))
522           (if (> *current-error-depth* *maximum-error-depth*)           (if (> *current-error-depth* *maximum-error-depth*)
523               (error-error "Help! " *current-error-depth* " nested errors.  "               (error-error _"Help! " *current-error-depth* _" nested errors.  "
524                            "KERNEL:*MAXIMUM-ERROR-DEPTH* exceeded.")                            _"KERNEL:*MAXIMUM-ERROR-DEPTH* exceeded.")
525               (progn ,@forms)))               (progn ,@forms)))
526         (%primitive halt)))         (%primitive halt)))
527    
528  ;;; Track the depth of recursive errors.  ;;; Track the depth of recursive errors.
529  ;;;  ;;;
530  (defvar *maximum-error-depth* 10  (defvar *maximum-error-depth* 10
531    "The maximum number of nested errors allowed.  Internal errors are    _N"The maximum number of nested errors allowed.  Internal errors are
532     double-counted.")     double-counted.")
533  (defvar *current-error-depth* 0 "The current number of nested errors.")  (defvar *current-error-depth* 0 _N"The current number of nested errors.")
534    
535  ;;; These specials are used by ERROR-ERROR to track the success of recovery  ;;; These specials are used by ERROR-ERROR to track the success of recovery
536  ;;; attempts.  ;;; attempts.
# Line 632  Line 634 
634                    (error 'simple-error                    (error 'simple-error
635                           :function-name name                           :function-name name
636                           :format-control                           :format-control
637                           "Unknown internal error, ~D?  args=~S"                           _"Unknown internal error, ~D?  args=~S"
638                           :format-arguments                           :format-arguments
639                           (list error-number                           (list error-number
640                                 (mapcar #'(lambda (sc-offset)                                 (mapcar #'(lambda (sc-offset)
# Line 643  Line 645 
645                    (error 'simple-error                    (error 'simple-error
646                           :function-name name                           :function-name name
647                           :format-control                           :format-control
648                           "Internal error ~D: ~A.  args=~S"                           _"Internal error ~D: ~A.  args=~S"
649                           :format-arguments                           :format-arguments
650                           (list error-number                           (list error-number
651                                 handler                                 handler
# Line 664  Line 666 
666  (defun yellow-zone-hit ()  (defun yellow-zone-hit ()
667    (let ((debug:*stack-top-hint* nil))    (let ((debug:*stack-top-hint* nil))
668      (format *error-output*      (format *error-output*
669              "~2&~@<A control stack overflow has occurred: ~              _"~2&~@<A control stack overflow has occurred: ~
670              the program has entered the yellow control stack guard zone.  ~              the program has entered the yellow control stack guard zone.  ~
671              Please note that you will be returned to the Top-Level if you ~              Please note that you will be returned to the Top-Level if you ~
672              enter the red control stack guard zone while debugging.~@:>~2%")              enter the red control stack guard zone while debugging.~@:>~2%")
# Line 682  Line 684 
684  #+stack-checking  #+stack-checking
685  (defun red-zone-hit ()  (defun red-zone-hit ()
686    (format *error-output*    (format *error-output*
687            "~2&~@<Fatal control stack overflow.  You have entered~%~            _"~2&~@<Fatal control stack overflow.  You have entered~%~
688             the red control stack guard zone while debugging.~%~             the red control stack guard zone while debugging.~%~
689             Returning to Top-Level.~@:>~2%")             Returning to Top-Level.~@:>~2%")
690    (throw 'lisp::top-level-catcher nil))    (throw 'lisp::top-level-catcher nil))
# Line 693  Line 695 
695      ;; Don't reserve any more pages      ;; Don't reserve any more pages
696      (setf lisp::reserved-heap-pages 0)      (setf lisp::reserved-heap-pages 0)
697      (format *error-output*      (format *error-output*
698              "~2&~@<Imminent dynamic space overflow has occurred:~%~              _"~2&~@<Imminent dynamic space overflow has occurred:~%~
699              Only a small amount of dynamic space is available now.~%~              Only a small amount of dynamic space is available now.~%~
700              Please note that you will be returned to the Top-Level without~%~              Please note that you will be returned to the Top-Level without~%~
701              warning if you run out of space while debugging.~@:>~%")              warning if you run out of space while debugging.~@:>~%")

Legend:
Removed from v.1.47  
changed lines
  Added in v.1.47.24.2

  ViewVC Help
Powered by ViewVC 1.1.5