If the last application of a procedure is deleted, make sure that the

procedure no longer satisfies `procedure-always-known-operator?'.

diff --git a/v7/src/compiler/base/contin.scm b/v7/src/compiler/base/contin.scm
index e42791b811d7ccbef25439dbba8fadc8beab5953..a9ed2ba678900b6e65a5afe4dcbca4acfeae947c 100644 (file)
--- a/v7/src/compiler/base/contin.scm
+++ b/v7/src/compiler/base/contin.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/contin.scm,v 4.7 1988/12/16 13:36:57 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/contin.scm,v 4.8 1989/05/08 22:20:37 cph Rel $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -77,7 +77,7 @@ MIT in each case. |#
 (define-integrable continuation/debugging-info procedure-debugging-info)
 (define-integrable set-continuation/debugging-info!
   set-procedure-debugging-info!)
-
+\f
 (define (continuation/register continuation)
   (or (procedure-register continuation)
       (let ((register (rtl:make-pseudo-register)))
@@ -110,4 +110,12 @@ MIT in each case. |#
        (procedure-arity-correct? rvalue 1)))
 
 (define-integrable (uni-continuation/parameter continuation)
-  (car (procedure-original-required continuation)))
\ No newline at end of file
+  (car (procedure-original-required continuation)))
+
+(define (delete-continuation/combination! continuation combination)
+  (let ((combinations
+        (delq! combination (continuation/combinations continuation))))
+    (set-continuation/combinations! continuation combinations)
+    (if (and (null? combinations)
+            (null? (continuation/returns continuation)))
+       (set-procedure-always-known-operator?! continuation false))))
\ No newline at end of file

diff --git a/v7/src/compiler/base/ctypes.scm b/v7/src/compiler/base/ctypes.scm
index 96c9cf297b6fcc3aff1939afef912f2695854aa5..db9fbdaaefecbc90942083a7144371dfdc6a1aac 100644 (file)
--- a/v7/src/compiler/base/ctypes.scm
+++ b/v7/src/compiler/base/ctypes.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/ctypes.scm,v 4.11 1989/04/17 18:42:36 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/ctypes.scm,v 4.12 1989/05/08 22:20:17 cph Rel $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -174,9 +174,7 @@ MIT in each case. |#
              (rvalue-values continuation))
     (for-each (lambda (operator)
                (if (rvalue/procedure? operator)
-                   (set-procedure-applications!
-                    operator
-                    (delq! combination (procedure-applications operator)))))
+                   (delete-procedure-application! operator combination)))
              (rvalue-values (combination/operator combination)))
     (set-application-type! combination 'RETURN)
     (set-application-operator! combination continuation)

diff --git a/v7/src/compiler/base/proced.scm b/v7/src/compiler/base/proced.scm
index 5e969b11f944c0d827f2a7a333a52cdfa622cae6..1a86822727526bcf1d73cf017105252d3682c960 100644 (file)
--- a/v7/src/compiler/base/proced.scm
+++ b/v7/src/compiler/base/proced.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/proced.scm,v 4.12 1989/04/21 17:05:12 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/proced.scm,v 4.13 1989/05/08 22:20:50 cph Rel $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -171,6 +171,12 @@ MIT in each case. |#
 (define-integrable (procedure-application-unique? procedure)
   (null? (cdr (procedure-applications procedure))))
 
+(define (delete-procedure-application! procedure application)
+  (let ((applications (delq! application (procedure-applications procedure))))
+    (set-procedure-applications! procedure applications)
+    (if (null? applications)
+       (set-procedure-always-known-operator?! procedure false))))
+
 (define-integrable (procedure/simplified? procedure)
   (assq 'SIMPLIFIED (procedure-properties procedure)))
 

diff --git a/v7/src/compiler/fgopt/operan.scm b/v7/src/compiler/fgopt/operan.scm
index a222ce5a59fba377a17b01afa2f7bc0b3fd55c7f..22c8560a1ed085892e64470fadb13635ff821005 100644 (file)
--- a/v7/src/compiler/fgopt/operan.scm
+++ b/v7/src/compiler/fgopt/operan.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/operan.scm,v 4.5 1989/04/17 17:07:19 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/operan.scm,v 4.6 1989/05/08 22:21:09 cph Rel $
 
 Copyright (c) 1987, 1989 Massachusetts Institute of Technology
 
@@ -73,17 +73,21 @@ MIT in each case. |#
                   (lambda (rvalue) (not (rvalue/procedure? rvalue))))))))))
 
 (define (analyze/continuation continuation)
-  (3-logic/and
-   (and (not (continuation/passed-out? continuation)) 'ALWAYS)
-   (3-logic/and
-    (for-some? (continuation/returns continuation)
-      (lambda (return)
-       (eq? (rvalue-known-value (return/operator return))
-            continuation)))
-    (for-some? (continuation/combinations continuation)
-      (lambda (combination)
-       (eq? (rvalue-known-value (combination/continuation combination))
-            continuation))))))
+  (let ((returns (continuation/returns continuation))
+       (combinations (continuation/combinations continuation)))
+    (and (or (not (null? returns))
+            (not (null? combinations)))
+        (3-logic/and
+         (and (not (continuation/passed-out? continuation)) 'ALWAYS)
+         (3-logic/and
+          (for-some? returns
+            (lambda (return)
+              (eq? (rvalue-known-value (return/operator return))
+                   continuation)))
+          (for-some? combinations
+            (lambda (combination)
+              (eq? (rvalue-known-value (combination/continuation combination))
+                   continuation))))))))
 
 (define (for-some? items predicate)
   (let loop ((items items) (default false))