From 4010d5f34528f6d09512efaee9cb8a0f69f67331 Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Wed, 18 Feb 1998 07:46:55 +0000 Subject: [PATCH] Better rules for (fix:lsh ? ) --- v7/src/compiler/machines/i386/rulfix.scm | 29 ++++++++++++++++++++++-- 1 file changed, 27 insertions(+), 2 deletions(-) diff --git a/v7/src/compiler/machines/i386/rulfix.scm b/v7/src/compiler/machines/i386/rulfix.scm index 1263c261d..8c0fe3d78 100644 --- a/v7/src/compiler/machines/i386/rulfix.scm +++ b/v7/src/compiler/machines/i386/rulfix.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: rulfix.scm,v 1.28 1997/03/30 23:26:56 cph Exp $ +$Id: rulfix.scm,v 1.29 1998/02/18 07:46:55 adams Exp $ -Copyright (c) 1992-97 Massachusetts Institute of Technology +Copyright (c) 1992-1998 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -588,6 +588,31 @@ MIT in each case. |# (LAP (SHR W ,target (& ,(- 0 n))) ,@(word->fixnum target)))))) +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FIXNUM->OBJECT + (FIXNUM-2-ARGS FIXNUM-LSH + (REGISTER (? source)) + (OBJECT->FIXNUM (CONSTANT (? n))) + #f))) + (QUALIFIER (and (exact-integer? n) (< (- scheme-datum-width) n 0))) + (fixnum-1-arg target source + (lambda (target) + (LAP (SHR W ,target (& ,(- scheme-type-width n))) + (OR W ,target + (&U ,(make-non-pointer-literal (ucode-type fixnum) 0))))))) + +(define-rule statement + (ASSIGN (REGISTER (? target)) + (FIXNUM-2-ARGS FIXNUM-LSH + (OBJECT->FIXNUM (REGISTER (? source))) + (OBJECT->FIXNUM (CONSTANT (? n))) + #f)) + (QUALIFIER (and (exact-integer? n) (< 0 n scheme-datum-width))) + (fixnum-1-arg target source + (lambda (target) + (LAP (SHL W ,target (& ,(+ scheme-type-width n))))))) + (define-arithmetic-method 'MULTIPLY-FIXNUM fixnum-methods/2-args-constant (lambda (target n overflow?) (multiply-fixnum-constant target n overflow?))) -- 2.25.1