Remove without-stepping and stepping-off!, but provide

hook/invoke-condition-handler so that they can be installed.

diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm
index f7785704f6f0e2ef1b37a8e263c11b988b7c3024..2cff9df16c48943756597ff57e9709a118a7d8f9 100644 (file)
--- a/v7/src/runtime/error.scm
+++ b/v7/src/runtime/error.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 14.24 1991/09/02 04:23:21 sybok Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 14.25 1991/09/08 02:56:42 jinx Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -441,6 +441,11 @@ MIT in each case. |#
   (set! break-on-signals-types types)
   unspecific)
 
+(define hook/invoke-condition-handler)
+
+(define (default/invoke-condition-handler handler condition)
+  (handler condition))
+
 (define (signal-condition condition)
   (guarantee-condition condition 'SIGNAL-CONDITION)
   (let ((generalizations
@@ -464,9 +469,7 @@ MIT in each case. |#
              (or (null? types)
                  (intersect-generalizations? types)))
            (fluid-let ((dynamic-handler-frames (cdr frames)))
-             (without-stepping
-              (lambda ()
-                ((cdar frames) condition))))))
+             (hook/invoke-condition-handler (cdar frames) condition))))
       (do ((frames static-handler-frames (cdr frames)))
          ((null? frames))
        (if (let ((types (caar frames)))
@@ -474,9 +477,7 @@ MIT in each case. |#
                  (intersect-generalizations? types)))
            (fluid-let ((static-handler-frames (cdr frames))
                        (dynamic-handler-frames '()))
-             (without-stepping
-              (lambda ()
-                ((cdar frames) condition)))))))))
+             (hook/invoke-condition-handler (cdar frames) condition)))))))
 \f
 ;;;; Standard Condition Signallers
 
@@ -663,6 +664,7 @@ MIT in each case. |#
   (memq condition-type:error (%condition-type/generalizations type)))
 \f
 (define (initialize-package!)
+  (set! hook/invoke-condition-handler default/invoke-condition-handler)
   (set! hook/before-restart default/before-restart)
   (set! condition-type:serious-condition
        (make-condition-type 'SERIOUS-CONDITION false '() false))
@@ -1018,12 +1020,6 @@ MIT in each case. |#
        (condition-signaller condition-type:file-touch-error
                             '(FILENAME MESSAGE)
                             standard-error-handler))
-  (set! stepping-off!
-       (lambda ()
-         (environment-assign! *old-hook-storage-environment*
-           'old-stepper-hooks 
-           (environment-lookup *old-hook-storage-environment*
-                               'null-hooks))))
 
   unspecific)
 \f
@@ -1142,41 +1138,4 @@ MIT in each case. |#
 
 (define-integrable (guarantee-restarts object operator)
   (if (not (and (list? object) (for-all? object restart?)))
-      (error:wrong-type-argument object "list of restarts" operator)))
-
-;; WITHOUT-STEPPING restores the stepper hooks to the state
-;; encountered on each entry to the thunk. It might be better to
-;; restore the hooks to the initial state. I flipped a coin.
-
-(define *old-hook-storage-environment*)
-
-(let-syntax ((ufixed-objects-slot
-             (macro (name)
-               (fixed-objects-vector-slot name))))
-
-  (define (without-stepping thunk)
-    (define (get-stepper-hooks)
-      (vector-ref (get-fixed-objects-vector)
-                 (ufixed-objects-slot stepper-state)))
-    (let ((old-stepper-hooks)
-         (null-hooks (hunk3-cons #f #f #f)))
-      (set! *old-hook-storage-environment* (the-environment))
-      (dynamic-wind
-       (lambda ()
-        (set! old-stepper-hooks (get-stepper-hooks))
-        (if old-stepper-hooks
-            ((ucode-primitive primitive-return-step 2)
-             unspecific null-hooks)))
-       thunk
-       (lambda ()
-        ((ucode-primitive primitive-return-step 2)
-         unspecific
-         (or old-stepper-hooks
-             null-hooks)))))))
-
-;; Without-stepping doesn't work right with the stepper unless stepping-off!
-;; is included in the thunk passed to it.
-
-(define stepping-off!)
- 
-
+      (error:wrong-type-argument object "list of restarts" operator)))
\ No newline at end of file

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index bd4278a6b618519da348d9abd551c8876830b107..78bfea77f4e850eca9f99f524db39122f677f2a4 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.121 1991/09/07 05:31:10 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.122 1991/09/08 02:57:03 jinx Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -587,6 +587,7 @@ MIT in each case. |#
          condition/type
          condition?
          continue
+         default/invoke-condition-handler
          error
          error-irritant/noise
          error:bad-range-argument
@@ -602,6 +603,7 @@ MIT in each case. |#
          error:wrong-type-datum
          find-restart
          format-error-message
+         hook/invoke-condition-handler
          invoke-restart
          invoke-restart-interactively
          make-condition
@@ -619,12 +621,10 @@ MIT in each case. |#
          standard-error-hook
          standard-warning-handler
          standard-warning-hook
-         stepping-off!
          store-value
          use-value
          warn
          with-simple-restart
-         without-stepping
          write-condition-report
          write-restart-report)
   (export (runtime microcode-errors)

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 560411cc67b603f02d7295f28ad84ffe5b08d81e..eec2b102ced2b13207237053321b2371051bc354 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.121 1991/09/07 05:31:10 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.122 1991/09/08 02:57:03 jinx Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -587,6 +587,7 @@ MIT in each case. |#
          condition/type
          condition?
          continue
+         default/invoke-condition-handler
          error
          error-irritant/noise
          error:bad-range-argument
@@ -602,6 +603,7 @@ MIT in each case. |#
          error:wrong-type-datum
          find-restart
          format-error-message
+         hook/invoke-condition-handler
          invoke-restart
          invoke-restart-interactively
          make-condition
@@ -619,12 +621,10 @@ MIT in each case. |#
          standard-error-hook
          standard-warning-handler
          standard-warning-hook
-         stepping-off!
          store-value
          use-value
          warn
          with-simple-restart
-         without-stepping
          write-condition-report
          write-restart-report)
   (export (runtime microcode-errors)