#| -*-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
(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)))
(define-integrable (reference-temporary-register! type)
(register-reference (allocate-temporary-register! type)))
\f
+(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))))))
\f
;; These procedures are used when the copy is going to be transformed,
;; and the machine has 3 operand instructions, which allow an implicit
(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)))))))))
\f
(define (add-pseudo-register-alias! register alias saved-into-home?)
(set! *register-map*
#| -*-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
(if (< register 8)
(INST-EA (@DO ,register ,(* 4 offset)))
(INST-EA (@AO ,(- register 8) ,(* 4 offset))))))
-
+\f
(define (load-dnw n d)
(cond ((zero? n)
(INST (CLR W (D ,d))))
(if (zero? n)
(INST (TST W (D ,d)))
(INST (CMPI W (& ,n) (D ,d)))))
-\f
-(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)
(& ,(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)))))
-
+\f
(define (test-byte n effective-address)
(if (and (zero? n) (TSTable-effective-address? effective-address))
(INST (TST B ,effective-address))
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)))
#| -*-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
(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
#| -*-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
(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))
(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)))))))
\f
;;; All assignments to pseudo registers are required to delete the
;;; dead registers BEFORE performing the assignment. This is because
;;; 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)))
(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*)
(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)
#| -*-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
(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))
,(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))))))
(MOVE W (& #x4eb9) (@A+ 5)) ; (JSR (L <entry>))
(MOVE L ,temp-ref (@A+ 5))
(CLR W (@A+ 5))
- ,@(increment-anl 5 size))))
+ ,@(increment-machine-register 15 size))))
\f
;;;; Entry Header
;;; This is invoked by the top level of the LAP generator.
projects / mit-scheme.git / commitdiff