diff --git a/src/CHANGELOG b/src/CHANGELOG
index a801518a3..9ba8b149b 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -1,3 +1,11 @@
+ECL 9.6.2:
+==========
+
+* Numerics:
+
+ - EXT:OUTPUT-FLOAT-NAN and EXT:OUTPUT-FLOAT-INFINITY can be redefined to
+   customized how NaNs and infinities are output.
+
 ECL 9.6:
 ========
 
diff --git a/src/c/print.d b/src/c/print.d
index d7e03d57b..a17f6def4 100644
--- a/src/c/print.d
+++ b/src/c/print.d
@@ -602,7 +602,7 @@ int edit_double(int n, DBL_TYPE d, int *sp, char *s, int *ep)
 }
 
 static void
-write_double(DBL_TYPE d, int e, int n, cl_object stream, const char *type_name)
+write_double(DBL_TYPE d, int e, int n, cl_object stream, cl_object o)
 {
 	int exp;
 #if defined(HAVE_FENV_H) || defined(_MSC_VER) || defined(mingw32)
@@ -616,16 +616,11 @@ write_double(DBL_TYPE d, int e, int n, cl_object stream, const char *type_name)
 # else
 	                FEprint_not_readable(ecl_make_doublefloat(d));
 # endif
-                write_str("#<", stream);
-                write_str(type_name, stream);
-                write_str(" quiet NaN>", stream);
+                funcall(3, @'ext::output-float-nan', o, stream);
                 return;
         }
         if (!isfinite(d)) {
-                write_str("#.EXT:", stream);
-                write_str(type_name, stream);
-                write_str(signbit(d)? "-NEGATIVE-INFINITY" : "-POSITIVE-INFINITY",
-                          stream);
+                funcall(3, @'ext::output-float-infinity', o, stream);
                 return;
         }
 	if (d < 0) {
@@ -1149,36 +1144,36 @@ si_write_ugly_object(cl_object x, cl_object stream)
 	case t_shortfloat:
 		r = ecl_symbol_value(@'*read-default-float-format*');
 		write_double(ecl_short_float(x), (r == @'short-float')? 0 : 'f',
-                             FLT_SIG, stream, "SHORT-FLOAT");
+                             FLT_SIG, stream, x);
 		break;
 	case t_singlefloat:
 		r = ecl_symbol_value(@'*read-default-float-format*');
 		write_double(sf(x), (r == @'single-float')? 0 : 's',
-                             FLT_SIG, stream, "SINGLE-FLOAT");
+                             FLT_SIG, stream, x);
 		break;
 #else
 	case t_singlefloat:
 		r = ecl_symbol_value(@'*read-default-float-format*');
 		write_double(sf(x), (r == @'single-float' || r == @'short-float')? 0 : 's',
-                             FLT_SIG, stream, "SINGLE-FLOAT");
+                             FLT_SIG, stream, x);
 		break;
 #endif
 #ifdef ECL_LONG_FLOAT
 	case t_doublefloat:
 		r = ecl_symbol_value(@'*read-default-float-format*');
 		write_double(df(x), (r == @'double-float')? 0 : 'd', DBL_SIG, stream,
-                             "DOUBLE-FLOAT");
+                             x);
 		break;
 	case t_longfloat:
 		r = ecl_symbol_value(@'*read-default-float-format*');
 		write_double(ecl_long_float(x), (r == @'long-float')? 0 : 'l',
-                             LDBL_SIG, stream, "LONG-FLOAT");
+                             LDBL_SIG, stream, x);
 		break;
 #else
 	case t_doublefloat:
 		r = ecl_symbol_value(@'*read-default-float-format*');
 		write_double(df(x), (r == @'double-float' || r == @'long-float')? 0 : 'd',
-                             DBL_SIG, stream, "DOUBLE-FLOAT");
+                             DBL_SIG, stream, x);
 		break;
 #endif
 	case t_complex:
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index ef9b3cccb..9dc839576 100644
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1785,5 +1785,8 @@ cl_symbols[] = {
 
 {SYS_ "READ-OBJECT-OR-IGNORE", EXT_ORDINARY, si_read_object_or_ignore, 2, OBJNULL},
 
+{EXT_ "OUTPUT-FLOAT-NAN", EXT_ORDINARY, NULL, -1, OBJNULL},
+{EXT_ "OUTPUT-FLOAT-INFINITY", EXT_ORDINARY, NULL, -1, OBJNULL},
+
 /* Tag for end of list */
 {NULL, CL_ORDINARY, NULL, -1, OBJNULL}};
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index 1e0dae311..5af3f43b4 100644
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1785,5 +1785,8 @@ cl_symbols[] = {
 
 {SYS_ "READ-OBJECT-OR-IGNORE","si_read_object_or_ignore"},
 
+{EXT_ "OUTPUT-FLOAT-NAN",NULL},
+{EXT_ "OUTPUT-FLOAT-INFINITY",NULL},
+
 /* Tag for end of list */
 {NULL,NULL}};
diff --git a/src/clos/print.lsp b/src/clos/print.lsp
index a20c90c33..4879d0469 100644
--- a/src/clos/print.lsp
+++ b/src/clos/print.lsp
@@ -154,6 +154,12 @@ printer and we should rather use MAKE-LOAD-FORM."
 	    (method-specializers m)))
   m)
 
+(defun ext::output-float-nan (x stream)
+  (format stream "#<~A quiet NaN>" (type-of x)))
+
+(defun ext::output-float-infinity (x stream)
+  (format stream "#.~A-~A-INFINITY" (type-of x)
+          (if (plusp x) "POSITIVE" "NEGATIVE")))
 
 ;;; ----------------------------------------------------------------------
 ;;; Describe