From 3eeb15edd9c8c268ef2a698be8526272580d8b89 Mon Sep 17 00:00:00 2001 From: Mark Friedman Date: Mon, 26 Aug 1991 20:28:01 +0000 Subject: [PATCH] Added WITHOUT-STEPPING to specify that a given thunk should not be stepped. --- v7/src/runtime/global.scm | 27 +++++++++++++++++++++++++-- v8/src/runtime/global.scm | 27 +++++++++++++++++++++++++-- 2 files changed, 50 insertions(+), 4 deletions(-) diff --git a/v7/src/runtime/global.scm b/v7/src/runtime/global.scm index e85d9a221..631e3fd3c 100644 --- 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 92fe1166d..ceebe7342 100644 --- 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 -- 2.25.1