When invoking restart in another thread, must call RESTART-THREAD.

Also, look for a special CONTINUE restart in the current thread and
invoke that.

diff --git a/v7/src/runtime/debug.scm b/v7/src/runtime/debug.scm
index 69b50b469f8ba7a596189b2747662d3bc9d2b151..3b672b176fd96525979903add886853874879b9a 100644 (file)
--- a/v7/src/runtime/debug.scm
+++ b/v7/src/runtime/debug.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: debug.scm,v 14.37 1993/12/22 01:26:13 jmiller Exp $
+$Id: debug.scm,v 14.38 1993/12/23 08:03:35 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -694,38 +694,40 @@ MIT in each case. |#
        (debugger-failure port "No condition to report."))))
 
 (define-command (command/condition-restart dstate port)
-  (let ((restarts
-        (let ((condition (dstate/condition dstate)))
+  (let ((condition (dstate/condition dstate)))
+    (let ((restarts
           (if condition
               (condition/restarts condition)
-              (bound-restarts)))))
-    (if (null? restarts)
-       (debugger-failure port "No options to choose from.")
-       (let ((n-restarts (length restarts))
-             (write-index
-              (lambda (index port)
-                (write-string (string-pad-left (number->string index) 3) port)
-                (write-string ":" port))))
-         (let ((invoke-option
-                (lambda (n)
-                  (invoke-restart-interactively
-                   (list-ref restarts (- n-restarts n))))))
-           (debugger-presentation port
-             (lambda ()
-               (if (= n-restarts 1)
-                   (begin
-                     (write-string "There is only one option:" port)
-                     (write-restarts restarts port write-index)
-                     (if (prompt-for-confirmation "Use this option" port)
-                         (invoke-option 1)))
-                   (begin
-                     (write-string "Choose an option by number:" port)
-                     (write-restarts restarts port write-index)
-                     (invoke-option
-                      (prompt-for-integer "Option number"
-                                          1
-                                          (+ n-restarts 1)
-                                          port)))))))))))
+              (bound-restarts))))
+      (if (null? restarts)
+         (debugger-failure port "No options to choose from.")
+         (let ((n-restarts (length restarts))
+               (write-index
+                (lambda (index port)
+                  (write-string (string-pad-left (number->string index) 3)
+                                port)
+                  (write-string ":" port))))
+           (let ((invoke-option
+                  (lambda (n)
+                    (invoke-restart-interactively
+                     (list-ref restarts (- n-restarts n))
+                     condition))))
+             (debugger-presentation port
+               (lambda ()
+                 (if (= n-restarts 1)
+                     (begin
+                       (write-string "There is only one option:" port)
+                       (write-restarts restarts port write-index)
+                       (if (prompt-for-confirmation "Use this option" port)
+                           (invoke-option 1)))
+                     (begin
+                       (write-string "Choose an option by number:" port)
+                       (write-restarts restarts port write-index)
+                       (invoke-option
+                        (prompt-for-integer "Option number"
+                                            1
+                                            (+ n-restarts 1)
+                                            port))))))))))))
 \f
 ;;;; Advanced hacking commands
 
@@ -769,33 +771,16 @@ MIT in each case. |#
              (if (not thread)
                  ((stack-frame->continuation subproblem) value)
                  (begin
-                   (restart-thread
-                    thread
-                    (prompt-for-confirmation
-                     "Restarting other thread; discard events in its queue"
-                     port)
-                    (lambda ()
-                      ((stack-frame->continuation subproblem) value)))
-                   (if (prompt-for-confirmation
-                        "Thread restarted; exit debugger"
-                        port)
-                       (standard-exit-command dstate port))))))))))
+                   (restart-thread thread 'ASK
+                     (lambda ()
+                       ((stack-frame->continuation subproblem) value)))
+                   (continue-from-derived-thread-error
+                    (dstate/condition dstate))))))))))
 
