From 5be13cdaab42df1d522c6bb540a5639b9c2f1352 Mon Sep 17 00:00:00 2001 From: Mark Friedman Date: Fri, 22 Apr 1988 16:21:29 +0000 Subject: [PATCH] Added rules to support open coding of fixnum arithmetic. --- v7/src/compiler/machines/bobcat/rules1.scm | 116 ++++++++++++++- v7/src/compiler/machines/bobcat/rules2.scm | 159 ++++++++++++++++++++- 2 files changed, 267 insertions(+), 8 deletions(-) diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm index d41e4b83c..dc7cddbb3 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.5 1988/03/25 21:20:04 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.6 1988/04/22 16:20:11 markf Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -104,8 +104,11 @@ MIT in each case. |# (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)))))) + (let ((source (indirect-reference! source n))) + (delete-dead-registers!) + (LAP (LEA ,source + ,(register-reference + (allocate-alias-register! target 'ADDRESS)))))))) (define-rule statement (ASSIGN (REGISTER (? target)) (CONSTANT (? source))) @@ -115,16 +118,20 @@ MIT in each case. |# (define-rule statement (ASSIGN (REGISTER (? target)) (VARIABLE-CACHE (? name))) (QUALIFIER (pseudo-register? target)) + (delete-dead-registers!) (LAP (MOV L (@PCR ,(free-reference-label name)) - ,(reference-assignment-alias! target 'ADDRESS)))) + ,(register-reference + (allocate-alias-register! target 'ADDRESS))))) (define-rule statement (ASSIGN (REGISTER (? target)) (ASSIGNMENT-CACHE (? name))) (QUALIFIER (pseudo-register? target)) + (delete-dead-registers!) (LAP (MOV L (@PCR ,(free-assignment-label name)) - ,(reference-assignment-alias! target 'ADDRESS)))) + ,(register-reference + (allocate-alias-register! target 'ADDRESS))))) (define-rule statement (ASSIGN (REGISTER (? target)) (REGISTER (? source))) @@ -199,6 +206,52 @@ MIT in each case. |# (MOV L ,temp ,target*) (MOV B (& ,type) ,target*)))))) +(define-rule statement + (ASSIGN (REGISTER (? target)) (OBJECT->FIXNUM (CONSTANT (? datum)))) + (QUALIFIER (pseudo-register? target)) + (delete-dead-registers!) + (let ((target-ref (register-reference (allocate-alias-register! target 'DATA)))) + (load-fixnum-constant datum target-ref))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) (OBJECT->FIXNUM (REGISTER (? source)))) + (QUALIFIER (pseudo-register? target)) + (let ((target-ref (move-to-alias-register! source 'DATA target))) + (LAP ,(remove-type-from-fixnum target-ref)))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) (OBJECT->FIXNUM (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))))) + +(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) + ,@(put-type-in-ea (ucode-type fixnum) (register-reference temp-reg))))) + (delete-dead-registers!) + (add-pseudo-register-alias! target temp-reg false) + operation))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FIXNUM-1-ARG (? operator) (? operand))) + (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) (register-reference temp-reg))))) + (delete-dead-registers!) + (add-pseudo-register-alias! target temp-reg false) + operation))) + ;;;; Transfers to Memory (define-rule statement @@ -249,6 +302,25 @@ MIT in each case. |# (LAP (MOV L ,source ,(indirect-reference! a0 n0))))) + +(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) + ,@(put-type-in-ea (ucode-type fixnum) 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) + ,@(put-type-in-ea (ucode-type fixnum) target-ref)))) ;;;; Consing @@ -273,6 +345,22 @@ MIT in each case. |# (ASSIGN (POST-INCREMENT (REGISTER 13) 1) (OFFSET (REGISTER (? r)) (? n))) (LAP (MOV L ,(indirect-reference! r n) (@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)) + ,@(put-type-in-ea (ucode-type fixnum) (INST-EA (@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)) + ,@(put-type-in-ea (ucode-type fixnum) (INST-EA (@A 5)))))) + ;; This pops the top of stack into the heap (define-rule statement @@ -312,4 +400,20 @@ MIT in each case. |# (define-rule statement (ASSIGN (PRE-INCREMENT (REGISTER 15) -1) (ENTRY:CONTINUATION (? label))) (LAP (PEA (@PCR ,label)) - (MOV B (& ,(ucode-type compiled-entry)) (@A 7)))) \ No newline at end of file + (MOV B (& ,(ucode-type compiled-entry)) (@A 7)))) + +(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)) + ,@(put-type-in-ea (ucode-type fixnum) (INST-EA (@A 7)))))) + +(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)) + ,@(put-type-in-ea (ucode-type fixnum) (INST-EA (@A 7)))))) diff --git a/v7/src/compiler/machines/bobcat/rules2.scm b/v7/src/compiler/machines/bobcat/rules2.scm index ddf95d6d0..777943931 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.2 1987/12/31 10:26:18 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules2.scm,v 4.3 1988/04/22 16:21:29 markf Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -187,4 +187,159 @@ MIT in each case. |# (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)) \ No newline at end of file + (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) + (if (non-pointer-object? constant) + (LAP (CMPI L (& ,(primitive-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) + (if (non-pointer-object? constant) + (LAP (CMPI L (& ,(primitive-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)))))) + + + +(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))) + +(define-rule predicate + (FIXNUM-PRED-2-ARGS (? predicate) + (CONSTANT (? constant)) (REGISTER (? register))) + (fixnum-pred/constant*register constant register + (invert-cc (fixnum-pred->cc predicate)))) + +(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))) + +(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)))) + +(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)))) + +(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))) + +(define-rule predicate + (FIXNUM-PRED-2-ARGS (? predicate) + (OFFSET (REGISTER (? register-1)) (? offset-1)) + (REGISTER (? register-2))) + (fixnum-pred/register*memory register-2 + (indirect-reference! register-1 offset-1) + (invert-cc (fixnum-pred->cc predicate)))) + +(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))) + +(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)))) + +(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-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))) + +(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 (& ,(primitive-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))) -- 2.25.1