/[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.26.1 by rtoy, Thu Feb 25 20:34:49 2010 UTC revision 1.51 by rtoy, Thu Sep 1 16:53:46 2011 UTC
# Line 50  Line 50 
50           (macrolet ((set-value (var value)           (macrolet ((set-value (var value)
51                        (let ((pos (position var ',required)))                        (let ((pos (position var ',required)))
52                          (unless pos                          (unless pos
53                            (error "~S isn't one of the required args."                            (error (intl:gettext "~S isn't one of the required args.")
54                                   var))                                   var))
55                          `(let ((,',temp ,value))                          `(let ((,',temp ,value))
56                             (di::sub-set-debug-var-slot                             (di::sub-set-debug-var-slot
# Line 82  Line 82 
82    
83    
84  (deferr unknown-error (&rest args)  (deferr unknown-error (&rest args)
85    (error "Unknown error:~{ ~S~})" args))    (error (intl:gettext "Unknown error:~{ ~S~})") args))
86    
87  (deferr object-not-function-error (object)  (deferr object-not-function-error (object)
88    (error 'type-error    (error 'type-error
# Line 246  Line 246 
246  (deferr invalid-argument-count-error (nargs)  (deferr invalid-argument-count-error (nargs)
247    (error 'simple-program-error    (error 'simple-program-error
248           :function-name name           :function-name name
249           :format-control "Invalid number of arguments: ~S"           :format-control (intl:gettext "Invalid number of arguments: ~S")
250           :format-arguments (list nargs)))           :format-arguments (list nargs)))
251    
252  (deferr bogus-argument-to-values-list-error (list)  (deferr bogus-argument-to-values-list-error (list)
# Line 254  Line 254 
254           :function-name name           :function-name name
255           :datum list           :datum list
256           :expected-type 'list           :expected-type 'list
257           :format-control "Attempt to use VALUES-LIST on a dotted-list:~%  ~S"           :format-control (intl:gettext "Attempt to use VALUES-LIST on a dotted-list:~%  ~S")
258           :format-arguments (list list)))           :format-arguments (list list)))
259    
260  (deferr unbound-symbol-error (symbol)  (deferr unbound-symbol-error (symbol)
# Line 276  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"))           (intl:gettext "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 (intl:gettext "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"           (intl:gettext "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 315  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 (intl:gettext "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 (intl:gettext "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 330  Line 330 
330           :expected-type `(integer 0 (,bound))           :expected-type `(integer 0 (,bound))
331           :format-control           :format-control
332           (cond ((zerop bound)           (cond ((zerop bound)
333                  "Invalid array index, ~D for ~S.  Array has no elements.")                  (intl:gettext "Invalid array index, ~D for ~S.  Array has no elements."))
334                 ((minusp index)                 ((minusp index)
335                  "Invalid array index, ~D for ~S.  Should have greater than or equal to 0.")                  (intl:gettext "Invalid array index, ~D for ~S.  Should have greater than or equal to 0."))
336                 (t                 (t
337                  "Invalid array index, ~D for ~S.  Should have been less than ~D"))                  (intl:gettext "Invalid array index, ~D for ~S.  Should have been less than ~D")))
338           :format-arguments (list index array bound)))           :format-arguments (list index array bound)))
339    
340  (deferr object-not-simple-array-error (object)  (deferr object-not-simple-array-error (object)
# Line 508  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 (intl:gettext "Undefined foreign symbol: ~S")
512           :format-arguments (list symbol)))           :format-arguments (list symbol)))
513    
514    
# Line 520  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 (intl:gettext "Help! ") *current-error-depth* (intl:gettext " nested errors.  ")
524                            _"KERNEL:*MAXIMUM-ERROR-DEPTH* exceeded.")                            (intl:gettext "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    _N"The maximum number of nested errors allowed.  Internal errors are    "The maximum number of nested errors allowed.  Internal errors are
532     double-counted.")     double-counted.")
533  (defvar *current-error-depth* 0 _N"The current number of nested errors.")  (defvar *current-error-depth* 0 "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 634  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"                           (intl:gettext "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 645  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"                           (intl:gettext "Internal error ~D: ~A.  args=~S")
649                           :format-arguments                           :format-arguments
650                           (list error-number                           (list error-number
651                                 handler                                 handler
# Line 666  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: ~              (intl:gettext "~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%"))
673      (infinite-error-protect (error 'stack-overflow))))      (infinite-error-protect (error 'stack-overflow))))
674    
675  ;;;  ;;;
# Line 684  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~%~            (intl:gettext "~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))
691    
692  #+heap-overflow-check  #+heap-overflow-check
# Line 695  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:~%~              (intl:gettext "~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.~@:>~%"))
702      (infinite-error-protect (error 'heap-overflow))))      (infinite-error-protect (error 'heap-overflow))))
703    
704  #+heap-overflow-check  #+heap-overflow-check

Legend:
Removed from v.1.47.26.1  
changed lines
  Added in v.1.51

  ViewVC Help
Powered by ViewVC 1.1.5