From dbdce067b7c50f23c52d3b9785cbd5873244545c Mon Sep 17 00:00:00 2001 From: Mark Friedman Date: Wed, 7 Jun 1989 20:47:04 +0000 Subject: [PATCH] Take into account the case where a variable is in a register (i.e. not on the stack). Delete-integrated-parameters is now done in a separate phase. --- v7/src/compiler/fgopt/desenv.scm | 121 +++++++++++-------------------- 1 file changed, 44 insertions(+), 77 deletions(-) diff --git a/v7/src/compiler/fgopt/desenv.scm b/v7/src/compiler/fgopt/desenv.scm index 4a72868a6..4a93bd907 100644 --- a/v7/src/compiler/fgopt/desenv.scm +++ b/v7/src/compiler/fgopt/desenv.scm @@ -1,6 +1,40 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/desenv.scm,v 4.1 1987/12/04 19:27:45 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/desenv.scm,v 4.2 1989/06/07 20:47:04 markf Exp $ + +Copyright (c) 1987 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. |# + +#| -*-Scheme-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/desenv.scm,v 4.2 1989/06/07 20:47:04 markf Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -87,16 +121,13 @@ Closed procedure frame: |# -(package (design-environment-frames!) - -(define-export (design-environment-frames! blocks) +(define (design-environment-frames! blocks) (for-each (lambda (block) (enumeration-case block-type (block-type block) ((IC) (if (rvalue/procedure? (block-procedure block)) (setup-ic-block-offsets! block))) ((STACK) - (delete-integrated-parameters! block) (for-each (lambda (variable) (if (variable-assigned? variable) (set-variable-in-cell?! variable true))) @@ -111,72 +142,7 @@ Closed procedure frame: (error "Illegal block type" block)))) blocks)) -(package (delete-integrated-parameters!) - -(define-export (delete-integrated-parameters! block) - (let ((deletions '()) - (procedure (block-procedure block))) - (if (procedure-interface-optimizible? procedure) - (begin - (let ((delete-integrations - (lambda (get-names set-names!) - (transmit-values - (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 (lvalue-integrated? rest)) - (begin (set! deletions (eq-set-adjoin deletions rest)) - (set-procedure-rest! procedure false)))))) - (transmit-values - (find-integrated-bindings (procedure-names procedure) - (procedure-values procedure)) - (lambda (names values integrated) - (set-procedure-names! procedure names) - (set-procedure-values! procedure values) - (set! deletions (eq-set-union deletions integrated)))) - (if (not (null? deletions)) - (set-block-bound-variables! - block - (eq-set-difference (block-bound-variables block) deletions))))) - -(define (find-integrated-bindings names values) - (if (null? names) - (return-3 '() '() '()) - (transmit-values (find-integrated-bindings (cdr names) (cdr values)) - (lambda (names* values* integrated) - (if (lvalue-integrated? (car names)) - (return-3 names* values* (cons (car names) integrated)) - (return-3 (cons (car names) names*) - (cons (car values) values*) - integrated)))))) - -(define (find-integrated-variables variables) - (if (null? variables) - (return-2 '() '()) - (transmit-values (find-integrated-variables (cdr variables)) - (lambda (not-integrated integrated) - (if (lvalue-integrated? (car variables)) - (return-2 not-integrated - (cons (car variables) integrated)) - (return-2 (cons (car variables) not-integrated) - integrated)))))) - -) - -(package (setup-ic-block-offsets! setup-stack-block-offsets!) - -(define-export (setup-ic-block-offsets! block) +(define (setup-ic-block-offsets! block) (let ((procedure (block-procedure block))) (setup-variable-offsets! (procedure-names procedure) @@ -187,7 +153,7 @@ Closed procedure frame: (setup-variable-offsets! (cdr (procedure-required procedure)) ic-block-first-parameter-offset)))))) -(define-export (setup-stack-block-offsets! block) +(define (setup-stack-block-offsets! block) (let ((procedure (block-procedure block))) (set-block-frame-size! block @@ -213,15 +179,16 @@ Closed procedure frame: (define (setup-variable-offsets! variables offset) (if (null? variables) offset - (begin (set-variable-normal-offset! (car variables) offset) - (setup-variable-offsets! (cdr variables) (1+ offset))))) + (if (variable-register (car variables)) + (setup-variable-offsets! (cdr variables) offset) + (begin (set-variable-normal-offset! (car variables) offset) + (setup-variable-offsets! (cdr variables) (1+ offset)))))) (define (setup-variable-offset! variable offset) - (if variable + (if (and variable (not (variable-register variable))) (begin (set-variable-normal-offset! variable offset) (1+ offset)) offset)) -) -) \ No newline at end of file + -- 2.25.1