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.

diff --git a/v7/src/runtime/conpar.scm b/v7/src/runtime/conpar.scm
index 3923d8011ad03c382be2dcd40920900b7e567cd6..50f3d6b7910b5e7d8db0c3d6b9a06d4a0da1e0a0 100644 (file)
--- 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 79548f5b95a401565ee183eacef25ab985f902b4..1f3e06fc388e39a9350ce2da32a76333dc2c2e90 100644 (file)
--- 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 959a474a14cc85da5186b5a38710484b2935e82e..15f6d5ae8f216d8bdab74a55a1d8cf3568d0dcae 100644 (file)
--- 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 1b0bfa99d4742b0b2b408ad2316757635c9bf6b3..ea7cac653a04a7ef3c2cf0d717eb2ac81a29da18 100644 (file)
--- 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 9dd3d9a28c34d7917415ba3fd11fe83efbe3e2cc..50f3d6b7910b5e7d8db0c3d6b9a06d4a0da1e0a0 100644 (file)
--- 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 1b0bfa99d4742b0b2b408ad2316757635c9bf6b3..ea7cac653a04a7ef3c2cf0d717eb2ac81a29da18 100644 (file)
--- 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)