diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2021-10-26 12:23:22 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-11-06 07:53:42 -0400 |
commit | ecd6d14215eb40ac441c075e432ddaa0237f3c72 (patch) | |
tree | 2624b27ecb49eef9306965d6d609be135d444fc4 /compiler | |
parent | d74cc01ef5fd077439bab71ffa063632efb40be4 (diff) | |
download | haskell-ecd6d14215eb40ac441c075e432ddaa0237f3c72.tar.gz |
i386: fix codegen of 64-bit comparisons
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/GHC/CmmToAsm/X86/CodeGen.hs | 35 |
1 files changed, 21 insertions, 14 deletions
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs index 9d7e1b9e7f..dccff1ef9d 100644 --- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs +++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs @@ -1875,12 +1875,16 @@ genCondBranch' is32Bit _bid true false (CmmMachOp mop [e1,e2]) ChildCode64 code2 r2 <- iselExpr64 e2 let cond = machOpToCond mop :: Cond - let cmpCode = intComparison cond true false r1 r2 + -- we mustn't clobber r1/r2 so we use temporaries + tmp1 <- getNewRegNat II32 + tmp2 <- getNewRegNat II32 + + let cmpCode = intComparison cond true false r1 r2 tmp1 tmp2 return $ code1 `appOL` code2 `appOL` cmpCode where - intComparison :: Cond -> BlockId -> BlockId -> Reg -> Reg -> InstrBlock - intComparison cond true false r1_lo r2_lo = + intComparison :: Cond -> BlockId -> BlockId -> Reg -> Reg -> Reg -> Reg -> InstrBlock + intComparison cond true false r1_lo r2_lo tmp1 tmp2 = case cond of -- Impossible results of machOpToCond ALWAYS -> panic "impossible" @@ -1897,29 +1901,32 @@ genCondBranch' is32Bit _bid true false (CmmMachOp mop [e1,e2]) GE -> cmpGE GEU -> cmpGE -- [x > y] <==> ![y >= x] - GTT -> intComparison GE false true r2_lo r1_lo - GU -> intComparison GEU false true r2_lo r1_lo + GTT -> intComparison GE false true r2_lo r1_lo tmp1 tmp2 + GU -> intComparison GEU false true r2_lo r1_lo tmp1 tmp2 -- [x <= y] <==> [y >= x] - LE -> intComparison GE true false r2_lo r1_lo - LEU -> intComparison GEU true false r2_lo r1_lo + LE -> intComparison GE true false r2_lo r1_lo tmp1 tmp2 + LEU -> intComparison GEU true false r2_lo r1_lo tmp1 tmp2 -- [x < y] <==> ![x >= x] - LTT -> intComparison GE false true r1_lo r2_lo - LU -> intComparison GEU false true r1_lo r2_lo + LTT -> intComparison GE false true r1_lo r2_lo tmp1 tmp2 + LU -> intComparison GEU false true r1_lo r2_lo tmp1 tmp2 where r1_hi = getHiVRegFromLo r1_lo r2_hi = getHiVRegFromLo r2_lo cmpExact :: OrdList Instr cmpExact = toOL - [ XOR II32 (OpReg r2_hi) (OpReg r1_hi) - , XOR II32 (OpReg r2_lo) (OpReg r1_lo) - , OR II32 (OpReg r1_hi) (OpReg r1_lo) + [ MOV II32 (OpReg r1_hi) (OpReg tmp1) + , MOV II32 (OpReg r1_lo) (OpReg tmp2) + , XOR II32 (OpReg r2_hi) (OpReg tmp1) + , XOR II32 (OpReg r2_lo) (OpReg tmp2) + , OR II32 (OpReg tmp1) (OpReg tmp2) , JXX cond true , JXX ALWAYS false ] cmpGE = toOL - [ CMP II32 (OpReg r2_lo) (OpReg r1_lo) - , SBB II32 (OpReg r2_hi) (OpReg r1_hi) + [ MOV II32 (OpReg r1_hi) (OpReg tmp1) + , CMP II32 (OpReg r2_lo) (OpReg r1_lo) + , SBB II32 (OpReg r2_hi) (OpReg tmp1) , JXX cond true , JXX ALWAYS false ] |