From 5621dba022011dcb7ec54a33ae46b198801333b7 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 13 Aug 1993 00:03:24 +0000 Subject: [PATCH] Implement WITH-REPL-EVAL-BOUNDARY and STACK-FRAME/REPL-EVAL-BOUNDARY? to mark the boundary between stack frames that are part of the REPL and those that are part of the expression being evaluated by the REPL. This marker frame is a "subproblem" frame because that is the easiest way to make it visible to the debuggers, but operationally it is a "reduction" frame. The runtime system's debugger currently ignores these marker frames; at some point it should be modified to do something with them. --- v7/src/runtime/conpar.scm | 25 ++++++++++++++++--------- v7/src/runtime/debug.scm | 20 +++++++++++++------- v7/src/runtime/rep.scm | 13 ++++++++++--- v7/src/runtime/runtime.pkg | 6 ++++-- v8/src/runtime/conpar.scm | 25 ++++++++++++++++--------- v8/src/runtime/runtime.pkg | 6 ++++-- 6 files changed, 63 insertions(+), 32 deletions(-) diff --git a/v7/src/runtime/conpar.scm b/v7/src/runtime/conpar.scm index 3923d8011..50f3d6b79 100644 --- a/v7/src/runtime/conpar.scm +++ b/v7/src/runtime/conpar.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/conpar.scm,v 14.25 1992/02/08 15:08:18 cph Exp $ +$Id: conpar.scm,v 14.26 1993/08/13 00:03:19 cph Exp $ -Copyright (c) 1988-92 Massachusetts Institute of Technology +Copyright (c) 1988-93 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -110,7 +110,8 @@ MIT in each case. |# (return-address/code return-address)))) (define (stack-frame/subproblem? stack-frame) - (stack-frame-type/subproblem? (stack-frame/type stack-frame))) + (or (stack-frame-type/subproblem? (stack-frame/type stack-frame)) + (stack-frame/repl-eval-boundary? stack-frame))) (define-integrable (stack-frame/compiled-code? stack-frame) (compiled-return-address? (stack-frame/return-address stack-frame))) @@ -126,18 +127,18 @@ MIT in each case. |# (define (stack-frame/skip-non-subproblems stack-frame) (let ((type (stack-frame/type stack-frame))) - (cond ((eq? type stack-frame-type/stack-marker) + (cond ((and (stack-frame/subproblem? stack-frame) + (not (and (eq? type stack-frame-type/compiled-return-address) + (eq? (stack-frame/return-address stack-frame) + continuation-return-address)))) + stack-frame) + ((eq? type stack-frame-type/stack-marker) (let loop ((stack-frame stack-frame)) (let ((stack-frame (stack-frame/next stack-frame))) (and stack-frame (if (stack-frame/subproblem? stack-frame) (stack-frame/next-subproblem stack-frame) (loop stack-frame)))))) - ((and (stack-frame/subproblem? stack-frame) - (not (and (eq? type stack-frame-type/compiled-return-address) - (eq? (stack-frame/return-address stack-frame) - continuation-return-address)))) - stack-frame) (else (let ((stack-frame (stack-frame/next stack-frame))) (and stack-frame @@ -354,6 +355,12 @@ MIT in each case. |# (continue (parser-state/dynamic-state state) (parser-state/interrupt-mask state)))))) +(define (stack-frame/repl-eval-boundary? stack-frame) + (let ((type (stack-frame/type stack-frame))) + (and (eq? type stack-frame-type/stack-marker) + (eq? with-repl-eval-boundary + (vector-ref (stack-frame/elements stack-frame) 1))))) + (define (parser/restore-interrupt-mask type elements state) (parser/standard type diff --git a/v7/src/runtime/debug.scm b/v7/src/runtime/debug.scm index 79548f5b9..1f3e06fc3 100644 --- a/v7/src/runtime/debug.scm +++ b/v7/src/runtime/debug.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: debug.scm,v 14.34 1993/07/01 22:19:19 cph Exp $ +$Id: debug.scm,v 14.35 1993/08/13 00:03:21 cph Exp $ Copyright (c) 1988-1993 Massachusetts Institute of Technology @@ -125,7 +125,7 @@ MIT in each case. |# (define (count-subproblems dstate) (do ((i 0 (1+ i)) (subproblem (dstate/subproblem dstate) - (stack-frame/next-subproblem subproblem))) + (next-subproblem subproblem))) ((or (not subproblem) (> i debugger:count-subproblems-limit)) i))) (define-structure (dstate @@ -294,7 +294,7 @@ MIT in each case. |# (write-string adjective port) (write-string " subproblem level)" port)))) (write level port) - (cond ((not (stack-frame/next-subproblem subproblem)) + (cond ((not (next-subproblem subproblem)) (qualify-level (if (zero? level) "only" "highest"))) ((zero? level) (qualify-level "lowest")))))) @@ -422,7 +422,7 @@ MIT in each case. |# expression environment port))) - (loop (stack-frame/next-subproblem frame) (1+ level))))))))) + (loop (next-subproblem frame) (1+ level))))))))) (define (terse-print-expression level expression environment port) (newline port) @@ -468,7 +468,7 @@ MIT in each case. |# (define (earlier-subproblem dstate port reason if-successful) (let ((subproblem (dstate/subproblem dstate))) - (let ((next (stack-frame/next-subproblem subproblem))) + (let ((next (next-subproblem subproblem))) (if next (begin (set-current-subproblem! @@ -481,6 +481,12 @@ MIT in each case. |# (reason+message (or reason "no more subproblems") "already at highest subproblem level.")))))) +(define (next-subproblem stack-frame) + (let ((next (stack-frame/next-subproblem stack-frame))) + (if (and next (stack-frame/repl-eval-boundary? next)) + (next-subproblem next) + next))) + (define-command (command/later-subproblem dstate port) (maybe-stop-using-history! dstate port) (later-subproblem dstate port false finish-move-to-subproblem!)) @@ -514,7 +520,7 @@ MIT in each case. |# (delta delta)) (if (zero? delta) (cons subproblem subproblems) - (let ((next (stack-frame/next-subproblem subproblem))) + (let ((next (next-subproblem subproblem))) (if next (loop next (cons subproblem subproblems) (-1+ delta)) (begin @@ -718,7 +724,7 @@ MIT in each case. |# ;;;; Advanced hacking commands (define-command (command/return-from dstate port) - (let ((next (stack-frame/next-subproblem (dstate/subproblem dstate)))) + (let ((next (next-subproblem (dstate/subproblem dstate)))) (if next (enter-subproblem dstate port next) (debugger-failure port "Can't continue!!!")))) diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm index 959a474a1..15f6d5ae8 100644 --- a/v7/src/runtime/rep.scm +++ b/v7/src/runtime/rep.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: rep.scm,v 14.33 1993/08/12 08:23:44 cph Exp $ +$Id: rep.scm,v 14.34 1993/08/13 00:03:23 cph Exp $ Copyright (c) 1988-93 Massachusetts Institute of Technology @@ -402,9 +402,16 @@ MIT in each case. |# (define hook/repl-eval) (define (default/repl-eval repl s-expression environment syntax-table) - repl (let ((scode (syntax s-expression syntax-table))) - (with-new-history (lambda () (extended-scode-eval scode environment))))) + (with-repl-eval-boundary repl + (lambda () + (extended-scode-eval scode environment))))) + +(define (with-repl-eval-boundary repl thunk) + ((ucode-primitive with-stack-marker 3) + (lambda () (with-new-history thunk)) + with-repl-eval-boundary + repl)) (define hook/repl-write) (define (default/repl-write repl object) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 1b0bfa99d..ea7cac653 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.188 1993/07/31 03:11:55 cph Exp $ +$Id: runtime.pkg,v 14.189 1993/08/13 00:03:24 cph Exp $ Copyright (c) 1988-1993 Massachusetts Institute of Technology @@ -339,6 +339,7 @@ MIT in each case. |# stack-frame/properties stack-frame/reductions stack-frame/ref + stack-frame/repl-eval-boundary? stack-frame/resolve-stack-address stack-frame/return-address stack-frame/return-code @@ -1836,7 +1837,8 @@ MIT in each case. |# set-repl/prompt! set-repl/reader-history! set-repl/syntax-table! - ve) + ve + with-repl-eval-boundary) (export (runtime load) hook/repl-eval hook/repl-write) diff --git a/v8/src/runtime/conpar.scm b/v8/src/runtime/conpar.scm index 9dd3d9a28..50f3d6b79 100644 --- a/v8/src/runtime/conpar.scm +++ b/v8/src/runtime/conpar.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/conpar.scm,v 14.25 1992/02/08 15:08:18 cph Exp $ +$Id: conpar.scm,v 14.26 1993/08/13 00:03:19 cph Exp $ -Copyright (c) 1988-92 Massachusetts Institute of Technology +Copyright (c) 1988-93 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -110,7 +110,8 @@ MIT in each case. |# (return-address/code return-address)))) (define (stack-frame/subproblem? stack-frame) - (stack-frame-type/subproblem? (stack-frame/type stack-frame))) + (or (stack-frame-type/subproblem? (stack-frame/type stack-frame)) + (stack-frame/repl-eval-boundary? stack-frame))) (define-integrable (stack-frame/compiled-code? stack-frame) (compiled-return-address? (stack-frame/return-address stack-frame))) @@ -126,18 +127,18 @@ MIT in each case. |# (define (stack-frame/skip-non-subproblems stack-frame) (let ((type (stack-frame/type stack-frame))) - (cond ((eq? type stack-frame-type/stack-marker) + (cond ((and (stack-frame/subproblem? stack-frame) + (not (and (eq? type stack-frame-type/compiled-return-address) + (eq? (stack-frame/return-address stack-frame) + continuation-return-address)))) + stack-frame) + ((eq? type stack-frame-type/stack-marker) (let loop ((stack-frame stack-frame)) (let ((stack-frame (stack-frame/next stack-frame))) (and stack-frame (if (stack-frame/subproblem? stack-frame) (stack-frame/next-subproblem stack-frame) (loop stack-frame)))))) - ((and (stack-frame/subproblem? stack-frame) - (not (and (eq? type stack-frame-type/compiled-return-address) - (eq? (stack-frame/return-address stack-frame) - continuation-return-address)))) - stack-frame) (else (let ((stack-frame (stack-frame/next stack-frame))) (and stack-frame @@ -354,6 +355,12 @@ MIT in each case. |# (continue (parser-state/dynamic-state state) (parser-state/interrupt-mask state)))))) +(define (stack-frame/repl-eval-boundary? stack-frame) + (let ((type (stack-frame/type stack-frame))) + (and (eq? type stack-frame-type/stack-marker) + (eq? with-repl-eval-boundary + (vector-ref (stack-frame/elements stack-frame) 1))))) + (define (parser/restore-interrupt-mask type elements state) (parser/standard type diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 1b0bfa99d..ea7cac653 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.188 1993/07/31 03:11:55 cph Exp $ +$Id: runtime.pkg,v 14.189 1993/08/13 00:03:24 cph Exp $ Copyright (c) 1988-1993 Massachusetts Institute of Technology @@ -339,6 +339,7 @@ MIT in each case. |# stack-frame/properties stack-frame/reductions stack-frame/ref + stack-frame/repl-eval-boundary? stack-frame/resolve-stack-address stack-frame/return-address stack-frame/return-code @@ -1836,7 +1837,8 @@ MIT in each case. |# set-repl/prompt! set-repl/reader-history! set-repl/syntax-table! - ve) + ve + with-repl-eval-boundary) (export (runtime load) hook/repl-eval hook/repl-write) -- 2.25.1