Make GHCi & TH work when the compiler is built with -prof

Summary:
Amazingly, there were zero changes to the byte code generator and very
few changes to the interpreter - mainly because we've used good
abstractions that hide the differences between profiling and
non-profiling.  So that bit was pleasantly straightforward, but there
were a pile of other wibbles to get the whole test suite through.

Note that a compiler built with -prof is now like one built with
-dynamic, in that to use TH you have to build the code the same way.
For dynamic, we automatically enable -dynamic-too when TH is required,
but we don't have anything equivalent for profiling, so you have to
explicitly use -prof when building code that uses TH with a profiled
compiler.  For this reason Cabal won't work with TH.  We don't expect
to ship a profiled compiler, so I think that's OK.

Test Plan: validate with GhcProfiled=YES in validate.mk

Reviewers: goldfire, bgamari, rwbarton, austin, hvr, erikd, ezyang

Reviewed By: ezyang

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1407

GHC Trac Issues: #4837, #545

58 files changed, 235 insertions, 235 deletions

diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index ce8b9f8b6b..723f7fc4cc 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -26,6 +26,7 @@ module CmmInfo (
   maxStdInfoTableSizeW,
   maxRetInfoTableSizeW,
   stdInfoTableSizeB,
+  conInfoTableSizeB,
   stdSrtBitmapOffset,
   stdClosureTypeOffset,
   stdPtrsOffset, stdNonPtrsOffset,
@@ -551,3 +552,6 @@ stdClosureTypeOffset dflags = stdInfoTableSizeB dflags - wORD_SIZE dflags
 stdPtrsOffset, stdNonPtrsOffset :: DynFlags -> ByteOff
 stdPtrsOffset    dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags
 stdNonPtrsOffset dflags = stdInfoTableSizeB dflags - 2 * wORD_SIZE dflags + hALF_WORD_SIZE dflags
+
+conInfoTableSizeB :: DynFlags -> Int
+conInfoTableSizeB dflags = stdInfoTableSizeB dflags + wORD_SIZE dflags
diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs
index a7384c725b..efad805120 100644
--- a/compiler/codeGen/StgCmmProf.hs
+++ b/compiler/codeGen/StgCmmProf.hs
@@ -321,14 +321,15 @@ dynLdvInit dflags =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE
 -- Initialise the LDV word of a new closure
 --
 ldvRecordCreate :: CmmExpr -> FCode ()
-ldvRecordCreate closure = do dflags <- getDynFlags
-                             emit $ mkStore (ldvWord dflags closure) (dynLdvInit dflags)
+ldvRecordCreate closure = do
+  dflags <- getDynFlags
+  emit $ mkStore (ldvWord dflags closure) (dynLdvInit dflags)
 
 --
--- Called when a closure is entered, marks the closure as having been "used".
--- The closure is not an 'inherently used' one.
--- The closure is not IND or IND_OLDGEN because neither is considered for LDV
--- profiling.
+-- | Called when a closure is entered, marks the closure as having
+-- been "used".  The closure is not an "inherently used" one.  The
+-- closure is not @IND@ or @IND_OLDGEN@ because neither is considered
+-- for LDV profiling.
 --
 ldvEnterClosure :: ClosureInfo -> CmmReg -> FCode ()
 ldvEnterClosure closure_info node_reg = do
diff --git a/compiler/ghci/ByteCodeItbls.hs b/compiler/ghci/ByteCodeItbls.hs
index a01fcd89b9..01420f5e34 100644
--- a/compiler/ghci/ByteCodeItbls.hs
+++ b/compiler/ghci/ByteCodeItbls.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, MagicHash #-}
+{-# LANGUAGE CPP, MagicHash, ScopedTypeVariables #-}
 {-# OPTIONS_GHC -optc-DNON_POSIX_SOURCE #-}
 --
 --  (c) The University of Glasgow 2002-2006
@@ -20,6 +20,7 @@ import DataCon          ( DataCon, dataConRepArgTys, dataConIdentity )
 import TyCon            ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
 import Type             ( flattenRepType, repType, typePrimRep )
 import StgCmmLayout     ( mkVirtHeapOffsets )
+import CmmInfo          ( conInfoTableSizeB, profInfoTableSizeW )
 import Util
 
 import Control.Monad
@@ -43,10 +44,6 @@ itblCode dflags (ItblPtr ptr)
  | ghciTablesNextToCode = castPtr ptr `plusPtr` conInfoTableSizeB dflags
  | otherwise            = castPtr ptr
 
--- XXX bogus
-conInfoTableSizeB :: DynFlags -> Int
-conInfoTableSizeB dflags = 3 * wORD_SIZE dflags
-
 type ItblEnv = NameEnv (Name, ItblPtr)
         -- We need the Name in the range so we know which
         -- elements to filter out when unloading a module
@@ -258,8 +255,10 @@ foreign import ccall "&stg_interp_constr_entry"
 -- Ultra-minimalist version specially for constructors
 #if SIZEOF_VOID_P == 8
 type HalfWord = Word32
+type FullWord = Word64
 #else
 type HalfWord = Word16
+type FullWord = Word32
 #endif
 
 data StgConInfoTable = StgConInfoTable {
@@ -311,6 +310,8 @@ sizeOfItbl dflags itbl
                                       Right xs -> sizeOf (head xs) * length xs
                                  else 0
         ]
+        + if rtsIsProfiled then profInfoTableSizeW * wORD_SIZE dflags
+                           else 0
 
 pokeItbl :: DynFlags -> Ptr StgInfoTable -> StgInfoTable -> IO ()
 pokeItbl _ a0 itbl
@@ -319,6 +320,9 @@ pokeItbl _ a0 itbl
            case entry itbl of
                Nothing -> return ()
                Just e  -> store e
+           when rtsIsProfiled $ do
+              store (0 :: FullWord)
+              store (0 :: FullWord)
            store (ptrs   itbl)
            store (nptrs  itbl)
            store (tipe   itbl)
@@ -335,6 +339,10 @@ peekItbl dflags a0
            entry'  <- if ghciTablesNextToCode
                       then return Nothing
                       else liftM Just load
+           when rtsIsProfiled $ do
+              (_ :: Ptr FullWord) <- advance
+              (_ :: Ptr FullWord) <- advance
+              return ()
            ptrs'   <- load
            nptrs'  <- load
            tipe'   <- load
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index f62998ce86..9fa89fec5e 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -504,24 +504,20 @@ dieWith dflags span msg = throwGhcExceptionIO (ProgramError (showSDoc dflags (mk
 
 
 checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe FilePath)
-checkNonStdWay dflags srcspan =
-  if interpWays == haskellWays
-      then return Nothing
-    -- see #3604: object files compiled for way "dyn" need to link to the
-    -- dynamic packages, so we can't load them into a statically-linked GHCi.
-    -- we have to treat "dyn" in the same way as "prof".
-    --
-    -- In the future when GHCi is dynamically linked we should be able to relax
-    -- this, but they we may have to make it possible to load either ordinary
-    -- .o files or -dynamic .o files into GHCi (currently that's not possible
-    -- because the dynamic objects contain refs to e.g. __stginit_base_Prelude_dyn
-    -- whereas we have __stginit_base_Prelude_.
-      else if objectSuf dflags == normalObjectSuffix && not (null haskellWays)
-      then failNonStd dflags srcspan
-      else return $ Just $ if dynamicGhc
-                           then "dyn_o"
-                           else "o"
-    where haskellWays = filter (not . wayRTSOnly) (ways dflags)
+checkNonStdWay dflags srcspan
+  | interpWays == haskellWays = return Nothing
+    -- Only if we are compiling with the same ways as GHC is built
+    -- with, can we dynamically load those object files. (see #3604)
+
+  | objectSuf dflags == normalObjectSuffix && not (null haskellWays)
+  = failNonStd dflags srcspan
+
+  | otherwise = return (Just (interpTag ++ "o"))
+  where
+    haskellWays = filter (not . wayRTSOnly) (ways dflags)
+    interpTag = case mkBuildTag interpWays of
+                  "" -> ""
+                  tag -> tag ++ "_"
 
 normalObjectSuffix :: String
 normalObjectSuffix = phaseInputExt StopLn
@@ -529,11 +525,13 @@ normalObjectSuffix = phaseInputExt StopLn
 failNonStd :: DynFlags -> SrcSpan -> IO (Maybe FilePath)
 failNonStd dflags srcspan = dieWith dflags srcspan $
   ptext (sLit "Dynamic linking required, but this is a non-standard build (eg. prof).") $$
-  ptext (sLit "You need to build the program twice: once the") <+> ghciWay <+> ptext (sLit "way, and then") $$
+  ptext (sLit "You need to build the program twice: once") <+>
+  ghciWay <> ptext (sLit ", and then") $$
   ptext (sLit "in the desired way using -osuf to set the object file suffix.")
-    where ghciWay = if dynamicGhc
-                    then ptext (sLit "dynamic")
-                    else ptext (sLit "normal")
+    where ghciWay
+            | dynamicGhc = ptext (sLit "with -dynamic")
+            | rtsIsProfiled = ptext (sLit "with -prof")
+            | otherwise = ptext (sLit "the normal way")
 
 getLinkDeps :: HscEnv -> HomePackageTable
             -> PersistentLinkerState
@@ -663,7 +661,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
                 ok <- doesFileExist new_file
                 if (not ok)
                    then dieWith dflags span $
-                          ptext (sLit "cannot find normal object file ")
+                          ptext (sLit "cannot find object file ")
                                 <> quotes (text new_file) $$ while_linking_expr
                    else return (DotO new_file)
             adjust_ul _ (DotA fp) = panic ("adjust_ul DotA " ++ show fp)
@@ -1199,22 +1197,34 @@ locateLib dflags is_hs dirs lib
     --       for a dynamic library (#5289)
     --   otherwise, assume loadDLL can find it
     --
-  = findDll `orElse` findArchive `orElse` tryGcc `orElse` tryGccPrefixed `orElse` assumeDll
-
-  | not dynamicGhc
-    -- When the GHC package was not compiled as dynamic library
-    -- (=DYNAMIC not set), we search for .o libraries or, if they
-    -- don't exist, .a libraries.
-  = findObject `orElse` findArchive `orElse` assumeDll
+  = findDll `orElse`
+    findArchive `orElse`
+    tryGcc `orElse`
+    tryGccPrefixed `orElse`
+    assumeDll
 
-  | otherwise
+  | dynamicGhc
     -- When the GHC package was compiled as dynamic library (=DYNAMIC set),
     -- we search for .so libraries first.
   = findHSDll `orElse` findDynObject `orElse` assumeDll
+
+  | rtsIsProfiled
+    -- When the GHC package is profiled, only a libHSfoo_p.a archive will do.
+  = findArchive `orElse`
+    assumeDll
+
+  | otherwise
+    -- HSfoo.o is the best, but only works for the normal way
+    -- libHSfoo.a is the backup option.
+  = findObject `orElse`
+    findArchive `orElse`
+    assumeDll
+
    where
      obj_file     = lib <.> "o"
      dyn_obj_file = lib <.> "dyn_o"
-     arch_file    = "lib" ++ lib <.> "a"
+     arch_file = "lib" ++ lib ++ lib_tag <.> "a"
+     lib_tag = if is_hs && rtsIsProfiled then "_p" else ""
 
      hs_dyn_lib_name = lib ++ '-':programName dflags ++ projectVersion dflags
      hs_dyn_lib_file = mkHsSOName platform hs_dyn_lib_name
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index b95d05322f..6853fbbaea 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -175,17 +175,17 @@ getClosureData :: DynFlags -> a -> IO Closure
 getClosureData dflags a =
    case unpackClosure# a of
      (# iptr, ptrs, nptrs #) -> do
-           let iptr'
-                | ghciTablesNextToCode =
-                   Ptr iptr
+           let iptr0 = Ptr iptr
+           let iptr1
+                | ghciTablesNextToCode = iptr0
                 | otherwise =
                    -- the info pointer we get back from unpackClosure#
                    -- is to the beginning of the standard info table,
                    -- but the Storable instance for info tables takes
                    -- into account the extra entry pointer when
                    -- !ghciTablesNextToCode, so we must adjust here:
-                   Ptr iptr `plusPtr` negate (wORD_SIZE dflags)
-           itbl <- peekItbl dflags iptr'
+                   iptr0 `plusPtr` negate (wORD_SIZE dflags)
+           itbl <- peekItbl dflags iptr1
            let tipe = readCType (BCI.tipe itbl)
                elems = fromIntegral (BCI.ptrs itbl)
                ptrsList = Array 0 (elems - 1) elems ptrs
@@ -193,7 +193,7 @@ getClosureData dflags a =
                               | I# i <- [0.. fromIntegral (BCI.nptrs itbl)-1] ]
            ASSERT(elems >= 0) return ()
            ptrsList `seq`
-            return (Closure tipe (Ptr iptr) itbl ptrsList nptrs_data)
+            return (Closure tipe iptr0 itbl ptrsList nptrs_data)
 
 readCType :: Integral a => a -> ClosureType
 readCType i
@@ -774,7 +774,8 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
             return (Term my_ty (Right dc) a subTerms)
 
 -- The otherwise case: can be a Thunk,AP,PAP,etc.
-      tipe_clos ->
+      tipe_clos -> do
+         traceTR (text "Unknown closure:" <+> ppr tipe_clos)
          return (Suspension tipe_clos my_ty a Nothing)
 
   -- insert NewtypeWraps around newtypes
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index fb6265cdfb..b8705603c7 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -172,10 +172,8 @@ import SrcLoc
 import BasicTypes       ( IntWithInf, treatZeroAsInf )
 import FastString
 import Outputable
-#ifdef GHCI
 import Foreign.C        ( CInt(..) )
 import System.IO.Unsafe ( unsafeDupablePerformIO )
-#endif
 import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessage )
 
 import System.IO.Unsafe ( unsafePerformIO )
@@ -1580,9 +1578,10 @@ defaultWays settings = if pc_DYNAMIC_BY_DEFAULT (sPlatformConstants settings)
                        else []
 
 interpWays :: [Way]
-interpWays = if dynamicGhc
-             then [WayDyn]
-             else []
+interpWays
+  | dynamicGhc = [WayDyn]
+  | rtsIsProfiled = [WayProf]
+  | otherwise = []
 
 --------------------------------------------------------------------------
 
@@ -3493,14 +3492,12 @@ glasgowExtsFlags = [
            , Opt_UnicodeSyntax
            , Opt_UnliftedFFITypes ]
 
-#ifdef GHCI
 -- Consult the RTS to find whether GHC itself has been built profiled
 -- If so, you can't use Template Haskell
 foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt
 
 rtsIsProfiled :: Bool
 rtsIsProfiled = unsafeDupablePerformIO rtsIsProfiledIO /= 0
-#endif
 
 #ifdef GHCI
 -- Consult the RTS to find whether GHC itself has been built with
@@ -4126,6 +4123,8 @@ compilerInfo dflags
                                        then "YES" else "NO"),
        ("GHC Dynamic",                 if dynamicGhc
                                        then "YES" else "NO"),
+       ("GHC Profiled",                if rtsIsProfiled
+                                       then "YES" else "NO"),
        ("Leading underscore",          cLeadingUnderscore),
        ("Debug on",                    show debugIsOn),
        ("LibDir",                      topDir dflags),
@@ -4217,6 +4216,14 @@ makeDynFlagsConsistent dflags
            "Enabling -fPIC as it is always on for this platform"
  | Left err <- checkOptLevel (optLevel dflags) dflags
     = loop (updOptLevel 0 dflags) err
+
+ | LinkInMemory <- ghcLink dflags
+ , rtsIsProfiled
+ , isObjectTarget (hscTarget dflags)
+ , WayProf `notElem` ways dflags
+    = loop dflags{ways = WayProf : ways dflags}
+         "Enabling -prof, because -fobject-code is enabled and GHCi is profiled"
+
  | otherwise = (dflags, [])
     where loc = mkGeneralSrcSpan (fsLit "when making flags consistent")
           loop updated_dflags warning
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 95cb5f222f..53c6f626e5 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -1787,11 +1787,6 @@ hscCompileCoreExpr hsc_env =
 
 hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO HValue
 hscCompileCoreExpr' hsc_env srcspan ds_expr
-    | rtsIsProfiled
-    = throwIO (InstallationError "You can't call hscCompileCoreExpr in a profiled compiler")
-            -- Otherwise you get a seg-fault when you run it
-
-    | otherwise
     = do { let dflags = hsc_dflags hsc_env
 
            {- Simplify it -}
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 1153afa414..21eff8ff62 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -83,7 +83,6 @@ import Data.Maybe
 
 import Exception hiding (catch)
 
-import Foreign.C
 #if __GLASGOW_HASKELL__ >= 709
 import Foreign
 #else
@@ -346,8 +345,6 @@ findEditor = do
         return ""
 #endif
 
-foreign import ccall unsafe "rts_isProfiled" isProfiled :: IO CInt
-
 default_progname, default_prompt, default_prompt2, default_stop :: String
 default_progname = "<interactive>"
 default_prompt = "%s> "
@@ -360,13 +357,6 @@ default_args = []
 interactiveUI :: GhciSettings -> [(FilePath, Maybe Phase)] -> Maybe [String]
               -> Ghc ()
 interactiveUI config srcs maybe_exprs = do
-   -- although GHCi compiles with -prof, it is not usable: the byte-code
-   -- compiler and interpreter don't work with profiling.  So we check for
-   -- this up front and emit a helpful error message (#2197)
-   i <- liftIO $ isProfiled
-   when (i /= 0) $
-     throwGhcException (InstallationError "GHCi cannot be used when compiled with -prof")
-
    -- HACK! If we happen to get into an infinite loop (eg the user
    -- types 'let x=x in x' at the prompt), then the thread will block
    -- on a blackhole, and become unreachable during GC.  The GC will
diff --git a/includes/rts/prof/CCS.h b/includes/rts/prof/CCS.h
index 74f18b85c0..607931d536 100644
--- a/includes/rts/prof/CCS.h
+++ b/includes/rts/prof/CCS.h
@@ -244,10 +244,12 @@ extern CostCentreStack * RTS_VAR(CCS_LIST);         // registered CCS list
 
 /* eliminate profiling overhead from allocation costs */
 #define CCS_ALLOC(ccs, size) (ccs)->mem_alloc += ((size)-sizeofW(StgProfHeader))
+#define ENTER_CCS_THUNK(cap,p) cap->r.rCCCS = p->header.prof.ccs
 
 #else /* !PROFILING */
 
 #define CCS_ALLOC(ccs, amount) doNothing()
+#define ENTER_CCS_THUNK(cap,p) doNothing()
 
 #endif /* PROFILING */
 
diff --git a/includes/rts/storage/InfoTables.h b/includes/rts/storage/InfoTables.h
index 3890d49a8e..228369b22f 100644
--- a/includes/rts/storage/InfoTables.h
+++ b/includes/rts/storage/InfoTables.h
@@ -49,28 +49,6 @@ typedef struct {
 } StgProfInfo;
 
 /* -----------------------------------------------------------------------------
-   Ticky info
-
-   There is no ticky-specific stuff in an info table at this time.
-   -------------------------------------------------------------------------- */
-
-/* -----------------------------------------------------------------------------
-   Debugging info
-   -------------------------------------------------------------------------- */
-
-#ifdef DEBUG_CLOSURE
-
-typedef struct {
-        ... whatever ...
-} StgDebugInfo;
-
-#else /* !DEBUG_CLOSURE */
-
-/* There is no DEBUG-specific stuff in an info table at this time. */
-
-#endif /* DEBUG_CLOSURE */
-
-/* -----------------------------------------------------------------------------
    Closure flags
    -------------------------------------------------------------------------- */
 
@@ -216,12 +194,6 @@ typedef struct StgInfoTable_ {
 #ifdef PROFILING
     StgProfInfo     prof;
 #endif
-#ifdef TICKY
-  /* Ticky-specific stuff would go here. */
-#endif
-#ifdef DEBUG_CLOSURE
-  /* Debug-specific stuff would go here. */
-#endif
 
     StgClosureInfo  layout;     /* closure layout info (one word) */
 
diff --git a/rts/Interpreter.c b/rts/Interpreter.c
index 573e4991f7..3ad3bc6d5b 100644
--- a/rts/Interpreter.c
+++ b/rts/Interpreter.c
@@ -340,6 +340,8 @@ eval_obj:
             RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
         }
 
+        ENTER_CCS_THUNK(cap,ap);
+
         /* Ok; we're safe.  Party on.  Push an update frame. */
         Sp -= sizeofW(StgUpdateFrame);
         {
@@ -529,7 +531,7 @@ do_return_unboxed:
         // get the offset of the stg_ctoi_ret_XXX itbl
         offset = stack_frame_sizeW((StgClosure *)Sp);
 
-        switch (get_itbl((StgClosure *)Sp+offset)->type) {
+        switch (get_itbl((StgClosure*)((StgPtr)Sp+offset))->type) {
 
         case RET_BCO:
             // Returning to an interpreted continuation: put the object on
@@ -883,7 +885,7 @@ run_BCO:
                   // the BCO
                   size_words = BCO_BITMAP_SIZE(obj) + 2;
                   new_aps = (StgAP_STACK *) allocate(cap, AP_STACK_sizeW(size_words));
-                  SET_HDR(new_aps,&stg_AP_STACK_info,CCS_SYSTEM);
+                  SET_HDR(new_aps,&stg_AP_STACK_info,cap->r.rCCCS);
                   new_aps->size = size_words;
                   new_aps->fun = &stg_dummy_ret_closure;
 
@@ -1098,7 +1100,7 @@ run_BCO:
             ap = (StgAP*)allocate(cap, AP_sizeW(n_payload));
             Sp[-1] = (W_)ap;
             ap->n_args = n_payload;
-            SET_HDR(ap, &stg_AP_info, CCS_SYSTEM/*ToDo*/)
+            SET_HDR(ap, &stg_AP_info, cap->r.rCCCS)
             Sp --;
             goto nextInsn;
         }
@@ -1109,7 +1111,7 @@ run_BCO:
             ap = (StgAP*)allocate(cap, AP_sizeW(n_payload));
             Sp[-1] = (W_)ap;
             ap->n_args = n_payload;
-            SET_HDR(ap, &stg_AP_NOUPD_info, CCS_SYSTEM/*ToDo*/)
+            SET_HDR(ap, &stg_AP_NOUPD_info, cap->r.rCCCS)
             Sp --;
             goto nextInsn;
         }
@@ -1122,7 +1124,7 @@ run_BCO:
             Sp[-1] = (W_)pap;
             pap->n_args = n_payload;
             pap->arity = arity;
-            SET_HDR(pap, &stg_PAP_info, CCS_SYSTEM/*ToDo*/)
+            SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS)
             Sp --;
             goto nextInsn;
         }
@@ -1192,7 +1194,7 @@ run_BCO:
                                                itbl->layout.payload.nptrs );
             StgClosure* con = (StgClosure*)allocate_NONUPD(cap,request);
             ASSERT( itbl->layout.payload.ptrs + itbl->layout.payload.nptrs > 0);
-            SET_HDR(con, (StgInfoTable*)BCO_LIT(o_itbl), CCS_SYSTEM/*ToDo*/);
+            SET_HDR(con, (StgInfoTable*)BCO_LIT(o_itbl), cap->r.rCCCS);
             for (i = 0; i < n_words; i++) {
                 con->payload[i] = (StgClosure*)Sp[i];
             }
diff --git a/rts/Linker.c b/rts/Linker.c
index fb7653960b..0507c9c268 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -31,6 +31,7 @@
 #include "GetEnv.h"
 #include "Stable.h"
 #include "RtsSymbols.h"
+#include "Profiling.h"
 
 #if !defined(mingw32_HOST_OS)
 #include "posix/Signals.h"
@@ -1831,9 +1832,15 @@ static HsInt loadArchive_ (pathchar *path)
         IF_DEBUG(linker,
                  debugBelch("loadArchive: Found member file `%s'\n", fileName));
 
-        isObject = thisFileNameSize >= 2
-                && fileName[thisFileNameSize - 2] == '.'
-                && fileName[thisFileNameSize - 1] == 'o';
+        isObject =
+               (thisFileNameSize >= 2 &&
+                fileName[thisFileNameSize - 2] == '.' &&
+                fileName[thisFileNameSize - 1] == 'o')
+            || (thisFileNameSize >= 4 &&
+                fileName[thisFileNameSize - 4] == '.' &&
+                fileName[thisFileNameSize - 3] == 'p' &&
+                fileName[thisFileNameSize - 2] == '_' &&
+                fileName[thisFileNameSize - 1] == 'o');
 
         IF_DEBUG(linker, debugBelch("loadArchive: \tthisFileNameSize = %d\n", (int)thisFileNameSize));
         IF_DEBUG(linker, debugBelch("loadArchive: \tisObject = %d\n", isObject));
@@ -2260,6 +2267,12 @@ static HsInt resolveObjs_ (void)
             oc->status = OBJECT_RESOLVED;
         }
     }
+
+#ifdef PROFILING
+    // collect any new cost centres & CCSs that were defined during runInit
+    initProfiling2();
+#endif
+
     IF_DEBUG(linker, debugBelch("resolveObjs: done\n"));
     return 1;
 }
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index f44519d4d3..7d0c661937 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1960,8 +1960,6 @@ stg_mkApUpd0zh ( P_ bco )
 
 stg_unpackClosurezh ( P_ closure )
 {
-// TODO: Consider the absence of ptrs or nonptrs as a special case ?
-
     W_ info, ptrs, nptrs, p, ptrs_arr, nptrs_arr;
     info  = %GET_STD_INFO(UNTAG(closure));
 
diff --git a/rts/ProfHeap.c b/rts/ProfHeap.c
index 0259a191eb..bfb8aaae2d 100644
--- a/rts/ProfHeap.c
+++ b/rts/ProfHeap.c
@@ -311,7 +311,7 @@ nextEra( void )
 FILE *hp_file;
 static char *hp_filename;
 
-void initProfiling1 (void)
+void initProfiling (void)
 {
 }
 
diff --git a/rts/Profiling.c b/rts/Profiling.c
index 23a48993fd..982b9461a0 100644
--- a/rts/Profiling.c
+++ b/rts/Profiling.c
@@ -142,8 +142,7 @@ static  void              initProfilingLogFile ( void );
    Initialise the profiling environment
    -------------------------------------------------------------------------- */
 
-void
-initProfiling1 (void)
+void initProfiling (void)
 {
     // initialise our arena
     prof_arena = newArena();
@@ -159,18 +158,6 @@ initProfiling1 (void)
 #ifdef THREADED_RTS
     initMutex(&ccs_mutex);
 #endif
-}
-
-void
-freeProfiling (void)
-{
-    arenaFree(prof_arena);
-}
-
-void
-initProfiling2 (void)
-{
-    CostCentreStack *ccs, *next;
 
     /* Set up the log file, and dump the header and cost centre
      * information into it.
@@ -205,14 +192,7 @@ initProfiling2 (void)
     CCS_MAIN->root = CCS_MAIN;
     ccsSetSelected(CCS_MAIN);
 
-    // make CCS_MAIN the parent of all the pre-defined CCSs.
-    for (ccs = CCS_LIST; ccs != NULL; ) {
-        next = ccs->prevStack;
-        ccs->prevStack = NULL;
-        actualPush_(CCS_MAIN,ccs->cc,ccs);
-        ccs->root = ccs;
-        ccs = next;
-    }
+    initProfiling2();
 
     if (RtsFlags.CcFlags.doCostCentres) {
         initTimeProfiling();
@@ -223,6 +203,29 @@ initProfiling2 (void)
     }
 }
 
+//
+// Should be called after loading any new Haskell code.
+//
+void initProfiling2 (void)
+{
+    CostCentreStack *ccs, *next;
+
+    // make CCS_MAIN the parent of all the pre-defined CCSs.
+    for (ccs = CCS_LIST; ccs != NULL; ) {
+        next = ccs->prevStack;
+        ccs->prevStack = NULL;
+        actualPush_(CCS_MAIN,ccs->cc,ccs);
+        ccs->root = ccs;
+        ccs = next;
+    }
+    CCS_LIST = NULL;
+}
+
+void
+freeProfiling (void)
+{
+    arenaFree(prof_arena);
+}
 
 static void
 initProfilingLogFile(void)
diff --git a/rts/Profiling.h b/rts/Profiling.h
index 8c365220fb..4158020596 100644
--- a/rts/Profiling.h
+++ b/rts/Profiling.h
@@ -20,7 +20,7 @@
 #define PROFILING_ONLY(s) doNothing()
 #endif
 
-void initProfiling1 (void);
+void initProfiling  (void);
 void initProfiling2 (void);
 void endProfiling   (void);
 void freeProfiling  (void);
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 584c31ef81..35e52aa36e 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -230,7 +230,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
     initThreadLabelTable();
 #endif
 
-    initProfiling1();
+    initProfiling();
 
     /* start the virtual timer 'subsystem'. */
     initTimer();
@@ -255,10 +255,6 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
 
     startupHpc();
 
-    // This must be done after module initialisation.
-    // ToDo: make this work in the presence of multiple hs_add_root()s.
-    initProfiling2();
-
     // ditto.
 #if defined(THREADED_RTS)
     ioManagerStart();
diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c
index 569255094f..3a4355797e 100644
--- a/rts/RtsSymbols.c
+++ b/rts/RtsSymbols.c
@@ -641,10 +641,25 @@
       SymI_HasProto(stg_INTLIKE_closure)
 #endif
 
+#if defined(PROFILING)
+#define RTS_PROF_SYMBOLS                        \
+      SymI_HasProto(CCS_DONT_CARE)              \
+      SymI_HasProto(CC_LIST)                    \
+      SymI_HasProto(CC_ID)                      \
+      SymI_HasProto(CCS_LIST)                   \
+      SymI_HasProto(CCS_ID)                     \
+      SymI_HasProto(stg_restore_cccs_info)      \
+      SymI_HasProto(enterFunCCS)                \
+      SymI_HasProto(pushCostCentre)             \
+      SymI_HasProto(era)
+#else
+#define RTS_PROF_SYMBOLS /* empty */
+#endif
 
 #define RTS_SYMBOLS                                                     \
       Maybe_Stable_Names                                                \
       RTS_TICKY_SYMBOLS                                                 \
+      RTS_PROF_SYMBOLS                                                  \
       SymI_HasProto(StgReturn)                                          \
       SymI_HasProto(stg_gc_noregs)                                      \
       SymI_HasProto(stg_ret_v_info)                                     \
diff --git a/testsuite/config/ghc b/testsuite/config/ghc
index 55a6a734df..fdb7250c10 100644
--- a/testsuite/config/ghc
+++ b/testsuite/config/ghc
@@ -179,7 +179,6 @@ def get_compiler_info():
 
     if re.match(".*_p(_.*|$)", rtsInfoDict["RTS way"]):
         config.compiler_profiled = True
-        config.run_ways = [x for x in config.run_ways if x != 'ghci']
     else:
         config.compiler_profiled = False
 
@@ -204,6 +203,11 @@ def get_compiler_info():
         config.ghci_way_flags   = "-dynamic"
         config.ghc_th_way       = "dyn"
         config.ghc_plugin_way   = "dyn"
+    elif config.compiler_profiled:
+        config.ghc_th_way_flags = "-prof"
+        config.ghci_way_flags   = "-prof"
+        config.ghc_th_way       = "prof"
+        config.ghc_plugin_way   = "prof"
     else:
         config.ghc_th_way_flags = "-static"
         config.ghci_way_flags   = "-static"
diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk
index 055c85659a..30398790d0 100644
--- a/testsuite/mk/boilerplate.mk
+++ b/testsuite/mk/boilerplate.mk
@@ -250,6 +250,10 @@ ifeq "$(GhcDynamic)" "YES"
 ghcThWayFlags     = -dynamic
 ghciWayFlags      = -dynamic
 ghcPluginWayFlags = -dynamic
+else ifeq "$(GhcProfiled)" "YES"
+ghcThWayFlags     = -prof
+ghciWayFlags      = -prof
+ghcPluginWayFlags = -prof
 else
 ghcThWayFlags     = -static
 ghciWayFlags      = -static
diff --git a/testsuite/mk/ghc-config.hs b/testsuite/mk/ghc-config.hs
index c5ad5ff3b7..4ca3d3085c 100644
--- a/testsuite/mk/ghc-config.hs
+++ b/testsuite/mk/ghc-config.hs
@@ -25,6 +25,7 @@ main = do
   getGhcFieldOrFail fields "GhcRTSWays" "RTS ways"
   getGhcFieldOrDefault fields "GhcDynamicByDefault" "Dynamic by default" "NO"
   getGhcFieldOrDefault fields "GhcDynamic" "GHC Dynamic" "NO"
+  getGhcFieldOrDefault fields "GhcProfiled" "GHC Profiled" "NO"
   getGhcFieldProgWithDefault fields "AR" "ar command" "ar"
   getGhcFieldProgWithDefault fields "LLC" "LLVM llc command" "llc"
 
diff --git a/testsuite/tests/annotations/should_compile/all.T b/testsuite/tests/annotations/should_compile/all.T
index 1c6690b2b8..57efc2634c 100644
--- a/testsuite/tests/annotations/should_compile/all.T
+++ b/testsuite/tests/annotations/should_compile/all.T
@@ -1,6 +1,3 @@
-
-setTestOpts(when(compiler_profiled(), skip))
-
 # Annotations, like Template Haskell, require runtime evaluation.  In
 # order for this to work with profiling, we would have to build the
 # program twice and use -osuf p_o (see the TH_splitE5_prof test).  For
diff --git a/testsuite/tests/annotations/should_compile/th/Makefile b/testsuite/tests/annotations/should_compile/th/Makefile
index 4159eeeda1..b10fc725db 100644
--- a/testsuite/tests/annotations/should_compile/th/Makefile
+++ b/testsuite/tests/annotations/should_compile/th/Makefile
@@ -5,7 +5,7 @@ include $(TOP)/mk/test.mk
 annth_make:
 	$(MAKE) clean_annth_make
 	mkdir build_make
-	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 --make \
+	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) -v0 --make \
 	   -odir build_make -hidir build_make -o build_make/annth annth.hs
 
 clean_annth_make:
@@ -14,16 +14,16 @@ clean_annth_make:
 annth_compunits:
 	$(MAKE) clean_annth_compunits
 	mkdir build_compunits
-	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic-too \
+	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) -v0 \
 	  -odir build_compunits -hidir build_compunits \
 	  -c AnnHelper.hs
-	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic-too \
+	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) -v0 \
 	  -odir build_compunits -hidir build_compunits \
 	  -c TestModule.hs
-	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -dynamic-too \
+	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) -v0 \
 	  -odir build_compunits -hidir build_compunits \
 	  -c TestModuleTH.hs
-	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 -ibuild_compunits \
+	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) -v0 -ibuild_compunits \
 	  -odir build_compunits -hidir build_compunits \
 	  -c annth.hs
 
diff --git a/testsuite/tests/annotations/should_compile/th/all.T b/testsuite/tests/annotations/should_compile/th/all.T
index b44a0d594f..a1681cfe0b 100644
--- a/testsuite/tests/annotations/should_compile/th/all.T
+++ b/testsuite/tests/annotations/should_compile/th/all.T
@@ -1,5 +1,3 @@
-setTestOpts(when(compiler_profiled(), skip))
-
 # Annotations and Template Haskell, require runtime evaluation.  In
 # order for this to work with profiling, we would have to build the
 # program twice and use -osuf p_o (see the TH_splitE5_prof test).  For
diff --git a/testsuite/tests/annotations/should_compile/th/annth.hs b/testsuite/tests/annotations/should_compile/th/annth.hs
index de5d4d32a8..8cc3a242ff 100644
--- a/testsuite/tests/annotations/should_compile/th/annth.hs
+++ b/testsuite/tests/annotations/should_compile/th/annth.hs
@@ -6,6 +6,7 @@ import Language.Haskell.TH.Syntax
 import AnnHelper
 import TestModule
 import TestModuleTH
+import System.IO
 
 main = do
   $(do
@@ -24,3 +25,4 @@ main = do
     anns <- reifyAnnotations (AnnLookupName 'TestTypeTH)
     runIO $ print (anns :: [String])
     [| return () |] )
+  hFlush stdout
diff --git a/testsuite/tests/annotations/should_run/all.T b/testsuite/tests/annotations/should_run/all.T
index db01b2579f..183ff97bcc 100644
--- a/testsuite/tests/annotations/should_run/all.T
+++ b/testsuite/tests/annotations/should_run/all.T
@@ -1,4 +1,3 @@
-setTestOpts(when(compiler_profiled(), skip))
 # These tests are very slow due to their use of package GHC
 setTestOpts(when(fast(), skip))
 
diff --git a/testsuite/tests/cabal/cabal04/Makefile b/testsuite/tests/cabal/cabal04/Makefile
index 34845ff642..9aaa25f404 100644
--- a/testsuite/tests/cabal/cabal04/Makefile
+++ b/testsuite/tests/cabal/cabal04/Makefile
@@ -14,7 +14,7 @@ cabal04:
 	$(MAKE) clean
 	'$(TEST_HC)' -v0 --make Setup
 	$(SETUP) clean
-	$(SETUP) configure --with-ghc='$(TEST_HC)' --ghc-options='$(filter-out -rtsopts,$(TEST_HC_OPTS))' $(VANILLA) $(PROF) $(DYN)
+	$(SETUP) configure --with-ghc='$(TEST_HC)' --ghc-options='$(filter-out -rtsopts,$(TEST_HC_OPTS))' $(VANILLA) $(PROF) $(DYN) --ghc-options='$(ghcThWayFlags)'
 	$(SETUP) build 2> err
 	! grep -v "Creating library file" err
 ifneq "$(CLEANUP)" ""
diff --git a/testsuite/tests/cabal/cabal04/all.T b/testsuite/tests/cabal/cabal04/all.T
index 6d9d13de54..53d90145ce 100644
--- a/testsuite/tests/cabal/cabal04/all.T
+++ b/testsuite/tests/cabal/cabal04/all.T
@@ -8,7 +8,7 @@ if config.have_profiling:
 else:
     prof = '--disable-library-profiling'
 
-if config.have_shared_libs:
+if not config.compiler_profiled and config.have_shared_libs:
     dyn = '--enable-shared'
 else:
     dyn = '--disable-shared'
diff --git a/testsuite/tests/ghc-e/should_fail/all.T b/testsuite/tests/ghc-e/should_fail/all.T
index d5400bf713..8cb6d9a68b 100644
--- a/testsuite/tests/ghc-e/should_fail/all.T
+++ b/testsuite/tests/ghc-e/should_fail/all.T
@@ -1,5 +1,3 @@
-setTestOpts(when(compiler_profiled(), skip))
-
 test('T7962', [exit_code(2), req_interp, ignore_output], run_command,
      ['$MAKE --no-print-directory -s T7962'])
 
diff --git a/testsuite/tests/ghc-e/should_run/all.T b/testsuite/tests/ghc-e/should_run/all.T
index 0e6f7f9c17..dcb720723d 100644
--- a/testsuite/tests/ghc-e/should_run/all.T
+++ b/testsuite/tests/ghc-e/should_run/all.T
@@ -1,6 +1,4 @@
 
-setTestOpts(when(compiler_profiled(), skip))
-
 test('ghc-e001', req_interp, run_command, ['$MAKE --no-print-directory -s ghc-e001'])
 test('ghc-e002', req_interp, run_command, ['$MAKE --no-print-directory -s ghc-e002'])
 test('ghc-e003', req_interp, run_command, ['$MAKE --no-print-directory -s ghc-e003'])
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index f8a054103d..28089a2727 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -1,5 +1,4 @@
 setTestOpts([extra_run_opts('-ignore-dot-ghci'),
-             when(compiler_profiled(), skip),
              normalise_slashes])
 
 test('print001', normal, ghci_script, ['print001.script'])
diff --git a/testsuite/tests/ghci.debugger/scripts/break022/all.T b/testsuite/tests/ghci.debugger/scripts/break022/all.T
index 497ad7e417..546a8f45ca 100644
--- a/testsuite/tests/ghci.debugger/scripts/break022/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/break022/all.T
@@ -1,4 +1,3 @@
 setTestOpts(extra_run_opts('-ignore-dot-ghci'))
-setTestOpts(when(compiler_profiled(), skip))
 
 test('break022', extra_clean(['A.hs']), ghci_script, ['break022.script'])
diff --git a/testsuite/tests/ghci.debugger/scripts/break023/all.T b/testsuite/tests/ghci.debugger/scripts/break023/all.T
index 22b608e317..ac747d4461 100644
--- a/testsuite/tests/ghci.debugger/scripts/break023/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/break023/all.T
@@ -1,4 +1,3 @@
 setTestOpts(extra_run_opts('-ignore-dot-ghci'))
-setTestOpts(when(compiler_profiled(), skip))
 
 test('break023', extra_clean(['A.hs']), ghci_script, ['break023.script'])
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index d58b2dc0aa..283251cf1f 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -1,7 +1,5 @@
 # coding=utf8
 
-setTestOpts(when(compiler_profiled(), skip))
-
 test('ghci001', combined_output, ghci_script, ['ghci001.script'])
 test('ghci002', combined_output, ghci_script, ['ghci002.script'])
 test('ghci003', combined_output, ghci_script, ['ghci003.script'])
diff --git a/testsuite/tests/ghci/should_fail/all.T b/testsuite/tests/ghci/should_fail/all.T
index 188975a4b7..58a396ed86 100644
--- a/testsuite/tests/ghci/should_fail/all.T
+++ b/testsuite/tests/ghci/should_fail/all.T
@@ -1,4 +1,2 @@
-setTestOpts(when(compiler_profiled(), skip))
-
 test('T10549', [], ghci_script, ['T10549.script'])
 test('T10549a', [], ghci_script, ['T10549a.script'])
diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T
index cd5b1f2dcf..bcb15380fb 100644
--- a/testsuite/tests/ghci/should_run/all.T
+++ b/testsuite/tests/ghci/should_run/all.T
@@ -1,6 +1,4 @@
 
-setTestOpts(when(compiler_profiled(), skip))
-
 # We only want to run these tests with GHCi
 def just_ghci( name, opts ):
   opts.only_ways = ['ghci']
diff --git a/testsuite/tests/layout/all.T b/testsuite/tests/layout/all.T
index 0b973dec6a..ddd53ee64f 100644
--- a/testsuite/tests/layout/all.T
+++ b/testsuite/tests/layout/all.T
@@ -31,8 +31,7 @@ test('layout006',
 
 test('layout007',
      [req_interp,
-      extra_clean(['layout007.hi', 'layout007.o']),
-      when(compiler_profiled(), skip)],
+      extra_clean(['layout007.hi', 'layout007.o'])],
      run_command,
      ['$MAKE -s --no-print-directory layout007'])
 
diff --git a/testsuite/tests/overloadedrecflds/ghci/all.T b/testsuite/tests/overloadedrecflds/ghci/all.T
index 013e34e730..f114c0fdfa 100644
--- a/testsuite/tests/overloadedrecflds/ghci/all.T
+++ b/testsuite/tests/overloadedrecflds/ghci/all.T
@@ -1,3 +1 @@
-setTestOpts(when(compiler_profiled(), skip))
-
 test('overloadedrecfldsghci01', combined_output, ghci_script, ['overloadedrecfldsghci01.script'])
diff --git a/testsuite/tests/partial-sigs/should_compile/all.T b/testsuite/tests/partial-sigs/should_compile/all.T
index 9e7b8a75e8..e99a414b13 100644
--- a/testsuite/tests/partial-sigs/should_compile/all.T
+++ b/testsuite/tests/partial-sigs/should_compile/all.T
@@ -48,9 +48,9 @@ test('TypeFamilyInstanceLHS', normal, compile, ['-ddump-types -fno-warn-partial-
 test('Uncurry', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures'])
 test('UncurryNamed', normal, compile, ['-ddump-types -fno-warn-partial-type-signatures'])
 test('WarningWildcardInstantiations', normal, compile, ['-ddump-types'])
-test('SplicesUsed', [req_interp, only_compiler_types(['ghc']), when(compiler_profiled(), skip),
+test('SplicesUsed', [req_interp, only_compiler_types(['ghc']),
                      extra_clean(['Splices.o', 'Splices.hi'])],
-     multimod_compile, ['SplicesUsed', ''])
+     multimod_compile, ['SplicesUsed', config.ghc_th_way_flags])
 test('TypedSplice', [req_interp, normal], compile, [''])
 test('T10403', normal, compile, [''])
 test('T10438', normal, compile, [''])
diff --git a/testsuite/tests/partial-sigs/should_fail/all.T b/testsuite/tests/partial-sigs/should_fail/all.T
index bebd8bda86..913b7d813a 100644
--- a/testsuite/tests/partial-sigs/should_fail/all.T
+++ b/testsuite/tests/partial-sigs/should_fail/all.T
@@ -5,11 +5,11 @@ test('ExtraConstraintsWildcardInExpressionSignature', normal, compile_fail, ['']
 test('ExtraConstraintsWildcardInPatternSignature', normal, compile_fail, [''])
 test('ExtraConstraintsWildcardInPatternSplice', normal, compile_fail, [''])
 test('ExtraConstraintsWildcardInTypeSpliceUsed',
-     [req_interp, when(compiler_profiled(), skip),
+     [req_interp,
       extra_clean(['ExtraConstraintsWildcardInTypeSplice.o', 'ExtraConstraintsWildcardInTypeSplice.hi'])],
-     multimod_compile_fail, ['ExtraConstraintsWildcardInTypeSpliceUsed', ''])
+     multimod_compile_fail, ['ExtraConstraintsWildcardInTypeSpliceUsed', config.ghc_th_way_flags])
 test('ExtraConstraintsWildcardInTypeSplice2',
-     [req_interp, when(compiler_profiled(), skip)],
+     req_interp,
      compile_fail, [''])
 test('ExtraConstraintsWildcardNotEnabled', normal, compile_fail, [''])
 test('ExtraConstraintsWildcardNotLast', normal, compile_fail, [''])
diff --git a/testsuite/tests/plugins/annotation-plugin/Makefile b/testsuite/tests/plugins/annotation-plugin/Makefile
index 7d957d0e95..ad54f75b6f 100644
--- a/testsuite/tests/plugins/annotation-plugin/Makefile
+++ b/testsuite/tests/plugins/annotation-plugin/Makefile
@@ -13,6 +13,6 @@ package.%:
 	mkdir pkg.$*
 	"$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
 	"$(GHC_PKG)" init pkg.$*/local.package.conf
-	pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
+	pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" $(if $(findstring _p,$(GhcRTSWays)), --enable-library-profiling) --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
 	pkg.$*/setup build     --distdir pkg.$*/dist -v0
 	pkg.$*/setup install   --distdir pkg.$*/dist -v0
diff --git a/testsuite/tests/plugins/rule-defining-plugin/Makefile b/testsuite/tests/plugins/rule-defining-plugin/Makefile
index 7d957d0e95..a78ba1ddc8 100644
--- a/testsuite/tests/plugins/rule-defining-plugin/Makefile
+++ b/testsuite/tests/plugins/rule-defining-plugin/Makefile
@@ -13,6 +13,6 @@ package.%:
 	mkdir pkg.$*
 	"$(TEST_HC)" -outputdir pkg.$* --make -v0 -o pkg.$*/setup Setup.hs
 	"$(GHC_PKG)" init pkg.$*/local.package.conf
-	pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
+	pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring _p,$(GhcRTSWays)), --enable-library-profiling)
 	pkg.$*/setup build     --distdir pkg.$*/dist -v0
 	pkg.$*/setup install   --distdir pkg.$*/dist -v0
diff --git a/testsuite/tests/plugins/simple-plugin/Makefile b/testsuite/tests/plugins/simple-plugin/Makefile
index eb7cc6ab1d..ed51533379 100644
--- a/testsuite/tests/plugins/simple-plugin/Makefile
+++ b/testsuite/tests/plugins/simple-plugin/Makefile
@@ -15,6 +15,6 @@ package.%:
 	
 	"$(GHC_PKG)" init pkg.$*/local.package.conf
 	
-	pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf
+	pkg.$*/setup configure --distdir pkg.$*/dist -v0 $(CABAL_PLUGIN_BUILD) --prefix="$(HERE)/pkg.$*/install" --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=pkg.$*/local.package.conf $(if $(findstring _p,$(GhcRTSWays)), --enable-library-profiling)
 	pkg.$*/setup build     --distdir pkg.$*/dist -v0
 	pkg.$*/setup install   --distdir pkg.$*/dist -v0
diff --git a/testsuite/tests/profiling/should_run/ioprof.prof.sample b/testsuite/tests/profiling/should_run/ioprof.prof.sample
index 5fd43b94d0..98f48fdadc 100644
--- a/testsuite/tests/profiling/should_run/ioprof.prof.sample
+++ b/testsuite/tests/profiling/should_run/ioprof.prof.sample
@@ -1,36 +1,46 @@
-	Thu Apr  2 20:30 2015 Time and Allocation Profiling Report  (Final)
+	Fri Oct 30 17:14 2015 Time and Allocation Profiling Report  (Final)
 
 	   ioprof +RTS -hc -p -RTS
 
 	total time  =        0.00 secs   (0 ticks @ 1000 us, 1 processor)
-	total alloc =      52,224 bytes  (excludes profiling overheads)
+	total alloc =      63,680 bytes  (excludes profiling overheads)
 
 COST CENTRE MODULE            %time %alloc
 
-MAIN        MAIN                0.0    1.4
-CAF         GHC.IO.Handle.FD    0.0   66.1
-CAF         GHC.IO.Encoding     0.0    6.3
-CAF         GHC.Conc.Signal     0.0    1.3
-main        Main                0.0   16.7
-errorM.\    Main                0.0    6.9
+CAF         GHC.IO.Handle.FD    0.0   54.2
+CAF         GHC.IO.Encoding     0.0    5.2
+CAF         GHC.Exception       0.0    1.2
+CAF         GHC.Conc.Signal     0.0    1.0
+main        Main                0.0   13.6
+errorM.\    Main                0.0   19.8
+CAF         Main                0.0    2.6
 
 
-                                                           individual      inherited
-COST CENTRE       MODULE                no.     entries  %time %alloc   %time %alloc
+                                                            individual      inherited
+COST CENTRE        MODULE                no.     entries  %time %alloc   %time %alloc
 
-MAIN              MAIN                   98           0    0.0    1.4     0.0  100.0
- main             Main                  197           0    0.0   16.5     0.0   16.5
- CAF              Main                  195           0    0.0    0.0     0.0    7.5
-  main            Main                  196           1    0.0    0.2     0.0    7.5
-   runM           Main                  198           1    0.0    0.3     0.0    7.3
-    bar           Main                  199           1    0.0    0.0     0.0    7.0
-     >>=          Main                  200           1    0.0    0.0     0.0    6.9
-      >>=.\       Main                  201           1    0.0    0.0     0.0    6.9
-       foo        Main                  202           1    0.0    0.0     0.0    6.9
-        errorM    Main                  203           1    0.0    0.0     0.0    6.9
-         errorM.\ Main                  204           1    0.0    6.9     0.0    6.9
- CAF              GHC.Conc.Signal       177           0    0.0    1.3     0.0    1.3
- CAF              GHC.Conc.Sync         176           0    0.0    0.4     0.0    0.4
- CAF              GHC.IO.Encoding       161           0    0.0    6.3     0.0    6.3
- CAF              GHC.IO.Encoding.Iconv 159           0    0.0    0.4     0.0    0.4
- CAF              GHC.IO.Handle.FD      150           0    0.0   66.1     0.0   66.1
+MAIN               MAIN                  102           0    0.0    1.0     0.0  100.0
+ main              Main                  205           0    0.0   13.5     0.0   13.5
+ CAF               Main                  203           0    0.0    2.6     0.0   23.2
+  fmap             Main                  212           1    0.0    0.0     0.0    0.0
+  <*>              Main                  208           1    0.0    0.0     0.0    0.0
+  main             Main                  204           1    0.0    0.2     0.0   20.6
+   runM            Main                  206           1    0.0    0.3     0.0   20.4
+    bar            Main                  207           1    0.0    0.2     0.0   20.1
+     foo           Main                  216           1    0.0    0.0     0.0    0.0
+      errorM       Main                  217           1    0.0    0.0     0.0    0.0
+     fmap          Main                  213           0    0.0    0.0     0.0    0.0
+      >>=          Main                  214           1    0.0    0.0     0.0    0.0
+     <*>           Main                  209           0    0.0    0.0     0.0   19.8
+      >>=          Main                  210           1    0.0    0.0     0.0   19.8
+       >>=.\       Main                  211           2    0.0    0.0     0.0   19.8
+        foo        Main                  218           0    0.0    0.0     0.0   19.8
+         errorM    Main                  219           0    0.0    0.0     0.0   19.8
+          errorM.\ Main                  220           1    0.0   19.8     0.0   19.8
+        fmap       Main                  215           0    0.0    0.0     0.0    0.0
+ CAF               GHC.Conc.Signal       197           0    0.0    1.0     0.0    1.0
+ CAF               GHC.Conc.Sync         196           0    0.0    0.4     0.0    0.4
+ CAF               GHC.Exception         194           0    0.0    1.2     0.0    1.2
+ CAF               GHC.IO.Encoding       187           0    0.0    5.2     0.0    5.2
+ CAF               GHC.IO.Encoding.Iconv 185           0    0.0    0.4     0.0    0.4
+ CAF               GHC.IO.Handle.FD      177           0    0.0   54.2     0.0   54.2
diff --git a/testsuite/tests/profiling/should_run/ioprof.stderr b/testsuite/tests/profiling/should_run/ioprof.stderr
index 7d8fe35da8..3910245347 100644
--- a/testsuite/tests/profiling/should_run/ioprof.stderr
+++ b/testsuite/tests/profiling/should_run/ioprof.stderr
@@ -1 +1,3 @@
 ioprof: a
+CallStack:
+  error, called at ioprof.hs:23:22 in main:Main
diff --git a/testsuite/tests/quasiquotation/qq007/Makefile b/testsuite/tests/quasiquotation/qq007/Makefile
index e31a732a26..79eb3b9085 100644
--- a/testsuite/tests/quasiquotation/qq007/Makefile
+++ b/testsuite/tests/quasiquotation/qq007/Makefile
@@ -7,6 +7,6 @@ TH_QQ:
 ifeq "$(GhcDynamic)" "YES"
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c QQ.hs -dynamic -osuf dyn_o -hisuf dyn_hi
 else
-	'$(TEST_HC)' $(TEST_HC_OPTS) -c QQ.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) -c QQ.hs
 endif
 
diff --git a/testsuite/tests/quasiquotation/qq007/test.T b/testsuite/tests/quasiquotation/qq007/test.T
index 0b4448cdc0..4d6767d3f8 100644
--- a/testsuite/tests/quasiquotation/qq007/test.T
+++ b/testsuite/tests/quasiquotation/qq007/test.T
@@ -4,4 +4,4 @@ test('qq007',
       pre_cmd('$MAKE -s --no-print-directory TH_QQ'),
       ],
      multimod_compile,
-     ['Test', '-v0'])
+     ['Test', '-v0 ' + config.ghc_th_way_flags])
diff --git a/testsuite/tests/quasiquotation/qq008/Makefile b/testsuite/tests/quasiquotation/qq008/Makefile
index e31a732a26..79eb3b9085 100644
--- a/testsuite/tests/quasiquotation/qq008/Makefile
+++ b/testsuite/tests/quasiquotation/qq008/Makefile
@@ -7,6 +7,6 @@ TH_QQ:
 ifeq "$(GhcDynamic)" "YES"
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c QQ.hs -dynamic -osuf dyn_o -hisuf dyn_hi
 else
-	'$(TEST_HC)' $(TEST_HC_OPTS) -c QQ.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) -c QQ.hs
 endif
 
diff --git a/testsuite/tests/quasiquotation/qq008/test.T b/testsuite/tests/quasiquotation/qq008/test.T
index 8cac1a9f0a..cb1feae7da 100644
--- a/testsuite/tests/quasiquotation/qq008/test.T
+++ b/testsuite/tests/quasiquotation/qq008/test.T
@@ -4,4 +4,4 @@ test('qq008',
       pre_cmd('$MAKE -s --no-print-directory TH_QQ'),
       ],
      multimod_compile,
-     ['Test', '-v0'])
+     ['Test', '-v0 ' + config.ghc_th_way_flags])
diff --git a/testsuite/tests/quasiquotation/qq009/Makefile b/testsuite/tests/quasiquotation/qq009/Makefile
index 0fa91dbf9a..f3fb673593 100644
--- a/testsuite/tests/quasiquotation/qq009/Makefile
+++ b/testsuite/tests/quasiquotation/qq009/Makefile
@@ -7,5 +7,5 @@ TH_QQ:
 ifeq "$(GhcDynamic)" "YES"
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c QQ.hs -dynamic -osuf dyn_o -hisuf dyn_hi
 else
