From: Guillermo J. Rozas Date: Tue, 5 Dec 1989 20:52:20 +0000 (+0000) Subject: Extend fixnum and flonum operations with an overflow? flag. X-Git-Tag: 20090517-FFI~11632 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=35d6e7ca89d9bfb54ad8bd998fa82b61d384f7ca;p=mit-scheme.git Extend fixnum and flonum operations with an overflow? flag. --- diff --git a/v7/src/compiler/machines/bobcat/rules1.scm b/v7/src/compiler/machines/bobcat/rules1.scm index 5e2918707..7ab505a6f 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.29 1989/11/15 02:40:21 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/rules1.scm,v 4.30 1989/12/05 20:52:00 jinx Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -404,10 +404,14 @@ MIT in each case. |# (QUALIFIER (pseudo-word? r)) (LAP (MOV L ,(standard-register-reference r false true) (@A+ 5)))) +#| +;; This seems like a fossil. Removed by Jinx. + (define-rule statement (ASSIGN (POST-INCREMENT (REGISTER 13) 1) (REGISTER (? r))) (QUALIFIER (pseudo-float? r)) (LAP (FMOVE D ,(machine-register-reference r 'FLOAT) (@A+ 5)))) +|# (define-rule statement (ASSIGN (POST-INCREMENT (REGISTER 13) 1) (OFFSET (REGISTER (? r)) (? n))) @@ -483,9 +487,10 @@ MIT in each case. |# ;;;; Fixnum Operations (define-rule statement - (ASSIGN (? target) (FIXNUM-1-ARG (? operator) (REGISTER (? source)))) + (ASSIGN (? target) (FIXNUM-1-ARG (? operator) (REGISTER (? source)) (? overflow?))) (QUALIFIER (and (machine-operation-target? target) (pseudo-register? source))) + overflow? ; ignored (reuse-and-load-machine-target! 'DATA target source @@ -495,10 +500,12 @@ MIT in each case. |# (ASSIGN (? target) (FIXNUM-2-ARGS (? operator) (REGISTER (? source1)) - (REGISTER (? source2)))) + (REGISTER (? source2)) + (? overflow?))) (QUALIFIER (and (machine-operation-target? target) (pseudo-register? source1) (pseudo-register? source2))) + overflow? ; ignored (two-arg-register-operation (fixnum-2-args/operate operator) (fixnum-2-args/commutative? operator) 'DATA @@ -515,18 +522,22 @@ MIT in each case. |# (ASSIGN (? target) (FIXNUM-2-ARGS (? operator) (REGISTER (? source)) - (OBJECT->FIXNUM (CONSTANT (? constant))))) + (OBJECT->FIXNUM (CONSTANT (? constant))) + (? overflow?))) (QUALIFIER (and (machine-operation-target? target) (pseudo-register? source))) + overflow? ; ignored (fixnum-2-args/register*constant operator target source constant)) (define-rule statement (ASSIGN (? target) (FIXNUM-2-ARGS (? operator) (OBJECT->FIXNUM (CONSTANT (? constant))) - (REGISTER (? source)))) + (REGISTER (? source)) + (? overflow?))) (QUALIFIER (and (machine-operation-target? target) (pseudo-register? source))) + overflow? ; ignored (if (fixnum-2-args/commutative? operator) (fixnum-2-args/register*constant operator target source constant) (fixnum-2-args/constant*register operator target constant source))) @@ -561,34 +572,42 @@ MIT in each case. |# (ASSIGN (? target) (FIXNUM-2-ARGS MULTIPLY-FIXNUM (OBJECT->FIXNUM (CONSTANT 4)) - (OBJECT->FIXNUM (REGISTER (? source))))) + (OBJECT->FIXNUM (REGISTER (? source))) + (? overflow?))) (QUALIFIER (and (machine-operation-target? target) (pseudo-register? source))) + overflow? ; ignored (convert-index->fixnum/register target source)) (define-rule statement (ASSIGN (? target) (FIXNUM-2-ARGS MULTIPLY-FIXNUM (OBJECT->FIXNUM (REGISTER (? source))) - (OBJECT->FIXNUM (CONSTANT 4)))) + (OBJECT->FIXNUM (CONSTANT 4)) + (? overflow?))) (QUALIFIER (and (machine-operation-target? target) (pseudo-register? source))) + overflow? ; ignored (convert-index->fixnum/register target source)) (define-rule statement (ASSIGN (? target) (FIXNUM-2-ARGS MULTIPLY-FIXNUM (OBJECT->FIXNUM (CONSTANT 4)) - (OBJECT->FIXNUM (OFFSET (REGISTER (? r)) (? n))))) + (OBJECT->FIXNUM (OFFSET (REGISTER (? r)) (? n))) + (? overflow?))) (QUALIFIER (machine-operation-target? target)) + overflow? ; ignored (convert-index->fixnum/offset target r n)) (define-rule statement (ASSIGN (? target) (FIXNUM-2-ARGS MULTIPLY-FIXNUM (OBJECT->FIXNUM (OFFSET (REGISTER (? r)) (? n))) - (OBJECT->FIXNUM (CONSTANT 4)))) + (OBJECT->FIXNUM (CONSTANT 4)) + (? overflow?))) (QUALIFIER (machine-operation-target? target)) + overflow? ; ignored (convert-index->fixnum/offset target r n)) ;;; end (IF (<= SCHEME-TYPE-WIDTH 6) ...) @@ -635,9 +654,10 @@ MIT in each case. |# (define-rule statement (ASSIGN (? target) - (FLONUM-1-ARG (? operator) (REGISTER (? source)))) + (FLONUM-1-ARG (? operator) (REGISTER (? source)) (? overflow?))) (QUALIFIER (and (machine-operation-target? target) (pseudo-float? source))) + overflow? ; ignored (let ((operate-on-target (lambda (target) ((flonum-1-arg/operate operator) @@ -652,10 +672,12 @@ MIT in each case. |# (ASSIGN (? target) (FLONUM-2-ARGS (? operator) (REGISTER (? source1)) - (REGISTER (? source2)))) + (REGISTER (? source2)) + (? overflow?))) (QUALIFIER (and (machine-operation-target? target) (pseudo-float? source1) (pseudo-float? source2))) + overflow? ; ignored (let ((source-reference (lambda (source) (standard-register-reference source 'FLOAT false)))) (two-arg-register-operation (flonum-2-args/operate operator) diff --git a/v7/src/compiler/rtlbase/rtlcon.scm b/v7/src/compiler/rtlbase/rtlcon.scm index afc3b02ac..563e9113e 100644 --- a/v7/src/compiler/rtlbase/rtlcon.scm +++ b/v7/src/compiler/rtlbase/rtlcon.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcon.scm,v 4.18 1989/10/26 07:38:28 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlcon.scm,v 4.19 1989/12/05 20:52:20 jinx Exp $ Copyright (c) 1988, 1989 Massachusetts Institute of Technology @@ -547,19 +547,19 @@ MIT in each case. |# (receiver (rtl:make-cons-pointer type datum)))))))) (define-expression-method 'FIXNUM-2-ARGS - (lambda (receiver scfg-append! operator operand1 operand2) + (lambda (receiver scfg-append! operator operand1 operand2 overflow?) (expression-simplify operand1 scfg-append! (lambda (operand1) (expression-simplify operand2 scfg-append! (lambda (operand2) (receiver - (rtl:make-fixnum-2-args operator operand1 operand2)))))))) + (rtl:make-fixnum-2-args operator operand1 operand2 overflow?)))))))) (define-expression-method 'FIXNUM-1-ARG - (lambda (receiver scfg-append! operator operand) + (lambda (receiver scfg-append! operator operand overflow?) (expression-simplify operand scfg-append! (lambda (operand) - (receiver (rtl:make-fixnum-1-arg operator operand)))))) + (receiver (rtl:make-fixnum-1-arg operator operand overflow?)))))) (define-expression-method 'GENERIC-BINARY (lambda (receiver scfg-append! operator operand1 operand2) @@ -577,15 +577,16 @@ MIT in each case. |# (receiver (rtl:make-generic-unary operator operand)))))) (define-expression-method 'FLONUM-1-ARG - (lambda (receiver scfg-append! operator operand) + (lambda (receiver scfg-append! operator operand overflow?) (expression-simplify operand scfg-append! (lambda (s-operand) (receiver (rtl:make-flonum-1-arg operator - s-operand)))))) + s-operand + overflow?)))))) (define-expression-method 'FLONUM-2-ARGS - (lambda (receiver scfg-append! operator operand1 operand2) + (lambda (receiver scfg-append! operator operand1 operand2 overflow?) (expression-simplify operand1 scfg-append! (lambda (s-operand1) (expression-simplify operand2 scfg-append! @@ -593,7 +594,8 @@ MIT in each case. |# (receiver (rtl:make-flonum-2-args operator s-operand1 - s-operand2)))))))) + s-operand2 + overflow?)))))))) (define-expression-method 'FLOAT->OBJECT (lambda (receiver scfg-append! expression) diff --git a/v7/src/compiler/rtlbase/rtlty1.scm b/v7/src/compiler/rtlbase/rtlty1.scm index 2f98ae855..459ecebd9 100644 --- a/v7/src/compiler/rtlbase/rtlty1.scm +++ b/v7/src/compiler/rtlbase/rtlty1.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty1.scm,v 4.14 1989/07/25 12:37:01 arthur Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlbase/rtlty1.scm,v 4.15 1989/12/05 20:51:48 jinx Exp $ Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology @@ -63,14 +63,16 @@ MIT in each case. |# (define-rtl-expression offset-address rtl: register number) (define-rtl-expression unassigned rtl:) -(define-rtl-expression fixnum-1-arg rtl: operator operand) -(define-rtl-expression fixnum-2-args rtl: operator operand-1 operand-2) +(define-rtl-expression fixnum-1-arg rtl: operator operand overflow?) +(define-rtl-expression fixnum-2-args rtl: operator operand-1 operand-2 + overflow?) (define-rtl-predicate fixnum-pred-1-arg % predicate operand) (define-rtl-predicate fixnum-pred-2-args % predicate operand-1 operand-2) -(define-rtl-expression flonum-1-arg rtl: operator operand) -(define-rtl-expression flonum-2-args rtl: operator operand-1 operand-2) +(define-rtl-expression flonum-1-arg rtl: operator operand overflow?) +(define-rtl-expression flonum-2-args rtl: operator operand-1 operand-2 + overflow?) (define-rtl-predicate flonum-pred-1-arg % predicate operand) (define-rtl-predicate flonum-pred-2-args % predicate operand-1 operand-2)