[commit: ghc] master: nativeGen.PPC: Fix shift arith. right > 31 bits (fb0d512)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/fb0d5120d383324c6934144b938525378e3ade75/ghc

>---------------------------------------------------------------

commit fb0d5120d383324c6934144b938525378e3ade75
Author: Peter Trommler <ptrommler at acm.org>
Date:   Wed Nov 11 12:32:19 2015 +0100

    nativeGen.PPC: Fix shift arith. right > 31 bits
    
    Arithmetic right shifts of more than 31 bits set all bits to
    the sign bit on PowerPC. iThe assembler does not allow shift
    amounts larger than 32 so do an arithemetic right shift of 31
    bit instead.
    
    Fixes #10870
    
    Test Plan: validate (especially on powerpc)
    
    Reviewers: austin, erikd, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1459
    
    GHC Trac Issues: #10870


>---------------------------------------------------------------

fb0d5120d383324c6934144b938525378e3ade75
 compiler/nativeGen/PPC/Ppr.hs                    | 11 ++++++++---
 testsuite/tests/codeGen/should_run/T10870.hs     |  1 +
 testsuite/tests/codeGen/should_run/T10870.stdout |  1 +
 3 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index e514779..99f9ab7 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -718,12 +718,17 @@ pprInstr (SR II32 reg1 reg2 (RIImm (ImmInt i))) | i < 0  || i > 31 =
     pprInstr (XOR reg1 reg2 (RIReg reg2))
 
 pprInstr (SL II32 reg1 reg2 (RIImm (ImmInt i))) | i < 0  || i > 31 =
-    -- As aboce for SR, but for left shifts.
+    -- As above for SR, but for left shifts.
     -- Fixes ticket http://ghc.haskell.org/trac/ghc/ticket/10870
     pprInstr (XOR reg1 reg2 (RIReg reg2))
 
-pprInstr (SRA II32 reg1 reg2 (RIImm (ImmInt i))) | i < 0  || i > 31 =
-    pprInstr (XOR reg1 reg2 (RIReg reg2))
+pprInstr (SRA II32 reg1 reg2 (RIImm (ImmInt i))) | i > 31 =
+    -- PT: I don't know what to do for negative shift amounts:
+    -- For now just panic.
+    --
+    -- For shift amounts greater than 31 set all bit to the
+    -- value of the sign bit, this also what sraw does.
+    pprInstr (SRA II32 reg1 reg2 (RIImm (ImmInt 31)))
 
 pprInstr (SL fmt reg1 reg2 ri) =
          let op = case fmt of
diff --git a/testsuite/tests/codeGen/should_run/T10870.hs b/testsuite/tests/codeGen/should_run/T10870.hs
index 642ef2c..255f578 100644
--- a/testsuite/tests/codeGen/should_run/T10870.hs
+++ b/testsuite/tests/codeGen/should_run/T10870.hs
@@ -8,4 +8,5 @@ unsafeShift32R x = unsafeShiftR x 32
 main :: IO ()
 main = do
     print $ map unsafeShift32R [ 123456, 0x7fffffff :: Int ]
+    print $ map unsafeShift32R [ -123456, -0x80000000 :: Int ]
     print $ map unsafeShift32R [ 123456, 0xffffffff :: Word ]
diff --git a/testsuite/tests/codeGen/should_run/T10870.stdout b/testsuite/tests/codeGen/should_run/T10870.stdout
index 945f244..54b015c 100644
--- a/testsuite/tests/codeGen/should_run/T10870.stdout
+++ b/testsuite/tests/codeGen/should_run/T10870.stdout
@@ -1,2 +1,3 @@
 [0,0]
+[-1,-1]
 [0,0]