-(define (dstate/thread dstate)
+(define (dstate/other-thread dstate)
   (let ((condition (dstate/condition dstate)))
     (and condition
-        (condition/derived-thread? condition)
-        (access-condition condition 'THREAD))))
-
-(define (dstate/other-thread dstate)
-  (let ((thread
-        (let ((condition (dstate/condition dstate)))
-          (and condition
-               (condition/derived-thread? condition)
-               (access-condition condition 'THREAD)))))
-    (and thread
-        (not (eq? thread (current-thread)))
-        thread)))
+        (condition/other-thread condition))))
 
 (define hook/debugger-before-return)
 (define (default/debugger-before-return)

diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm
index b78d37506125bca479b5eef5018a734dc97df2fc..deb2200ba2887d017a7a11171fbc9cb5bd8fa09b 100644 (file)
--- a/v7/src/runtime/error.scm
+++ b/v7/src/runtime/error.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: error.scm,v 14.44 1993/12/17 02:47:39 cph Exp $
+$Id: error.scm,v 14.45 1993/12/23 08:03:22 cph Exp $
 
 Copyright (c) 1988-93 Massachusetts Institute of Technology
 
@@ -368,14 +368,38 @@ MIT in each case. |#
   (guarantee-restart restart 'INVOKE-RESTART)
   (hook/invoke-restart (%restart/effector restart) arguments))
 
-(define (invoke-restart-interactively restart)
+(define (invoke-restart-interactively restart #!optional condition)
   (guarantee-restart restart 'INVOKE-RESTART-INTERACTIVELY)
-  (hook/invoke-restart
-   (%restart/effector restart)
-   (let ((interactor (%restart/interactor restart)))
-     (if interactor
-        (call-with-values interactor list)
-        '()))))
+  (let ((effector (%restart/effector restart))
+       (arguments
+        (let ((interactor (%restart/interactor restart)))
+          (if interactor
+              (call-with-values interactor list)
+              '())))
+       (condition (if (default-object? condition) #f condition)))
+    (let ((thread (and condition (condition/other-thread condition))))
+      (if thread
+         (begin
+           (restart-thread thread 'ASK
+             (lambda ()
+               (hook/invoke-restart effector arguments)))
+           (continue-from-derived-thread-error condition))
+         (hook/invoke-restart effector arguments)))))
+
+(define (condition/other-thread condition)
+  (and (condition/derived-thread? condition)
+       (let ((thread (access-condition condition 'THREAD)))
+        (and (not (eq? thread (current-thread)))
+             thread))))
+
+(define (continue-from-derived-thread-error condition)
+  (let loop ((restarts (bound-restarts)))
+    (if (not (null? restarts))
+       (if (and (eq? 'CONTINUE (restart/name (car restarts)))
+                (eq? condition
+                     (restart/get (car restarts) 'ASSOCIATED-CONDITION)))
+           (invoke-restart (car restarts))
+           (loop (cdr restarts))))))
 
 (define hook/invoke-restart)
 
@@ -949,10 +973,17 @@ MIT in each case. |#
                                      '(THREAD CONDITION))))
          (lambda (thread condition)
            (guarantee-condition condition 'ERROR:DERIVED-THREAD)
-           (error (make-condition (%condition/continuation condition)
+           (let ((condition
+                  (make-condition (%condition/continuation condition)
                                   (%condition/restarts condition)
                                   thread
-                                  condition)))))
+                                  condition)))
+             (with-simple-restart 'CONTINUE "Continue from error."
+               (lambda ()
+                 (restart/put! (first-bound-restart)
+                               'ASSOCIATED-CONDITION
+                               condition)
+                 (error condition)))))))
   (set! condition/derived-thread?
        (condition-predicate condition-type:derived-thread-error))
 \f

diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm
index fb229a18dd3efd69a27625f9c03a369e17bec349..cea263b8344d36462273e07086953d1703514eae 100644 (file)
--- a/v7/src/runtime/rep.scm
+++ b/v7/src/runtime/rep.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rep.scm,v 14.46 1993/12/17 00:09:03 cph Exp $
+$Id: rep.scm,v 14.47 1993/12/23 08:03:10 cph Exp $
 
 Copyright (c) 1988-93 Massachusetts Institute of Technology
 
@@ -174,10 +174,8 @@ MIT in each case. |#
                              (error "Non-owner thread can't start CMDL:"
                                     thread)))))
                   (lambda ()
-                    (with-simple-restart 'CONTINUE "Continue from error."
-                      (lambda ()
-                        (unblock-thread-events)
-                        (signaller cmdl thread))))))
+                    (unblock-thread-events)
+                    (signaller cmdl thread))))
               (stop-current-thread))
              ((let ((parent (cmdl/parent cmdl)))
                 (and parent
@@ -530,65 +528,55 @@ MIT in each case. |#
                (write-string ";Package: " port)
                (write (package/name package) port))))))))
 \f
-(define (condition-restarts-message condition)
-  (cmdl-message/active
-   (lambda (port)
-     (fresh-line port)
-     (write-string ";To continue, call RESTART with an option number:" port)
-     (write-restarts (filter-restarts (condition/restarts condition)) port
-       (lambda (index port)
-        (write-string "; (RESTART " port)
-        (write index port)
-        (write-string ") =>" port))))))
-
 (define (restart #!optional n)
-  (let ((restarts
-        (filter-restarts
-         (let ((condition (nearest-repl/condition)))
+  (let ((condition (nearest-repl/condition)))
+    (let ((restarts
+          (filter-restarts
            (if condition
                (condition/restarts condition)
-               (bound-restarts))))))
-    (let ((n-restarts (length restarts)))
-      (if (zero? n-restarts)
-         (error "Can't RESTART: no options available."))
-      (invoke-restart-interactively
-       (list-ref
-       restarts
-       (- n-restarts
-          (if (default-object? n)
-              (let ((port (interaction-i/o-port)))
-                (fresh-line port)
-                (write-string ";Choose an option by number:" port)
-                (write-restarts restarts port
-                  (lambda (index port)
-                    (write-string ";" port)
-                    (write-string (string-pad-left (number->string index) 3)
-                                  port)
-                    (write-string ":" port)))
-                (let loop ()
-                  (let ((n
-                         (prompt-for-evaluated-expression
-                          "Option number"
-                          (nearest-repl/environment)
-                          port)))
-                    (if (and (exact-integer? n) (<= 1 n n-restarts))
-                        n
-                        (begin
-                          (beep port)
-                          (fresh-line port)
-                          (write-string
-                           ";Option must be an integer between 1 and "
-                           port)
-                          (write n-restarts port)
-                          (write-string ", inclusive.")
-                          (loop))))))
-              (begin
-                (if (not (exact-integer? n))
-                    (error:wrong-type-argument n "exact integer" 'RESTART))
-                (if (not (<= 1 n n-restarts))
-                    (error:bad-range-argument n 'RESTART))
-                n))))))))
-
+               (bound-restarts)))))
+      (let ((n-restarts (length restarts)))
+       (if (zero? n-restarts)
+           (error "Can't RESTART: no options available."))
+       (invoke-restart-interactively
+        (list-ref
+         restarts
+         (- n-restarts
+            (if (default-object? n)
+                (let ((port (interaction-i/o-port)))
+                  (fresh-line port)
+                  (write-string ";Choose an option by number:" port)
+                  (write-restarts restarts port
+                    (lambda (index port)
+                      (write-string ";" port)
+                      (write-string (string-pad-left (number->string index) 3)
+                                    port)
+                      (write-string ":" port)))
+                  (let loop ()
+                    (let ((n
+                           (prompt-for-evaluated-expression
+                            "Option number"
+                            (nearest-repl/environment)
+                            port)))
+                      (if (and (exact-integer? n) (<= 1 n n-restarts))
+                          n
+                          (begin
+                            (beep port)
+                            (fresh-line port)
+                            (write-string
+                             ";Option must be an integer between 1 and "
+                             port)
+                            (write n-restarts port)
+                            (write-string ", inclusive.")
+                            (loop))))))
+                (begin
+                  (if (not (exact-integer? n))
+                      (error:wrong-type-argument n "exact integer" 'RESTART))
+                  (if (not (<= 1 n n-restarts))
+                      (error:bad-range-argument n 'RESTART))
+                  n))))
+        condition)))))
+\f
 (define (write-restarts restarts port write-index)
   (newline port)
   (do ((restarts restarts (cdr restarts))
@@ -610,6 +598,17 @@ MIT in each case. |#
          (if (restart/interactor (car restarts))
              (cons (car restarts) rest)
              rest)))))
+
+(define (condition-restarts-message condition)
+  (cmdl-message/active
+   (lambda (port)
+     (fresh-line port)
+     (write-string ";To continue, call RESTART with an option number:" port)
+     (write-restarts (filter-restarts (condition/restarts condition)) port
+       (lambda (index port)
+        (write-string "; (RESTART " port)
+        (write index port)
+        (write-string ") =>" port))))))
 \f
 (define-structure (repl-state
                   (conc-name repl-state/)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 08d0eb37b3f76037d5b7560c6497f7cb30472d9d..16b7666ab39c965a75f6c4ce87130373182440dc 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.221 1993/12/17 00:05:06 cph Exp $
+$Id: runtime.pkg,v 14.222 1993/12/23 08:03:45 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -587,6 +587,7 @@ MIT in each case. |#
          condition/derived-thread?
          condition/error?
          condition/get
+         condition/other-thread
          condition/properties
          condition/put!
          condition/report-string
@@ -643,6 +644,8 @@ MIT in each case. |#
   (export (runtime rep)
          *bound-restarts*
          dynamic-handler-frames)
+  (export (runtime debugger)
+         continue-from-derived-thread-error)
   (initialization (initialize-package!)))
 
 (define-package (runtime event-distributor)

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 08d0eb37b3f76037d5b7560c6497f7cb30472d9d..16b7666ab39c965a75f6c4ce87130373182440dc 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.221 1993/12/17 00:05:06 cph Exp $
+$Id: runtime.pkg,v 14.222 1993/12/23 08:03:45 cph Exp $
 
 Copyright (c) 1988-1993 Massachusetts Institute of Technology
 
@@ -587,6 +587,7 @@ MIT in each case. |#
          condition/derived-thread?
          condition/error?
          condition/get
+         condition/other-thread
          condition/properties
          condition/put!
          condition/report-string
@@ -643,6 +644,8 @@ MIT in each case. |#
   (export (runtime rep)
          *bound-restarts*
          dynamic-handler-frames)
+  (export (runtime debugger)
+         continue-from-derived-thread-error)
   (initialization (initialize-package!)))
 
 (define-package (runtime event-distributor)