Stepping stuff moved here from global.scm

diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm
index b8935938128e36a19a4d123f58757380657ff603..9434787c5a0e6bd0f8ad94be5e1b72cc774de617 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.20 1991/08/27 00:52:40 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 14.21 1991/09/02 03:55:24 sybok Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -1136,4 +1136,42 @@ 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)))
\ No newline at end of file
+      (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!)
+  (set! (access old-stepper-hooks *old-hook-storage-environment*)
+       (access null-hooks *old-hook-storage-environment*)))
+

diff --git a/v7/src/runtime/global.scm b/v7/src/runtime/global.scm
index 116f89805ab5f0a6d71ed77f58c39d0f69e14b93..00ac70d79bb6f983cd73b4f1a382dadd889f21d9 100644 (file)
--- a/v7/src/runtime/global.scm
+++ b/v7/src/runtime/global.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/global.scm,v 14.31 1991/09/02 03:41:05 sybok Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/global.scm,v 14.32 1991/09/02 03:55:52 sybok Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -259,39 +259,3 @@ MIT in each case. |#
                 (cdr bucket)
                 (cons (car bucket) accumulator))))))))
 
-;; 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.
-
-
-
-(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)))
-    (define old-hook-storage-environment)
-    (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)))))))
-
-(define (stepping-off!)
-  (let ((hook-environment (access old-hook-storage-environment (procedure-environment without-stepping))))
-    (set! (access old-stepper-hooks hook-environment) (access null-hooks hook-environment))))
-
-

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index a407c5f3fec6386f02f131519922a13780c61132..dfeda0166dd02158b31b977d8fe20ee5cd24dea9 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.119 1991/08/29 21:47:26 sybok Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.120 1991/09/02 03:57:21 sybok Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -619,10 +619,12 @@ 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/global.scm b/v8/src/runtime/global.scm
index 8f624e31baa3231ce1deb11054ae9b57d5e1a327..76ce1e1626f406b8f26b2b98a78b26cb6cc9b254 100644 (file)
--- a/v8/src/runtime/global.scm
+++ b/v8/src/runtime/global.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/global.scm,v 14.31 1991/09/02 03:41:05 sybok Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/global.scm,v 14.32 1991/09/02 03:55:52 sybok Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -259,39 +259,3 @@ MIT in each case. |#
                 (cdr bucket)
                 (cons (car bucket) accumulator))))))))
 
-;; 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.
-
-
-
-(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)))
-    (define old-hook-storage-environment)
-    (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)))))))
-
-(define (stepping-off!)
-  (let ((hook-environment (access old-hook-storage-environment (procedure-environment without-stepping))))
-    (set! (access old-stepper-hooks hook-environment) (access null-hooks hook-environment))))
-
-

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 53a658657cee521f64de502086b4ea0e6fe28163..905ce4895e36e9a8549c271ad529dc3d1d5c12b7 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.119 1991/08/29 21:47:26 sybok Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.120 1991/09/02 03:57:21 sybok Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -619,10 +619,12 @@ 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)