From: Alexey D. <ade...@us...> - 2003-09-12 09:17:29
|
Update of /cvsroot/sbcl/sbcl/src/compiler In directory sc8-pr-cvs1:/tmp/cvs-serv747/src/compiler Modified Files: srctran.lisp Log Message: 0.8.3.54: * Fix type derivers for %DPB and %DEPOSIT-FIELD: SIGNED-BYTE representation requires extra sign bit. (reported by Paul Dietz) Index: srctran.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v retrieving revision 1.83 retrieving revision 1.84 diff -u -d -r1.83 -r1.84 --- srctran.lisp 11 Sep 2003 15:49:45 -0000 1.83 +++ srctran.lisp 12 Sep 2003 09:16:53 -0000 1.84 @@ -2346,53 +2346,32 @@ (specifier-type 'unsigned-byte))) *universal-type*))) -(defoptimizer (%dpb derive-type) ((newbyte size posn int)) +(defun %deposit-field-derive-type-aux (size posn int) (let ((size (continuation-type size)) (posn (continuation-type posn)) (int (continuation-type int))) - (if (and (numeric-type-p size) - (csubtypep size (specifier-type 'integer)) - (numeric-type-p posn) - (csubtypep posn (specifier-type 'integer)) - (numeric-type-p int) - (csubtypep int (specifier-type 'integer))) - (let ((size-high (numeric-type-high size)) - (posn-high (numeric-type-high posn)) - (high (numeric-type-high int)) - (low (numeric-type-low int))) - (if (and size-high posn-high high low - (<= (+ size-high posn-high) sb!vm:n-word-bits)) - (specifier-type - (list (if (minusp low) 'signed-byte 'unsigned-byte) - (max (integer-length high) - (integer-length low) - (+ size-high posn-high)))) - *universal-type*)) - *universal-type*))) + (when (and (numeric-type-p size) + (numeric-type-p posn) + (numeric-type-p int)) + (let ((size-high (numeric-type-high size)) + (posn-high (numeric-type-high posn)) + (high (numeric-type-high int)) + (low (numeric-type-low int))) + (when (and size-high posn-high high low + (<= (+ size-high posn-high) sb!vm:n-word-bits)) + (let ((raw-bit-count (max (integer-length high) + (integer-length low) + (+ size-high posn-high)))) + (specifier-type + (if (minusp low) + `(signed-byte ,(1+ raw-bit-count)) + `(unsigned-byte ,raw-bit-count))))))))) + +(defoptimizer (%dpb derive-type) ((newbyte size posn int)) + (%deposit-field-derive-type-aux size posn int)) (defoptimizer (%deposit-field derive-type) ((newbyte size posn int)) - (let ((size (continuation-type size)) - (posn (continuation-type posn)) - (int (continuation-type int))) - (if (and (numeric-type-p size) - (csubtypep size (specifier-type 'integer)) - (numeric-type-p posn) - (csubtypep posn (specifier-type 'integer)) - (numeric-type-p int) - (csubtypep int (specifier-type 'integer))) - (let ((size-high (numeric-type-high size)) - (posn-high (numeric-type-high posn)) - (high (numeric-type-high int)) - (low (numeric-type-low int))) - (if (and size-high posn-high high low - (<= (+ size-high posn-high) sb!vm:n-word-bits)) - (specifier-type - (list (if (minusp low) 'signed-byte 'unsigned-byte) - (max (integer-length high) - (integer-length low) - (+ size-high posn-high)))) - *universal-type*)) - *universal-type*))) + (%deposit-field-derive-type-aux size posn int)) (deftransform %ldb ((size posn int) (fixnum fixnum integer) |