[commit: vector] simd: Incorporate prefetching. (7f1a61a)

[Geoffrey Mainland]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : simd

http://hackage.haskell.org/trac/ghc/changeset/7f1a61a8f546a3a837f74f92d71dced0c1ed94cf

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

commit 7f1a61a8f546a3a837f74f92d71dced0c1ed94cf
Author: Geoffrey Mainland <mainland at apeiron.net>
Date:   Thu Nov 15 14:56:29 2012 +0000

    Incorporate prefetching.

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

 Data/Vector/Fusion/Bundle/Monadic.hs |   17 ++++++++++++-----
 Data/Vector/Generic/Base.hs          |    2 ++
 Data/Vector/Storable.hs              |    4 ++++
 Data/Vector/Unboxed/Base.hs          |   12 +++++++++++-
 4 files changed, 29 insertions(+), 6 deletions(-)

diff --git a/Data/Vector/Fusion/Bundle/Monadic.hs b/Data/Vector/Fusion/Bundle/Monadic.hs
index 8954d04..68fe22a 100644
--- a/Data/Vector/Fusion/Bundle/Monadic.hs
+++ b/Data/Vector/Fusion/Bundle/Monadic.hs
@@ -113,6 +113,7 @@ import qualified Data.List as List
 import Data.Char      ( ord )
 import GHC.Base       ( unsafeChr )
 import Control.Monad  ( liftM )
+import Foreign        ( sizeOf )
 import Prelude hiding ( length, null,
                         replicate, (++),
                         head, last, (!!),
@@ -144,6 +145,9 @@ data Bundle m v a = Bundle { sElems  :: Stream m a
                            }
 
 #if defined(__GLASGOW_HASKELL_LLVM__)
+mAGIC_PREFETCH_CONSTANT :: Int
+mAGIC_PREFETCH_CONSTANT = 128*12
+
 type Multis m a = Either (MultiStream m a) (Stream m (Either a (Multi a)))
 
 toMixedStream :: Monad m => Multis m a -> Stream m (Either a (Multi a))
@@ -1322,9 +1326,11 @@ mzipWithHackM p q v1 v2 =
 
     {-# INLINE stepm #-}
     stepm i | i >= k    = return Done
-            | otherwise = case basicUnsafeIndexAsMultiM v1 i of
-                            Box x -> case basicUnsafeIndexAsMultiM v2 i of
-                                       Box y -> liftM (`Yield` (i+m)) (q x y)
+            | otherwise =              case basicUnsafePrefetchDataM v1  i mAGIC_PREFETCH_CONSTANT of
+                          { Box v1' -> case basicUnsafePrefetchDataM v2  i mAGIC_PREFETCH_CONSTANT of
+                          { Box v2' -> case basicUnsafeIndexAsMultiM v1' i of
+                          { Box x   -> case basicUnsafeIndexAsMultiM v2' i of
+                          { Box y   -> liftM (`Yield` (i+m)) (q x y) }}}}
     
     {-# INLINE vstep #-}
     vstep i = do r <- step i
@@ -1465,8 +1471,9 @@ fromPackedVector v = v `seq` n `seq` Bundle (Stream step 0)
 
     {-# INLINE stepm #-}
     stepm i | i >= k    = return Done
-            | otherwise = case basicUnsafeIndexAsMultiM v i of
-                            Box x -> return $ Yield x (i+m)
+            | otherwise =             case basicUnsafePrefetchDataM v  i mAGIC_PREFETCH_CONSTANT of
+                          { Box v' -> case basicUnsafeIndexAsMultiM v' i of
+                          { Box x  -> return $ Yield x (i+m) }}
 
     {-# INLINE step1 #-}
     step1 i | i >= n    = return Done
diff --git a/Data/Vector/Generic/Base.hs b/Data/Vector/Generic/Base.hs
index 2a2f03b..e127955 100644
--- a/Data/Vector/Generic/Base.hs
+++ b/Data/Vector/Generic/Base.hs
@@ -150,4 +150,6 @@ class (MultiType a, Vector v a, M.PackedMVector (Mutable v) a) => PackedVector v
   -- | Yield the element at the given position in a monad. No range checks are
   -- performed. The index is given in @a@'s, but the result is a @Multi a at .
   basicUnsafeIndexAsMultiM  :: Monad m => v a -> Int -> m (Multi a)
+
+  basicUnsafePrefetchDataM  :: Monad m => v a -> Int -> Int -> m (v a)
 #endif /* defined(__GLASGOW_HASKELL_LLVM__) */
diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs
index 6f6ec72..2f876ad 100644
--- a/Data/Vector/Storable.hs
+++ b/Data/Vector/Storable.hs
@@ -265,6 +265,10 @@ instance (Storable a, MultiPrim a, Storable (Multi a))
     = return $! unsafeInlineIO
     $ withForeignPtr fp $ \p ->
       peekElemOffAsMulti p i
+  {-# INLINE basicUnsafePrefetchDataM #-}               
+  basicUnsafePrefetchDataM (Vector n fp) j k
+    = case prefetchForeignPtrData fp (j * sizeOf (undefined::a)+k) of
+        fp' -> return $ Vector n fp'
 #endif /* defined(__GLASGOW_HASKELL_LLVM__) */
 
 -- See http://trac.haskell.org/vector/ticket/12
diff --git a/Data/Vector/Unboxed/Base.hs b/Data/Vector/Unboxed/Base.hs
index baaadfc..bf3e5f7 100644
--- a/Data/Vector/Unboxed/Base.hs
+++ b/Data/Vector/Unboxed/Base.hs
@@ -34,6 +34,7 @@ import Control.Monad ( liftM )
 
 #if defined(__GLASGOW_HASKELL_LLVM__)
 import Data.Primitive.Multi
+import Foreign ( sizeOf )
 #endif /* defined(__GLASGOW_HASKELL_LLVM__) */
 
 import Data.Word ( Word, Word8, Word16, Word32, Word64 )
@@ -219,7 +220,11 @@ instance M.PackedMVector MVector ty where {                             \
 instance G.PackedVector Vector ty where {                               \
   {-# INLINE basicUnsafeIndexAsMultiM #-}                               \
 ; basicUnsafeIndexAsMultiM (con (P.Vector i _ arr)) j =                 \
-      return $! indexByteArrayAsMulti arr (i+j) }
+      return $! indexByteArrayAsMulti arr (i+j)                         \
+; {-# INLINE basicUnsafePrefetchDataM #-}                               \
+; basicUnsafePrefetchDataM (con (P.Vector i n arr)) j k =               \
+      do { arr' <- return $! prefetchByteArrayData arr ((i+j)*sizeOf (undefined::ty)+k)  \
+         ; return (con (P.Vector i n arr')) }}
 
 newtype instance MVector s Int = MV_Int (P.MVector s Int)
 newtype instance Vector    Int = V_Int  (P.Vector    Int)
@@ -461,4 +466,9 @@ instance (Unbox a, G.PackedVector Vector a) => G.PackedVector Vector (a, a) wher
       do  x <- G.basicUnsafeIndexAsMultiM v1 j
           y <- G.basicUnsafeIndexAsMultiM v2 j
           return $! M_2 x y
+
+  basicUnsafePrefetchDataM (V_2 n v1 v2) j k =
+      do  v1' <- G.basicUnsafePrefetchDataM v1 j k
+          v2' <- G.basicUnsafePrefetchDataM v2 j k
+          return $! V_2 n v1' v2'
 #endif /* defined(__GLASGOW_HASKELL_LLVM__) */