Fix two history-related bugs:

- previous-history-offsets were being incorrectly computed in
make-intermediate-state.

- make-control-point was adding a new (join-stacklets) frame even when
there was one, therefore invalidating all previous-history-offsets
contained in the stream.  This latter bug was "fixed" by changing
control-point/element-stream to not include the last (join-stacklets)
frame.

diff --git a/v7/src/runtime/conpar.scm b/v7/src/runtime/conpar.scm
index 6da76abea333cffd718c633b386bb4e93f32796f..f4743d73ffc0e92f5aa7f7be92456bf994b3c9ff 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.22 1991/08/06 22:13:25 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/conpar.scm,v 14.23 1991/08/11 15:24:22 jinx Exp $
 
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-1991 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -203,18 +203,22 @@ MIT in each case. |#
 
 (define (make-intermediate-state state length stream)
   (let ((previous-history-control-point
-        (parser-state/previous-history-control-point state)))
+        (parser-state/previous-history-control-point state))
+       (new-length
+        (- (parser-state/n-elements state) length)))    
     (make-parser-state
      (parser-state/dynamic-state state)
      (parser-state/fluid-bindings state)
      (parser-state/interrupt-mask state)
      (parser-state/history state)
-     (if previous-history-control-point
-        (parser-state/previous-history-offset state)
-        (max 0 (- (parser-state/previous-history-offset state) (-1+ length))))
+     (let ((previous (parser-state/previous-history-offset state)))
+       (if (or previous-history-control-point
+              (>= new-length previous))
+          previous
+          0))
      previous-history-control-point
      stream
-     (- (parser-state/n-elements state) length)
+     new-length
      (parser-state/next-control-point state)
      (parser-state/previous-type state))))
 

diff --git a/v7/src/runtime/cpoint.scm b/v7/src/runtime/cpoint.scm
index f19f6912220f8039ecdcd1f4e20e7e2152c77e87..6d325086e5f6958257b33991df54167506049822 100644 (file)
--- a/v7/src/runtime/cpoint.scm
+++ b/v7/src/runtime/cpoint.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/cpoint.scm,v 14.3 1988/12/30 06:42:23 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/cpoint.scm,v 14.4 1991/08/11 15:24:05 jinx Exp $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988-1991 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -67,12 +67,29 @@ MIT in each case. |#
 (define-integrable (control-point/first-element-index control-point)
   (control-point-index control-point 6))
 
+#|
+
+;; Disabled because some procedures in conpar.scm and uenvir.scm
+;; depend on the actual length for finding compiled code variables,
+;; etc.
+
+(define (control-point/n-elements control-point)
+  (let ((real-length (- (system-vector-length control-point)
+                       (control-point/first-element-index control-point))))
+    (if (control-point/next-control-point? control-point)
+       (- real-length 2)
+       real-length)))
+|#
+
 (define (control-point/n-elements control-point)
   (- (system-vector-length control-point)
      (control-point/first-element-index control-point)))
 
 (define (control-point/element-stream control-point)
-  (let ((end (system-vector-length control-point)))
+  (let ((end (let ((end (system-vector-length control-point)))
+              (if (control-point/next-control-point? control-point)
+                  (- end 2)
+                  end))))
     (let loop ((index (control-point/first-element-index control-point)))
       (cond ((= index end) '())
            (((ucode-primitive primitive-object-type? 2)

diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index b146cf0b5d0fa4fc73c504b764f725f358f0ef07..1bbcd37871ad4def4bb6e3e472cfd8ddd778c2c9 100644 (file)
--- a/v7/src/runtime/version.scm
+++ b/v7/src/runtime/version.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.129 1991/08/08 19:54:33 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.130 1991/08/11 15:24:37 jinx Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -45,7 +45,7 @@ MIT in each case. |#
                     '()))
   (add-system! microcode-system)
   (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-identification! "Runtime" 14 129))
+  (add-identification! "Runtime" 14 130))
 
 (define microcode-system)
 

diff --git a/v8/src/runtime/conpar.scm b/v8/src/runtime/conpar.scm
index f979a42230a26bcf5c2e48d4422e29a2726a438b..8747458271eff32874a9fd3025f6b53b7dc61e48 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.22 1991/08/06 22:13:25 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/conpar.scm,v 14.23 1991/08/11 15:24:22 jinx Exp $
 
-Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1988-1991 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -203,18 +203,22 @@ MIT in each case. |#
 
 (define (make-intermediate-state state length stream)
   (let ((previous-history-control-point
-        (parser-state/previous-history-control-point state)))
+        (parser-state/previous-history-control-point state))
+       (new-length
+        (- (parser-state/n-elements state) length)))    
     (make-parser-state
      (parser-state/dynamic-state state)
      (parser-state/fluid-bindings state)
      (parser-state/interrupt-mask state)
      (parser-state/history state)
-     (if previous-history-control-point
-        (parser-state/previous-history-offset state)
-        (max 0 (- (parser-state/previous-history-offset state) (-1+ length))))
+     (let ((previous (parser-state/previous-history-offset state)))
+       (if (or previous-history-control-point
+              (>= new-length previous))
+          previous
+          0))
      previous-history-control-point
      stream
-     (- (parser-state/n-elements state) length)
+     new-length
      (parser-state/next-control-point state)
      (parser-state/previous-type state))))