Change use of assoc in constant->label to a use of warning-assoc so

the compiler will issue a warning when coalescing constant objects.

diff --git a/v7/src/compiler/back/lapgn3.scm b/v7/src/compiler/back/lapgn3.scm
index 860eb8160166fe91b4fb04ddea0ab5189a1f7119..42a6b402a1340a1f4ec970ae0421315f37b4ff74 100644 (file)
--- a/v7/src/compiler/back/lapgn3.scm
+++ b/v7/src/compiler/back/lapgn3.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn3.scm,v 4.6 1991/10/22 09:02:43 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn3.scm,v 4.7 1992/03/02 23:38:09 jinx Exp $
 
-Copyright (c) 1987-91 Massachusetts Institute of Technology
+Copyright (c) 1987-1992 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -57,6 +57,13 @@ MIT in each case. |#
 (define (allocate-constant-label)
   (allocate-named-label "CONSTANT-"))
 
+(define (warning-assoc obj pairs)
+  (let ((pair (assoc obj pairs)))
+    (if (and (pair? pair)
+            (not (eqv? obj (car pair))))
+       (warn "Coalescing constant objects" obj (car pair)))
+    pair))
+
 (define-integrable (object->label find read write allocate-label)
   (lambda (object)
     (let ((entry (find object (read))))
@@ -83,7 +90,7 @@ MIT in each case. |#
                                         (string-append (symbol->string object)
                                                        ,suffix))))))))
 (define constant->label
-  (->label assoc *interned-constants*))
+  (->label warning-assoc *interned-constants*))
 
 (define free-reference-label
   (->label assq *interned-variables* "-READ-CELL-"))