diff options
author | John Ericson <John.Ericson@Obsidian.Systems> | 2021-06-10 23:14:35 +0000 |
---|---|---|
committer | John Ericson <John.Ericson@Obsidian.Systems> | 2021-07-21 22:51:41 +0000 |
commit | e8f7734d8a052f99b03e1123466dc9f47b48c311 (patch) | |
tree | fda662d428a825c69d24b204a9777d4f70235acd /testsuite/tests/numeric | |
parent | 10124b16538091806953d732e24ca485a0664895 (diff) | |
download | haskell-e8f7734d8a052f99b03e1123466dc9f47b48c311.tar.gz |
Fix #19931
The issue was the renderer for x86 addressing modes assumes native size
registers, but we were passing in a possibly-smaller index in
conjunction with a native-sized base pointer.
The easist thing to do is just extend the register first.
I also changed the other NGC backends implementing jump tables
accordingly. On one hand, I think PowerPC and Sparc don't have the small
sub-registers anyways so there is less to worry about. On the other
hand, to the extent that's true the zero extension can become a no-op.
I should give credit where it's due: @hsyl20 really did all the work for
me in
https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4717#note_355874,
but I was daft and missed the "Oops" and so ended up spending a silly
amount of time putting it all back together myself.
The unregisterised backend change is a bit different, because here we
are translating the actual case not a jump table, and the fix is to
handle right-sized literals not addressing modes. But it makes sense to
include here too because it's the same change in the subsequent commit
that exposes both bugs.
Diffstat (limited to 'testsuite/tests/numeric')
-rw-r--r-- | testsuite/tests/numeric/should_run/T19931.hs | 35 | ||||
-rw-r--r-- | testsuite/tests/numeric/should_run/T19931.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/numeric/should_run/all.T | 1 |
3 files changed, 37 insertions, 0 deletions
diff --git a/testsuite/tests/numeric/should_run/T19931.hs b/testsuite/tests/numeric/should_run/T19931.hs new file mode 100644 index 0000000000..1ab9002d2e --- /dev/null +++ b/testsuite/tests/numeric/should_run/T19931.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +module Main where + +import GHC.Exts +import GHC.Types +import GHC.Num + +data T = T Word8# + +instance Num T where + fromInteger i = T (wordToWord8# (integerToWord# i)) + +instance Eq T where + (==) (T a) (T b) = isTrue# (a `eqWord8#` b) + (/=) (T a) (T b) = isTrue# (a `neWord8#` b) + +main :: IO () +main = do + let !addr = "\0\1\2\3\4\5\6\7\8"# + + w8 <- IO (\s -> case readWord8OffAddr# (plusAddr# addr 5#) 0# s of + (# s', w8 #) -> (# s', T w8 #)) + -- w8 must be small enough for one of the branch to be taken. + -- we need several alternatives for a jump table to be used + print $ case w8 of + 0 -> 1000 + 1 -> 1001 + 2 -> 1002 + 3 -> 1003 + 4 -> 1004 + 5 -> 1005 + 6 -> 1006 + _ -> 1010 diff --git a/testsuite/tests/numeric/should_run/T19931.stdout b/testsuite/tests/numeric/should_run/T19931.stdout new file mode 100644 index 0000000000..49bc2728c7 --- /dev/null +++ b/testsuite/tests/numeric/should_run/T19931.stdout @@ -0,0 +1 @@ +1005 diff --git a/testsuite/tests/numeric/should_run/all.T b/testsuite/tests/numeric/should_run/all.T index 028677e52d..1123984bdd 100644 --- a/testsuite/tests/numeric/should_run/all.T +++ b/testsuite/tests/numeric/should_run/all.T @@ -74,5 +74,6 @@ test('T18499', normal, compile_and_run, ['']) test('T18509', normal, compile_and_run, ['']) test('T18515', normal, compile_and_run, ['']) test('T18604', normal, compile_and_run, ['']) +test('T19931', normal, compile_and_run, ['-O2']) test('IntegerToFloat', normal, compile_and_run, ['']) |