[commit: ghc] wip/T16094: PPC NCG: Simple 64-bit condition code on 32-bit (e29adf0)

[git at git.haskell.org]

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

On branch  : wip/T16094
Link       : http://ghc.haskell.org/trac/ghc/changeset/e29adf0577f59bcd265ac6ff7a73f26d900d66f7/ghc

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

commit e29adf0577f59bcd265ac6ff7a73f26d900d66f7
Author: Peter Trommler <ptrommler at acm.org>
Date:   Wed Dec 26 13:15:38 2018 +0100

    PPC NCG: Simple 64-bit condition code on 32-bit
    
    Fixes #16094.


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

e29adf0577f59bcd265ac6ff7a73f26d900d66f7
 compiler/nativeGen/PPC/CodeGen.hs | 29 ++++++++++++++++++++++++++---
 1 file changed, 26 insertions(+), 3 deletions(-)

diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index a716765..6c5d7d2 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -904,10 +904,33 @@ getCondCode _ = panic "getCondCode(2)(powerpc)"
 -- passed back up the tree.
 
 condIntCode :: Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
+condIntCode cond width x y = do
+  dflags <- getDynFlags
+  condIntCode' (target32Bit (targetPlatform dflags)) cond width x y
+
+condIntCode' :: Bool -> Cond -> Width -> CmmExpr -> CmmExpr -> NatM CondCode
+
+-- simple code for 64-bit on 32-bit platforms
+condIntCode' True cond W64 x y = do
+  ChildCode64 code_x x_lo <- iselExpr64 x
+  ChildCode64 code_y y_lo <- iselExpr64 y
+  let x_hi = getHiVRegFromLo x_lo
+      y_hi = getHiVRegFromLo y_lo
+      cmp  = if condUnsigned cond then CMPL else CMP
+  end_lbl <- getBlockIdNat
+  let code = code_x `appOL` code_y `appOL` toOL
+             [ cmp II32 x_hi (RIReg y_hi)
+             , BCC NE end_lbl Nothing
+             , cmp II32 x_lo (RIReg y_lo)
+             , BCC ALWAYS end_lbl Nothing
+
+             , NEWBLOCK end_lbl
+             ]
+  return (CondCode False cond code)
                
 -- optimize pointer tag checks. Operation andi. sets condition register
 -- so cmpi ..., 0 is redundant.
-condIntCode cond _ (CmmMachOp (MO_And _) [x, CmmLit (CmmInt imm rep)])
+condIntCode' _ cond _ (CmmMachOp (MO_And _) [x, CmmLit (CmmInt imm rep)])
                  (CmmLit (CmmInt 0 _))
   | not $ condUnsigned cond,
     Just src2 <- makeImmediate rep False imm
@@ -916,7 +939,7 @@ condIntCode cond _ (CmmMachOp (MO_And _) [x, CmmLit (CmmInt imm rep)])
       let code' = code `snocOL` AND r0 src1 (RIImm src2)
       return (CondCode False cond code')
 
-condIntCode cond width x (CmmLit (CmmInt y rep))
+condIntCode' _ cond width x (CmmLit (CmmInt y rep))
   | Just src2 <- makeImmediate rep (not $ condUnsigned cond) y
   = do
       let op_len = max W32 width
@@ -927,7 +950,7 @@ condIntCode cond width x (CmmLit (CmmInt y rep))
             (if condUnsigned cond then CMPL else CMP) format src1 (RIImm src2)
       return (CondCode False cond code')
 
-condIntCode cond width x y = do
+condIntCode' _ cond width x y = do
   let op_len = max W32 width
   let extend = if condUnsigned cond then extendUExpr width op_len
                else extendSExpr width op_len