From: Chris Hanson Date: Fri, 25 Mar 1988 21:22:06 +0000 (+0000) Subject: Add missing rule. Generalize `increment-anl' to X-Git-Tag: 20090517-FFI~12846 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f20e21bc798a2776752eaf772681f68ca0bc4ba1;p=mit-scheme.git Add missing rule. Generalize `increment-anl' to `increment-machine-register'. Generalize `reuse-pseudo-register-alias!' to capture idea of reuse without making assumptions about loading the target register from the source register. --- diff --git a/v7/src/compiler/back/lapgn2.scm b/v7/src/compiler/back/lapgn2.scm index c7c4a4041..3498d907c 100644 --- a/v7/src/compiler/back/lapgn2.scm +++ b/v7/src/compiler/back/lapgn2.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn2.scm,v 1.6 1988/03/14 20:44:59 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/back/lapgn2.scm,v 1.7 1988/03/25 21:21:27 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -116,6 +116,9 @@ MIT in each case. |# (prefix-instructions! instructions) alias) +(define-integrable (reference-existing-alias register type) + (register-reference (register-alias register type))) + (define-integrable (reference-alias-register! register type) (register-reference (load-alias-register! register type))) @@ -125,38 +128,44 @@ MIT in each case. |# (define-integrable (reference-temporary-register! type) (register-reference (allocate-temporary-register! type))) +(define (reuse-pseudo-register-alias! source type if-reusable if-not) + (let ((reusable-alias + (and (dead-register? source) + (register-alias source type)))) + (if reusable-alias + (begin (delete-dead-registers!) + (if-reusable reusable-alias)) + (if-not)))) + (define (move-to-alias-register! source type target) - (reuse-pseudo-register-alias! source type + (reuse-and-load-pseudo-register-alias! source type (lambda (reusable-alias) (add-pseudo-register-alias! target reusable-alias false)) (lambda () (allocate-alias-register! target type)))) (define (move-to-temporary-register! source type) - (reuse-pseudo-register-alias! source type + (reuse-and-load-pseudo-register-alias! source type need-register! (lambda () (allocate-temporary-register! type)))) -(define (reuse-pseudo-register-alias! source type if-reusable if-not) - ;; IF-NOT is assumed to return a machine register. - (let ((reusable-alias - (and (dead-register? source) - (register-alias source type)))) - (if reusable-alias - (begin (delete-dead-registers!) - (if-reusable reusable-alias) - (register-reference reusable-alias)) - (let ((alias (if (machine-register? source) - source - (register-alias source false)))) - (delete-dead-registers!) - (let ((target (if-not))) - (prefix-instructions! - (cond ((not alias) (home->register-transfer source target)) - ((= alias target) '()) - (else (register->register-transfer alias target)))) - (register-reference target)))))) +(define (reuse-and-load-pseudo-register-alias! source type if-reusable if-not) + (reuse-pseudo-register-alias! source type + (lambda (reusable-alias) + (if-reusable reusable-alias) + (register-reference reusable-alias)) + (lambda () + (let ((alias (if (machine-register? source) + source + (register-alias source false)))) + (delete-dead-registers!) + (let ((target (if-not))) + (prefix-instructions! + (cond ((not alias) (home->register-transfer source target)) + ((= alias target) '()) + (else (register->register-transfer alias target)))) + (register-reference target)))))) ;; These procedures are used when the copy is going to be transformed, ;; and the machine has 3 operand instructions, which allow an implicit @@ -186,27 +195,24 @@ MIT in each case. |# (allocate-temporary-register! type)))) (define (provide-copy-reusing-alias! source type rec1 rec2 if-reusable if-not) - ;; IF-NOT is assumed to return a machine register. - (let ((reusable-alias - (and (dead-register? source) - (register-alias source type)))) - (if reusable-alias - (begin (delete-dead-registers!) - (if-reusable reusable-alias) - (rec1 (register-reference reusable-alias))) - (let ((alias (if (machine-register? source) - source - (register-alias source false)))) - (delete-dead-registers!) - (let ((target (if-not))) - (cond ((not alias) - (rec2 (pseudo-register-home source) - (register-reference target))) - ((= alias target) - (rec1 (register-reference target))) - (else - (rec2 (register-reference alias) - (register-reference target))))))))) + (reuse-pseudo-register-alias! source type + (lambda (reusable-alias) + (if-reusable reusable-alias) + (rec1 (register-reference reusable-alias))) + (lambda () + (let ((alias (if (machine-register? source) + source + (register-alias source false)))) + (delete-dead-registers!) + (let ((target (if-not))) + (cond ((not alias) + (rec2 (pseudo-register-home source) + (register-reference target))) + ((= alias target) + (rec1 (register-reference target))) + (else + (rec2 (register-reference alias) + (register-reference target))))))))) (define (add-pseudo-register-alias! register alias saved-into-home?) (set! *register-map* diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm index cb6fdb8e2..e44ba2849 100644 --- a/v7/src/compiler/machines/bobcat/lapgen.scm +++ b/v7/src/compiler/machines/bobcat/lapgen.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 4.2 1988/03/14 19:16:33 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/lapgen.scm,v 4.3 1988/03/25 21:20:28 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -80,7 +80,7 @@ MIT in each case. |# (if (< register 8) (INST-EA (@DO ,register ,(* 4 offset))) (INST-EA (@AO ,(- register 8) ,(* 4 offset)))))) - + (define (load-dnw n d) (cond ((zero? n) (INST (CLR W (D ,d)))) @@ -93,13 +93,15 @@ MIT in each case. |# (if (zero? n) (INST (TST W (D ,d))) (INST (CMPI W (& ,n) (D ,d))))) - -(define (increment-anl an n) - (case n - ((0) (LAP)) - ((1 2) (LAP (ADDQ L (& ,(* 4 n)) (A ,an)))) - ((-1 -2) (LAP (SUBQ L (& ,(* -4 n)) (A ,an)))) - (else (LAP (LEA (@AO ,an ,(* 4 n)) (A ,an)))))) + +(define (increment-machine-register register n) + (let ((target (register-reference register))) + (case n + ((0) (LAP)) + ((1 2) (LAP (ADDQ L (& ,(* 4 n)) ,target))) + ((-1 -2) (LAP (SUBQ L (& ,(* -4 n)) ,target))) + ((< register 8) (LAP (ADD L (& ,(* 4 n)) ,target))) + (else (LAP (LEA (@AO ,(- register 8) ,(* 4 n)) ,target)))))) (define (load-constant constant target) (if (non-pointer-object? constant) @@ -116,12 +118,13 @@ MIT in each case. |# (& ,(make-non-pointer-literal type datum)) ,target))) ((and (zero? datum) - (memq (lap:ea-keyword target) '(D @D @A @A+ @-A @AO @DO @AOX W L))) + (memq (lap:ea-keyword target) + '(D @D @A @A+ @-A @AO @DO @AOX W L))) (INST (CLR L ,target))) ((and (<= -128 datum 127) (eq? (lap:ea-keyword target) 'D)) (INST (MOVEQ (& ,datum) ,target))) (else (INST (MOV L (& ,datum) ,target))))) - + (define (test-byte n effective-address) (if (and (zero? n) (TSTable-effective-address? effective-address)) (INST (TST B ,effective-address)) @@ -185,7 +188,8 @@ MIT in each case. |# result))) (define-integrable (TSTable-effective-address? effective-address) - (memq (lap:ea-keyword effective-address) '(D @D @A @A+ @-A @DO @AO @AOX W L))) + (memq (lap:ea-keyword effective-address) + '(D @D @A @A+ @-A @DO @AO @AOX W L))) (define-integrable (register-effective-address? effective-address) (memq (lap:ea-keyword effective-address) '(A D))) diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040 index 01653c258..42b8ed2d3 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.7 1988/03/14 19:38:20 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.8 1988/03/25 21:22:06 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -44,11 +44,11 @@ MIT in each case. |# (make-environment (define :name "Liar (Bobcat 68020)") (define :version 4) - (define :modification 7) + (define :modification 8) (define :files) (define :rcs-header - "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.7 1988/03/14 19:38:20 jinx Exp $") + "$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.8 1988/03/25 21:22:06 cph Exp $") (define :files-lists (list diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm index 96d3edf04..d41e4b83c 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.4 1988/03/14 19:38:35 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.5 1988/03/25 21:20:04 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -49,7 +49,7 @@ MIT in each case. |# (define-rule statement (ASSIGN (REGISTER 15) (OFFSET-ADDRESS (REGISTER 15) (? n))) - (increment-anl 7 n)) + (increment-machine-register 15 n)) (define-rule statement (ASSIGN (REGISTER 12) (REGISTER 15)) @@ -79,15 +79,16 @@ MIT in each case. |# (define-rule statement (ASSIGN (REGISTER 12) (OBJECT->ADDRESS (REGISTER (? source)))) (QUALIFIER (pseudo-register? source)) - (if (and (dead-register? source) - (register-has-alias? source 'DATA)) - (let ((source (register-reference (register-alias source 'DATA)))) + (reuse-pseudo-register-alias! source 'DATA + (lambda (reusable-alias) + (let ((source (register-reference reusable-alias))) (LAP (AND L ,mask-reference ,source) - (MOV L ,source (A 4)))) + (MOV L ,source (A 4))))) + (lambda () (let ((temp (reference-temporary-register! 'DATA))) (LAP (MOV L ,(coerce->any source) ,temp) (AND L ,mask-reference ,temp) - (MOV L ,temp (A 4)))))) + (MOV L ,temp (A 4))))))) ;;; All assignments to pseudo registers are required to delete the ;;; dead registers BEFORE performing the assignment. This is because @@ -96,11 +97,15 @@ MIT in each case. |# ;;; happened after the assignment. (define-rule statement - (ASSIGN (REGISTER (? target)) (OFFSET-ADDRESS (REGISTER 15) (? n))) + (ASSIGN (REGISTER (? target)) (OFFSET-ADDRESS (REGISTER (? source)) (? n))) (QUALIFIER (pseudo-register? target)) - (LAP - (LEA (@AO 7 ,(* 4 n)) - ,(reference-assignment-alias! target 'ADDRESS)))) + (reuse-pseudo-register-alias! source 'DATA + (lambda (reusable-alias) + (add-pseudo-register-alias! target reusable-alias false) + (increment-machine-register reusable-alias n)) + (lambda () + (LAP (LEA ,(indirect-reference! source n) + ,(reference-assignment-alias! target 'ADDRESS)))))) (define-rule statement (ASSIGN (REGISTER (? target)) (CONSTANT (? source))) @@ -180,7 +185,7 @@ MIT in each case. |# (ASSIGN (REGISTER (? target)) (CONS-POINTER (CONSTANT (? type)) (ENTRY:PROCEDURE (? label)))) (QUALIFIER (pseudo-register? target)) - (let ((temp (register-reference (allocate-temporary-register! 'ADDRESS)))) + (let ((temp (reference-temporary-register! 'ADDRESS))) (delete-dead-registers!) (let ((target* (coerce->any target))) (if (register-effective-address? target*) @@ -231,7 +236,7 @@ MIT in each case. |# (ASSIGN (OFFSET (REGISTER (? a)) (? n)) (CONS-POINTER (CONSTANT (? type)) (ENTRY:PROCEDURE (? label)))) (let* ((target (indirect-reference! a n)) - (temp (register-reference (allocate-temporary-register! 'ADDRESS)))) + (temp (reference-temporary-register! 'ADDRESS))) (LAP (LEA (@PCR ,(rtl-procedure/external-label (label->object label))) ,temp) (MOV L ,temp ,target) diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm index 932fe4b44..562945cfe 100644 --- a/v7/src/compiler/machines/bobcat/rules3.scm +++ b/v7/src/compiler/machines/bobcat/rules3.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.5 1988/03/14 19:38:53 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules3.scm,v 4.6 1988/03/25 21:20:55 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -152,10 +152,10 @@ MIT in each case. |# (cond ((zero? how-far) (LAP)) ((zero? frame-size) - (increment-anl 7 how-far)) + (increment-machine-register 15 how-far)) ((= frame-size 1) (LAP (MOV L (@A+ 7) ,(offset-reference a7 (-1+ how-far))) - ,@(increment-anl 7 (-1+ how-far)))) + ,@(increment-machine-register 15 (-1+ how-far)))) ((= frame-size 2) (if (= how-far 1) (LAP (MOV L (@AO 7 4) (@AO 7 8)) @@ -165,7 +165,7 @@ MIT in each case. |# ,(offset-reference a7 (-1+ how-far))))))) (LAP ,(i) ,(i) - ,@(increment-anl 7 (- how-far 2)))))) + ,@(increment-machine-register 15 (- how-far 2)))))) (else (generate/move-frame-up frame-size (offset-reference a7 offset)))))) @@ -370,7 +370,7 @@ MIT in each case. |# (MOVE W (& #x4eb9) (@A+ 5)) ; (JSR (L )) (MOVE L ,temp-ref (@A+ 5)) (CLR W (@A+ 5)) - ,@(increment-anl 5 size)))) + ,@(increment-machine-register 15 size)))) ;;;; Entry Header ;;; This is invoked by the top level of the LAP generator.