From d9bdff607e79a605197a13203ca9421153e8dd37 Mon Sep 17 00:00:00 2001
From: Kevin Buhr <buhr@asaurus.net>
Date: Wed, 1 May 2019 17:13:33 -0500
Subject: [PATCH] stg_floatToWord32zh: zero-extend the Word32 (#16617)

The primop stgFloatToWord32 was sign-extending the 32-bit word, resulting
in weird negative Word32s.  Zero-extend them instead.

Closes #16617.
---
 includes/Cmm.h                                   |  7 ++++++-
 libraries/base/cbits/CastFloatWord.cmm           |  3 ++-
 testsuite/tests/codeGen/should_run/T16617.hs     | 10 ++++++++++
 testsuite/tests/codeGen/should_run/T16617.stdout |  4 ++++
 testsuite/tests/codeGen/should_run/all.T         |  1 +
 5 files changed, 23 insertions(+), 2 deletions(-)
 create mode 100644 testsuite/tests/codeGen/should_run/T16617.hs
 create mode 100644 testsuite/tests/codeGen/should_run/T16617.stdout

diff --git a/includes/Cmm.h b/includes/Cmm.h
index ba84328a73..99f5233ab5 100644
--- a/includes/Cmm.h
+++ b/includes/Cmm.h
@@ -159,14 +159,19 @@
 #define BYTES_TO_WDS(n) ((n) / SIZEOF_W)
 #define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W)
 
-/* TO_W_(n) converts n to W_ type from a smaller type */
+/*
+ * TO_W_(n) and TO_ZXW_(n) convert n to W_ type from a smaller type,
+ * with and without sign extension respectively
+ */
 #if SIZEOF_W == 4
 #define TO_I64(x) %sx64(x)
 #define TO_W_(x) %sx32(x)
+#define TO_ZXW_(x) %zx32(x)
 #define HALF_W_(x) %lobits16(x)
 #elif SIZEOF_W == 8
 #define TO_I64(x) (x)
 #define TO_W_(x) %sx64(x)
+#define TO_ZXW_(x) %zx64(x)
 #define HALF_W_(x) %lobits32(x)
 #endif
 
diff --git a/libraries/base/cbits/CastFloatWord.cmm b/libraries/base/cbits/CastFloatWord.cmm
index 18d275f4af..2edb006472 100644
--- a/libraries/base/cbits/CastFloatWord.cmm
+++ b/libraries/base/cbits/CastFloatWord.cmm
@@ -61,7 +61,8 @@ stg_floatToWord32zh(F_ f)
 
     reserve 1 = ptr {
         F_[ptr] = f;
-        w = TO_W_(I32[ptr]);
+        // Fix #16617: use zero-extending (TO_ZXW_) here
+        w = TO_ZXW_(I32[ptr]);
     }
 
     return (w);
diff --git a/testsuite/tests/codeGen/should_run/T16617.hs b/testsuite/tests/codeGen/should_run/T16617.hs
new file mode 100644
index 0000000000..49e5e74a20
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T16617.hs
@@ -0,0 +1,10 @@
+import GHC.Float
+
+main :: IO ()
+main = do
+  -- As per #16617, Word32s should be non-negative
+  print $ castFloatToWord32 (-1)
+  print $ toInteger (castFloatToWord32 (-1)) > 0
+  -- For completeness, so should Word64s
+  print $ castDoubleToWord64 (-1)
+  print $ toInteger (castDoubleToWord64 (-1)) > 0
diff --git a/testsuite/tests/codeGen/should_run/T16617.stdout b/testsuite/tests/codeGen/should_run/T16617.stdout
new file mode 100644
index 0000000000..3a0c8ecbc9
--- /dev/null
+++ b/testsuite/tests/codeGen/should_run/T16617.stdout
@@ -0,0 +1,4 @@
+3212836864
+True
+13830554455654793216
+True
diff --git a/testsuite/tests/codeGen/should_run/all.T b/testsuite/tests/codeGen/should_run/all.T
index 189fb72e7f..6b4d772627 100644
--- a/testsuite/tests/codeGen/should_run/all.T
+++ b/testsuite/tests/codeGen/should_run/all.T
@@ -194,3 +194,4 @@ test('T15892',
         # happen, so -G1 -A32k:
         extra_run_opts('+RTS -G1 -A32k -RTS') ],
      compile_and_run, ['-O'])
+test('T16617', normal, compile_and_run, [''])
-- 
GitLab