From d0ae2572f13859b6360274d4b57973378eff836a Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Mon, 2 Mar 1992 23:38:09 +0000
Subject: [PATCH] Change use of assoc in constant->label to a use of
 warning-assoc so the compiler will issue a warning when coalescing constant
 objects.

---
 v7/src/compiler/back/lapgn3.scm | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

diff --git a/v7/src/compiler/back/lapgn3.scm b/v7/src/compiler/back/lapgn3.scm
index 860eb8160..42a6b402a 100644
--- 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-"))
-- 
2.25.1