From: Guillermo J. Rozas Date: Sun, 8 Sep 1991 02:57:03 +0000 (+0000) Subject: Remove without-stepping and stepping-off!, but provide X-Git-Tag: 20090517-FFI~10231 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1757ab1cc6000c5295ad35ebc2f82c5151b23057;p=mit-scheme.git 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 f7785704f..2cff9df16 100644 --- 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))))))) ;;;; Standard Condition Signallers @@ -663,6 +664,7 @@ MIT in each case. |# (memq condition-type:error (%condition-type/generalizations type))) (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) @@ -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 bd4278a6b..78bfea77f 100644 --- 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 560411cc6..eec2b102c 100644 --- 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)