Added WITHOUT-STEPPING to specify that a given thunk should not be

stepped.

diff --git a/v7/src/runtime/global.scm b/v7/src/runtime/global.scm
index e85d9a22123e805a75cf8f99ef6949385c0e7658..631e3fd3cedee906c7cc89df7368fe3b08e5d0c6 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.24 1991/08/26 15:28:38 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/global.scm,v 14.25 1991/08/26 20:28:01 markf Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -256,4 +256,27 @@ MIT in each case. |#
                (per-bucket (-1+ index) accumulator)
                (per-symbol
                 (cdr bucket)
-                (cons (car bucket) accumulator))))))))
\ No newline at end of file
+                (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.
+(define without-stepping
+  (let ((microcode-vector-stepper-slot
+        (fixed-objects-vector-slot 'stepper-state)))
+
+    (define (get-stepper-hooks)
+      (vector-ref (get-fixed-objects-vector) microcode-vector-stepper-slot))
+
+    (lambda (thunk)
+      (let ((old-stepper-hooks)
+           (null-hooks (hunk3-cons #f #f #f)))
+       (dynamic-wind
+        (lambda ()
+          (set! old-stepper-hooks (get-stepper-hooks))
+          ((ucode-primitive primitive-return-step 2) unspecific null-hooks))
+        thunk
+        (lambda ()
+          ((ucode-primitive primitive-return-step 2)
+           unspecific
+           old-stepper-hooks)))))))
\ No newline at end of file

diff --git a/v8/src/runtime/global.scm b/v8/src/runtime/global.scm
index 92fe1166d8e84793ca014c273e666a73eb459419..ceebe73425b0896ad487fecd143b2e640cf290fe 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.24 1991/08/26 15:28:38 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/global.scm,v 14.25 1991/08/26 20:28:01 markf Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -256,4 +256,27 @@ MIT in each case. |#
                (per-bucket (-1+ index) accumulator)
                (per-symbol
                 (cdr bucket)
-                (cons (car bucket) accumulator))))))))
\ No newline at end of file
+                (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.
+(define without-stepping
+  (let ((microcode-vector-stepper-slot
+        (fixed-objects-vector-slot 'stepper-state)))
+
+    (define (get-stepper-hooks)
+      (vector-ref (get-fixed-objects-vector) microcode-vector-stepper-slot))
+
+    (lambda (thunk)
+      (let ((old-stepper-hooks)
+           (null-hooks (hunk3-cons #f #f #f)))
+       (dynamic-wind
+        (lambda ()
+          (set! old-stepper-hooks (get-stepper-hooks))
+          ((ucode-primitive primitive-return-step 2) unspecific null-hooks))
+        thunk
+        (lambda ()
+          ((ucode-primitive primitive-return-step 2)
+           unspecific
+           old-stepper-hooks)))))))
\ No newline at end of file