Add support for bitreverse primop

    This commit includes the necessary changes in code and
    documentation to support a primop that reverses a word's
    bits. It also includes a test.

9 files changed, 50 insertions, 5 deletions

diff --git a/compiler/cmm/CmmMachOp.hs b/compiler/cmm/CmmMachOp.hs
index 1441ecaa0f..7cd5c1bc20 100644
--- a/compiler/cmm/CmmMachOp.hs
+++ b/compiler/cmm/CmmMachOp.hs
@@ -617,6 +617,7 @@ data CallishMachOp
   | MO_Ctz Width
 
   | MO_BSwap Width
+  | MO_BRev Width
 
   -- Atomic read-modify-write.
   | MO_AtomicRMW Width AtomicMachOp
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index c8b9ef76e2..822de431a4 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -814,6 +814,7 @@ pprCallishMachOp_for_C mop
         MO_Memmove _    -> text "memmove"
         MO_Memcmp _     -> text "memcmp"
         (MO_BSwap w)    -> ptext (sLit $ bSwapLabel w)
+        (MO_BRev w)     -> ptext (sLit $ bRevLabel w)
         (MO_PopCnt w)   -> ptext (sLit $ popCntLabel w)
         (MO_Pext w)     -> ptext (sLit $ pextLabel w)
         (MO_Pdep w)     -> ptext (sLit $ pdepLabel w)
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 714e544f8f..ae73f0af04 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -619,6 +619,12 @@ emitPrimOp _      [res] BSwap32Op [w] = emitBSwapCall res w W32
 emitPrimOp _      [res] BSwap64Op [w] = emitBSwapCall res w W64
 emitPrimOp dflags [res] BSwapOp   [w] = emitBSwapCall res w (wordWidth dflags)
 
+emitPrimOp _      [res] BRev8Op  [w] = emitBRevCall res w W8
+emitPrimOp _      [res] BRev16Op [w] = emitBRevCall res w W16
+emitPrimOp _      [res] BRev32Op [w] = emitBRevCall res w W32
+emitPrimOp _      [res] BRev64Op [w] = emitBRevCall res w W64
+emitPrimOp dflags [res] BRevOp   [w] = emitBRevCall res w (wordWidth dflags)
+
 -- Population count
 emitPrimOp _      [res] PopCnt8Op  [w] = emitPopCntCall res w W8
 emitPrimOp _      [res] PopCnt16Op [w] = emitPopCntCall res w W16
@@ -2511,6 +2517,13 @@ emitBSwapCall res x width = do
         (MO_BSwap width)
         [ x ]
 
+emitBRevCall :: LocalReg -> CmmExpr -> Width -> FCode ()
+emitBRevCall res x width = do
+    emitPrimCall
+        [ res ]
+        (MO_BRev width)
+        [ x ]
+
 emitPopCntCall :: LocalReg -> CmmExpr -> Width -> FCode ()
 emitPopCntCall res x width = do
     emitPrimCall
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index f6b47b091c..236b26dbdf 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -230,6 +230,8 @@ genCall t@(PrimTarget (MO_Ctz w)) dsts args =
     genCallSimpleCast w t dsts args
 genCall t@(PrimTarget (MO_BSwap w)) dsts args =
     genCallSimpleCast w t dsts args
+genCall t@(PrimTarget (MO_BRev w)) dsts args =
+    genCallSimpleCast w t dsts args
 
 genCall (PrimTarget (MO_AtomicRMW width amop)) [dst] [addr, n] = runStmtsDecls $ do
     addrVar <- exprToVarW addr
@@ -791,10 +793,11 @@ cmmPrimOpFunctions mop = do
     MO_Memset _   -> fsLit $ "llvm.memset."  ++ intrinTy2
     MO_Memcmp _   -> fsLit $ "memcmp"
 
-    (MO_PopCnt w) -> fsLit $ "llvm.ctpop."  ++ showSDoc dflags (ppr $ widthToLlvmInt w)
-    (MO_BSwap w)  -> fsLit $ "llvm.bswap."  ++ showSDoc dflags (ppr $ widthToLlvmInt w)
-    (MO_Clz w)    -> fsLit $ "llvm.ctlz."   ++ showSDoc dflags (ppr $ widthToLlvmInt w)
-    (MO_Ctz w)    -> fsLit $ "llvm.cttz."   ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    (MO_PopCnt w) -> fsLit $ "llvm.ctpop."      ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    (MO_BSwap w)  -> fsLit $ "llvm.bswap."      ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    (MO_BRev w)   -> fsLit $ "llvm.bitreverse." ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    (MO_Clz w)    -> fsLit $ "llvm.ctlz."       ++ showSDoc dflags (ppr $ widthToLlvmInt w)
+    (MO_Ctz w)    -> fsLit $ "llvm.cttz."       ++ showSDoc dflags (ppr $ widthToLlvmInt w)
 
     (MO_Pdep w)   ->  let w' = showSDoc dflags (ppr $ widthInBits w)
                       in  if isBmi2Enabled dflags
