From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 1 Nov 2001 18:30:05 +0000 (+0000)
Subject: Change value of PROCEDURE-FREE-CALLEES so that it contains sets of
X-Git-Tag: 20090517-FFI~2480
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=67b60d8c6f493bceac7d54d37d744bce0aa01af5;p=mit-scheme.git

Change value of PROCEDURE-FREE-CALLEES so that it contains sets of
blocks rather than lists of variables.
---

diff --git a/v7/src/compiler/fgopt/closan.scm b/v7/src/compiler/fgopt/closan.scm
index 5788fbe4a..a9bc1b212 100644
--- a/v7/src/compiler/fgopt/closan.scm
+++ b/v7/src/compiler/fgopt/closan.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: closan.scm,v 4.18 1999/01/02 06:06:43 cph Exp $
+$Id: closan.scm,v 4.19 2001/11/01 18:29:59 cph Exp $
 
-Copyright (c) 1987-1999 Massachusetts Institute of Technology
+Copyright (c) 1987-1991, 1998, 1999, 2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -16,7 +16,8 @@ General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
 |#
 
 ;;;; Closure Analysis
@@ -286,10 +287,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	    (if (not (block-ancestor-or-self? block* block**))
 		(undrifting-constraint! block* block**
 					savedproc reason1 reason2))))
-	(map->eq-set
-	 variable-block
-	 (cdr (or (assq procedure (procedure-free-callees procedure*))
-		  (error "missing free-callee" procedure procedure*)))))))
+	(cdr (or (assq procedure (procedure-free-callees procedure*))
+		 (error "missing free-callee" procedure procedure*))))))
    (procedure-free-callers procedure)))
 
 (define (update-callers-and-callees! block block* procedure** reason1 reason2)
diff --git a/v7/src/compiler/fgopt/envopt.scm b/v7/src/compiler/fgopt/envopt.scm
index 15451d42c..d76423b0c 100644
--- a/v7/src/compiler/fgopt/envopt.scm
+++ b/v7/src/compiler/fgopt/envopt.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: envopt.scm,v 1.8 1999/01/02 06:06:43 cph Exp $
+$Id: envopt.scm,v 1.9 2001/11/01 18:30:05 cph Exp $
 
-Copyright (c) 1988, 1989, 1990, 1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1990, 1999, 2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -16,7 +16,8 @@ General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
 |#
 
 ;;;; Procedure environment optimization
@@ -207,16 +208,15 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	(add-free-callee! procedure on-whom var)
 	(add-free-caller! on-whom procedure))))
 
-(define (add-free-callee! procedure on-whom var)
-  (let ((bucket (procedure-free-callees procedure)))
-    (if (null? bucket)
-	(set-procedure-free-callees! procedure (list (list on-whom var)))
-	(let ((place (assq on-whom bucket)))
-	  (if (false? place)
-	      (set-procedure-free-callees! procedure
-					   (cons (list on-whom var) bucket))
-	      (set-cdr! place (cons var (cdr place)))))))
-  unspecific)
+(define (add-free-callee! procedure on-whom variable)
+  (let ((entries (procedure-free-callees procedure))
+	(block (variable-block variable)))
+    (let ((entry (assq on-whom entries)))
+      (if entry
+	  (if (not (memq block (cdr entry)))
+	      (set-cdr! entry (cons block (cdr entry))))
+	  (set-procedure-free-callees! procedure
+				       (cons (list on-whom block) entries))))))
 
 (define (add-free-caller! procedure on-whom)
   (let ((bucket (procedure-free-callers procedure)))