From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 29 Aug 1988 22:49:54 +0000 (+0000)
Subject: Many many changes.
X-Git-Tag: 20090517-FFI~12573
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9ac23386d852384a89c97a6b2aa151fd1400a61f;p=mit-scheme.git
Many many changes.
---
diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm
index ebd445a0d..c9ff53e0c 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.13 1988/06/14 08:48:22 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.14 1988/08/29 22:47:55 cph Exp $
Copyright (c) 1988 Massachusetts Institute of Technology
@@ -40,7 +40,7 @@ MIT in each case. |#
(define-rule statement
(ASSIGN (REGISTER 15) (REGISTER (? source)))
- (LAP (MOV L ,(coerce->any source) (A 7))))
+ (LAP (MOV L ,(standard-register-reference source false) (A 7))))
(define-rule statement
(ASSIGN (REGISTER 15) (OFFSET-ADDRESS (REGISTER (? source)) (? offset)))
@@ -64,56 +64,51 @@ MIT in each case. |#
(QUALIFIER (pseudo-register? source))
(LAP (LEA ,(indirect-reference! source offset) (A 4))))
-;;; The following rule always occurs immediately after an instruction
-;;; of the form
-;;;
-;;; (ASSIGN (REGISTER (? source)) (POST-INCREMENT (REGISTER 15) 1))
-;;;
-;;; in which case it could be implemented very efficiently using the
-;;; sequence
-;;;
-;;; (LAP (CLR (@A 7)) (MOV L (@A+ 7) (A 4)))
-;;;
-;;; but unfortunately we have no mechanism to take advantage of this.
-
(define-rule statement
(ASSIGN (REGISTER 12) (OBJECT->ADDRESS (REGISTER (? source))))
(QUALIFIER (pseudo-register? source))
- (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)))))
- (lambda ()
- (let ((temp (reference-temporary-register! 'DATA)))
- (LAP (MOV L ,(coerce->any source) ,temp)
- (AND L ,mask-reference ,temp)
- (MOV L ,temp (A 4)))))))
+ (let ((temp (move-to-temporary-register! source 'DATA)))
+ (LAP (AND L ,mask-reference ,temp)
+ (MOV L ,temp (A 4)))))
+
+(define-rule statement
+ (ASSIGN (REGISTER 12) (OBJECT->ADDRESS (POST-INCREMENT (REGISTER 15) 1)))
+ (let ((temp (reference-temporary-register! 'DATA)))
+ (LAP (MOV L (@A+ 7) ,temp)
+ (AND L ,mask-reference ,temp)
+ (MOV L ,temp (A 4)))))
;;; All assignments to pseudo registers are required to delete the
-;;; dead registers BEFORE performing the assignment. This is because
-;;; the register being assigned may be PSEUDO-REGISTER=? to one of the
-;;; dead registers, and thus would be flushed if the deletions
-;;; happened after the assignment.
+;;; dead registers BEFORE performing the assignment. However, it is
+;;; necessary to derive the effective address of the source
+;;; expression(s) before deleting the dead registers. Otherwise any
+;;; source expression containing dead registers might refer to aliases
+;;; which have been reused.
(define-rule statement
(ASSIGN (REGISTER (? target)) (OFFSET-ADDRESS (REGISTER (? source)) (? n)))
- (QUALIFIER (pseudo-register? target))
+ (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)))))
+
+(define-rule statement
+ (ASSIGN (REGISTER (? target)) (OFFSET-ADDRESS (REGISTER (? source)) (? n)))
+ (QUALIFIER (and (pseudo-register? target) (pseudo-register? source)))
(reuse-pseudo-register-alias! source 'DATA
(lambda (reusable-alias)
- (add-pseudo-register-alias! target reusable-alias false)
+ (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
- ,(register-reference
- (allocate-alias-register! target 'ADDRESS))))))))
+ (LAP (LEA ,source ,(reference-target-alias! target 'ADDRESS)))))))
(define-rule statement
(ASSIGN (REGISTER (? target)) (CONSTANT (? source)))
(QUALIFIER (pseudo-register? target))
- (LAP ,(load-constant source (coerce->any target))))
+ (LAP ,(load-constant source (standard-target-reference target))))
(define-rule statement
(ASSIGN (REGISTER (? target)) (VARIABLE-CACHE (? name)))
@@ -121,8 +116,7 @@ MIT in each case. |#
(delete-dead-registers!)
(LAP (MOV L
(@PCR ,(free-reference-label name))
- ,(register-reference
- (allocate-alias-register! target 'ADDRESS)))))
+ ,(reference-target-alias! target 'ADDRESS))))
(define-rule statement
(ASSIGN (REGISTER (? target)) (ASSIGNMENT-CACHE (? name)))
@@ -130,8 +124,7 @@ MIT in each case. |#
(delete-dead-registers!)
(LAP (MOV L
(@PCR ,(free-assignment-label name))
- ,(register-reference
- (allocate-alias-register! target 'ADDRESS)))))
+ ,(reference-target-alias! target 'ADDRESS))))
(define-rule statement
(ASSIGN (REGISTER (? target)) (REGISTER (? source)))
@@ -146,41 +139,20 @@ MIT in each case. |#
(LAP (RO L L (& 8) ,target))))
(define-rule statement
- (ASSIGN (REGISTER (? target)) (OBJECT->ADDRESS (CONSTANT (? source))))
- (QUALIFIER (pseudo-register? target))
- (let ((target (reference-assignment-alias! target 'DATA)))
- (LAP ,(load-constant source target)
- (AND L ,mask-reference ,target))))
-
-(define-rule statement
- (ASSIGN (REGISTER (? target)) (OBJECT->ADDRESS (REGISTER (? source))))
- (QUALIFIER (pseudo-register? target))
- (let ((target (move-to-alias-register! source 'DATA target)))
- (LAP (AND L ,mask-reference ,target))))
-
-(define-rule statement
- (ASSIGN (REGISTER (? target))
- (OBJECT->ADDRESS (OFFSET (REGISTER (? address)) (? offset))))
- (QUALIFIER (pseudo-register? target))
- (let ((source (indirect-reference! address offset)))
- (delete-dead-registers!)
- (let ((target-ref
- (register-reference (allocate-alias-register! target 'DATA))))
- (LAP (MOV L ,source ,target-ref)))))
-
-(define-rule statement
- (ASSIGN (REGISTER (? target)) (OBJECT->DATUM (CONSTANT (? datum))))
+ (ASSIGN (REGISTER (? target)) (OBJECT->DATUM (CONSTANT (? constant))))
(QUALIFIER (pseudo-register? target))
(delete-dead-registers!)
- (let ((target-ref
- (register-reference (allocate-alias-register! target 'DATA))))
- (load-constant-datum datum target-ref)))
+ (let ((target (reference-target-alias! target 'DATA)))
+ (if (non-pointer-object? constant)
+ (LAP ,(load-non-pointer 0 (object-datum constant) target))
+ (LAP ,(load-constant constant target)
+ (AND L ,mask-reference ,target)))))
(define-rule statement
(ASSIGN (REGISTER (? target)) (OBJECT->DATUM (REGISTER (? source))))
(QUALIFIER (pseudo-register? target))
- (let ((target-ref (move-to-alias-register! source 'DATA target)))
- (LAP ,(scheme-object->datum target-ref))))
+ (let ((target (move-to-alias-register! source 'DATA target)))
+ (LAP (AND L ,mask-reference ,target))))
(define-rule statement
(ASSIGN (REGISTER (? target))
@@ -188,72 +160,61 @@ MIT in each case. |#
(QUALIFIER (pseudo-register? target))
(let ((source (indirect-reference! address offset)))
(delete-dead-registers!)
- (let ((target-ref
- (register-reference (allocate-alias-register! target 'DATA))))
- (LAP (MOV L ,source ,target-ref)
- ,(scheme-object->datum target-ref)))))
+ (let ((target (reference-target-alias! target 'DATA)))
+ (LAP (MOV L ,source ,target)
+ (AND L ,mask-reference ,target)))))
(define-rule statement
- (ASSIGN (REGISTER (? target)) (OBJECT->FIXNUM (CONSTANT (? datum))))
+ (ASSIGN (REGISTER (? target)) (OBJECT->ADDRESS (CONSTANT (? constant))))
(QUALIFIER (pseudo-register? target))
(delete-dead-registers!)
- (let ((target-ref
- (register-reference (allocate-alias-register! target 'DATA))))
- (load-fixnum-constant datum target-ref)))
+ (let ((target (reference-target-alias! target 'DATA)))
+ (if (non-pointer-object? constant)
+ (LAP ,(load-non-pointer 0 (object-datum constant) target))
+ (LAP ,(load-constant constant target)
+ (AND L ,mask-reference ,target)))))
(define-rule statement
- (ASSIGN (REGISTER (? target)) (OBJECT->FIXNUM (REGISTER (? source))))
+ (ASSIGN (REGISTER (? target)) (OBJECT->ADDRESS (REGISTER (? source))))
(QUALIFIER (pseudo-register? target))
- (let ((target-ref (move-to-alias-register! source 'DATA target)))
- (LAP ,(remove-type-from-fixnum target-ref))))
+ (let ((target (move-to-alias-register! source 'DATA target)))
+ (LAP (AND L ,mask-reference ,target))))
(define-rule statement
(ASSIGN (REGISTER (? target))
- (OBJECT->FIXNUM (OFFSET (REGISTER (? address)) (? offset))))
+ (OBJECT->ADDRESS (OFFSET (REGISTER (? address)) (? offset))))
(QUALIFIER (pseudo-register? target))
(let ((source (indirect-reference! address offset)))
(delete-dead-registers!)
- (let ((target-ref
- (register-reference (allocate-alias-register! target 'DATA))))
- (LAP (MOV L ,source ,target-ref)
- ,(remove-type-from-fixnum target-ref)))))
+ (let ((target (reference-target-alias! target 'DATA)))
+ (LAP (MOV L ,source ,target)
+ (AND L ,mask-reference ,target)))))
(define-rule statement
(ASSIGN (REGISTER (? target)) (OFFSET (REGISTER (? address)) (? offset)))
(QUALIFIER (pseudo-register? target))
(let ((source (indirect-reference! address offset)))
- (delete-dead-registers!)
- ;; The fact that the target register here is a data register is a
- ;; heuristic that works reasonably well since if the value is a
- ;; pointer, we will probably want to dereference it, which
- ;; requires that we first mask it.
- (LAP (MOV L
- ,source
- ,(register-reference
- (allocate-alias-register! target 'DATA))))))
+ (LAP (MOV L ,source ,(standard-target-reference target)))))
(define-rule statement
(ASSIGN (REGISTER (? target)) (POST-INCREMENT (REGISTER 15) 1))
(QUALIFIER (pseudo-register? target))
- (delete-dead-registers!)
- (LAP (MOV L
- (@A+ 7)
- ,(register-reference
- (allocate-alias-register! target 'DATA)))))
+ (LAP (MOV L (@A+ 7) ,(standard-target-reference target))))
(define-rule statement
(ASSIGN (REGISTER (? target))
(CONS-POINTER (CONSTANT (? type)) (REGISTER (? datum))))
- (QUALIFIER (pseudo-register? target))
- (let ((datum (coerce->any datum)))
- (delete-dead-registers!)
- (let ((target* (coerce->any target)))
- (if (register-effective-address? target*)
- (LAP (MOV L ,datum ,reg:temp)
- (MOV B (& ,type) ,reg:temp)
- (MOV L ,reg:temp ,target*))
- (LAP (MOV L ,datum ,target*)
- (MOV B (& ,type) ,target*))))))
+ (QUALIFIER (and (pseudo-register? target) (machine-register? datum)))
+ (let ((target (reference-target-alias! target 'DATA)))
+ (LAP (MOV L ,(register-reference datum) ,target)
+ (OR L (& ,(make-non-pointer-literal type 0)) ,target))))
+
+(define-rule statement
+ (ASSIGN (REGISTER (? target))
+ (CONS-POINTER (CONSTANT (? type)) (REGISTER (? datum))))
+ (QUALIFIER (and (pseudo-register? target) (pseudo-register? datum)))
+ (let ((target (move-to-alias-register! datum 'DATA target)))
+ (LAP (OR L (& ,(make-non-pointer-literal type 0)) ,target))))
(define-rule statement
(ASSIGN (REGISTER (? target))
@@ -261,129 +222,48 @@ MIT in each case. |#
(QUALIFIER (pseudo-register? target))
(let ((temp (reference-temporary-register! 'ADDRESS)))
(delete-dead-registers!)
- (let ((target* (coerce->any target)))
- (if (register-effective-address? target*)
- (LAP
- (LEA (@PCR ,(rtl-procedure/external-label (label->object label)))
- ,temp)
- (MOV L ,temp ,reg:temp)
- (MOV B (& ,type) ,reg:temp)
- (MOV L ,reg:temp ,target*))
- (LAP
- (LEA (@PCR ,(rtl-procedure/external-label (label->object label)))
+ (let ((target (reference-target-alias! target 'DATA)))
+ (LAP (LEA (@PCR ,(rtl-procedure/external-label (label->object label)))
,temp)
- (MOV L ,temp ,target*)
- (MOV B (& ,type) ,target*))))))
-
-(define-rule statement
- (ASSIGN (REGISTER (? target)) (FIXNUM->OBJECT (REGISTER (? source))))
- (QUALIFIER (pseudo-register? target))
- (let ((target-ref (move-to-alias-register! source 'DATA target)))
- (LAP ,(put-type-in-ea (ucode-type fixnum) target-ref))))
-
-(define-rule statement
- (ASSIGN (REGISTER (? target))
- (FIXNUM->OBJECT
- (FIXNUM-2-ARGS (? operator) (? operand1) (? operand2))))
- (QUALIFIER (pseudo-register? target))
- (let ((temp-reg (allocate-temporary-register! 'DATA)))
- (let ((operation
- (LAP ,@(fixnum-do-2-args! operator operand1 operand2 temp-reg)
- ,@(put-type-in-ea (ucode-type fixnum) temp-reg))))
- (delete-dead-registers!)
- (add-pseudo-register-alias! target temp-reg false)
- operation)))
+ (MOV L ,temp ,target)
+ (OR L (& ,(make-non-pointer-literal type 0)) ,target)))))
(define-rule statement
- (ASSIGN (REGISTER (? target))
- (FIXNUM->OBJECT
- (FIXNUM-1-ARG (? operator) (? operand))))
+ (ASSIGN (REGISTER (? target)) (OBJECT->FIXNUM (CONSTANT (? constant))))
(QUALIFIER (pseudo-register? target))
- (let ((temp-reg (allocate-temporary-register! 'DATA)))
- (let ((operation
- (LAP ,@(fixnum-do-1-arg! operator operand temp-reg)
- ,@(put-type-in-ea (ucode-type fixnum) temp-reg))))
- (delete-dead-registers!)
- (add-pseudo-register-alias! target temp-reg false)
- operation)))
-
-(define-rule statement
- (ASSIGN (REGISTER (? target))
- (FIXNUM-2-ARGS (? operator) (? operand1) (? operand2)))
- (QUALIFIER (pseudo-register? target))
- (let ((temp-reg (allocate-temporary-register! 'DATA)))
- (let ((operation
- (LAP ,@(fixnum-do-2-args! operator operand1 operand2 temp-reg))))
- (delete-dead-registers!)
- (add-pseudo-register-alias! target temp-reg false)
- operation)))
+ (delete-dead-registers!)
+ (load-fixnum-constant constant (reference-target-alias! target 'DATA)))
(define-rule statement
- (ASSIGN (REGISTER (? target))
- (FIXNUM-1-ARG (? operator) (? operand)))
+ (ASSIGN (REGISTER (? target)) (OBJECT->FIXNUM (REGISTER (? source))))
(QUALIFIER (pseudo-register? target))
- (let ((temp-reg (allocate-temporary-register! 'DATA)))
- (let ((operation
- (LAP ,@(fixnum-do-1-arg! operator operand temp-reg))))
- (delete-dead-registers!)
- (add-pseudo-register-alias! target temp-reg false)
- operation)))
-
-;;;; CHAR->ASCII/BYTE-OFFSET
+ (reuse-alias-deleting-dead-registers! source 'DATA
+ (lambda (alias)
+ (add-pseudo-register-alias! target alias)
+ (let ((reference (register-reference alias)))
+ (object->fixnum reference reference)))
+ (lambda (source)
+ (object->fixnum source (reference-target-alias! target 'DATA)))))
(define-rule statement
(ASSIGN (REGISTER (? target))
- (CHAR->ASCII (OFFSET (REGISTER (? address)) (? offset))))
- (QUALIFIER (pseudo-register? target))
- (byte-offset->register (indirect-char/ascii-reference! address offset)
- (indirect-register address)
- target))
-
-(define-rule statement
- (ASSIGN (REGISTER (? target)) (CHAR->ASCII (REGISTER (? source))))
+ (OBJECT->FIXNUM (OFFSET (REGISTER (? address)) (? offset))))
(QUALIFIER (pseudo-register? target))
- (let ((machine-register (if (machine-register? source)
- source
- (register-alias source false))))
- (if machine-register
- (let ((source-ref (register-reference machine-register)))
- (delete-dead-registers!)
- (let ((target-ref
- (register-reference (allocate-alias-register! target 'DATA))))
- (LAP (BFEXTU ,source-ref (& 24) (& 8) ,target-ref))))
- (byte-offset->register
- (indirect-char/ascii-reference! regnum:regs-pointer
- (pseudo-register-offset source))
- (indirect-register regnum:regs-pointer)
- target))))
-
-(define-rule statement
- (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
- (CHAR->ASCII (REGISTER (? source))))
- (let ((source (coerce->any/byte-reference source)))
- (let ((target (indirect-byte-reference! address offset)))
- (LAP (MOV B ,source ,target)))))
-
-(define-rule statement
- (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
- (CHAR->ASCII (CONSTANT (? character))))
- (LAP (MOV B (& ,(char->signed-8-bit-immediate character))
- ,(indirect-byte-reference! address offset))))
+ (let ((source (indirect-reference! address offset)))
+ (delete-dead-registers!)
+ (object->fixnum source (reference-target-alias! target 'DATA))))
(define-rule statement
- (ASSIGN (REGISTER (? target))
- (BYTE-OFFSET (REGISTER (? address)) (? offset)))
+ (ASSIGN (REGISTER (? target)) (FIXNUM->OBJECT (REGISTER (? source))))
(QUALIFIER (pseudo-register? target))
- (byte-offset->register (indirect-byte-reference! address offset)
- (indirect-register address)
- target))
+ (fixnum->object (move-to-alias-register! source 'DATA target)))
(define-rule statement
- (ASSIGN (BYTE-OFFSET (REGISTER (? target)) (? target-offset))
- (CHAR->ASCII (OFFSET (REGISTER (? source)) (? source-offset))))
- (let ((source (indirect-char/ascii-reference! source source-offset)))
- (LAP (MOV B ,source ,(indirect-byte-reference! target target-offset)))))
-
+ (ASSIGN (OFFSET (REGISTER (? a)) (? n))
+ (FIXNUM->OBJECT (REGISTER (? source))))
+ (let ((target (indirect-reference! a n)))
+ (LAP (MOV L ,(standard-register-reference source false) ,target)
+ ,@(fixnum->object target))))
;;;; Transfers to Memory
@@ -403,28 +283,26 @@ MIT in each case. |#
(ASSIGN (OFFSET (REGISTER (? a)) (? n))
(REGISTER (? r)))
(LAP (MOV L
- ,(coerce->any r)
+ ,(standard-register-reference r false)
,(indirect-reference! a n))))
(define-rule statement
(ASSIGN (OFFSET (REGISTER (? a)) (? n))
(POST-INCREMENT (REGISTER 15) 1))
- (LAP (MOV L
- (@A+ 7)
- ,(indirect-reference! a n))))
+ (LAP (MOV L (@A+ 7) ,(indirect-reference! a n))))
(define-rule statement
- (ASSIGN (OFFSET (REGISTER (? a)) (? n))
- (CONS-POINTER (CONSTANT (? type)) (REGISTER (? r))))
- (let ((target (indirect-reference! a n)))
- (LAP (MOV L ,(coerce->any r) ,target)
+ (ASSIGN (OFFSET (REGISTER (? address)) (? offset))
+ (CONS-POINTER (CONSTANT (? type)) (REGISTER (? datum))))
+ (let ((target (indirect-reference! address offset)))
+ (LAP (MOV L ,(standard-register-reference datum 'DATA) ,target)
(MOV B (& ,type) ,target))))
(define-rule statement
- (ASSIGN (OFFSET (REGISTER (? a)) (? n))
+ (ASSIGN (OFFSET (REGISTER (? address)) (? offset))
(CONS-POINTER (CONSTANT (? type)) (ENTRY:PROCEDURE (? label))))
- (let* ((target (indirect-reference! a n))
- (temp (reference-temporary-register! 'ADDRESS)))
+ (let ((temp (reference-temporary-register! 'ADDRESS))
+ (target (indirect-reference! address offset)))
(LAP (LEA (@PCR ,(rtl-procedure/external-label (label->object label)))
,temp)
(MOV L ,temp ,target)
@@ -434,33 +312,7 @@ MIT in each case. |#
(ASSIGN (OFFSET (REGISTER (? a0)) (? n0))
(OFFSET (REGISTER (? a1)) (? n1)))
(let ((source (indirect-reference! a1 n1)))
- (LAP (MOV L
- ,source
- ,(indirect-reference! a0 n0)))))
-
-(define-rule statement
- (ASSIGN (OFFSET (REGISTER (? a)) (? n))
- (FIXNUM->OBJECT (REGISTER (? r))))
- (let ((target (indirect-reference! a n)))
- (LAP (MOV L ,(coerce->any r) ,target)
- ,@(put-type-in-ea (ucode-type fixnum) target))))
-
-(define-rule statement
- (ASSIGN (OFFSET (REGISTER (? a)) (? n))
- (FIXNUM-2-ARGS (? operator) (? operand1) (? operand2)))
- (let ((temp-reg (allocate-temporary-register! 'DATA))
- (target-ref (indirect-reference! a n)))
- (LAP ,@(fixnum-do-2-args! operator operand1 operand2 temp-reg)
- (MOV L ,(register-reference temp-reg) ,target-ref))))
-
-
-(define-rule statement
- (ASSIGN (OFFSET (REGISTER (? a)) (? n))
- (FIXNUM-1-ARG (? operator) (? operand)))
- (let ((temp-reg (allocate-temporary-register! 'DATA))
- (target-ref (indirect-reference! a n)))
- (LAP ,@(fixnum-do-1-arg! operator operand temp-reg)
- (MOV L ,(register-reference temp-reg) ,target-ref))))
+ (LAP (MOV L ,source ,(indirect-reference! a0 n0)))))
;;;; Consing
@@ -479,7 +331,7 @@ MIT in each case. |#
(define-rule statement
(ASSIGN (POST-INCREMENT (REGISTER 13) 1) (REGISTER (? r)))
- (LAP (MOV L ,(coerce->any r) (@A+ 5))))
+ (LAP (MOV L ,(standard-register-reference r false) (@A+ 5))))
(define-rule statement
(ASSIGN (POST-INCREMENT (REGISTER 13) 1) (OFFSET (REGISTER (? r)) (? n)))
@@ -488,26 +340,11 @@ MIT in each case. |#
(define-rule statement
(ASSIGN (POST-INCREMENT (REGISTER 13) 1)
(FIXNUM->OBJECT (REGISTER (? r))))
- (LAP (MOV L ,(coerce->any r) (@A+ 5))
- ,@(put-type-in-ea (ucode-type fixnum) (INST-EA (@A 5)))))
-
-(define-rule statement
- (ASSIGN (POST-INCREMENT (REGISTER 13) 1)
- (FIXNUM-2-ARGS (? operator) (? operand1) (? operand2)))
- (let ((temp-reg (allocate-temporary-register! 'DATA)))
- (LAP ,@(fixnum-do-2-args! operator operand1 operand2 temp-reg)
- (MOV L ,(register-reference temp-reg) (@A+ 5)))))
-
-(define-rule statement
- (ASSIGN (POST-INCREMENT (REGISTER 13) 1)
- (FIXNUM-1-ARG (? operator) (? operand)))
- (let ((temp-reg (allocate-temporary-register! 'DATA)))
- (LAP ,@(fixnum-do-1-arg! operator operand temp-reg)
- (MOV L ,(register-reference temp-reg) (@A+ 5)))))
-
-;; This pops the top of stack into the heap
+ (LAP (MOV L ,(standard-register-reference r false) (@A+ 5))
+ ,@(fixnum->object (INST-EA (@A 5)))))
(define-rule statement
+ ;; This pops the top of stack into the heap
(ASSIGN (POST-INCREMENT (REGISTER 13) 1) (POST-INCREMENT (REGISTER 15) 1))
(LAP (MOV L (@A+ 7) (@A+ 5))))
@@ -523,12 +360,12 @@ MIT in each case. |#
(define-rule statement
(ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (REGISTER (? r)))
- (LAP (MOV L ,(coerce->any r) (@-A 7))))
+ (LAP (MOV L ,(standard-register-reference r false) (@-A 7))))
(define-rule statement
(ASSIGN (PRE-INCREMENT (REGISTER 15) -1)
- (CONS-POINTER (CONSTANT (? type)) (REGISTER (? r))))
- (LAP (MOV L ,(coerce->any r) (@-A 7))
+ (CONS-POINTER (CONSTANT (? type)) (REGISTER (? datum))))
+ (LAP (MOV L ,(standard-register-reference datum 'DATA) (@-A 7))
(MOV B (& ,type) (@A 7))))
(define-rule statement
@@ -549,19 +386,170 @@ MIT in each case. |#
(define-rule statement
(ASSIGN (PRE-INCREMENT (REGISTER 15) -1)
(FIXNUM->OBJECT (REGISTER (? r))))
- (LAP (MOV L ,(coerce->any r) (@-A 7))
- ,@(put-type-in-ea (ucode-type fixnum) (INST-EA (@A 7)))))
+ (LAP (MOV L ,(standard-register-reference r false) (@-A 7))
+ ,@(fixnum->object (INST-EA (@A 7)))))
+
+;;;; Fixnum Operations
+
+(define-rule statement
+ (ASSIGN (? target) (FIXNUM-1-ARG (? operator) (REGISTER (? source))))
+ (QUALIFIER (and (fixnum-operation-target? target) (pseudo-register? source)))
+ (reuse-and-load-fixnum-target! target
+ source
+ (fixnum-1-arg/operate operator)))
+
+(define-rule statement
+ (ASSIGN (? target)
+ (FIXNUM-2-ARGS (? operator)
+ (REGISTER (? source))
+ (OBJECT->FIXNUM (CONSTANT (? constant)))))
+ (QUALIFIER (and (fixnum-operation-target? target) (pseudo-register? source)))
+ (fixnum-2-args/register*constant operator target source constant))
+
+(define-rule statement
+ (ASSIGN (? target)
+ (FIXNUM-2-ARGS (? operator)
+ (OBJECT->FIXNUM (CONSTANT (? constant)))
+ (REGISTER (? source))))
+ (QUALIFIER (and (fixnum-operation-target? target) (pseudo-register? source)))
+ (if (fixnum-2-args/commutative? operator)
+ (fixnum-2-args/register*constant operator target source constant)
+ (fixnum-2-args/constant*register operator target constant source)))
+
+(define (fixnum-2-args/register*constant operator target source constant)
+ (reuse-and-load-fixnum-target! target source
+ (lambda (target)
+ ((fixnum-2-args/operate-constant operator) target constant))))
+
+(define (fixnum-2-args/constant*register operator target constant source)
+ (let ((operate-on-target
+ (lambda (target)
+ (LAP ,@(load-fixnum-constant constant target)
+ ,@((fixnum-2-args/operate operator)
+ target
+ (if (eq? operator 'MULTIPLY-FIXNUM)
+ (standard-multiply-source source)
+ (standard-register-reference source 'DATA)))))))
+ (reuse-fixnum-target! target
+ (lambda (target)
+ (operate-on-target (reference-target-alias! target 'DATA)))
+ operate-on-target)))
+
+(define-rule statement
+ (ASSIGN (? target)
+ (FIXNUM-2-ARGS (? operator)
+ (REGISTER (? source1))
+ (REGISTER (? source2))))
+ (QUALIFIER (and (fixnum-operation-target? target)
+ (pseudo-register? source1)
+ (pseudo-register? source2)))
+ (let ((worst-case
+ (lambda (target source1 source2)
+ (LAP (MOV L ,source1 ,target)
+ ,@((fixnum-2-args/operate operator) target source2))))
+ (source-reference
+ (if (eq? operator 'MULTIPLY-FIXNUM)
+ standard-multiply-source
+ (lambda (source) (standard-register-reference source 'DATA)))))
+ (reuse-fixnum-target! target
+ (lambda (target)
+ (reuse-pseudo-register-alias! source1 'DATA
+ (lambda (alias)
+ (let ((source2 (source-reference source2)))
+ (delete-dead-registers!)
+ (add-pseudo-register-alias! target alias)
+ ((fixnum-2-args/operate operator) (register-reference alias)
+ source2)))
+ (lambda ()
+ (let ((new-target-alias!
+ (lambda (source1 source2)
+ (delete-dead-registers!)
+ (worst-case (reference-target-alias! target 'DATA)
+ source1
+ source2))))
+ (reuse-pseudo-register-alias source2 'DATA
+ (lambda (alias)
+ (let ((source1 (source-reference source1))
+ (source2 (register-reference alias)))
+ (let ((use-source2-alias!
+ (lambda ()
+ (delete-machine-register! alias)
+ (delete-dead-registers!)
+ (add-pseudo-register-alias! target alias)
+ ((fixnum-2-args/operate operator) source2
+ source1))))
+ (cond ((fixnum-2-args/commutative? operator)
+ (use-source2-alias!))
+ ((effective-address/data-register? source1)
+ (LAP (EXG ,source2 ,source1)
+ ,@(use-source2-alias!)))
+ (else
+ (new-target-alias! source1 source2))))))
+ (lambda ()
+ (new-target-alias!
+ (standard-register-reference source1 'DATA)
+ (source-reference source2)))))))) (lambda (target)
+ (worst-case target
+ (standard-register-reference source1 'DATA)
+ (source-reference source2))))))
+
+(define (standard-multiply-source register)
+ (let ((alias (register-alias register 'DATA)))
+ (cond (alias
+ (register-reference alias))
+ ((register-saved-into-home? register)
+ (pseudo-register-home register))
+ (else
+ (reference-alias-register! register 'DATA)))))
+
+;;;; CHAR->ASCII/BYTE-OFFSET
(define-rule statement
- (ASSIGN (PRE-INCREMENT (REGISTER 15) -1)
- (FIXNUM-2-ARGS (? operator) (? operand1) (? operand2)))
- (let ((temp-reg (allocate-temporary-register! 'DATA)))
- (LAP ,@(fixnum-do-2-args! operator operand1 operand2 temp-reg)
- (MOV L ,(register-reference temp-reg) (@-A 7)))))
+ (ASSIGN (REGISTER (? target))
+ (CHAR->ASCII (OFFSET (REGISTER (? address)) (? offset))))
+ (QUALIFIER (pseudo-register? target))
+ (byte-offset->register (indirect-char/ascii-reference! address offset)
+ (indirect-register address)
+ target))
(define-rule statement
- (ASSIGN (PRE-INCREMENT (REGISTER 15) -1)
- (FIXNUM-1-ARG (? operator) (? operand)))
- (let ((temp-reg (allocate-temporary-register! 'DATA)))
- (LAP ,@(fixnum-do-1-arg! operator operand temp-reg)
- (MOV L ,(register-reference temp-reg) (@-A 7)))))
+ (ASSIGN (REGISTER (? target)) (CHAR->ASCII (REGISTER (? source))))
+ (QUALIFIER (pseudo-register? target))
+ (let ((source-reference (machine-register-reference source false)))
+ (if source-reference
+ (begin
+ (delete-dead-registers!)
+ (LAP (BFEXTU ,source-reference (& 24) (& 8)
+ ,(reference-target-alias! target 'DATA))))
+ (byte-offset->register
+ (indirect-char/ascii-reference! regnum:regs-pointer
+ (pseudo-register-offset source))
+ (indirect-register regnum:regs-pointer)
+ target))))
+
+(define-rule statement
+ (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
+ (CHAR->ASCII (REGISTER (? source))))
+ (let ((source (coerce->any/byte-reference source)))
+ (let ((target (indirect-byte-reference! address offset)))
+ (LAP (MOV B ,source ,target)))))
+
+(define-rule statement
+ (ASSIGN (BYTE-OFFSET (REGISTER (? address)) (? offset))
+ (CHAR->ASCII (CONSTANT (? character))))
+ (LAP (MOV B (& ,(char->signed-8-bit-immediate character))
+ ,(indirect-byte-reference! address offset))))
+
+(define-rule statement
+ (ASSIGN (REGISTER (? target))
+ (BYTE-OFFSET (REGISTER (? address)) (? offset)))
+ (QUALIFIER (pseudo-register? target))
+ (byte-offset->register (indirect-byte-reference! address offset)
+ (indirect-register address)
+ target))
+
+(define-rule statement
+ (ASSIGN (BYTE-OFFSET (REGISTER (? target)) (? target-offset))
+ (CHAR->ASCII (OFFSET (REGISTER (? source)) (? source-offset))))
+ (let ((source (indirect-char/ascii-reference! source source-offset)))
+ (LAP (MOV B ,source ,(indirect-byte-reference! target target-offset)))))
\ No newline at end of file
diff --git a/v7/src/compiler/machines/bobcat/rules2.scm b/v7/src/compiler/machines/bobcat/rules2.scm
index 909ae421a..bf866b501 100644
--- a/v7/src/compiler/machines/bobcat/rules2.scm
+++ b/v7/src/compiler/machines/bobcat/rules2.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules2.scm,v 4.4 1988/06/14 08:48:37 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules2.scm,v 4.5 1988/08/29 22:49:54 cph Exp $
Copyright (c) 1988 Massachusetts Institute of Technology
@@ -36,26 +36,84 @@ MIT in each case. |#
(declare (usual-integrations))
-;;;; Predicates
-
+(define (predicate/memory-operand? expression)
+ (or (rtl:offset? expression)
+ (and (rtl:post-increment? expression)
+ (interpreter-stack-pointer?
+ (rtl:post-increment-register expression)))))
+
+(define (predicate/memory-operand-reference expression)
+ (case (rtl:expression-type expression)
+ ((OFFSET) (offset->indirect-reference! expression))
+ ((POST-INCREMENT) (INST-EA (@A+ 7)))
+ (else (error "Illegal memory operand" expression))))
+
+(define (compare/register*register register-1 register-2 cc)
+ (let ((finish
+ (lambda (reference-1 reference-2 cc)
+ (set-standard-branches! cc)
+ (LAP (CMP L ,reference-2 ,reference-1)))))
+ (let ((finish-1
+ (lambda (alias)
+ (finish (register-reference alias)
+ (standard-register-reference register-2 'DATA)
+ cc)))
+ (finish-2
+ (lambda (alias)
+ (finish (register-reference alias)
+ (standard-register-reference register-1 'DATA)
+ (invert-cc-noncommutative cc)))))
+ (let ((try-type
+ (lambda (type continue)
+ (let ((alias (register-alias register-1 type)))
+ (if alias
+ (finish-1 alias)
+ (let ((alias (register-alias register-2 type)))
+ (if alias
+ (finish-2 alias)
+ (continue))))))))
+ (try-type 'DATA
+ (lambda ()
+ (try-type 'ADDRESS
+ (lambda ()
+ (if (dead-register? register-1)
+ (finish-2 (load-alias-register! register-2 'DATA))
+ (finish-1 (load-alias-register! register-1 'DATA)))))))))))
+
+(define (compare/register*memory register memory cc)
+ (let ((reference (standard-register-reference register 'DATA)))
+ (if (effective-address/register? reference)
+ (begin
+ (set-standard-branches! cc)
+ (LAP (CMP L ,memory ,reference)))
+ (compare/memory*memory reference memory cc))))
+
+(define (compare/memory*memory memory-1 memory-2 cc)
+ (set-standard-branches! cc)
+ (let ((temp (reference-temporary-register! 'DATA)))
+ (LAP (MOV L ,memory-1 ,temp)
+ (CMP L ,memory-2 ,temp))))
+
(define-rule predicate
(TRUE-TEST (REGISTER (? register)))
(set-standard-branches! 'NE)
- (LAP ,(test-non-pointer (ucode-type false) 0 (coerce->any register))))
+ (LAP ,(test-non-pointer (ucode-type false)
+ 0
+ (standard-register-reference register false))))
(define-rule predicate
- (TRUE-TEST (OFFSET (REGISTER (? register)) (? offset)))
+ (TRUE-TEST (? memory))
+ (QUALIFIER (predicate/memory-operand? memory))
(set-standard-branches! 'NE)
- (LAP ,(test-non-pointer (ucode-type false) 0
- (indirect-reference! register offset))))
+ (LAP ,(test-non-pointer (ucode-type false)
+ 0
+ (predicate/memory-operand-reference memory))))
(define-rule predicate
(TYPE-TEST (REGISTER (? register)) (? type))
(QUALIFIER (pseudo-register? register))
(set-standard-branches! 'EQ)
- (LAP ,(test-byte
- type
- (register-reference (load-alias-register! register 'DATA)))))
+ (LAP ,(test-byte type (reference-alias-register! register 'DATA))))
(define-rule predicate
(TYPE-TEST (OBJECT->TYPE (REGISTER (? register))) (? type))
@@ -66,284 +124,200 @@ MIT in each case. |#
,(test-byte type reference))))
(define-rule predicate
- (TYPE-TEST (OBJECT->TYPE (OFFSET (REGISTER (? register)) (? offset)))
- (? type))
+ (TYPE-TEST (OBJECT->TYPE (? memory)) (? type))
+ (QUALIFIER (predicate/memory-operand? memory))
(set-standard-branches! 'EQ)
- (LAP ,(test-byte type (indirect-reference! register offset))))
+ (LAP ,(test-byte type (predicate/memory-operand-reference memory))))
(define-rule predicate
(UNASSIGNED-TEST (REGISTER (? register)))
(set-standard-branches! 'EQ)
- (LAP ,(test-non-pointer (ucode-type unassigned) 0
- (coerce->any register))))
+ (LAP ,(test-non-pointer (ucode-type unassigned)
+ 0
+ (standard-register-reference register 'DATA))))
(define-rule predicate
- (UNASSIGNED-TEST (OFFSET (REGISTER (? register)) (? offset)))
+ (UNASSIGNED-TEST (? memory))
+ (QUALIFIER (predicate/memory-operand? memory))
(set-standard-branches! 'EQ)
- (LAP ,(test-non-pointer (ucode-type unassigned) 0
- (indirect-reference! register offset))))
-
-(define (eq-test/constant*register constant register)
- (set-standard-branches! 'EQ)
- (if (non-pointer-object? constant)
- (LAP ,(test-non-pointer (object-type constant)
- (object-datum constant)
- (coerce->any register)))
- (LAP (CMP L (@PCR ,(constant->label constant))
- ,(coerce->machine-register register)))))
-
-(define (eq-test/constant*memory constant memory-reference)
- (set-standard-branches! 'EQ)
- (if (non-pointer-object? constant)
- (LAP ,(test-non-pointer (object-type constant)
- (object-datum constant)
- memory-reference))
- (let ((temp (reference-temporary-register! false)))
- (LAP (MOV L ,memory-reference ,temp)
- (CMP L (@PCR ,(constant->label constant))
- ,temp)))))
-
-(define (eq-test/register*register register-1 register-2)
- (set-standard-branches! 'EQ)
- (let ((finish
- (lambda (register-1 register-2)
- (LAP (CMP L ,(coerce->any register-2)
- ,(coerce->machine-register register-1))))))
- (if (or (and (not (register-has-alias? register-1 'DATA))
- (register-has-alias? register-2 'DATA))
- (and (not (register-has-alias? register-1 'ADDRESS))
- (register-has-alias? register-2 'ADDRESS)))
- (finish register-2 register-1)
- (finish register-1 register-2))))
-
-(define (eq-test/register*memory register memory-reference)
- (set-standard-branches! 'EQ)
- (LAP (CMP L ,memory-reference
- ,(coerce->machine-register register))))
-
-(define (eq-test/memory*memory register-1 offset-1 register-2 offset-2)
- (set-standard-branches! 'EQ)
- (let ((temp (reference-temporary-register! false)))
- (let ((finish
- (lambda (register-1 offset-1 register-2 offset-2)
- (LAP (MOV L ,(indirect-reference! register-1 offset-1)
- ,temp)
- (CMP L ,(indirect-reference! register-2 offset-2)
- ,temp)))))
- (if (or (and (not (register-has-alias? register-1 'ADDRESS))
- (register-has-alias? register-2 'ADDRESS))
- (and (not (register-has-alias? register-1 'DATA))
- (register-has-alias? register-2 'DATA)))
- (finish register-2 offset-2 register-1 offset-1)
- (finish register-1 offset-1 register-2 offset-2)))))
-
-(define-rule predicate
- (EQ-TEST (REGISTER (? register)) (CONSTANT (? constant)))
- (eq-test/constant*register constant register))
-
-(define-rule predicate
- (EQ-TEST (CONSTANT (? constant)) (REGISTER (? register)))
- (eq-test/constant*register constant register))
+ (LAP ,(test-non-pointer (ucode-type unassigned)
+ 0
+ (predicate/memory-operand-reference memory))))
(define-rule predicate
- (EQ-TEST (OFFSET (REGISTER (? register)) (? offset)) (CONSTANT (? constant)))
- (eq-test/constant*memory constant (indirect-reference! register offset)))
-
-(define-rule predicate
- (EQ-TEST (CONSTANT (? constant)) (OFFSET (REGISTER (? register)) (? offset)))
- (eq-test/constant*memory constant (indirect-reference! register offset)))
-
-(define-rule predicate
- (EQ-TEST (CONSTANT (? constant)) (POST-INCREMENT (REGISTER 15) 1))
- (eq-test/constant*memory constant (INST-EA (@A+ 7))))
-
-(define-rule predicate
- (EQ-TEST (POST-INCREMENT (REGISTER 15) 1) (CONSTANT (? constant)))
- (eq-test/constant*memory constant (INST-EA (@A+ 7))))
-
+ (OVERFLOW-TEST)
+ (set-standard-branches! 'VS))
+
(define-rule predicate
(EQ-TEST (REGISTER (? register-1)) (REGISTER (? register-2)))
- (eq-test/register*register register-1 register-2))
+ (QUALIFIER (and (pseudo-register? register-1)
+ (pseudo-register? register-2)))
+ (compare/register*register register-1 register-2 'EQ))
(define-rule predicate
- (EQ-TEST (OFFSET (REGISTER (? register-1)) (? offset-1))
- (REGISTER (? register-2)))
- (eq-test/register*memory register-2
- (indirect-reference! register-1 offset-1)))
+ (EQ-TEST (REGISTER (? register)) (? memory))
+ (QUALIFIER (and (predicate/memory-operand? memory)
+ (pseudo-register? register)))
+ (compare/register*memory register
+ (predicate/memory-operand-reference memory)
+ 'EQ))
(define-rule predicate
- (EQ-TEST (REGISTER (? register-1))
- (OFFSET (REGISTER (? register-2)) (? offset-2)))
- (eq-test/register*memory register-1
- (indirect-reference! register-2 offset-2)))
+ (EQ-TEST (? memory) (REGISTER (? register)))
+ (QUALIFIER (and (predicate/memory-operand? memory)
+ (pseudo-register? register)))
+ (compare/register*memory register
+ (predicate/memory-operand-reference memory)
+ 'EQ))
(define-rule predicate
- (EQ-TEST (POST-INCREMENT (REGISTER 15) 1) (REGISTER (? register)))
- (eq-test/register*memory register (INST-EA (@A+ 7))))
+ (EQ-TEST (? memory-1) (? memory-2))
+ (QUALIFIER (and (predicate/memory-operand? memory-1)
+ (predicate/memory-operand? memory-2)))
+ (compare/memory*memory (predicate/memory-operand-reference memory-1)
+ (predicate/memory-operand-reference memory-2)
+ 'EQ))
-(define-rule predicate
- (EQ-TEST (REGISTER (? register)) (POST-INCREMENT (REGISTER 15) 1))
- (eq-test/register*memory register (INST-EA (@A+ 7))))
-
-(define-rule predicate
- (EQ-TEST (OFFSET (REGISTER (? register-1)) (? offset-1))
- (OFFSET (REGISTER (? register-2)) (? offset-2)))
- (eq-test/memory*memory register-1 offset-1 register-2 offset-2))
-
-
-;;; fixnum predicates
-
-(define (fixnum-pred/register*register register-1 register-2 cc)
- (let ((finish
- (lambda (register-1 register-2 maybe-invert)
- (set-standard-branches! (maybe-invert cc))
- (LAP (CMP L ,(coerce->any register-1)
- ,(coerce->machine-register register-2))))))
- (if (or (and (not (register-has-alias? register-1 'DATA))
- (register-has-alias? register-2 'DATA))
- (and (not (register-has-alias? register-1 'ADDRESS))
- (register-has-alias? register-2 'ADDRESS)))
- (finish register-2 register-1 invert-cc)
- (finish register-1 register-2 (lambda (x) x)))))
-
-(define (fixnum-pred/constant*register constant register cc)
- (set-standard-branches! cc)
+(define (eq-test/constant*register constant register)
(if (non-pointer-object? constant)
- (LAP (CMPI L (& ,(object-datum constant)) ,(coerce->any register)))
- (LAP (CMP L (@PCR ,(constant->label constant))
- ,(coerce->machine-register register)))))
-
-(define (fixnum-pred/constant*memory constant memory-reference cc)
- (set-standard-branches! cc)
+ (begin
+ (set-standard-branches! 'EQ)
+ (LAP ,(test-non-pointer (object-type constant)
+ (object-datum constant)
+ (standard-register-reference register 'DATA))))
+ (compare/register*memory register
+ (INST-EA (@PCR ,(constant->label constant)))
+ 'EQ)))
+
+(define (eq-test/constant*memory constant memory)
(if (non-pointer-object? constant)
- (LAP (CMPI L (& ,(object-datum constant)) ,memory-reference))
- (let ((temp (reference-temporary-register! false)))
- (LAP (MOV L ,memory-reference ,temp)
- (CMP L (@PCR ,(constant->label constant))
- ,temp)))))
-
-(define (fixnum-pred/register*memory register memory-reference cc)
- (set-standard-branches! cc)
- (LAP (CMP L ,memory-reference
- ,(coerce->machine-register register))))
-
-(define (fixnum-pred/memory*memory register-1 offset-1 register-2 offset-2 cc)
- (let ((temp (reference-temporary-register! false)))
- (let ((finish
- (lambda (register-1 offset-1 register-2 offset-2 maybe-invert)
- (set-standard-branches! (maybe-invert cc))
- (LAP (MOV L ,(indirect-reference! register-1 offset-1)
- ,temp)
- (CMP L ,(indirect-reference! register-2 offset-2)
- ,temp)))))
- (if (or (and (not (register-has-alias? register-1 'ADDRESS))
- (register-has-alias? register-2 'ADDRESS))
- (and (not (register-has-alias? register-1 'DATA))
- (register-has-alias? register-2 'DATA)))
- (finish register-2 offset-2 register-1 offset-1 invert-cc)
- (finish register-1 offset-1 register-2 offset-2 (lambda (x) x))))))
-
-
+ (begin
+ (set-standard-branches! 'EQ)
+ (LAP ,(test-non-pointer (object-type constant)
+ (object-datum constant)
+ memory)))
+ (compare/memory*memory memory
+ (INST-EA (@PCR ,(constant->label constant)))
+ 'EQ)))
(define-rule predicate
- (FIXNUM-PRED-2-ARGS (? predicate)
- (REGISTER (? register-1)) (REGISTER (? register-2)))
- (fixnum-pred/register*register register-2 register-1
- (fixnum-pred->cc predicate)))
-
-(define-rule predicate
- (FIXNUM-PRED-2-ARGS (? predicate)
- (REGISTER (? register)) (CONSTANT (? constant)))
- (fixnum-pred/constant*register constant register
- (fixnum-pred->cc predicate)))
+ (EQ-TEST (CONSTANT (? constant)) (REGISTER (? register)))
+ (QUALIFIER (pseudo-register? register))
+ (eq-test/constant*register constant register))
(define-rule predicate
- (FIXNUM-PRED-2-ARGS (? predicate)
- (CONSTANT (? constant)) (REGISTER (? register)))
- (fixnum-pred/constant*register constant register
- (invert-cc (fixnum-pred->cc predicate))))
+ (EQ-TEST (REGISTER (? register)) (CONSTANT (? constant)))
+ (QUALIFIER (pseudo-register? register))
+ (eq-test/constant*register constant register))
(define-rule predicate
- (FIXNUM-PRED-2-ARGS (? predicate)
- (OFFSET (REGISTER (? register)) (? offset))
- (CONSTANT (? constant)))
- (fixnum-pred/constant*memory constant (indirect-reference! register offset)
- (fixnum-pred->cc predicate)))
+ (EQ-TEST (CONSTANT (? constant)) (? memory))
+ (QUALIFIER (predicate/memory-operand? memory))
+ (eq-test/constant*memory constant
+ (predicate/memory-operand-reference memory)))
(define-rule predicate
- (FIXNUM-PRED-2-ARGS (? predicate)
- (CONSTANT (? constant))
- (OFFSET (REGISTER (? register)) (? offset)))
- (fixnum-pred/constant*memory constant (indirect-reference! register offset)
- (invert-cc (fixnum-pred->cc predicate))))
+ (EQ-TEST (? memory) (CONSTANT (? constant)))
+ (QUALIFIER (predicate/memory-operand? memory))
+ (eq-test/constant*memory constant
+ (predicate/memory-operand-reference memory)))
+
+;;;; Fixnum Predicates
(define-rule predicate
- (FIXNUM-PRED-2-ARGS (? predicate)
- (CONSTANT (? constant))
- (POST-INCREMENT (REGISTER 15) 1))
- (fixnum-pred/constant*memory constant (INST-EA (@A+ 7))
- (invert-cc (fixnum-pred->cc predicate))))
+ (FIXNUM-PRED-1-ARG (? predicate) (REGISTER (? register)))
+ (QUALIFIER (pseudo-register? register))
+ (set-standard-branches! (fixnum-predicate->cc predicate))
+ (test-fixnum (standard-register-reference register 'DATA)))
(define-rule predicate
- (FIXNUM-PRED-2-ARGS (? predicate)
- (POST-INCREMENT (REGISTER 15) 1) (CONSTANT (? constant)))
- (fixnum-pred/constant*memory constant (INST-EA (@A+ 7))
- (fixnum-pred->cc predicate)))
+ (FIXNUM-PRED-1-ARG (? predicate) (? memory))
+ (QUALIFIER (predicate/memory-operand? memory))
+ (set-standard-branches! (fixnum-predicate->cc predicate))
+ (test-fixnum (predicate/memory-operand-reference memory)))
(define-rule predicate
(FIXNUM-PRED-2-ARGS (? predicate)
- (OFFSET (REGISTER (? register-1)) (? offset-1))
+ (REGISTER (? register-1))
(REGISTER (? register-2)))
- (fixnum-pred/register*memory register-2
- (indirect-reference! register-1 offset-1)
- (invert-cc (fixnum-pred->cc predicate))))
+ (QUALIFIER (and (pseudo-register? register-1)
+ (pseudo-register? register-2)))
+ (compare/register*register register-1
+ register-2
+ (fixnum-predicate->cc predicate)))
+
+(define-rule predicate
+ (FIXNUM-PRED-2-ARGS (? predicate) (REGISTER (? register)) (? memory))
+ (QUALIFIER (and (predicate/memory-operand? memory)
+ (pseudo-register? register)))
+ (compare/register*memory register
+ (predicate/memory-operand-reference memory)
+ (fixnum-predicate->cc predicate)))
+
+(define-rule predicate
+ (FIXNUM-PRED-2-ARGS (? predicate) (? memory) (REGISTER (? register)))
+ (QUALIFIER (and (predicate/memory-operand? memory)
+ (pseudo-register? register)))
+ (compare/register*memory
+ register
+ (predicate/memory-operand-reference memory)
+ (invert-cc-noncommutative (fixnum-predicate->cc predicate))))
+
+(define-rule predicate
+ (FIXNUM-PRED-2-ARGS (? predicate) (? memory-1) (? memory-2))
+ (QUALIFIER (and (predicate/memory-operand? memory-1)
+ (predicate/memory-operand? memory-2)))
+ (compare/memory*memory (predicate/memory-operand-reference memory-1)
+ (predicate/memory-operand-reference memory-2)
+ (fixnum-predicate->cc predicate)))
+
+(define (fixnum-predicate/register*constant register constant cc)
+ (set-standard-branches! cc)
+ (guarantee-signed-fixnum constant)
+ (let ((reference (standard-register-reference register 'DATA)))
+ (if (effective-address/register? reference)
+ (LAP (CMP L (& ,constant) ,reference))
+ (LAP (CMPI L (& ,constant) ,reference)))))
(define-rule predicate
(FIXNUM-PRED-2-ARGS (? predicate)
- (REGISTER (? register-1))
- (OFFSET (REGISTER (? register-2)) (? offset-2)))
- (fixnum-pred/register*memory register-1
- (indirect-reference! register-2 offset-2)
- (fixnum-pred->cc predicate)))
+ (REGISTER (? register))
+ (OBJECT->FIXNUM (CONSTANT (? constant))))
+ (QUALIFIER (pseudo-register? register))
+ (fixnum-predicate/register*constant register
+ constant
+ (fixnum-predicate->cc predicate)))
(define-rule predicate
(FIXNUM-PRED-2-ARGS (? predicate)
- (POST-INCREMENT (REGISTER 15) 1) (REGISTER (? register)))
- (fixnum-pred/register*memory register (INST-EA (@A+ 7))
- (invert-cc (fixnum-pred->cc predicate))))
+ (OBJECT->FIXNUM (CONSTANT (? constant)))
+ (REGISTER (? register)))
+ (QUALIFIER (pseudo-register? register))
+ (fixnum-predicate/register*constant
+ register
+ constant
+ (invert-cc-noncommutative (fixnum-predicate->cc predicate))))
-(define-rule predicate
- (FIXNUM-PRED-2-ARGS (? predicate)
- (REGISTER (? register)) (POST-INCREMENT (REGISTER 15) 1))
- (fixnum-pred/register*memory register (INST-EA (@A+ 7))
- (fixnum-pred->cc predicate)))
+(define (fixnum-predicate/memory*constant memory constant cc)
+ (set-standard-branches! cc)
+ (guarantee-signed-fixnum constant)
+ (LAP (CMPI L (& ,constant) ,memory)))
(define-rule predicate
(FIXNUM-PRED-2-ARGS (? predicate)
- (OFFSET (REGISTER (? register-1)) (? offset-1))
- (OFFSET (REGISTER (? register-2)) (? offset-2)))
- (fixnum-pred/memory*memory register-1 offset-1 register-2 offset-2
- (fixnum-pred->cc predicate)))
-
-
-(define-rule predicate
- (FIXNUM-PRED-1-ARG (? predicate) (REGISTER (? register)))
- (set-standard-branches! (fixnum-pred->cc predicate))
- (test-fixnum (coerce->any register)))
+ (? memory)
+ (OBJECT->FIXNUM (CONSTANT (? constant))))
+ (QUALIFIER (predicate/memory-operand? memory))
+ (fixnum-predicate/memory*constant (predicate/memory-operand-reference memory)
+ constant
+ (fixnum-predicate->cc predicate)))
(define-rule predicate
- (FIXNUM-PRED-1-ARG (? predicate) (CONSTANT (? constant)))
- (set-standard-branches! (fixnum-pred->cc predicate))
- (if (non-pointer-object? constant)
- (test-fixnum (INST-EA (& ,(object-datum constant))))
- (test-fixnum (INST-EA (@PCR ,(constant->label constant))))))
-
-(define-rule predicate
- (FIXNUM-PRED-1-ARG (? predicate) (POST-INCREMENT (REGISTER 15) 1))
- (set-standard-branches! (fixnum-pred->cc predicate))
- (test-fixnum (INST-EA (@A+ 7))))
-
-(define-rule predicate
- (FIXNUM-PRED-1-ARG (? predicate) (OFFSET (REGISTER (? register)) (? offset)))
- (set-standard-branches! (fixnum-pred->cc predicate))
- (test-fixnum (indirect-reference! offset register)))
+ (FIXNUM-PRED-2-ARGS (? predicate)
+ (OBJECT->FIXNUM (CONSTANT (? constant)))
+ (? memory))
+ (QUALIFIER (predicate/memory-operand? memory))
+ (fixnum-predicate/memory*constant
+ (predicate/memory-operand-reference memory)
+ constant
+ (invert-cc-noncommutative (fixnum-predicate->cc predicate))))
\ No newline at end of file