-	'$(TEST_HC)' $(TEST_HC_OPTS) -c QQ.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) $(ghcThWayFlags) -c QQ.hs
 endif
diff --git a/testsuite/tests/quasiquotation/qq009/test.T b/testsuite/tests/quasiquotation/qq009/test.T
index 10b939a3bd..7ad1ebef49 100644
--- a/testsuite/tests/quasiquotation/qq009/test.T
+++ b/testsuite/tests/quasiquotation/qq009/test.T
@@ -4,4 +4,4 @@ test('qq009',
       pre_cmd('$MAKE -s --no-print-directory TH_QQ'),
       ],
      multimod_compile,
-     ['Test', '-v0'])
+     ['Test', '-v0 ' + config.ghc_th_way_flags])
diff --git a/testsuite/tests/runghc/all.T b/testsuite/tests/runghc/all.T
index d268f2eb52..3ffaa20cbc 100644
--- a/testsuite/tests/runghc/all.T
+++ b/testsuite/tests/runghc/all.T
@@ -1,6 +1,3 @@
-
-setTestOpts(when(compiler_profiled(), skip))
-
 test('T7859', req_interp, run_command,
      ['$MAKE --no-print-directory -s T7859'])
 
diff --git a/testsuite/tests/th/Makefile b/testsuite/tests/th/Makefile
index d219e80aa8..5d2be1eb34 100644
--- a/testsuite/tests/th/Makefile
+++ b/testsuite/tests/th/Makefile
@@ -16,7 +16,7 @@ HC_OPTS = -XTemplateHaskell -package template-haskell
 
 TH_spliceE5_prof::
 	$(RM) TH_spliceE5_prof*.o TH_spliceE5_prof*.hi TH_spliceE5_prof*.p.o 
