Index: generic/tclBinary.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBinary.c,v
retrieving revision 1.69
diff -u -r1.69 tclBinary.c
--- generic/tclBinary.c	10 Dec 2010 13:08:54 -0000	1.69
+++ generic/tclBinary.c	22 Dec 2010 14:18:38 -0000
@@ -2039,7 +2039,12 @@
 				 * different numbers have been scanned. */
 {
     long value;
-    float fvalue;
+    union {
+	long l;
+	float f;
+	double d;
+	Tcl_WideUInt w;
+    } val;
     double dvalue;
     Tcl_WideUInt uwvalue;
 
@@ -2206,8 +2211,15 @@
     case 'f':
     case 'R':
     case 'r':
-	CopyNumber(buffer, &fvalue, sizeof(float), type);
-	return Tcl_NewDoubleObj(fvalue);
+	CopyNumber(buffer, &val.f, sizeof(float), type);
+	if (TclIsNaN(val.f)) {
+		/* don't use type cast for NaN, because it might clear the signaling bit */
+		val.w = ((((Tcl_WideUInt) val.l & 0x80000000) | 0x7ff00000) << 32)
+			| ((((Tcl_WideUInt) val.l) & 0x7fffff) << 29);
+	} else {
+	    val.d = (double)(val.f);
+	}
+	return Tcl_NewDoubleObj(val.d);
 
 	/*
 	 * 64-bit IEEE double-precision floating point.
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.490
diff -u -r1.490 tclInt.h
--- generic/tclInt.h	10 Dec 2010 21:59:23 -0000	1.490
+++ generic/tclInt.h	22 Dec 2010 14:18:39 -0000
@@ -4265,12 +4265,24 @@
     } while (0)
 #endif
 
-#define TclSetDoubleObj(objPtr, d) \
+#define TclSetDoubleObj(objPtr, dbl) \
     do {							\
 	TclInvalidateStringRep(objPtr);				\
 	TclFreeIntRep(objPtr);					\
-	(objPtr)->internalRep.doubleValue = (double)(d);	\
+	(objPtr)->internalRep.doubleValue = (double)(dbl);	\
 	(objPtr)->typePtr = &tclDoubleType;			\
+	if (TclIsNaN((objPtr)->internalRep.doubleValue)) { \
+	    char buffer[TCL_INTEGER_SPACE]; \
+	    char *bytes = buffer; \
+	    if (!((objPtr)->internalRep.wideValue & (((Tcl_WideInt)1) << 51))) { \
+		if ((objPtr)->internalRep.wideValue & (((Tcl_WideInt)1) << 63)) { \
+		    *bytes++ = '-'; \
+		} \
+		sprintf(bytes, "sNaN(%" TCL_LL_MODIFIER "x)", (objPtr)->internalRep.wideValue & ((((Tcl_WideInt)1) << 51) - 1)); \
+		TclInitStringRep(objPtr, buffer, strlen(buffer)); \
+	    (objPtr)->typePtr = NULL;			\
+	    } \
+	} \
     } while (0)
 
 /*
@@ -4312,14 +4324,26 @@
 #define TclNewBooleanObj(objPtr, b) \
     TclNewIntObj((objPtr), ((b)? 1 : 0))
 
-#define TclNewDoubleObj(objPtr, d) \
+#define TclNewDoubleObj(objPtr, dbl) \
     do {							\
 	TclIncrObjsAllocated();					\
 	TclAllocObjStorage(objPtr);				\
 	(objPtr)->refCount = 0;					\
 	(objPtr)->bytes = NULL;					\
-	(objPtr)->internalRep.doubleValue = (double)(d);	\
+	(objPtr)->internalRep.doubleValue = (double)(dbl);	\
 	(objPtr)->typePtr = &tclDoubleType;			\
+	if (TclIsNaN((objPtr)->internalRep.doubleValue)) { \
+	    char buffer[TCL_INTEGER_SPACE]; \
+	    char *bytes = buffer; \
+	    if (!((objPtr)->internalRep.wideValue & (((Tcl_WideInt)1) << 51))) { \
+		if ((objPtr)->internalRep.wideValue & (((Tcl_WideInt)1) << 63)) { \
+		    *bytes++ = '-'; \
+		} \
+		sprintf(bytes, "sNaN(%" TCL_LL_MODIFIER "x)", (objPtr)->internalRep.wideValue & ((((Tcl_WideInt)1) << 51) - 1)); \
+		TclInitStringRep(objPtr, buffer, strlen(buffer)); \
+		(objPtr)->typePtr = NULL;			\
+	    } \
+	} \
 	TCL_DTRACE_OBJ_CREATE(objPtr);				\
     } while (0)
 
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.177
diff -u -r1.177 tclObj.c
--- generic/tclObj.c	2 Oct 2010 11:37:02 -0000	1.177
+++ generic/tclObj.c	22 Dec 2010 14:18:39 -0000
@@ -2186,6 +2186,17 @@
 
     objPtr->internalRep.doubleValue = dblValue;
     objPtr->typePtr = &tclDoubleType;
+	if (TclIsNaN((objPtr)->internalRep.doubleValue)) {
+	    char buffer[TCL_INTEGER_SPACE];
+	    char *bytes = buffer;
+	    if (!((objPtr)->internalRep.wideValue & (((Tcl_WideInt)1) << 51))) {
+		if ((objPtr)->internalRep.wideValue & (((Tcl_WideInt)1) << 63)) {
+		    *bytes++ = '-';
+		}
+	    sprintf(bytes, "sNaN(%" TCL_LL_MODIFIER "x)", (objPtr)->internalRep.wideValue & ((((Tcl_WideInt)1) << 51) - 1));
+	    TclInitStringRep(objPtr, buffer, strlen(buffer));
+	    (objPtr)->typePtr = NULL;
+	}
     return objPtr;
 }
 
Index: tests/binary.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/binary.test,v
retrieving revision 1.43
diff -u -r1.43 binary.test
--- tests/binary.test	9 Nov 2010 14:20:19 -0000	1.43
+++ tests/binary.test	22 Dec 2010 14:18:39 -0000
@@ -1583,6 +1583,14 @@
     unset -nocomplain arg1
     list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1
 } -match glob -result {1 -NaN*}
+test binary-40.5 {ScanNumber: sNaN} -body {
+    unset -nocomplain arg1
+    list [binary scan \xff\x9f\x9f\xff f arg1] $arg1
+} -result {1 -sNaN(3f3ffe0000000)}
+test binary-40.6 {ScanNumber: sNaN} -body {
+    unset -nocomplain arg1
+    list [binary scan \xff\xf3\xff\xff\xff\xff\xf3\xff d arg1] $arg1
+} -result {1 -sNaN(3fffffffff3ff)}
 
 test binary-41.1 {ScanNumber: word alignment} {
     unset -nocomplain arg1; unset arg2
@@ -2318,6 +2326,10 @@
 	v1 v2 v3 v4 v5 v6
     list $v1 $v2 $v3 $v4 $v5 $v6
 } -match regexp -result {NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))?}
+test binary-60.2 {[binary format] with sNaN} -body {
+    binary scan \x7f\xf3\xff\xff\xff\xff\xf3\x7f d d
+    binary format d $d
+} -returnCodes 1 -result {expected floating-point number but got "sNaN(3fffffffff37f)"}
 
 # scan m
 test binary-61.1 {Tcl_BinaryObjCmd: scan wide int} bigEndian {
@@ -2388,9 +2400,17 @@
     set d
 } -match glob -result NaN*
 test binary-64.2 {NaN} -constraints ieeeFloatingPoint -body {
-    binary scan [binary format w 0x7ff0123456789aBc] q d
+    binary scan [binary format w 0x7ffc123456789aBc] q d
     set d
 } -match glob -result NaN(*123456789abc)
+test binary-64.3 {sNaN} -constraints ieeeFloatingPoint -body {
+    binary scan [binary format w 0x7ff0000000000001] q d
+    set d
+} -match glob -result sNaN(1)
+test binary-64.4 {NaN} -constraints ieeeFloatingPoint -body {
+    binary scan [binary format w 0x7ff0123456789aBc] q d
+    set d
+} -match glob -result sNaN(123456789abc)
 
 test binary-65.1 {largest significand} ieeeFloatingPoint {
     binary scan [binary format w 0x3fcfffffffffffff] q d
