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
54c46b3
..
53957e7
100644
(file)
--- a/
compiler/main/StaticFlags.hs
+++ b/
compiler/main/StaticFlags.hs
@@
-41,7
+41,6
@@
module StaticFlags (
-- optimisation opts
opt_NoMethodSharing,
opt_NoStateHack,
-- optimisation opts
opt_NoMethodSharing,
opt_NoStateHack,
- opt_LiberateCaseThreshold,
opt_CprOff,
opt_RulesOff,
opt_SimplNoPreInlining,
opt_CprOff,
opt_RulesOff,
opt_SimplNoPreInlining,
@@
-98,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
@@
-292,7
+291,6
@@
opt_NoMethodSharing = lookUp FSLIT("-fno-method-sharing")
opt_CprOff = lookUp FSLIT("-fcpr-off")
opt_RulesOff = lookUp FSLIT("-frules-off")
-- Switch off CPR analysis in the new demand analyser
opt_CprOff = lookUp FSLIT("-fcpr-off")
opt_RulesOff = lookUp FSLIT("-frules-off")
-- Switch off CPR analysis in the new demand analyser
-opt_LiberateCaseThreshold = lookup_def_int "-fliberate-case-threshold" (10::Int)
opt_MaxWorkerArgs = lookup_def_int "-fmax-worker-args" (10::Int)
opt_GranMacros = lookUp FSLIT("-fgransim")
opt_MaxWorkerArgs = lookup_def_int "-fmax-worker-args" (10::Int)
opt_GranMacros = lookUp FSLIT("-fgransim")
@@
-491,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)
@@
-505,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))