diff options
| author | Kevin Buhr <buhr@asaurus.net> | 2019-05-01 17:13:33 -0500 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-05-08 15:35:13 -0400 |
| commit | d9bdff607e79a605197a13203ca9421153e8dd37 (patch) | |
| tree | 64b7b42f69f00311793dff046c4e4328eaf706a9 | |
| parent | ed5f858b8484a207e28baf9cbec4c60de1c86187 (diff) | |
| download | haskell-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.h | 7 | ||||
| -rw-r--r-- | libraries/base/cbits/CastFloatWord.cmm | 3 | ||||
| -rw-r--r-- | testsuite/tests/codeGen/should_run/T16617.hs | 10 | ||||
| -rw-r--r-- | testsuite/tests/codeGen/should_run/T16617.stdout | 4 | ||||
| -rw-r--r-- | testsuite/tests/codeGen/should_run/all.T | 1 |
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, ['']) |