diff --git a/src/lisp/setexception.c b/src/lisp/setexception.c index a0f568c054c81aab4a22273cb833bb6a454827d9..a77a9d8fa247629dd794c590181a48e307769ec3 100644 --- a/src/lisp/setexception.c +++ b/src/lisp/setexception.c @@ -4,6 +4,37 @@ #include "fdlibm.h" +/* + * Test if the given number is a quiet NaN + */ + +int +isQNaN(double x) +{ + int hx; + union { int i[2]; double d; } ux; + + ux.d = x; + hx = ux.i[HIWORD] & 0x7fffffff; + + if (hx >= 0x7ff00000) { + /* + * We have some kind of infinity or NaN. Get the (top) + * mantissa bits. We have a quiet NaN if the most significant + * bit is 1. The other bits of the mantissa don't matter. We + * also don't distinguish this from the quiet NaN + * floating-point indefinite which only has the most + * significant bit set. These are all considered NaNs for our + * purposes. + */ + hx &= 0xfffff; + + return hx & 0x80000; + } + + return 0; +} + /* * Signal the floating-point exception of the given |type|, based on * the value of |x|. @@ -36,13 +67,21 @@ fdlibm_setexception(double x, enum FDLIBM_EXCEPTION type) case 3: { /* invalid */ - feraiseexcept(FE_INVALID); + + if (!isQNaN(x)) { + /* + * If it's not a quiet NaN, we want to signal an invalid + * operation. Otherwise, we silently return a NaN. + */ + feraiseexcept(FE_INVALID); + } + /* * FIXME: Of the many NaN values that we have, what NaN * should we return? */ union { int i[2]; double d; } ux; - ux.i[HIWORD] = 0x7ff00000; + ux.i[HIWORD] = 0x7ff80000; ux.i[LOWORD] = 0xdeadbeef; ret = ux.d;