From 80eb1e3981f12fc4abed931361a31324a050902f Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Wed, 20 Aug 2008 17:07:32 +0000 Subject: [PATCH] o LOGAND-DERIVE-TYPE-AUX was deriving the result to be too wide for (defun foo (x) (declare (type unsigned-byte x)) (logand x #xff)) It was returning unsigned-byte when the result should have a bounded type like (unsigned-byte 8). o Small optimization for %ldb deftransform: If the byte positiion is known to be 0, don't transform to (ash int 0), but just replace it with int. --- compiler/srctran.lisp | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index 43e6d65c1..52c4b800d 100644 --- a/compiler/srctran.lisp +++ b/compiler/srctran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.166 2008/08/18 20:38:20 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.167 2008/08/20 17:07:32 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2424,9 +2424,17 @@ ;; X must be positive. (if (not y-neg) ;; The must both be positive. - (cond ((or (null x-len) (null y-len)) + (cond ((and (null x-len) (null y-len)) + ;; Both are unbounded, so result is unbounded. (specifier-type 'unsigned-byte)) + ((or (and x-len (null y-len)) + (and y-len (null x-len))) + ;; One is bounded, so the result is bounded. + ;; The computed length here is a bit loose. + (specifier-type `(unsigned-byte ,(max (or x-len 0) + (or y-len 0))))) ((or (zerop x-len) (zerop y-len)) + ;; One has zero length, so the result has zero length. (specifier-type '(integer 0 0))) ((and (<= x-len 32) (<= y-len 32)) ;; If both args are unsigned 32-bit numbers, we @@ -2855,17 +2863,19 @@ "convert to inline logical ops" ;; Try to help out the compiler by precomputing things if SIZE or ;; POSN are constants. This helps out modular arithmetic in some - ;; cases. (I think it's a deficiency in modular arithmetic it can't - ;; figure some things out for itself.) - (let ((posn-form (if (constant-continuation-p posn) - (- (continuation-value posn)) - '(- posn))) - (size-form (if (constant-continuation-p size) + ;; cases. (I think it's a deficiency in modular arithmetic that it + ;; can't figure some things out for itself.) + (let ((shift-form (if (constant-continuation-p posn) + (if (zerop (continuation-value posn)) + 'int + `(ash int ,(- (continuation-value posn)))) + '(ash int (- posn)))) + (mask-form (if (constant-continuation-p size) (ash (1- (ash 1 vm:word-bits)) (- (continuation-value size) vm:word-bits)) `(ash ,(1- (ash 1 vm:word-bits)) (- size vm:word-bits))))) - `(logand (ash int ,posn-form) ,size-form))) + `(logand ,shift-form ,mask-form))) (deftransform %mask-field ((size posn int) (fixnum fixnum integer) -- GitLab