From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Mon, 3 Jul 1995 23:40:20 +0000 (+0000)
Subject: *** empty log message ***
X-Git-Tag: 20090517-FFI~6221
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=116b743a1332f6fab81c1cbe23e145e5e0499575;p=mit-scheme.git

*** empty log message ***
---

diff --git a/v8/src/compiler/midend/dbgstr.scm b/v8/src/compiler/midend/dbgstr.scm
index 8b786d25e..5d3fd1f6b 100644
--- a/v8/src/compiler/midend/dbgstr.scm
+++ b/v8/src/compiler/midend/dbgstr.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dbgstr.scm,v 1.12 1995/05/05 12:58:36 adams Exp $
+$Id: dbgstr.scm,v 1.13 1995/07/03 23:40:20 adams Exp $
 
 Copyright (c) 1994-1995 Massachusetts Institute of Technology
 
@@ -124,7 +124,7 @@ MIT in each case. |#
 	(write-char #\Space port)
 	(write (new-dbg-block/type block) port)
 	(if (null? (new-dbg-block/variables block))
-	    (write-string " (no vars)")
+	    (write-string " (no vars)" port)
 	    (begin
 	      (write-string " vars:" port)
 	      (for-each (lambda (var)
@@ -133,30 +133,28 @@ MIT in each case. |#
 			(new-dbg-block/variables block))))))))
   (type false read-only false)
   (parent false read-only false)
-  (variables '() read-only false)
-  (flattened false read-only false))
-
-;;(define (new-dbg-block/copy-transforming expression-copier block)
-;;  ;; Copy entire environment model structure whilst transforming the
-;;  ;; variable expressions.
-;;  (define (new-variables variables block*)
-;;    (map (lambda (variable)
-;;	   (new-dbg-variable/new-expression&block
-;;	    variable
-;;	    (expression-copier (new-dbg-variable/expression variable))
-;;	    block*))
-;;	 variables))
-;;  (let copy-block ((block block))
-;;    (and block
-;;	 (let ((block*  (new-dbg-block/%make
-;;			 (new-dbg-block/type block)
-;;			 (copy-block (new-dbg-block/parent block))
-;;			 '()
-;;			 (new-dbg-block/flattened block))))
-;;	   (set-new-dbg-block/variables!
-;;	    block*
-;;	    (new-variables (new-dbg-block/variables block) block*))
-;;	   block*))))
+  (variables '() read-only false))
+
+(define (new-dbg-block/reconstruct block variable->path)
+  ;; Copy entire environment model BLOCK, using VARIABLE->PATH to fill in
+  ;; the variable expressions.
+  (define (new-variables variables block*)
+    (map (lambda (variable)
+	   (new-dbg-variable/new-expression&block
+	    variable
+	    (variable->path variable)
+	    block*))
+	 variables))
+  (let copy-block ((block block))
+    (and block
+	 (let ((block*  (new-dbg-block/%make
+			 (new-dbg-block/type block)
+			 (copy-block (new-dbg-block/parent block))
+			 '())))
+	   (set-new-dbg-block/variables!
+	    block*
+	    (new-variables (new-dbg-block/variables block) block*))
+	   block*))))
 
 
 
@@ -269,15 +267,21 @@ MIT in each case. |#
 	 (QUOTE/? (call/operator form))
 	 (hash-table/get *dbg-unconstructable-operators*
 			 (quote/text (call/operator form)) #F)))
-  (if (not (unconstructable? to))
-      (set-cdr! *dbg-rewrites* (cons (list from to) (cdr *dbg-rewrites*)))))
+  (if (and (not (unconstructable? to))
+	   (not (continuation-variable? from)))
+      (set-cdr! *dbg-rewrites* (cons (vector from to) (cdr *dbg-rewrites*)))))
 
 (define *dbg-unconstructable-operators* (make-eq-hash-table))
 
+(define (dbg-info/for-all-dbg-expressions! procedure)
+  (for-each (lambda (from+to)
+	      (procedure (vector-ref from+to 1)))
+    (cdr *dbg-rewrites*)))
+
 (let ((forbid
        (lambda (operator)
 	 (hash-table/put! *dbg-unconstructable-operators* operator #T))))
   (forbid %make-heap-closure)
   (forbid CONS)
   (forbid %cons)
-  (forbid %vector))
\ No newline at end of file
+  (forbid %vector))