diff --git a/code/interr.lisp b/code/interr.lisp
index eddf955620938c5cee16ed97ae098d0b6b3c51c4..18f1f41d434141504a02167e76c69631babf5ec5 100644
--- a/code/interr.lisp
+++ b/code/interr.lisp
@@ -7,12 +7,10 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.19 1991/11/09 20:49:49 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.20 1992/01/21 17:25:01 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/interr.lisp,v 1.19 1991/11/09 20:49:49 ram Exp $
-;;;
 ;;; Functions and macros to define and deal with internal errors (i.e.
 ;;; problems that can be signaled from assembler code).
 ;;;
@@ -21,7 +19,8 @@
 
 (in-package "KERNEL")
 
-(export '(error-number-or-lose))
+(export '(error-number-or-lose infinite-error-protect find-caller-name
+			       *maximum-error-depth*))
 
 (export '(unknown-error object-not-function-error object-not-list-error
 	  object-not-bignum-error object-not-ratio-error
@@ -586,9 +585,81 @@
 
 
 
-;;;; internal-error signal handler.
+;;; INFINITE-ERROR-PROTECT is used by ERROR and friends to keep us out of
+;;; hyperspace.
+;;;
+(defmacro infinite-error-protect (&rest forms)
+  `(if (and (boundp '*error-system-initialized*)
+	    (numberp *current-error-depth*))
+       (let ((*current-error-depth* (1+ *current-error-depth*)))
+	 (if (> *current-error-depth* *maximum-error-depth*)
+	     (error-error "Help! " *current-error-depth* " nested errors."
+			  "KERNEL:*MAXIMUM-ERROR-DEPTH* exceeded.")
+	     (progn ,@forms)))
+       (%primitive halt)))
+
+;;; Track the depth of recursive errors.
+;;;
+(defvar *maximum-error-depth* 10
+  "The maximum number of nested errors allowed.  Internal errors are
+   double-counted.")
+(defvar *current-error-depth* 0 "The current number of nested errors.")
+
+;;; These specials are used by ERROR-ERROR to track the success of recovery
+;;; attempts.
+;;;
+(defvar *error-error-depth* 0)
+(defvar *error-throw-up-count* 0)
+
+;;; This protects against errors that happen before we run this top-level form.
+;;;
+(defvar *error-system-initialized* t)
+
+;;; ERROR-ERROR can be called when the error system is in trouble and needs
+;;; to punt fast.  Prints a message without using format.  If we get into
+;;; this recursively, then halt.
+;;;
+(defun error-error (&rest messages)
+  (let ((*error-error-depth* (1+ *error-error-depth*)))
+    (when (> *error-throw-up-count* 50)
+      (%primitive halt)
+      (throw 'lisp::top-level-catcher nil))
+    (case *error-error-depth*
+      (1)
+      (2
+       (lisp::stream-init))
+      (3
+       (incf *error-throw-up-count*)
+       (throw 'lisp::top-level-catcher nil))
+      (t
+       (%primitive halt)
+       (throw 'lisp::top-level-catcher nil)))
+
+    (with-standard-io-syntax
+      (dolist (item messages) (princ item *terminal-io*))
+      (debug:internal-debug))))
+
+
+;;;; Fetching errorful function name.
+
+;;; Used to prevent infinite recursive lossage when we can't find the caller
+;;; for some reason.
+;;;
+(defvar *finding-caller* nil)
+
+;;; FIND-CALLER-NAME  --  Internal
+;;;
+(defun find-caller-name ()
+  (if *finding-caller*
+      "<error finding name>"
+      (handler-case
+	  (let ((*finding-caller* t))
+	    (di:debug-function-name
+	     (di:frame-debug-function
+	      (di:frame-down (di:frame-down (di:top-frame))))))
+	(error () "<error finding name>")
+	(di:debug-condition () "<error finding name>"))))
 
-(defvar *finding-name* nil)
 
 (defun find-interrupted-name ()
   (if *finding-name*
@@ -606,48 +677,53 @@
 	(error () "<error finding name>")
 	(di:debug-condition () "<error finding name>"))))
 
+
+;;;; internal-error signal handler.
 
 (defun internal-error (scp continuable)
   (declare (ignore continuable))
-  (alien-bind ((sc (make-alien 'mach:sigcontext
-			       #.(c-sizeof 'mach:sigcontext)
-			       scp)
-		   mach:sigcontext
-		   t))
-    (multiple-value-bind
-	(error-number arguments)
-	(vm:internal-error-arguments (alien-value sc))
-      (let ((fp (int-sap (di::escape-register (alien-value sc)
-					      vm::cfp-offset)))
-	    (name (find-interrupted-name))
-	    (info (and (< -1 error-number (length *internal-errors*))
-		       (svref *internal-errors* error-number))))
-	(cond ((null info)
-	       (error 'simple-error
-		      :function-name name
-		      :format-string
-		      "Unknown internal error, ~D?  args=~S"
-		      :format-arguments
-		      (list error-number
-			    (mapcar #'(lambda (sc-offset)
-					(di::sub-access-debug-var-slot
-					 fp
-					 sc-offset
-					 (alien-value sc)))
-				    arguments))))
-	      ((null (error-info-function info))
-	       (error 'simple-error
-		      :function-name name
-		      :format-string
-		      "Internal error ~D: ~A.  args=~S"
-		      :format-arguments
-		      (list error-number
-			    (error-info-description info)
-			    (mapcar #'(lambda (sc-offset)
-					(di::sub-access-debug-var-slot
-					 fp
-					 sc-offset
-					 (alien-value sc)))
-				    arguments))))
-	      (t
-	       (funcall (error-info-function info) name fp sc arguments)))))))
+  (infinite-error-protect
+    (alien-bind ((sc (make-alien 'mach:sigcontext
+				 #.(c-sizeof 'mach:sigcontext)
+				 scp)
+		     mach:sigcontext
+		     t))
+      (multiple-value-bind
+	  (error-number arguments)
+	  (vm:internal-error-arguments (alien-value sc))
+	(let ((fp (int-sap (di::escape-register (alien-value sc)
+						vm::cfp-offset)))
+	      (name (find-interrupted-name))
+	      (info (and (< -1 error-number (length *internal-errors*))
+			 (svref *internal-errors* error-number))))
+	  (cond ((null info)
+		 (error 'simple-error
+			:function-name name
+			:format-string
+			"Unknown internal error, ~D?  args=~S"
+			:format-arguments
+			(list error-number
+			      (mapcar #'(lambda (sc-offset)
+					  (di::sub-access-debug-var-slot
+					   fp
+					   sc-offset
+					   (alien-value sc)))
+				      arguments))))
+		((null (error-info-function info))
+		 (error 'simple-error
+			:function-name name
+			:format-string
+			"Internal error ~D: ~A.  args=~S"
+			:format-arguments
+			(list error-number
+			      (error-info-description info)
+			      (mapcar #'(lambda (sc-offset)
+					  (di::sub-access-debug-var-slot
+					   fp
+					   sc-offset
+					   (alien-value sc)))
+				      arguments))))
+		(t
+		 (funcall (error-info-function info) name fp sc
+			  arguments))))))))
+