From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 22 Jan 1990 23:45:31 +0000 (+0000)
Subject: Make changes to use more space-efficient representation for dbg-label
X-Git-Tag: 20090517-FFI~11570
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e107a12b302d684cfd963e5b3c005677c32e9fe5;p=mit-scheme.git

Make changes to use more space-efficient representation for dbg-label
objects.  These changes require runtime version 14.72 or later.
---

diff --git a/v7/src/compiler/base/infnew.scm b/v7/src/compiler/base/infnew.scm
index 29a549524..99b572f2a 100644
--- a/v7/src/compiler/base/infnew.scm
+++ b/v7/src/compiler/base/infnew.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/infnew.scm,v 4.6 1989/10/26 07:35:51 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/infnew.scm,v 4.7 1990/01/22 23:44:42 cph Exp $
 
-Copyright (c) 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -250,20 +250,20 @@ MIT in each case. |#
 
 (define (info-generation-phase-3 expression procedures continuations
 				 label-bindings external-labels)
-  (let ((dbg-labels (labels->dbg-labels label-bindings)))
+  (let ((label-bindings (labels->dbg-labels label-bindings)))
     (let ((labels (make-btree)))
-      (for-each (lambda (dbg-label)
+      (for-each (lambda (label-binding)
 		  (for-each (lambda (name)
 			      (btree-insert! labels string<? car name
 				(lambda (name)
-				  (cons name dbg-label))
+				  (cons name (cdr label-binding)))
 				(lambda (association)
 				  (error "redefining label" association))
 				(lambda (association)
 				  association
 				  unspecific)))
-			    (dbg-label/names dbg-label)))
-		dbg-labels)
+			    (car label-binding)))
+		label-bindings)
       (let ((map-label
 	     (lambda (label)
 	       (btree-lookup labels string<? car (system-pair-car label)
@@ -297,32 +297,28 @@ MIT in each case. |#
      expression
      (list->vector (sort procedures dbg-procedure<?))
      (list->vector (sort continuations dbg-continuation<?))
-     (list->vector dbg-labels))))
+     (list->vector (map cdr label-bindings)))))
 
 (define (labels->dbg-labels label-bindings)
-  (let ((dbg-labels
-	 (let ((labels (make-btree)))
-	   (for-each
-	    (lambda (binding)
-	      (let ((name (system-pair-car (car binding))))
-		(btree-insert! labels < dbg-label/offset (cdr binding)
-		  (lambda (offset)
-		    (make-dbg-label name offset))
-		  (lambda (dbg-label)
-		    (set-dbg-label/names!
-		     dbg-label
-		     (cons name (dbg-label/names dbg-label))))
-		  (lambda (dbg-label)
-		    dbg-label
-		    unspecific))))
-	    label-bindings)
-	   (btree-fringe labels))))
-    (for-each (lambda (dbg-label)
-		(set-dbg-label/name!
-		 dbg-label
-		 (choose-distinguished-label (dbg-label/names dbg-label))))
-	      dbg-labels)
-    dbg-labels))
+  (map (lambda (offset-binding)
+	 (let ((names (cdr offset-binding)))
+	   (cons names
+		 (make-dbg-label-2 (choose-distinguished-label names)
+				   (car offset-binding)))))
+       (let ((offsets (make-btree)))
+	 (for-each (lambda (binding)
+		     (let ((name (system-pair-car (car binding))))
+		       (btree-insert! offsets < car (cdr binding)
+			 (lambda (offset)
+			   (list offset name))
+			 (lambda (offset-binding)
+			   (set-cdr! offset-binding
+				     (cons name (cdr offset-binding))))
+			 (lambda (offset-binding)
+			   offset-binding
+			   unspecific))))
+		   label-bindings)
+	 (btree-fringe offsets))))
 
 (define (choose-distinguished-label names)
   (if (null? (cdr names))
diff --git a/v7/src/compiler/machines/bobcat/compiler.pkg b/v7/src/compiler/machines/bobcat/compiler.pkg
index 863d74348..b93954aea 100644
--- a/v7/src/compiler/machines/bobcat/compiler.pkg
+++ b/v7/src/compiler/machines/bobcat/compiler.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/compiler.pkg,v 1.26 1990/01/18 22:43:21 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/compiler.pkg,v 1.27 1990/01/22 23:45:02 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -279,11 +279,8 @@ MIT in each case. |#
 	  dbg-block-name/return-address
 	  dbg-block-name/static-link
 
-	  make-dbg-label
-	  dbg-label/names
-	  set-dbg-label/names!
+	  make-dbg-label-2
 	  dbg-label/offset
-	  set-dbg-label/name!
 	  set-dbg-label/external?!))
 
 (define-package (compiler constraints)
diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040
index 8c3c7d5fa..c61e72164 100644
--- a/v7/src/compiler/machines/bobcat/make.scm-68040
+++ b/v7/src/compiler/machines/bobcat/make.scm-68040
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.64 1990/01/18 22:43:49 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.65 1990/01/22 23:45:31 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -41,4 +41,4 @@ MIT in each case. |#
 	    ((package/reference (find-package name) 'INITIALIZE-PACKAGE!)))
 	  '((COMPILER MACROS)
 	    (COMPILER DECLARATIONS)))
-(add-system! (make-system "Liar (Motorola MC68020)" 4 64 '()))
\ No newline at end of file
+(add-system! (make-system "Liar (Motorola MC68020)" 4 65 '()))
\ No newline at end of file