[commit: ghc] wip/angerman/llvmng: Add Pdep and Pext primops. (8702bae)

[git at git.haskell.org]

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

On branch  : wip/angerman/llvmng
Link       : http://ghc.haskell.org/trac/ghc/changeset/8702bae688341baae371a00c369ff70edc0aae83/ghc

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

commit 8702bae688341baae371a00c369ff70edc0aae83
Author: Moritz Angermann <moritz.angermann at gmail.com>
Date:   Sat Nov 18 17:45:26 2017 +0800

    Add Pdep and Pext primops.
    
    Were introduced in f5dc8ccc
    [bmi] only if enabled.
    Adds +bmi/bmi2 as needed.
    pdep/pext signature fix.


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

8702bae688341baae371a00c369ff70edc0aae83
 compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs | 38 ++++++++++++++++++++++++++++
 compiler/main/DriverPipeline.hs              |  2 ++
 libraries/ghc-prim/cbits/pdep.c              |  3 +--
 libraries/ghc-prim/cbits/pext.c              |  3 +--
 4 files changed, 42 insertions(+), 4 deletions(-)

diff --git a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs
index 09ffd99..0f02df2 100644
--- a/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs
+++ b/compiler/llvmGen-ng/Data/BitCode/LLVM/Gen.hs
@@ -888,6 +888,44 @@ genCall blockMap regMap target dsts args = case target of
         ty <- EDSL.deptr (EDSL.ty slot)
         EDSL.store slot =<< cast ty ret
     | otherwise -> panic "genCall: PopCnt not implemented."
+  (PrimTarget (MO_Pdep w))
+    | ([dst], [src, mask]) <- (dsts, args) -> do
+        slot <- lookupLocalReg dst regMap
+
+        src'  <- bind2 cast (EDSL.i (widthInBits w)) (exprToVar blockMap regMap src)
+        mask' <- bind2 cast (EDSL.i (widthInBits w)) (exprToVar blockMap regMap mask)
+
+        hasBmi <- isBmiEnabled <$> getDynFlags
+        f <- let w' = widthInBits w
+                 fn = if hasBmi
+                      then "llvm.x86.bmi.pdep."
+                      else "hs_pdep"
+             in EDSL.fun (fn ++ show w') =<< [ EDSL.i w', EDSL.i w' ] --> EDSL.i w'
+
+        Just ret <- EDSL.ccall f [ src', mask' ]
+        ty <- EDSL.deptr (EDSL.ty slot)
+        EDSL.store slot =<< cast ty ret
+    | otherwise -> panic "genCall: Pdep not implemented."
+  (PrimTarget (MO_Pext w))
+    | ([dst], [src, mask]) <- (dsts, args) -> do
+        slot <- lookupLocalReg dst regMap
+
+        src'  <- bind2 cast (EDSL.i (widthInBits w)) (exprToVar blockMap regMap src)
+        mask' <- bind2 cast (EDSL.i (widthInBits w)) (exprToVar blockMap regMap mask)
+
+        arch <- platformArch . targetPlatform <$> getDynFlags
+
+        hasBmi <- isBmiEnabled <$> getDynFlags
+        f <- let w' = widthInBits w
+                 fn = if hasBmi
+                      then "llvm.x86.bmi.pext."
+                      else "hs_pext"
+             in EDSL.fun (fn ++ show w') =<< [ EDSL.i w', EDSL.i w' ] --> EDSL.i w'
+
+        Just ret <- EDSL.ccall f [ src', mask' ]
+        ty <- EDSL.deptr (EDSL.ty slot)
+        EDSL.store slot =<< cast ty ret
+    | otherwise -> panic "genCall: Pext not implemented."
   (PrimTarget (MO_Clz w))
     | ([dst], [e]) <- (dsts, args) -> do
         slot <- lookupLocalReg dst regMap
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 035fb17..af64874 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -848,6 +848,8 @@ llvmOptions dflags =
               ++ ["+avx512cd"| isAvx512cdEnabled dflags ]
               ++ ["+avx512er"| isAvx512erEnabled dflags ]
               ++ ["+avx512pf"| isAvx512pfEnabled dflags ]
+              ++ ["+bmi"     | isBmiEnabled dflags      ]
+              ++ ["+bmi2"    | isBmi2Enabled dflags     ]
 
 -- -----------------------------------------------------------------------------
 -- | Each phase in the pipeline returns the next phase to execute, and the
diff --git a/libraries/ghc-prim/cbits/pdep.c b/libraries/ghc-prim/cbits/pdep.c
index a3b7da3..9a2b014 100644
--- a/libraries/ghc-prim/cbits/pdep.c
+++ b/libraries/ghc-prim/cbits/pdep.c
@@ -1,9 +1,8 @@
 #include "Rts.h"
 #include "MachDeps.h"
 
-extern StgWord hs_pdep64(StgWord64 src, StgWord mask);
 StgWord
-hs_pdep64(StgWord src, StgWord mask)
+hs_pdep64(StgWord64 src, StgWord64 mask)
 {
   uint64_t result = 0;
 
diff --git a/libraries/ghc-prim/cbits/pext.c b/libraries/ghc-prim/cbits/pext.c
index d08fb94..db9fddf 100644
--- a/libraries/ghc-prim/cbits/pext.c
+++ b/libraries/ghc-prim/cbits/pext.c
@@ -1,9 +1,8 @@
 #include "Rts.h"
 #include "MachDeps.h"
 
-extern StgWord hs_pext64(StgWord src, StgWord mask);
 StgWord
-hs_pext64(StgWord src, StgWord mask)
+hs_pext64(StgWord64 src, StgWord64 mask)
 {
   uint64_t result = 0;
   int offset = 0;