diff --git a/compiler/nativeGen/CPrim.hs b/compiler/nativeGen/CPrim.hs
index 399d646000..17e5cda845 100644
--- a/compiler/nativeGen/CPrim.hs
+++ b/compiler/nativeGen/CPrim.hs
@@ -8,6 +8,7 @@ module CPrim
     , pdepLabel
     , pextLabel
     , bSwapLabel
+    , bRevLabel
     , clzLabel
     , ctzLabel
     , word2FloatLabel
@@ -54,6 +55,15 @@ bSwapLabel w = "hs_bswap" ++ pprWidth w
     pprWidth W64 = "64"
     pprWidth w   = pprPanic "bSwapLabel: Unsupported word width " (ppr w)
 
+bRevLabel :: Width -> String
+bRevLabel w = "hs_bitrev" ++ pprWidth w
+  where
+    pprWidth W8  = "8"
+    pprWidth W16 = "16"
+    pprWidth W32 = "32"
+    pprWidth W64 = "64"
+    pprWidth w   = pprPanic "bRevLabel: Unsupported word width " (ppr w)
+
 clzLabel :: Width -> String
 clzLabel w = "hs_clz" ++ pprWidth w
   where
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index c640ba115f..86525f4736 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -2007,6 +2007,7 @@ genCCall' dflags gcp target dest_regs args
                     MO_Memcmp _  -> (fsLit "memcmp", False)
 
                     MO_BSwap w   -> (fsLit $ bSwapLabel w, False)
+                    MO_BRev w    -> (fsLit $ bRevLabel w, False)
                     MO_PopCnt w  -> (fsLit $ popCntLabel w, False)
                     MO_Pdep w    -> (fsLit $ pdepLabel w, False)
                     MO_Pext w    -> (fsLit $ pextLabel w, False)
diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs
index 83402bb126..851a6f2f0a 100644
--- a/compiler/nativeGen/SPARC/CodeGen.hs
+++ b/compiler/nativeGen/SPARC/CodeGen.hs
@@ -667,6 +667,7 @@ outOfLineMachOp_table mop
         MO_Memcmp _  -> fsLit "memcmp"
 
         MO_BSwap w   -> fsLit $ bSwapLabel w
+        MO_BRev w    -> fsLit $ bRevLabel w
         MO_PopCnt w  -> fsLit $ popCntLabel w
         MO_Pdep w    -> fsLit $ pdepLabel w
         MO_Pext w    -> fsLit $ pextLabel w
diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs
index abd4995376..0424b1b84f 100644
--- a/compiler/nativeGen/X86/CodeGen.hs
+++ b/compiler/nativeGen/X86/CodeGen.hs
@@ -531,7 +531,7 @@ getRegister' dflags is32Bit (CmmRegOff r n)
 getRegister' dflags is32Bit (CmmMachOp (MO_AlignmentCheck align _) [e])
   = addAlignmentCheck align <$> getRegister' dflags is32Bit e
 
--- for 32-bit architectuers, support some 64 -> 32 bit conversions:
+-- for 32-bit architectures, support some 64 -> 32 bit conversions:
 -- TO_W_(x), TO_W_(x >> 32)
 
 getRegister' _ is32Bit (CmmMachOp (MO_UU_Conv W64 W32)
@@ -2936,6 +2936,10 @@ outOfLineCmmOp bid mop res args
 
               MO_PopCnt _  -> fsLit "popcnt"
               MO_BSwap _   -> fsLit "bswap"
+              {- Here the C implementation is used as there is no x86
+              instruction to reverse a word's bit order.
+              -}
+              MO_BRev w    -> fsLit $ bRevLabel w
               MO_Clz w     -> fsLit $ clzLabel w
               MO_Ctz _     -> unsupported
 
diff --git a/compiler/prelude/primops.txt.pp b/compiler/prelude/primops.txt.pp
index bfa1ffd7b6..cbefe2d25f 100644
--- a/compiler/prelude/primops.txt.pp
+++ b/compiler/prelude/primops.txt.pp
@@ -655,6 +655,17 @@ primop   BSwap64Op   "byteSwap64#"   Monadic   WORD64 -> WORD64
 primop   BSwapOp     "byteSwap#"     Monadic   Word# -> Word#
     {Swap bytes in a word.}
 
+primop   BRev8Op    "bitReverse8#"   Monadic   Word# -> Word#
+    {Reverse the order of the bits in a 8-bit word.}
+primop   BRev16Op   "bitReverse16#"   Monadic   Word# -> Word#
+    {Reverse the order of the bits in a 16-bit word.}
+primop   BRev32Op   "bitReverse32#"   Monadic   Word# -> Word#
+    {Reverse the order of the bits in a 32-bit word.}
+primop   BRev64Op   "bitReverse64#"   Monadic   WORD64 -> WORD64
+    {Reverse the order of the bits in a 64-bit word.}
+primop   BRevOp     "bitReverse#"     Monadic   Word# -> Word#
+    {Reverse the order of the bits in a word.}
+
 ------------------------------------------------------------------------
 section "Narrowings"
         {Explicit narrowing of native-sized ints or words.}