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 29a549524bde05a9cc4b9c31a08df274d4e61e18..99b572f2a831340708e2d15ead9c9a38da92a046 100644 (file)
--- 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)))))
 \f
 (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 863d743481676701d201aea828b8982a3c47a36e..b93954aea8c28fc34f040971046836eb0ccf6f0f 100644 (file)
--- 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 8c3c7d5fa4ed5b986c27429360c12870e45faf39..c61e72164f19feda3673599b872a985704f80e31 100644 (file)
--- 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