From ff06743dae648568ae2d8e4641da575e1fa640af Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Fri, 13 Aug 1999 16:41:55 +0000
Subject: [PATCH] Add the varible *debug-readtable* to allow the binding of an
 alternate readtable during debug, from Raymond Toy.

---
 code/debug.lisp | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/code/debug.lisp b/code/debug.lisp
index eb3ab311c..99c3e8eab 100644
--- a/code/debug.lisp
+++ b/code/debug.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug.lisp,v 1.48 1998/01/05 20:09:21 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug.lisp,v 1.49 1999/08/13 16:41:55 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -20,7 +20,7 @@
 
 (export '(internal-debug *in-the-debugger* backtrace *flush-debug-errors*
 	  *debug-print-level* *debug-print-length* *debug-prompt*
-	  *help-line-scroll-count* *stack-top-hint*
+	  *debug-readtable* *help-line-scroll-count* *stack-top-hint*
 
 	  *auto-eval-in-frame* var arg
 	  *only-block-start-locations* *print-location-kind*
@@ -712,12 +712,17 @@ See the CMU Common Lisp User's Manual for more information.
   "When set, avoid calling INVOKE-DEBUGGER recursively when errors occur while
    executing in the debugger.  The 'flush' command toggles this.")
 
+(defvar *debug-readtable* nil
+  "When non-NIL, becomes the system *READTABLE* in the debugger
+   read-eval-print loop")
+
 (defun debug-loop ()
   (let* ((*debug-command-level* (1+ *debug-command-level*))
 	 (*real-stack-top* (di:top-frame))
 	 (*stack-top* (or *stack-top-hint* *real-stack-top*))
 	 (*stack-top-hint* nil)
-	 (*current-frame* *stack-top*))
+	 (*current-frame* *stack-top*)
+	 (*readtable* (or *debug-readtable* *readtable*)))
     (handler-bind ((di:debug-condition #'(lambda (condition)
 					   (princ condition *debug-io*)
 					   (throw 'debug-loop-catcher nil))))
-- 
GitLab