From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 15 May 1991 22:03:00 +0000 (+0000)
Subject: Bind a condition handler to catch and ignore errors that occur while
X-Git-Tag: 20090517-FFI~10571
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2a379230d7c4f92470d609fd71f6dc49e9de88d9;p=mit-scheme.git

Bind a condition handler to catch and ignore errors that occur while
executing debugger commands.
---

diff --git a/v7/src/runtime/dbgcmd.scm b/v7/src/runtime/dbgcmd.scm
index ad3460c70..914bc8e6b 100644
--- a/v7/src/runtime/dbgcmd.scm
+++ b/v7/src/runtime/dbgcmd.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dbgcmd.scm,v 14.11 1991/02/15 18:04:45 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/dbgcmd.scm,v 14.12 1991/05/15 22:03:00 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -68,22 +68,32 @@ MIT in each case. |#
 	     make-cmdl))
 
 (define (letter-commands/driver cmdl)
-  (let ((command-set (vector-ref (cmdl/state cmdl) 0))
-	(prompt (vector-ref (cmdl/state cmdl) 1))
-	(state (vector-ref (cmdl/state cmdl) 2)))
-    (let loop ()
-      (let ((char (char-upcase (prompt-for-command-char prompt cmdl))))
-	(with-output-to-port (cmdl/output-port cmdl)
-	  (lambda ()
-	    (let ((entry (assv char (cdr command-set))))
-	      (if entry
-		  ((cadr entry) state)
-		  (begin
-		    (beep)
-		    (newline)
-		    (write-string "Unknown command char: ")
-		    (write char)
-		    (loop)))))))))
+  (call-with-current-continuation
+   (lambda (continuation)
+     (bind-condition-handler (list condition-type:error)
+	 (lambda (condition)
+	   (let ((port (cmdl/output-port cmdl)))
+	     (beep port)
+	     (write-string ";Ignoring error:\n;" port)
+	     (write-condition-report condition port))
+	   (continuation unspecific))
+       (lambda ()
+	 (let ((command-set (vector-ref (cmdl/state cmdl) 0))
+	       (prompt (vector-ref (cmdl/state cmdl) 1))
+	       (state (vector-ref (cmdl/state cmdl) 2)))
+	   (let loop ()
+	     (let ((char (char-upcase (prompt-for-command-char prompt cmdl))))
+	       (with-output-to-port (cmdl/output-port cmdl)
+		 (lambda ()
+		   (let ((entry (assv char (cdr command-set))))
+		     (if entry
+			 ((cadr entry) state)
+			 (begin
+			   (beep)
+			   (newline)
+			   (write-string "Unknown command char: ")
+			   (write char)
+			   (loop)))))))))))))
   (cmdl-message/null))
 
 (define ((standard-help-command command-set) state)