From: Chris Hanson Date: Thu, 2 Nov 1989 08:08:54 +0000 (+0000) Subject: * Change variable-indirection pass to occur after closure analysis. X-Git-Tag: 20090517-FFI~11704 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ec1d5a736bf8f418338275931663ec756c6dd99a;p=mit-scheme.git * Change variable-indirection pass to occur after closure analysis. Disable variable-indirection if either the source or target variable is closed-over. * Change RTL code-compression to permit compression of `offset-address' expressions across multiple instructions. Add two new rules needed to accomplish this for the standard static-link setup code. The goal of this modification is to permit the use of the "pea" instruction when pushing static-links. --- diff --git a/v7/src/compiler/base/toplev.scm b/v7/src/compiler/base/toplev.scm index 3a0362ec1..de4d6cfcd 100644 --- a/v7/src/compiler/base/toplev.scm +++ b/v7/src/compiler/base/toplev.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/toplev.scm,v 4.22 1989/10/26 07:36:07 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/toplev.scm,v 4.23 1989/11/02 08:08:04 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -586,10 +586,11 @@ MIT in each case. |# (phase/fold-constants) (phase/open-coding-analysis) (phase/operator-analysis) - (phase/variable-indirection) (phase/environment-optimization) (phase/identify-closure-limits) - (phase/setup-block-types) (phase/compute-call-graph) + (phase/setup-block-types) + (phase/variable-indirection) + (phase/compute-call-graph) (phase/side-effect-analysis) (phase/continuation-analysis) (phase/subproblem-analysis) diff --git a/v7/src/compiler/fgopt/varind.scm b/v7/src/compiler/fgopt/varind.scm index 27100e4c4..12dd686f3 100644 --- a/v7/src/compiler/fgopt/varind.scm +++ b/v7/src/compiler/fgopt/varind.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/varind.scm,v 1.2 1989/10/27 07:27:13 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/varind.scm,v 1.3 1989/11/02 08:08:21 cph Exp $ Copyright (c) 1989 Massachusetts Institute of Technology @@ -53,6 +53,7 @@ MIT in each case. |# (let ((block (variable-block variable))) (and (not (lvalue-known-value variable)) (null? (variable-assignments variable)) + (not (variable-closed-over? variable)) (not (lvalue/source? variable)) (not (block-passed-out? block)) (let ((indirection @@ -64,7 +65,9 @@ MIT in each case. |# (car links))))) (and possibility (lvalue/variable? possibility) - (null? (variable-assignments possibility)) (let ((block* (variable-block possibility))) + (null? (variable-assignments possibility)) + (not (variable-closed-over? possibility)) + (let ((block* (variable-block possibility))) (and (not (block-passed-out? block*)) (block-ancestor? block block*))) (begin diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040 index d550d4a41..dd00844e7 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.57 1989/10/27 07:57:36 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.58 1989/11/02 08:08:54 cph Exp $ Copyright (c) 1988, 1989 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 57 '())) \ No newline at end of file +(add-system! (make-system "Liar (Motorola MC68020)" 4 58 '())) \ No newline at end of file diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm index 44eb2d3f9..89d1e4b4e 100644 --- a/v7/src/compiler/machines/bobcat/rules1.scm +++ b/v7/src/compiler/machines/bobcat/rules1.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.27 1989/10/26 07:37:51 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.28 1989/11/02 08:08:36 cph Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -86,23 +86,42 @@ MIT in each case. |# (define-rule statement (ASSIGN (REGISTER (? target)) (OFFSET-ADDRESS (REGISTER (? source)) (? n))) - (QUALIFIER (and (pseudo-register? target) (machine-register? source))) - (let ((source (indirect-reference! source n))) - (delete-dead-registers!) - (LAP (LEA ,source ,(reference-target-alias! target 'ADDRESS))))) + (QUALIFIER (pseudo-word? target)) + (load-static-link target source n false)) (define-rule statement - (ASSIGN (REGISTER (? target)) (OFFSET-ADDRESS (REGISTER (? source)) (? n))) - (QUALIFIER (and (pseudo-word? target) (pseudo-register? source))) - (reuse-pseudo-register-alias! source 'DATA - (lambda (reusable-alias) - (delete-dead-registers!) - (add-pseudo-register-alias! target reusable-alias) - (increment-machine-register reusable-alias n)) - (lambda () - (let ((source (indirect-reference! source n))) - (delete-dead-registers!) - (LAP (LEA ,source ,(reference-target-alias! target 'ADDRESS))))))) + (ASSIGN (REGISTER (? target)) + (CONS-POINTER (CONSTANT (? type)) + (OFFSET-ADDRESS (REGISTER (? source)) (? n)))) + (QUALIFIER (pseudo-word? target)) + (load-static-link target source n + (lambda (target) + (LAP (OR UL (& ,(make-non-pointer-literal type 0)) ,target))))) + +(define (load-static-link target source n suffix) + (let ((non-reusable + (lambda () + (let ((source (indirect-reference! source n))) + (delete-dead-registers!) + (if suffix + (let ((temp (reference-temporary-register! 'ADDRESS))) + (let ((target (reference-target-alias! target 'DATA))) + (LAP (LEA ,source ,temp) + (MOV L ,temp ,target) + ,@(suffix target)))) + (LAP (LEA ,source + ,(reference-target-alias! target 'ADDRESS)))))))) + (if (machine-register? source) + (non-reusable) + (reuse-pseudo-register-alias! source 'DATA + (lambda (reusable-alias) + (delete-dead-registers!) + (add-pseudo-register-alias! target reusable-alias) + (LAP ,@(increment-machine-register reusable-alias n) + ,@(if suffix + (suffix (register-reference reusable-alias)) + (LAP)))) + non-reusable)))) (define-rule statement (ASSIGN (REGISTER (? target)) (CONSTANT (? source))) @@ -329,6 +348,16 @@ MIT in each case. |# (LAP (MOV L ,(standard-register-reference datum 'DATA true) ,target) ,(memory-set-type type target)))) +(define-rule statement + (ASSIGN (OFFSET (REGISTER (? address)) (? offset)) + (CONS-POINTER (CONSTANT (? type)) + (OFFSET-ADDRESS (REGISTER (? source)) (? n)))) + (let ((temp (reference-temporary-register! 'ADDRESS)) + (target (indirect-reference! address offset))) + (LAP (LEA ,(indirect-reference! source n) ,temp) + (MOV L ,temp ,target) + ,(memory-set-type type target)))) + (define-rule statement (ASSIGN (OFFSET (REGISTER (? address)) (? offset)) (CONS-POINTER (CONSTANT (? type)) (ENTRY:PROCEDURE (? label)))) @@ -424,17 +453,26 @@ MIT in each case. |# (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) - (OFFSET-ADDRESS (REGISTER (? r)) (? n))) - (LAP (PEA ,(indirect-reference! r n)))) - -(define-rule statement - (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (OFFSET (REGISTER (? r)) (? n))) - (LAP (MOV L ,(indirect-reference! r n) (@-A 7)))) + (CONS-POINTER (CONSTANT (? type)) (ENTRY:CONTINUATION (? label)))) + (LAP (PEA (@PCR ,label)) + ,(memory-set-type type (INST-EA (@A 7))))) (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (ENTRY:CONTINUATION (? label))) (LAP (PEA (@PCR ,label)) ,(memory-set-type (ucode-type compiled-entry) (INST-EA (@A 7))))) + +(define-rule statement + (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) + (CONS-POINTER (CONSTANT (? type)) + (OFFSET-ADDRESS (REGISTER (? r)) (? n)))) + (LAP (PEA ,(indirect-reference! r n)) + ,(memory-set-type type (INST-EA (@A 7))))) + +(define-rule statement + (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (OFFSET (REGISTER (? r)) (? n))) + (LAP (MOV L ,(indirect-reference! r n) (@-A 7)))) + (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (FIXNUM->OBJECT (REGISTER (? r)))) diff --git a/v7/src/compiler/rtlopt/rcompr.scm b/v7/src/compiler/rtlopt/rcompr.scm index bcbb35e01..9f39dd649 100644 --- a/v7/src/compiler/rtlopt/rcompr.scm +++ b/v7/src/compiler/rtlopt/rcompr.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcompr.scm,v 1.8 1988/12/12 21:30:30 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlopt/rcompr.scm,v 1.9 1989/11/02 08:07:46 cph Exp $ -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 @@ -114,6 +114,10 @@ MIT in each case. |# (or (and (rtl:assign? rtl) (equal? (rtl:assign-address rtl) expression)) (expression-clobbers-stack-pointer? rtl))))) + ((and (rtl:offset-address? expression) + (interpreter-stack-pointer? + (rtl:offset-address-register expression))) + (search-stopping-at expression-clobbers-stack-pointer?)) ((rtl:constant-expression? expression) (let loop ((next (rinst-next next))) (if (rinst-dead-register? next register) @@ -138,3 +142,29 @@ MIT in each case. |# (rtl:post-increment-register expression))) (else (loop expression)))))))) + +(define (fold-instructions! live rinst next register expression) + ;; Attempt to fold `expression' into the place of `register' in the + ;; RTL instruction `next'. If the resulting instruction is + ;; reasonable (i.e. if the LAP generator informs us that it has a + ;; pattern for generating that instruction), the folding is + ;; performed. + (let ((rtl (rinst-rtl next))) + (if (rtl:refers-to-register? rtl register) + (let ((rtl (rtl:subst-register rtl register expression))) + (if (lap-generator/match-rtl-instruction rtl) + (begin + (set-rinst-rtl! rinst false) + (set-rinst-rtl! next rtl) + (let ((dead (rinst-dead-registers rinst))) + (for-each increment-register-live-length! dead) + (set-rinst-dead-registers! + next + (eqv-set-union dead + (delv! register + (rinst-dead-registers next))))) + (for-each-regset-member live decrement-register-live-length!) + (reset-register-n-refs! register) + (reset-register-n-deaths! register) + (reset-register-live-length! register) + (set-register-bblock! register false))))))) \ No newline at end of file