From 4861e02c1f2d6de3ebc32d27d433cdbe9154ef0e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 5 Oct 2022 10:31:28 +0200
Subject: [PATCH 1/2] decode-float: fix the implementation

The previous code returned 0 for negative floats. Moreover it did not honor
the signed negative zero wrt third returned value.
---
 src/c/num_co.d | 48 ++++++++++++++++++++++--------------------------
 1 file changed, 22 insertions(+), 26 deletions(-)

diff --git a/src/c/num_co.d b/src/c/num_co.d
index 3f1c120b5..1a88fc970 100644
--- a/src/c/num_co.d
+++ b/src/c/num_co.d
@@ -115,51 +115,47 @@ cl_object
 cl_decode_float(cl_object x)
 {
   const cl_env_ptr the_env = ecl_process_env();
-  int e, s;
-  cl_type tx = ecl_t_of(x);
-  float f;
+  int e, s = 1;
+  cl_object y = ECL_NIL;
 
-  switch (tx) {
-  case t_singlefloat: {
-    f = ecl_single_float(x);
-    if (f >= 0.0) {
-      s = 1;
-    } else {
-      f = -f;
-      s = 0;
+  switch (ecl_t_of(x)) {
+  case t_longfloat: {
+    long double d = ecl_long_float(x);
+    if (signbit(d)) {
+      s = -1;
+      d = -d;
     }
-    f = frexpf(f, &e);
-    x = ecl_make_single_float(f);
+    d = frexpl(d, &e);
+    x = ecl_make_long_float(d);
+    y = ecl_make_long_float(s);
     break;
   }
   case t_doublefloat: {
     double d = ecl_double_float(x);
-    if (d >= 0.0) {
-      s = 1;
-    } else {
+    if (signbit(d)) {
+      s = -1;
       d = -d;
-      s = 0;
     }
     d = frexp(d, &e);
     x = ecl_make_double_float(d);
+    y = ecl_make_double_float(s);
     break;
   }
-  case t_longfloat: {
-    long double d = ecl_long_float(x);
-    if (d >= 0.0)
-      s = 1;
-    else {
+  case t_singlefloat: {
+    float d = ecl_single_float(x);
+    if (signbit(d)) {
+      s = -1;
       d = -d;
-      s = 0;
     }
-    d = frexpl(d, &e);
-    x = ecl_make_long_float(d);
+    d = frexpf(d, &e);
+    x = ecl_make_single_float(d);
+    y = ecl_make_single_float(s);
     break;
   }
   default:
     FEwrong_type_only_arg(@[decode-float],x,@[float]);
   }
-  ecl_return3(the_env, x, ecl_make_fixnum(e), ecl_make_single_float(s));
+  ecl_return3(the_env, x, ecl_make_fixnum(e), y);
 }
 
 cl_object

From 3b4c4f3c98b88423aa9c89a0723bee790d0da2ca Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Wed, 5 Oct 2022 10:44:27 +0200
Subject: [PATCH 2/2] tests: add a regression test for decode-float

Cases are hand picked.
---
 src/tests/normal-tests/ieee-fp.lsp | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/src/tests/normal-tests/ieee-fp.lsp b/src/tests/normal-tests/ieee-fp.lsp
index 0f3adf18a..503e20b25 100644
--- a/src/tests/normal-tests/ieee-fp.lsp
+++ b/src/tests/normal-tests/ieee-fp.lsp
@@ -813,3 +813,18 @@ Common Lisp type contagion rules."
                                   :floating-point-inexact)
                      do (signals error (si:trap-fpe sym flag) "~s should be an invalid EXT:FPE-TRAP condition." sym)))
           (si:trap-fpe bits t))))
+
+(test ieee-fp.0034.decode-float
+      (labels ((test-float (proto num res exp sign)
+                 (equal (multiple-value-list (decode-float (float num proto)))
+                        (list (float res proto) exp (float sign proto))))
+               (test-float* (num res exp sign)
+                 (is (test-float 1.0f0 num res exp sign))
+                 (is (test-float 1.0d0 num res exp sign))
+                 (is (test-float 1.0l0 num res exp sign))))
+        (test-float* -10.0 0.625 4 -1.0)
+        (test-float*  -1.0 0.5   1 -1.0)
+        (test-float*  -0.0 0.0   0 -1.0)
+        (test-float*  +0.0 0.0   0 +1.0)
+        (test-float*  +1.0 0.5   1 +1.0)
+        (test-float* +10.0 0.625 4 +1.0)))