Add experimental support for dtrace-based profiling
authorRoman Leshchinskiy <rl@cse.unsw.edu.au>
Thu, 29 Oct 2009 13:29:13 +0000 (13:29 +0000)
committerRoman Leshchinskiy <rl@cse.unsw.edu.au>
Thu, 29 Oct 2009 13:29:13 +0000 (13:29 +0000)
This is rather hackish at the moment but here is how it works (on OS X only).
We manually build libdph-trace.dylib, manually edit Extra-Lib-Dirs in
dph-base.cabal to point to it, manually turn on the DTrace flag and rebuild
DPH from scratch (as in rm */dist-install; make stage=2). Then, we build an
example and run it as follows:

  sudo dtrace -c './seq/quickhull 100000' -s loop-profile.d

This should produce a table which shows how much time is spent in which loops.

dph-base/Data/Array/Parallel/Base.hs
dph-base/Data/Array/Parallel/Base/DTrace.hs [new file with mode: 0644]
dph-base/dph-base.cabal

index 30850e1..13aca35 100644 (file)
@@ -18,6 +18,7 @@ module Data.Array.Parallel.Base (
   module Data.Array.Parallel.Base.Util,
   module Data.Array.Parallel.Base.Text,
   module Data.Array.Parallel.Base.Rebox,
+  module Data.Array.Parallel.Base.DTrace,
 
   ST(..), runST
 ) where
@@ -27,6 +28,7 @@ import Data.Array.Parallel.Base.Hyperstrict
 import Data.Array.Parallel.Base.Util
 import Data.Array.Parallel.Base.Text
 import Data.Array.Parallel.Base.Rebox
+import Data.Array.Parallel.Base.DTrace
 
 import GHC.ST (ST(..), runST)
 
diff --git a/dph-base/Data/Array/Parallel/Base/DTrace.hs b/dph-base/Data/Array/Parallel/Base/DTrace.hs
new file mode 100644 (file)
index 0000000..22a780d
--- /dev/null
@@ -0,0 +1,71 @@
+{-# LANGUAGE ForeignFunctionInterface, CPP #-}
+module Data.Array.Parallel.Base.DTrace (
+  traceLoopEntry, traceLoopExit,
+
+  traceLoopST, traceLoopEntryST, traceLoopExitST,
+  traceLoopIO, traceLoopEntryIO, traceLoopExitIO
+) where
+
+#ifdef DPH_ENABLE_DTRACE
+import Foreign
+import Foreign.C.Types
+import Foreign.C.String
+#endif
+
+import GHC.ST ( ST )
+import GHC.IOBase ( unsafeIOToST )
+
+traceLoopST :: String -> ST s a -> ST s a
+{-# INLINE traceLoopST #-}
+traceLoopST s p = do
+                    traceLoopEntryST s
+                    x <- p
+                    traceLoopExitST s
+                    return x
+
+traceLoopIO :: String -> IO a -> IO a
+{-# INLINE traceLoopIO #-}
+traceLoopIO s p = do
+                    traceLoopEntryIO s
+                    x <- p
+                    traceLoopExitIO s
+                    return x
+
+
+traceLoopEntryST :: String -> ST s ()
+traceLoopExitST  :: String -> ST s ()
+
+traceLoopEntryIO :: String -> IO ()
+traceLoopExitIO  :: String -> IO ()
+
+traceLoopEntry :: String -> a -> a
+traceLoopExit  :: String -> a -> a
+
+
+#ifdef DPH_ENABLE_DTRACE
+
+traceLoopEntry s x = unsafePerformIO (traceLoopEntryIO s >> return x)
+traceLoopExit  s x = unsafePerformIO (traceLoopExitIO  s >> return x)
+
+traceLoopEntryST s = unsafeIOToST (traceLoopEntryIO s)
+traceLoopExitST  s = unsafeIOToST (traceLoopExitIO  s)
+
+traceLoopEntryIO s = withCString s dph_loop_entry
+traceLoopExitIO  s = withCString s dph_loop_exit
+
+foreign import ccall safe dph_loop_entry :: Ptr CChar -> IO ()
+foreign import ccall safe dph_loop_exit  :: Ptr CChar -> IO () 
+
+#else
+
+traceLoopEntry s x = x
+traceLoopExit  s x = x
+
+traceLoopEntryST s = return ()
+traceLoopExitST  s = return ()
+
+traceLoopEntryIO s = return ()
+traceLoopExitIO  s = return ()
+
+#endif
+
index 5db50bf..63c7a80 100644 (file)
@@ -11,11 +11,16 @@ Synopsis:       Basic Definitions for Data-Parallel Haskell.
 Cabal-Version:  >= 1.2.3
 Build-Type:     Simple
 
+Flag DTrace
+  Description: Enable experimental support for dtrace-based profiling
+  Default:     False
+
 Library
   Exposed-Modules:
         Data.Array.Parallel.Base
         Data.Array.Parallel.Arr
         Data.Array.Parallel.Stream
+        Data.Array.Parallel.Base.DTrace
 
   Other-Modules:
         Data.Array.Parallel.Base.Config
@@ -41,7 +46,12 @@ Library
   Install-Includes:
         fusion-phases.h
 
-  Exposed: False
+  Exposed: True
+
+  if flag(DTrace)
+    CPP-Options: -DDPH_ENABLE_DTRACE
+    Extra-Libraries: dph-trace
+    Extra-Lib-Dirs: /Users/rl/projects/ndp/dtrace
 
   Extensions: TypeFamilies, GADTs, RankNTypes,
               BangPatterns, MagicHash, UnboxedTuples, TypeOperators