T19659 wipwip/T19659

6 files changed, 286 insertions, 2 deletions

diff --git a/Test.dump-asm b/Test.dump-asm
new file mode 100644
index 0000000000..2b044bbac1
--- /dev/null
+++ b/Test.dump-asm
@@ -0,0 +1,120 @@
+
+==================== Asm code ====================
+2022-03-23 21:16:21.239468 UTC
+
+.section	__TEXT,__cstring,cstring_literals
+.align 1
+.align 0
+.globl Main.$trModule2_bytes
+Main.$trModule2_bytes:
+	.string "Main"
+
+
+==================== Asm code ====================
+2022-03-23 21:16:21.240354 UTC
+
+.section	__TEXT,__cstring,cstring_literals
+.align 1
+.align 0
+.globl Main.$trModule4_bytes
+Main.$trModule4_bytes:
+	.string "main"
+
+
+==================== Asm code ====================
+2022-03-23 21:16:21.24134 UTC
+
+.section	__TEXT,__cstring,cstring_literals
+.align 1
+.align 0
+.globl Main.main4_bytes
+Main.main4_bytes:
+	.string "======="
+
+
+==================== Asm code ====================
+2022-03-23 21:16:21.242333 UTC
+
+.section	__TEXT,__cstring,cstring_literals
+.align 1
+.align 0
+.globl Main.main6_bytes
+Main.main6_bytes:
+	.string "Pattern match failure in 'do' block at Test.hs:19:3-5"
+
+
+==================== Asm code ====================
+2022-03-23 21:16:21.243208 UTC
+
+.section	__TEXT,__cstring,cstring_literals
+.align 1
+.align 0
+lvl_r2DK_bytes:
+	.string "Test.hs:(10,14)-(12,12)|case"
+
+
+==================== Asm code ====================
+2022-03-23 21:16:21.245335 UTC
+
+.data
+.align 3
+.align 0
+_u2GS_srt:
+	.quad	stg_SRT_1_info
+	.quad	Control.Exception.Base.patError_closure
+	.quad	0
+
+
+==================== Asm code ====================
+2022-03-23 21:16:21.246899 UTC
+
+.text
+.align 3
+dsp_Main.divInt#1_info_dsp:
+.align 3
+	.quad	0
+	.long	21
+	.long	_u2GS_srt-(Main.divInt#1_info)+0
+.globl Main.divInt#1_info
+Main.divInt#1_info:
+_blk_c2GP:
+	leaq -16(%rbp),%rax
+	cmpq %r15,%rax
+	jb _blk_c2GQ
+_blk_c2GR:
+	subq $8,%rsp
+	movq %r13,%rax
+	movq %rbx,%rsi
+	movq %rax,%rdi
+	xorl %eax,%eax
+	call newCAF
+	addq $8,%rsp
+	testq %rax,%rax
+	je _blk_c2GO
+_blk_c2GN:
+	leaq _stg_bh_upd_frame_info(%rip),%rbx
+	movq %rbx,-16(%rbp)
+	movq %rax,-8(%rbp)
+	leaq _Llvl_r2DK_bytes(%rip),%r14
+	addq $-16,%rbp
+	jmp Control.Exception.Base.patError_info
+_blk_c2GO:
+	jmp *(%rbx)
+_blk_c2GQ:
+	jmp *-16(%r13)
+	.long  Main.divInt#1_info - dsp_Main.divInt#1_info_dsp
+
+
+==================== Asm code ====================
+2022-03-23 21:16:21.247358 UTC
+
+.data
+.align 3
+.align 0
+.globl Main.divInt#1_closure
+Main.divInt#1_closure:
+	.quad	Main.divInt#1_info
+	.quad	0
+	.quad	0
+	.quad	0
+
diff --git a/Test.dump-cmm b/Test.dump-cmm
new file mode 100644
index 0000000000..892856f541
--- /dev/null
+++ b/Test.dump-cmm
@@ -0,0 +1,123 @@
+
+==================== Output Cmm ====================
+2022-03-23 21:16:21.237317 UTC
+
+[section ""cstring" . Main.$trModule2_bytes" {
+     Main.$trModule2_bytes:
+         I8[] "Main"
+ }]
+
+
+==================== Output Cmm ====================
+2022-03-23 21:16:21.239853 UTC
+
+[section ""cstring" . Main.$trModule4_bytes" {
+     Main.$trModule4_bytes:
+         I8[] "main"
+ }]
+
+
+==================== Output Cmm ====================
+2022-03-23 21:16:21.240777 UTC
+
+[section ""cstring" . Main.main4_bytes" {
+     Main.main4_bytes:
+         I8[] "======="
+ }]
+
+
+==================== Output Cmm ====================
+2022-03-23 21:16:21.241777 UTC
+
+[section ""cstring" . Main.main6_bytes" {
+     Main.main6_bytes:
+         I8[] "Pattern match failure in 'do' block at Test.hs:19:3-5"
+ }]
+
+
+==================== Output Cmm ====================
+2022-03-23 21:16:21.242695 UTC
+
+[section ""cstring" . lvl_r2DK_bytes" {
+     lvl_r2DK_bytes:
+         I8[] "Test.hs:(10,14)-(12,12)|case"
+ }]
+
+
+==================== Output Cmm ====================
+2022-03-23 21:16:21.244353 UTC
+
+[section ""data" . _u2GS_srt" {
+     _u2GS_srt:
+         const stg_SRT_1_info;
+         const Control.Exception.Base.patError_closure;
+         const 0;
+ },
+ Main.divInt#1_entry() { //  [R1]
+         { info_tbls: [(c2GP,
+                        label: Main.divInt#1_info
+                        rep: HeapRep static { Thunk }
+                        srt: Just _u2GS_srt)]
+           stack_info: arg_space: 8
+         }
+     {offset
+       c2GP: // global
+           if ((Sp + -16) < SpLim) (likely: False) goto c2GQ; else goto c2GR;
+       c2GQ: // global
+           call (stg_gc_enter_1)(R1) args: 8, res: 0, upd: 8;
+       c2GR: // global
+           (_c2GM::I64) = call "ccall" arg hints:  [PtrHint,
+                                                    PtrHint]  result hints:  [PtrHint] newCAF(BaseReg, R1);
+           if (_c2GM::I64 == 0) goto c2GO; else goto c2GN;
+       c2GO: // global
+           call (I64[R1])() args: 8, res: 0, upd: 8;
+       c2GN: // global
+           I64[Sp - 16] = stg_bh_upd_frame_info;
+           I64[Sp - 8] = _c2GM::I64;
+           R2 = lvl_r2DK_bytes;
+           Sp = Sp - 16;
+           call Control.Exception.Base.patError_info(R2) args: 24, res: 0, upd: 24;
+     }
+ },
+ section ""data" . Main.divInt#1_closure" {
+     Main.divInt#1_closure:
+         const Main.divInt#1_info;
+         const 0;
+         const 0;
+         const 0;
+ }]
+
+
+==================== Output Cmm ====================
+2022-03-23 21:16:21.248286 UTC
+
+[Main.divInt#_entry() { //  [R2]
+         { info_tbls: [(c2Ha,
+                        label: Main.divInt#_info
+                        rep: HeapRep static { Fun {arity: 1 fun_type: ArgSpec 4} }
+                        srt: Just Main.divInt#1_closure)]
+           stack_info: arg_space: 8
+         }
+     {offset
+       c2Ha: // global
+           _s2Gh::I64 = %MO_S_Lt_W64(R2, 0);
+           if (_s2Gh::I64 != 0) goto u2Hd; else goto c2H8;
+       u2Hd: // global
+           if (_s2Gh::I64 != 1) goto c2H7; else goto c2H9;
+       c2H7: // global
+           R1 = Main.divInt#1_closure;
+           call (I64[R1])(R1) args: 8, res: 0, upd: 8;
+       c2H9: // global
+           R1 = 0;
+           call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
+       c2H8: // global
+           R1 = 4;
+           call (P64[Sp])(R1) args: 8, res: 0, upd: 8;
+     }
+ },
+ section ""data" . Main.divInt#_closure" {
+     Main.divInt#_closure:
+         const Main.divInt#_info;
+         const 0;
+ }]
+
diff --git a/Test.hs b/Test.hs
new file mode 100644
index 0000000000..2d3cd9c577
--- /dev/null
+++ b/Test.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE TypeApplications #-}
+module Main where
+
+import System.Environment
+import GHC.Exts
+import Data.Foldable
+
+divInt# :: Int# -> Int#
+divInt# y# = case y# <# 0# of
+    0# -> 4#
+    1# -> 0#
+
+-- unI# :: Int -> Int#
+-- unI# (I# i#) = i#
+-- {-# INLINE unI# #-}
+
+main = do
+  [n] <- map (read @Int) <$> getArgs
+  -- let r = foldl' (\acc v -> acc + (I# (divInt# (unI# v)))) 0 [negate n..n]
+  -- print r
+  print "======="
+  -- forM_ [negate n .. n] $ \x -> do
+  --   putStr ("For " ++ show x ++ " ")
+  --   print (I# (divInt# (unI# x)))
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 1fefe3a346..86476aa87d 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -28,6 +28,8 @@ module GHC.CmmToAsm.X86.CodeGen (
 
 where
 
+import GHC.Utils.Trace
+
 -- NCG stuff:
 import GHC.Prelude
 
@@ -2910,7 +2912,14 @@ extractUnwindPoints instrs =
 -- register allocator.
 
 condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
-
+condIntReg LTT x (CmmLit (CmmInt 0 pk)) = do
+  let oneLit = OpImm (litToImm (CmmInt 1 pk))
+      fmt = intFormat pk
+      code x_reg = toOL
+                 [ ROL fmt oneLit (OpReg x_reg)
+                 , AND fmt oneLit (OpReg x_reg)
+                 ]
+  return (Any II32 code)
 condIntReg cond x y = do
   CondCode _ cond cond_code <- condIntCode cond x y
   tmp <- getNewRegNat II8
@@ -4331,4 +4340,3 @@ genPred64 cond dst x y = do
           , SETCC cond (OpReg dst_r)
           , MOVZxL II8 (OpReg dst_r) (OpReg dst_r)
           ]
-
diff --git a/compiler/GHC/CmmToAsm/X86/Instr.hs b/compiler/GHC/CmmToAsm/X86/Instr.hs
index 1f1515b0c9..1ed36d05a3 100644
--- a/compiler/GHC/CmmToAsm/X86/Instr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Instr.hs
@@ -244,6 +244,9 @@ data Instr
         | SAR         Format Operand{-amount-} Operand
         | SHR         Format Operand{-amount-} Operand
 
+        -- Rotate
+        | ROL         Format Operand Operand
+
         | BT          Format Imm Operand
         | NOP
 
@@ -389,6 +392,7 @@ regUsageOfInstr platform instr
     SHL    _ imm dst    -> usageRM imm dst
     SAR    _ imm dst    -> usageRM imm dst
     SHR    _ imm dst    -> usageRM imm dst
+    ROL    _ imm dst    -> usageRM imm dst
     BT     _ _   src    -> mkRUR (use_R src [])
 
     PUSH   _ op         -> mkRUR (use_R op [])
@@ -547,6 +551,7 @@ patchRegsOfInstr instr env
     SHL  fmt imm dst     -> patch1 (SHL fmt imm) dst
     SAR  fmt imm dst     -> patch1 (SAR fmt imm) dst
     SHR  fmt imm dst     -> patch1 (SHR fmt imm) dst
+    ROL  fmt imm dst     -> patch1 (ROL fmt imm) dst
     BT   fmt imm src     -> patch1 (BT  fmt imm) src
     TEST fmt src dst     -> patch2 (TEST fmt) src dst
     CMP  fmt src dst     -> patch2 (CMP  fmt) src dst
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index 49b6988c1d..fd4bd60c45 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -757,6 +757,9 @@ pprInstr platform i = case i of
    SHR format src dst
       -> pprShift (text "shr") format src dst
 
+   ROL format src dst
+      -> pprFormatOpOp (text "rol") format src dst
+
    BT format imm src
       -> pprFormatImmOp (text "bt") format imm src