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 5788fbe4ac99580a45c0c5baded05e01fabbd815..a9bc1b212a6b557d3225c9d3f2afd3499f8808c3 100644 (file)
--- 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 15451d42c5b099036ff07816a445eaf183067ef3..d76423b0c0219f5100649c130c5317e31fe27ac3 100644 (file)
--- 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)))