projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Lightweight ticky-ticky profiling
[ghc-hetmet.git]
/
compiler
/
main
/
StaticFlags.hs
diff --git
a/compiler/main/StaticFlags.hs
b/compiler/main/StaticFlags.hs
index
ab2c8e8
..
53957e7
100644
(file)
--- a/
compiler/main/StaticFlags.hs
+++ b/
compiler/main/StaticFlags.hs
@@
-97,7
+97,7
@@
parseStaticFlags args = do
when (not (null errs)) $ throwDyn (UsageError (unlines errs))
-- deal with the way flags: the way (eg. prof) gives rise to
when (not (null errs)) $ throwDyn (UsageError (unlines errs))
-- deal with the way flags: the way (eg. prof) gives rise to
- -- futher flags, some of which might be static.
+ -- further flags, some of which might be static.
way_flags <- findBuildTag
-- if we're unregisterised, add some more flags
way_flags <- findBuildTag
-- if we're unregisterised, add some more flags
@@
-489,7
+489,8
@@
findBuildTag :: IO [String] -- new options
findBuildTag = do
way_names <- readIORef v_Ways
let ws = sort (nub way_names)
findBuildTag = do
way_names <- readIORef v_Ways
let ws = sort (nub way_names)
- if not (allowed_combination ws)
+ res <-
+ if not (allowed_combination ws)
then throwDyn (CmdLineError $
"combination not supported: " ++
foldr1 (\a b -> a ++ '/':b)
then throwDyn (CmdLineError $
"combination not supported: " ++
foldr1 (\a b -> a ++ '/':b)
@@
-503,6
+504,15
@@
findBuildTag = do
writeIORef v_RTS_Build_tag rts_tag
return (concat flags)
writeIORef v_RTS_Build_tag rts_tag
return (concat flags)
+ -- krc: horrible, I know.
+ (if opt_DoTickyProfiling then do
+ writeIORef v_RTS_Build_tag (mkBuildTag [(lkupWay WayTicky)])
+ return (res ++ (wayOpts (lkupWay WayTicky)))
+ else
+ return res)
+
+
+
mkBuildTag :: [Way] -> String
mkBuildTag ways = concat (intersperse "_" (map wayTag ways))
mkBuildTag :: [Way] -> String
mkBuildTag ways = concat (intersperse "_" (map wayTag ways))