(list x y)))
(funcall (eval #'foo) 1)))
+269:
+ SCALE-FLOAT should accept any integer for its second argument.
+
DEFUNCT CATEGORIES OF BUGS
IR1-#:
These labels were used for bugs related to the old IR1 interpreter.
"FDEFINITION-OBJECT"
"FDOCUMENTATION" "FILENAME"
"FIND-AND-INIT-OR-CHECK-LAYOUT"
- "FLOAT-EXPONENT" "FLOAT-FORMAT-DIGITS" "FLOAT-FORMAT-NAME"
- "FLOAT-FORMAT-MAX" "FLOATING-POINT-EXCEPTION"
+ "FLOAT-EXPONENT"
+ "FLOAT-FORMAT-DIGITS" "FLOAT-FORMAT-NAME" "FLOAT-FORMAT-MAX"
+ "FLOAT-INT-EXPONENT"
+ "FLOATING-POINT-EXCEPTION"
"FORM"
"FORMAT-CONTROL"
"*FREE-INTERRUPT-CONTEXT-INDEX*" "FUNCALLABLE-INSTANCE-P"
;; IEEE float special cases
((zerop bits) 0.0)
((= bits #x-80000000) -0.0)
- (t (let ((sign (ecase (ldb (byte 1 31) bits)
- (0 1.0)
- (1 -1.0)))
- (expt (- (ldb (byte 8 23) bits) 127))
- (mant (* (logior (ldb (byte 23 0) bits)
- (ash 1 23))
- (expt 0.5 23))))
+ (t (let* ((sign (ecase (ldb (byte 1 31) bits)
+ (0 1.0)
+ (1 -1.0)))
+ (iexpt (ldb (byte 8 23) bits))
+ (expt (if (zerop iexpt) ; denormalized
+ -126
+ (- iexpt 127)))
+ (mant (* (logior (ldb (byte 23 0) bits)
+ (if (zerop iexpt)
+ 0
+ (ash 1 23)))
+ (expt 0.5 23))))
(* sign (kludge-opaque-expt 2.0 expt) mant)))))
(defun make-double-float (hi lo)
(sign (ecase (ldb (byte 1 63) bits)
(0 1.0d0)
(1 -1.0d0)))
- (expt (- (ldb (byte 11 52) bits) 1023))
+ (iexpt (ldb (byte 11 52) bits))
+ (expt (if (zerop iexpt) ; denormalized
+ -1022
+ (- iexpt 1023)))
(mant (* (logior (ldb (byte 52 0) bits)
- (ash 1 52))
+ (if (zerop iexpt)
+ 0
+ (ash 1 52)))
(expt 0.5d0 52))))
(* sign (kludge-opaque-expt 2.0d0 expt) mant)))))
(defconstant least-negative-short-float least-negative-single-float)
(defconstant least-positive-double-float (double-from-bits 0 0 1))
#!-long-float
-(defconstant least-positive-long-float least-positive-double-float)
+(defconstant least-positive-long-float (double-from-bits 0 0 1))
#!+(and long-float x86)
(defconstant least-positive-long-float (long-from-bits 0 0 1))
(defconstant least-negative-double-float (double-from-bits 1 0 1))
#!-long-float
-(defconstant least-negative-long-float least-negative-double-float)
+(defconstant least-negative-long-float (double-from-bits 1 0 1))
#!+(and long-float x86)
(defconstant least-negative-long-float (long-from-bits 1 0 1))
(defoptimizer (aref derive-type) ((array &rest indices) node)
(assert-array-rank array (length indices))
- ;; If the node continuation has a single use then assert its type.
- (let ((cont (node-cont node)))
- (when (= (length (find-uses cont)) 1)
- (assert-continuation-type cont (extract-upgraded-element-type array)
- (lexenv-policy (node-lexenv node)))))
(extract-upgraded-element-type array))
(defoptimizer (%aset derive-type) ((array &rest stuff))
(defknown decode-float (float) (values float float-exponent float)
(movable foldable flushable explicit-check))
(defknown scale-float (float float-exponent) float
- (movable foldable flushable explicit-check))
+ (movable foldable unsafely-flushable explicit-check))
(defknown float-radix (float) float-radix
(movable foldable flushable explicit-check))
(defknown float-sign (float &optional float) float
(defknown (float-digits float-precision) (float) float-digits
(movable foldable flushable explicit-check))
(defknown integer-decode-float (float)
- (values integer float-exponent (member -1 1))
+ (values integer float-int-exponent (member -1 1))
(movable foldable flushable explicit-check))
(defknown complex (real &optional real) number
#!-long-float `(integer 0 ,sb!vm:double-float-digits)
#!+long-float `(integer 0 ,sb!vm:long-float-digits))
(sb!xc:deftype float-radix () '(integer 2 2))
+(sb!xc:deftype float-int-exponent ()
+ #!-long-float 'double-float-int-exponent
+ #!+long-float 'long-float-int-exponent)
;;; a code for BOOLE
(sb!xc:deftype boole-code () '(unsigned-byte 4))
unsafely-flushable
;; may be moved with impunity. Has no side effects except possibly
;; consing, and is affected only by its arguments.
+ ;;
+ ;; Since it is not used now, its distribution in fndb.lisp is
+ ;; mere random; use with caution.
movable
;; The function is a true predicate likely to be open-coded. Convert
;; any non-conditional uses into (IF <pred> T NIL). Not usually
(assert (typep (nth-value 1 (ignore-errors
(funcall (fdefinition 'float-radix) "notfloat")))
'type-error))
+
+;;; Before 0.8.2.14 the cross compiler failed to work with
+;;; denormalized numbers
+(when (subtypep 'single-float 'short-float)
+ (assert (eql least-positive-single-float least-positive-short-float)))
+
+#+nil ; bug 269
+(let ((f (eval 'least-positive-double-float)))
+ (assert (eql (multiple-value-bind (signif expon sign)
+ (integer-decode-float f)
+ (scale-float (float signif f) expon))
+ f)))
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.2.13"
+"0.8.2.14"