From abfd152b6b78119e49661023d9af91c74f8bd61e Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 19 Nov 1990 22:51:08 +0000 Subject: [PATCH] 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. --- v7/src/compiler/base/lvalue.scm | 18 ++++++- v7/src/compiler/base/proced.scm | 6 +-- v7/src/compiler/fgopt/delint.scm | 50 +++++++++---------- v7/src/compiler/fgopt/order.scm | 20 +++----- .../compiler/machines/bobcat/make.scm-68040 | 4 +- 5 files changed, 50 insertions(+), 48 deletions(-) diff --git a/v7/src/compiler/base/lvalue.scm b/v7/src/compiler/base/lvalue.scm index 0aa0a39bc..ce5c2a049 100644 --- 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 967779ab3..eb039454a 100644 --- 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 fdaf62327..1b2eef2b2 100644 --- 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 9122111b6..b3bc6f7fe 100644 --- 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 750f2c920..078c2a124 100644 --- 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 -- 2.25.1