From 13ca8e4cc7065ec1f13199cb74a4c126f8aaf41c Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 8 May 1989 22:21:09 +0000 Subject: [PATCH] If the last application of a procedure is deleted, make sure that the procedure no longer satisfies `procedure-always-known-operator?'. --- v7/src/compiler/base/contin.scm | 16 ++++++++++++---- v7/src/compiler/base/ctypes.scm | 6 ++---- v7/src/compiler/base/proced.scm | 10 ++++++++-- v7/src/compiler/fgopt/operan.scm | 28 ++++++++++++++++------------ 4 files changed, 38 insertions(+), 22 deletions(-) diff --git a/v7/src/compiler/base/contin.scm b/v7/src/compiler/base/contin.scm index e42791b81..a9ed2ba67 100644 --- 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!) - + (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 96c9cf297..db9fbdaae 100644 --- 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 5e969b11f..1a8682272 100644 --- 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 a222ce5a5..22c8560a1 100644 --- 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)) -- 2.25.1