-	'$(TEST_HC)' $(TEST_HC_OPTS) $(HC_OPTS) --make -v0 TH_spliceE5_prof.hs -c
+	'$(TEST_HC)' $(TEST_HC_OPTS) $(HC_OPTS) $(ghcThWayFlags) --make -v0 TH_spliceE5_prof.hs -c
 	'$(TEST_HC)' $(TEST_HC_OPTS) $(HC_OPTS) --make -v0 TH_spliceE5_prof.hs -prof -auto-all -osuf p.o -o $@
 	./$@
 
diff --git a/testsuite/tests/th/T2014/all.T b/testsuite/tests/th/T2014/all.T
index 77709c23c5..5dd92919a6 100644
--- a/testsuite/tests/th/T2014/all.T
+++ b/testsuite/tests/th/T2014/all.T
@@ -1,5 +1,3 @@
-setTestOpts(when(compiler_profiled(), skip))
-
 test('T2014',
      [req_interp,
       extra_clean(['A.hi-boot','A.hi','A.o','A.o-boot',
diff --git a/testsuite/tests/th/T4255.hs b/testsuite/tests/th/T4255.hs
deleted file mode 100644
index 8509f0ece9..0000000000
--- a/testsuite/tests/th/T4255.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-
-{-# LANGUAGE TemplateHaskell #-}
-module T4255 where
-
-f x = $([| x |])
diff --git a/testsuite/tests/th/T4255.stderr b/testsuite/tests/th/T4255.stderr
deleted file mode 100644
index e2c4f2f055..0000000000
--- a/testsuite/tests/th/T4255.stderr
+++ /dev/null
@@ -1,2 +0,0 @@
-ghc: T4255.hs:2:14-28: You can't use Template Haskell with a profiled compiler
-Usage: For basic information, try the `--help' option.
diff --git a/testsuite/tests/th/TH_import_loop/TH_import_loop.T b/testsuite/tests/th/TH_import_loop/TH_import_loop.T
index 8a4a180c28..770c75c0c8 100644
--- a/testsuite/tests/th/TH_import_loop/TH_import_loop.T
+++ b/testsuite/tests/th/TH_import_loop/TH_import_loop.T
@@ -1,6 +1,4 @@
 
-setTestOpts(when(compiler_profiled(), skip))
-
 test('TH_import_loop',
      [extra_clean(['ModuleA.o-boot', 'ModuleA.hi-boot',
                    'ModuleC.o', 'ModuleC.hi']),
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 3d08f365fa..2a040f295c 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -4,10 +4,6 @@
 # and no splices, consider adding it to the quotes/ directory instead
 # of the th/ directory; this way, we can test it on the stage 1 compiler too!
 
-# This test needs to come before the setTestOpts calls below, as we want
-# to run it if compiler_profiled.
-test('T4255', unless(compiler_profiled(), skip), compile_fail, ['-v0'])
-
 def f(name, opts):
     opts.extra_hc_opts = '-XTemplateHaskell -package template-haskell'
     if (ghc_with_interpreter == 0):
@@ -15,7 +11,6 @@ def f(name, opts):
 
 setTestOpts(f)
 setTestOpts(only_ways(['normal','ghci']))
-setTestOpts(when(compiler_profiled(), skip))
 
 test('TH_mkName', normal, compile, ['-v0'])
 test('TH_1tuple', normal, compile_fail, ['-v0'])
@@ -130,7 +125,7 @@ test('TH_linePragma', normal, compile_fail, ['-v0'])
 test('T1830_3',
      extra_clean(['T1830_3a.o','T1830_3a.hi']),
      multimod_compile_and_run,
-     ['T1830_3', '-v0'])
+     ['T1830_3', '-v0 ' + config.ghc_th_way_flags])
 test('T2700', normal, compile, ['-v0'])
 test('T2817', normal, compile, ['-v0'])
 test('T2713', normal, compile_fail, ['-v0'])
@@ -320,7 +315,8 @@ test('TH_StaticPointers02',
      compile_fail, [''])
 test('T8759', normal, compile_fail, ['-v0'])
 test('T7021',
-     extra_clean(['T7021a.hi', 'T7021a.o']), multimod_compile, ['T7021','-v0'])
+     extra_clean(['T7021a.hi', 'T7021a.o']), multimod_compile,
+     ['T7021','-v0 ' + config.ghc_th_way_flags])
 test('T8807', normal, compile, ['-v0'])
 test('T8884', normal, compile, ['-v0'])
 test('T8954', normal, compile, ['-v0'])
@@ -348,7 +344,7 @@ test('T10047', normal, ghci_script, ['T10047.script'])
 test('T10019', normal, ghci_script, ['T10019.script'])
 test('T10267', extra_clean(['T10267a.hi', 'T10267a.o']),
                multimod_compile_fail,
-               ['T10267', '-dsuppress-uniques -v0'])
+               ['T10267', '-dsuppress-uniques -v0 ' + config.ghc_th_way_flags])
 test('T10279', normal, compile_fail, ['-v0'])
 test('T10306', normal, compile, ['-v0'])
 test('T10596', normal, compile, ['-v0'])
@@ -357,7 +353,7 @@ test('T10638', normal, compile_fail, ['-v0'])
 test('T10704',
      extra_clean(['T10704a.o','T10704a.hi']),
      multimod_compile_and_run,
-     ['T10704', '-v0'])
+     ['T10704', '-v0 ' + config.ghc_th_way_flags])
 test('T6018th', normal, compile_fail, ['-v0'])
 test('TH_namePackage', normal, compile_and_run, ['-v0'])
 test('TH_nameSpace', normal, compile_and_run, ['-v0'])