Fix bug: `delete-integrated-parameters' was deleting parameter's in a

procedure's interface only when the `procedure-interface-optimizible?'
said that it was OK to do so.  However, `lvalue-integrated?', used in
many places, would return #t for variables in that interface,
independent of `procedure-interface-optimizible?'.  The fix gets
rid of `procedure-interface-optimizible?' and alters
`lvalue-integrated?' to take the procedure interface restrictions into
account.

diff --git a/v7/src/compiler/base/lvalue.scm b/v7/src/compiler/base/lvalue.scm
index 0aa0a39bcbd3a0f0db609228fa681c7a23993f7c..ce5c2a049e7b9d8a88ab3aac23ead3610e3c37a1 100644 (file)
--- a/v7/src/compiler/base/lvalue.scm
+++ b/v7/src/compiler/base/lvalue.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/lvalue.scm,v 4.18 1990/05/03 15:04:56 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/lvalue.scm,v 4.19 1990/11/19 22:50:15 cph Rel $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -257,7 +257,21 @@ MIT in each case. |#
         (or (rvalue/constant? value)
             (and (rvalue/procedure? value)
                  (procedure/virtually-open? value))
-            (lvalue-get lvalue 'INTEGRATED)))))
+            (lvalue-get lvalue 'INTEGRATED))
+        (if (lvalue/variable? lvalue)
+            (let ((block (variable-block lvalue)))
+              (if (stack-block? block)
+                  (let ((procedure (block-procedure block)))
+                    (cond ((procedure-always-known-operator? procedure)
+                           true)
+                          ((or (memq lvalue
+                                     (cdr (procedure-required procedure)))
+                               (memq lvalue (procedure-optional procedure))
+                               (eq? lvalue (procedure-rest procedure)))
+                           false)
+                          (else true)))
+                  true))
+            true))))
 
 (define (variable-unused? variable)
   (or (lvalue-integrated? variable)

diff --git a/v7/src/compiler/base/proced.scm b/v7/src/compiler/base/proced.scm
index 967779ab390b0e6647be12aa5887f1c932df1bf2..eb039454a8d99194039102991e9fa7158a2f8962 100644 (file)
--- a/v7/src/compiler/base/proced.scm
+++ b/v7/src/compiler/base/proced.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/proced.scm,v 4.16 1990/05/03 15:05:01 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/proced.scm,v 4.17 1990/11/19 22:50:26 cph Rel $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -161,10 +161,6 @@ MIT in each case. |#
   ;; for trivial closures.
   (not (procedure/trivial-closure? procedure)))
 
-(define (procedure-interface-optimizible? procedure)
-  (and (stack-block? (procedure-block procedure))
-       (procedure-always-known-operator? procedure)))
-
 (define-integrable (procedure-application-unique? procedure)
   (null? (cdr (procedure-applications procedure))))
 

diff --git a/v7/src/compiler/fgopt/delint.scm b/v7/src/compiler/fgopt/delint.scm
index fdaf62327431a6befb8cf4106a1f37bded7b554a..1b2eef2b2579039cea22d21d4735cd970fb81d14 100644 (file)
--- a/v7/src/compiler/fgopt/delint.scm
+++ b/v7/src/compiler/fgopt/delint.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/delint.scm,v 1.2 1989/10/26 07:36:48 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/delint.scm,v 1.3 1990/11/19 22:50:46 cph Rel $
 
-Copyright (c) 1989 Massachusetts Institute of Technology
+Copyright (c) 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
@@ -46,30 +46,28 @@ MIT in each case. |#
 (define (delete-integrated-parameters! block)
   (let ((deletions '())
        (procedure (block-procedure block)))
-    (if (procedure-interface-optimizible? procedure)
-       (begin
-         (let ((delete-integrations
-                (lambda (get-names set-names!)
-                  (with-values
-                      (lambda ()
-                        (find-integrated-variables (get-names procedure)))
-                    (lambda (not-integrated integrated)
-                      (if (not (null? integrated))
-                          (begin
-                            (set-names! procedure not-integrated)
-                            (set! deletions
-                                  (eq-set-union deletions integrated)))))))))
-           (delete-integrations (lambda (procedure)
-                                  (cdr (procedure-required procedure)))
-                                (lambda (procedure required)
-                                  (set-cdr! (procedure-required procedure)
-                                            required)))
-           (delete-integrations procedure-optional set-procedure-optional!))
-         (let ((rest (procedure-rest procedure)))
-           (if (and rest (variable-unused? rest))
-               (begin
-                 (set! deletions (eq-set-adjoin deletions rest))
-                 (set-procedure-rest! procedure false))))))
+    (let ((delete-integrations
+          (lambda (get-names set-names!)
+            (with-values
+                (lambda ()
+                  (find-integrated-variables (get-names procedure)))
+              (lambda (not-integrated integrated)
+                (if (not (null? integrated))
+                    (begin
+                      (set-names! procedure not-integrated)
+                      (set! deletions
+                            (eq-set-union deletions integrated)))))))))
+      (delete-integrations (lambda (procedure)
+                            (cdr (procedure-required procedure)))
+                          (lambda (procedure required)
+                            (set-cdr! (procedure-required procedure)
+                                      required)))
+      (delete-integrations procedure-optional set-procedure-optional!))
+    (let ((rest (procedure-rest procedure)))
+      (if (and rest (variable-unused? rest))
+         (begin
+           (set! deletions (eq-set-adjoin deletions rest))
+           (set-procedure-rest! procedure false))))
     (with-values
        (lambda ()
          (find-integrated-bindings (procedure-names procedure)

diff --git a/v7/src/compiler/fgopt/order.scm b/v7/src/compiler/fgopt/order.scm
index 9122111b6bc4e58bf84739abced8d7fa29727d1e..b3bc6f7fee00f00df4f3955fd8229a55ab7979fc 100644 (file)
--- a/v7/src/compiler/fgopt/order.scm
+++ b/v7/src/compiler/fgopt/order.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/order.scm,v 4.14 1990/02/02 18:38:54 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/order.scm,v 4.15 1990/11/19 22:50:55 cph Rel $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -290,18 +290,12 @@ MIT in each case. |#
          (if (not (stack-block? model-block))
              standard
              (let ((thunk
-                    (cond
-
-                     ;; At this point, the following should be true.
-                     ;; (procedure-interface-optimizible? model)
-                     ((procedure-always-known-operator? model) optimized)
-
-                     ;; The behavior of known lexpr closures should
-                     ;; be improved at least when the listification
-                     ;; is trivial (0 or 1 args).
-                     ((procedure-rest model) standard)
-
-                     (else known))))
+                    (cond ((procedure-always-known-operator? model) optimized)
+                          ;; The behavior of known lexpr closures should
+                          ;; be improved at least when the listification
+                          ;; is trivial (0 or 1 args).
+                          ((procedure-rest model) standard)
+                          (else known))))
                (if (and (procedure/open? model)
                         (stack-block/static-link? model-block))
                    (lambda ()

diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040
index 750f2c920508777604c204f420938087bae106e0..078c2a124a268aadf6e978c3df706f4e177b0cef 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.76 1990/08/24 20:19:45 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.77 1990/11/19 22:51:08 cph Rel $
 
 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 76 '()))
\ No newline at end of file
+(add-system! (make-system "Liar (Motorola MC68020)" 4 77 '()))
\ No newline at end of file