From 047c27f61fbd7fe6d76e2c9cd97f5e54b627a2e6 Mon Sep 17 00:00:00 2001 From: Mark Friedman Date: Thu, 19 May 1988 15:26:57 +0000 Subject: [PATCH] Added support for FIXNUM->OBJECT rtl type. Removed the implicit boxing of fixnum operations because it is now done explicitly by FIXNUM->OBJECT. --- v7/src/compiler/machines/bobcat/rules1.scm | 85 +++++++++++++++++----- 1 file changed, 68 insertions(+), 17 deletions(-) diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm index 52e9c029e..e568f37dd 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.10 1988/05/17 16:57:01 mhwu Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.11 1988/05/19 15:26:57 markf Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -145,6 +145,14 @@ MIT in each case. |# (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->TYPE (REGISTER (? source)))) (QUALIFIER (pseudo-register? target)) @@ -228,26 +236,56 @@ MIT in each case. |# (LAP (MOV L ,source ,target-ref) ,(remove-type-from-fixnum target-ref))))) +(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-2-ARGS (? operator) (? operand1) (? operand2))) + (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) (register-reference temp-reg))))) + ,@(put-type-in-ea (ucode fixnum) 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))) + (FIXNUM->OBJECT + (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))))) + ,@(put-type-in-ea (ucode 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))) + +(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)))) (delete-dead-registers!) (add-pseudo-register-alias! target temp-reg false) operation))) @@ -386,14 +424,20 @@ MIT in each case. |# ,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) - ,@(put-type-in-ea (ucode-type fixnum) target-ref)))) + (MOV L ,(register-reference temp-reg) ,target-ref)))) (define-rule statement @@ -402,8 +446,7 @@ MIT in each case. |# (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)))) + (MOV L ,(register-reference temp-reg) ,target-ref)))) ;;;; Consing @@ -428,21 +471,25 @@ 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->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)) - ,@(put-type-in-ea (ucode-type fixnum) (INST-EA (@A 5)))))) + (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)) - ,@(put-type-in-ea (ucode-type fixnum) (INST-EA (@A 5)))))) + (MOV L ,(register-reference temp-reg) (@A+ 5))))) ;; This pops the top of stack into the heap @@ -485,18 +532,22 @@ MIT in each case. |# (LAP (PEA (@PCR ,label)) (MOV B (& ,(ucode-type compiled-entry)) (@A 7)))) +(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))))) + (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)))))) + (MOV L ,(register-reference temp-reg) (@-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)))))) + (MOV L ,(register-reference temp-reg) (@-A 7))))) -- 2.25.1