summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKevin Buhr <buhr@asaurus.net>2019-05-01 17:13:33 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-05-08 15:35:13 -0400
commitd9bdff607e79a605197a13203ca9421153e8dd37 (patch)
tree64b7b42f69f00311793dff046c4e4328eaf706a9
parented5f858b8484a207e28baf9cbec4c60de1c86187 (diff)
downloadhaskell-d9bdff607e79a605197a13203ca9421153e8dd37.tar.gz
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.
-rw-r--r--includes/Cmm.h7
-rw-r--r--libraries/base/cbits/CastFloatWord.cmm3
-rw-r--r--testsuite/tests/codeGen/should_run/T16617.hs10
-rw-r--r--testsuite/tests/codeGen/should_run/T16617.stdout4
-rw-r--r--testsuite/tests/codeGen/should_run/all.T1
5 files changed, 23 insertions, 2 deletions
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, [''])