Adding Reflect to hpc package
authorandy@galois.com <unknown>
Wed, 27 Jun 2007 06:33:18 +0000 (06:33 +0000)
committerandy@galois.com <unknown>
Wed, 27 Jun 2007 06:33:18 +0000 (06:33 +0000)
Trace.Hpc.Reflect is Reflection into the hpc subsystem
It provides 3 basic functions:

clearTix :: IO ()
examineTix :: IO Tix
updateTix :: Tix -> IO ()

It requires the latest rts in ghc

Trace/Hpc/Mix.hs
Trace/Hpc/Reflect.hsc [new file with mode: 0644]
Trace/Hpc/Tix.hs
hpc.cabal

index a5c1b5f..0f098ed 100644 (file)
@@ -38,11 +38,11 @@ import Trace.Hpc.Util (HpcPos, insideHpcPos, Hash, HpcHash(..))
 --  * With hpc-tracer, this is 8 (a tab represents several spaces).
 
 data Mix = Mix 
-            FilePath           -- location of original file
-            Integer            -- time (in seconds) of original file's last update, since 1970.
-            Hash               -- hash of mix entry + timestamp
-            Int                -- tab stop value.
-            [MixEntry]         -- entries
+            FilePath           -- ^location of original file
+            Integer            -- ^time (in seconds) of original file's last update, since 1970.
+            Hash               -- ^hash of mix entry + timestamp
+            Int                -- ^tab stop value.
+            [MixEntry]         -- ^entries
        deriving (Show,Read)
 
 -- We would rather use ClockTime in Mix, but ClockTime has no Read instance in 6.4 and before,
diff --git a/Trace/Hpc/Reflect.hsc b/Trace/Hpc/Reflect.hsc
new file mode 100644 (file)
index 0000000..4dd64cf
--- /dev/null
@@ -0,0 +1,75 @@
+{-# OPTIONS -fglasgow-exts -cpp #-}
+module Trace.Hpc.Reflect 
+  ( clearTix
+  , examineTix
+  , updateTix 
+  ) where
+
+import Foreign.C.String
+import Foreign.Marshal.Array
+import Foreign.Ptr
+import Foreign.Storable ( Storable(..) )
+import Data.Word 
+import Data.Int
+import Trace.Hpc.Tix
+import Trace.Hpc.Util
+import System.IO.Unsafe
+
+#include "Rts.h"
+
+foreign import ccall unsafe hs_hpc_rootModule :: IO (Ptr ())
+
+modInfo :: [ModuleInfo]
+modInfo = unsafePerformIO $ do
+      ptr <- hs_hpc_rootModule 
+      moduleInfoList ptr
+
+data ModuleInfo = ModuleInfo String Int Hash (Ptr Word64) 
+
+moduleInfoList :: Ptr () -> IO [ModuleInfo]
+moduleInfoList ptr
+  | ptr == nullPtr = return []
+  | otherwise = do
+        cModName  <- (#peek HpcModuleInfo, modName) ptr
+        modName   <- peekCString cModName
+        tickCount <- (#peek HpcModuleInfo, tickCount) ptr
+        hashNo    <- (#peek HpcModuleInfo, hashNo) ptr
+        tixArr    <- (#peek HpcModuleInfo, tixArr) ptr
+       next      <- (#peek HpcModuleInfo, next) ptr
+        rest      <- moduleInfoList next
+        return $ ModuleInfo modName tickCount (toHash (hashNo :: Int)) tixArr : rest
+
+clearTix :: IO ()
+clearTix = do
+      sequence_ [ pokeArray ptr $ take count $ repeat 0
+               | ModuleInfo _mod count _hash ptr <- modInfo
+               ]
+      return ()
+
+
+examineTix :: IO Tix
+examineTix = do
+      mods <- sequence [ do tixs <- peekArray count ptr
+                           return $ TixModule mod' hash count
+                                  $ map fromIntegral tixs
+                      | (ModuleInfo mod' count hash ptr) <- modInfo
+                      ]
+      return $ Tix mods
+
+-- requirement that the tix be of the same shape as the 
+-- internal tix.
+updateTix :: Tix -> IO ()
+updateTix (Tix modTixes) 
+  | length modTixes /= length modInfo = error "updateTix failed"
+  | otherwise = do
+      sequence_ [ pokeArray ptr $ map fromIntegral tixs
+               | (ModuleInfo mod1 count1 hash1 ptr,
+                  TixModule mod2 hash2 count2 tixs) <- zip modInfo modTixes
+               , if mod1 /= mod2 
+               || count1 /= count2 
+               || hash1 /= hash2
+               || length tixs /= count2
+                 then error "updateTix failed"
+                 else True
+               ]
+      return ()
index 8544053..69dbf53 100644 (file)
@@ -17,10 +17,10 @@ data Tix = Tix [TixModule]
        deriving (Read, Show, Eq)
 
 data TixModule = TixModule 
-                String    -- module name
-                Hash      -- hash number
-                Int       -- length of tix list (allows pre-allocation at parse time).
-                [Integer] -- actual ticks
+                String    -- ^module name
+                Hash      -- ^hash number
+                Int       -- ^length of tix list (allows pre-allocation at parse time).
+                [Integer] -- ^actual ticks
        deriving (Read, Show, Eq)
 
 tixModuleName :: TixModule -> String
index 1ac5ebd..b98c03b 100644 (file)
--- a/hpc.cabal
+++ b/hpc.cabal
@@ -10,5 +10,7 @@ ghc-options: -Wall
 exposed-modules:
                 Trace.Hpc.Util,
                 Trace.Hpc.Mix,
-                Trace.Hpc.Tix
+                Trace.Hpc.Tix,
+                Trace.Hpc.Reflect
+
 build-depends: base, directory, old-time