X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FStaticFlags.hs;h=b13661ed99d8d32868432e07ac5ba9f8a6fe6921;hb=c5cafbcca54c4b1117bc43b31d86afa583fb7f62;hp=2398c20086cdb11652a321aead6b960df88a0030;hpb=e6243a818496aad82b6f47511d3bd9bc800f747d;p=ghc-hetmet.git diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs index 2398c20..b13661e 100644 --- a/compiler/main/StaticFlags.hs +++ b/compiler/main/StaticFlags.hs @@ -26,11 +26,7 @@ module StaticFlags ( opt_NoDebugOutput, -- profiling opts - opt_AutoSccsOnAllToplevs, - opt_AutoSccsOnExportedToplevs, - opt_AutoSccsOnIndividualCafs, opt_SccProfilingOn, - opt_DoTickyProfiling, -- Hpc opts opt_Hpc, @@ -43,6 +39,7 @@ module StaticFlags ( -- optimisation opts opt_DsMultiTyVar, opt_NoStateHack, + opt_SimpleListLiterals, opt_SpecInlineJoinPoints, opt_CprOff, opt_SimplNoPreInlining, @@ -71,7 +68,6 @@ module StaticFlags ( opt_HistorySize, opt_OmitBlackHoling, opt_Unregisterised, - opt_EmitExternalCore, v_Ld_inputs, tablesNextToCode, opt_StubDeadValues, @@ -138,7 +134,7 @@ lookUp sw = sw `elem` packed_static_opts -- (lookup_str "foo") looks for the flag -foo=X or -fooX, -- and returns the string X lookup_str sw - = case firstJust (map (maybePrefixMatch sw) staticFlags) of + = case firstJust (map (stripPrefix sw) staticFlags) of Just ('=' : str) -> Just str Just str -> Just str Nothing -> Nothing @@ -196,16 +192,8 @@ opt_NoDebugOutput = lookUp (fsLit "-dno-debug-output") -- profiling opts -opt_AutoSccsOnAllToplevs :: Bool -opt_AutoSccsOnAllToplevs = lookUp (fsLit "-fauto-sccs-on-all-toplevs") -opt_AutoSccsOnExportedToplevs :: Bool -opt_AutoSccsOnExportedToplevs = lookUp (fsLit "-fauto-sccs-on-exported-toplevs") -opt_AutoSccsOnIndividualCafs :: Bool -opt_AutoSccsOnIndividualCafs = lookUp (fsLit "-fauto-sccs-on-individual-cafs") opt_SccProfilingOn :: Bool opt_SccProfilingOn = lookUp (fsLit "-fscc-profiling") -opt_DoTickyProfiling :: Bool -opt_DoTickyProfiling = WayTicky `elem` (unsafePerformIO $ readIORef v_Ways) -- Hpc opts opt_Hpc :: Bool @@ -227,8 +215,12 @@ opt_DsMultiTyVar = not (lookUp (fsLit "-fno-ds-multi-tyvar")) opt_SpecInlineJoinPoints :: Bool opt_SpecInlineJoinPoints = lookUp (fsLit "-fspec-inline-join-points") +opt_SimpleListLiterals :: Bool +opt_SimpleListLiterals = lookUp (fsLit "-fsimple-list-literals") + opt_NoStateHack :: Bool opt_NoStateHack = lookUp (fsLit "-fno-state-hack") + opt_CprOff :: Bool opt_CprOff = lookUp (fsLit "-fcpr-off") -- Switch off CPR analysis in the new demand analyser @@ -258,7 +250,7 @@ opt_SimplExcessPrecision = lookUp (fsLit "-fexcess-precision") opt_UF_CreationThreshold :: Int opt_UF_CreationThreshold = lookup_def_int "-funfolding-creation-threshold" (45::Int) opt_UF_UseThreshold :: Int -opt_UF_UseThreshold = lookup_def_int "-funfolding-use-threshold" (8::Int) -- Discounts can be big +opt_UF_UseThreshold = lookup_def_int "-funfolding-use-threshold" (6::Int) -- Discounts can be big opt_UF_FunAppDiscount :: Int opt_UF_FunAppDiscount = lookup_def_int "-funfolding-fun-discount" (6::Int) -- It's great to inline a fn opt_UF_KeenessFactor :: Float @@ -283,14 +275,11 @@ opt_Unregisterised = lookUp (fsLit "-funregisterised") -- Derived, not a real option. Determines whether we will be compiling -- info tables that reside just before the entry code, or with an -- indirection to the entry code. See TABLES_NEXT_TO_CODE in --- includes/InfoTables.h. +-- includes/rts/storage/InfoTables.h. tablesNextToCode :: Bool tablesNextToCode = not opt_Unregisterised && cGhcEnableTablesNextToCode == "YES" -opt_EmitExternalCore :: Bool -opt_EmitExternalCore = lookUp (fsLit "-fext-core") - -- Include full span info in error messages, instead of just the start position. opt_ErrorSpans :: Bool opt_ErrorSpans = lookUp (fsLit "-ferror-spans") @@ -327,6 +316,7 @@ data WayName = WayThreaded | WayDebug | WayProf + | WayEventLog | WayTicky | WayPar | WayGran @@ -366,6 +356,7 @@ allowed_combination way = and [ x `allowedWith` y WayProf `allowedWith` WayNDP = True WayThreaded `allowedWith` WayProf = True + WayThreaded `allowedWith` WayEventLog = True _ `allowedWith` _ = False @@ -432,6 +423,10 @@ way_details = , "-DPROFILING" , "-optc-DPROFILING" ]), + (WayEventLog, Way "l" True "RTS Event Logging" + [ "-DEVENTLOG" + , "-optc-DEVENTLOG" ]), + (WayTicky, Way "t" True "Ticky-ticky Profiling" [ "-DTICKY_TICKY" , "-optc-DTICKY_TICKY" ]),