Merge branch 'master' of http://darcs.haskell.org/ghc

17 files changed, 188 insertions, 52 deletions

diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index 843626303a..dffd417e07 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -183,6 +183,20 @@ cmmMachOpFoldM dflags mop1@(MO_Add{}) [CmmMachOp mop2@(MO_Sub{}) [arg1,arg2], ar
    | not (isLit arg1) && not (isPicReg arg1)
    = Just (cmmMachOpFold dflags mop1 [arg1, cmmMachOpFold dflags mop2 [arg3,arg2]])
 
+-- special case: (PicBaseReg + lit) + N  ==>  PicBaseReg + (lit+N)
+--
+-- this is better because lit+N is a single link-time constant (e.g. a
+-- CmmLabelOff), so the right-hand expression needs only one
+-- instruction, whereas the left needs two.  This happens when pointer
+-- tagging gives us label+offset, and PIC turns the label into
+-- PicBaseReg + label.
+--
+cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op@MO_Add{} [pic, CmmLit lit]
+                          , CmmLit (CmmInt n rep) ]
+  | isPicReg pic
+  = Just $ CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ]
+  where off = fromIntegral (narrowS rep n)
+
 -- Make a RegOff if we can
 cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
   = Just $ cmmRegOff reg (fromIntegral (narrowS rep n))
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index 0cd956ab44..aa8fa2c1f5 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -25,6 +25,7 @@ import ErrUtils
 import HscTypes
 import Control.Monad
 import Outputable
+import Platform
 
 -----------------------------------------------------------------------------
 -- | Top level driver for C-- pipeline
@@ -156,6 +157,7 @@ cpsTop hsc_env proc =
             return (cafEnv, [g])
 
   where dflags = hsc_dflags hsc_env
+        platform = targetPlatform dflags
         dump = dumpGraph dflags
         dump' = dumpWith dflags
 
@@ -177,6 +179,40 @@ cpsTop hsc_env proc =
         -- the entry point.
         splitting_proc_points = hscTarget dflags /= HscAsm
                              || not (tablesNextToCode dflags)
+                             || usingDarwinX86Pic -- Note [darwin-x86-pic]
+        usingDarwinX86Pic = platformArch platform == ArchX86
+                         && platformOS platform == OSDarwin
+                         && gopt Opt_PIC dflags
+
+{- Note [darwin-x86-pic]
+
+On x86/Darwin, PIC is implemented by inserting a sequence like
+
+    call 1f
+ 1: popl %reg
+
+at the proc entry point, and then referring to labels as offsets from
+%reg.  If we don't split proc points, then we could have many entry
+points in a proc that would need this sequence, and each entry point
+would then get a different value for %reg.  If there are any join
+points, then at the join point we don't have a consistent value for
+%reg, so we don't know how to refer to labels.
+
+Hence, on x86/Darwin, we have to split proc points, and then each proc
+point will get its own PIC initialisation sequence.
+
+This isn't an issue on x86/ELF, where the sequence is
+
+    call 1f
+ 1: popl %reg
+    addl $_GLOBAL_OFFSET_TABLE_+(.-1b), %reg
+
+so %reg always has a consistent value: the address of
+_GLOBAL_OFFSET_TABLE_, regardless of which entry point we arrived via.
+
+-}
+
+
 
 runUniqSM :: UniqSM a -> IO a
 runUniqSM m = do
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs
index 19f0155908..ddccf7ba49 100644
--- a/compiler/cmm/CmmProcPoint.hs
+++ b/compiler/cmm/CmmProcPoint.hs
@@ -234,9 +234,10 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
      --    the proc point is a callPP)
      -- Due to common blockification, we may overestimate the set of procpoints.
      let add_label map pp = mapInsert pp lbls map
-           where lbls | pp == entry = (entry_label, Just (toInfoLbl entry_label))
-                      | otherwise   = (blockLbl pp, guard (setMember pp callPPs) >> 
-                                                    Just (infoTblLbl pp))
+           where lbls | pp == entry = (entry_label, fmap cit_lbl (mapLookup entry info_tbls))
+                      | otherwise   = (block_lbl, guard (setMember pp callPPs) >>
+                                                    Just (toInfoLbl block_lbl))
+                      where block_lbl = blockLbl pp
 
          procLabels :: LabelMap (CLabel, Maybe CLabel)
          procLabels = foldl add_label mapEmpty
@@ -288,23 +289,25 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
 
      graphEnv <- foldM add_jumps emptyBlockMap $ mapToList graphEnv
 
-     let to_proc (bid, g) = case expectJust "pp label" $ mapLookup bid procLabels of
-             (lbl, Just info_lbl)
-               | bid == entry
-               -> CmmProc (TopInfo {info_tbls  = info_tbls,
-                                    stack_info = stack_info})
-                          top_l (replacePPIds g)
-               | otherwise
-               -> CmmProc (TopInfo {info_tbls = mapSingleton (g_entry g) (mkEmptyContInfoTable info_lbl), stack_info=stack_info})
-                          lbl (replacePPIds g)
-             (lbl, Nothing)
-               -> CmmProc (TopInfo {info_tbls = mapEmpty, stack_info=stack_info})
-                          lbl (replacePPIds g)
-            where
-             stack_info = StackInfo { arg_space = 0
-                                    , updfr_space =  Nothing
-                                    , do_layout = True }
-                          -- cannot use panic, this is printed by -ddump-cmmz
+     let to_proc (bid, g)
+             | bid == entry
+             =  CmmProc (TopInfo {info_tbls  = info_tbls,
+                                  stack_info = stack_info})
+                        top_l (replacePPIds g)
+             | otherwise
+             = case expectJust "pp label" $ mapLookup bid procLabels of
+                 (lbl, Just info_lbl)
+                    -> CmmProc (TopInfo { info_tbls = mapSingleton (g_entry g) (mkEmptyContInfoTable info_lbl)
+                                        , stack_info=stack_info})
+                               lbl (replacePPIds g)
+                 (lbl, Nothing)
+                    -> CmmProc (TopInfo {info_tbls = mapEmpty, stack_info=stack_info})
+                               lbl (replacePPIds g)
+                where
+                 stack_info = StackInfo { arg_space = 0
+                                        , updfr_space =  Nothing
+                                        , do_layout = True }
+                               -- cannot use panic, this is printed by -ddump-cmmz
 
          -- References to procpoint IDs can now be replaced with the
          -- infotable's label
diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs
index 6dccdabe89..ad70b96aed 100644
--- a/compiler/cmm/CmmSink.hs
+++ b/compiler/cmm/CmmSink.hs
@@ -178,7 +178,7 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
       drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets')
           where
             should_drop =  conflicts dflags a final_last
-                        || {- not (isSmall rhs) && -} live_in_multi live_sets r
+                        || not (isTrivial rhs) && live_in_multi live_sets r
                         || r `Set.member` live_in_joins
 
             live_sets' | should_drop = live_sets
@@ -205,12 +205,12 @@ isSmall (CmmLit _) = True
 isSmall (CmmMachOp (MO_Add _) [x,y]) = isTrivial x && isTrivial y
 isSmall (CmmRegOff (CmmLocal _) _) = True
 isSmall _ = False
+-}
 
 isTrivial :: CmmExpr -> Bool
 isTrivial (CmmReg (CmmLocal _)) = True
-isTrivial (CmmLit _) = True
+-- isTrivial (CmmLit _) = True
 isTrivial _ = False
--}
 
 --
 -- annotate each node with the set of registers live *after* the node
@@ -365,9 +365,8 @@ tryToInline dflags live node assigs = go usages node [] assigs
   go _usages node _skipped [] = (node, [])
 
   go usages node skipped (a@(l,rhs,_) : rest)
-   | can_inline              = inline_and_discard
-   | False {- isTiny rhs -}  = inline_and_keep
-     --  ^^ seems to make things slightly worse
+   | can_inline     = inline_and_discard
+   | isTrivial rhs  = inline_and_keep
    where
         inline_and_discard = go usages' node' skipped rest
 
@@ -464,8 +463,8 @@ conflicts dflags (r, rhs, addr) node
   -- foreign call.  See Note [foreign calls clobber GlobalRegs].
   | CmmUnsafeForeignCall{} <- node, anyCallerSavesRegs dflags rhs = True
 
-  -- (5) foreign calls clobber memory, but not heap/stack memory
-  | CmmUnsafeForeignCall{} <- node, AnyMem <- addr                = True
+  -- (5) foreign calls clobber heap: see Note [foreign calls clobber heap]
+  | CmmUnsafeForeignCall{} <- node, memConflicts addr AnyMem      = True
 
   -- (6) native calls clobber any memory
   | CmmCall{} <- node, memConflicts addr AnyMem                   = True
@@ -523,6 +522,21 @@ data AbsMem
 --  that was written in the same basic block.  To take advantage of
 --  non-aliasing of heap memory we will have to be more clever.
 
+-- Note [foreign calls clobber]
+--
+-- It is tempting to say that foreign calls clobber only
+-- non-heap/stack memory, but unfortunately we break this invariant in
+-- the RTS.  For example, in stg_catch_retry_frame we call
+-- stmCommitNestedTransaction() which modifies the contents of the
+-- TRec it is passed (this actually caused incorrect code to be
+-- generated).
+--
+-- Since the invariant is true for the majority of foreign calls,
+-- perhaps we ought to have a special annotation for calls that can
+-- modify heap/stack memory.  For now we just use the conservative
+-- definition here.
+
+
 bothMems :: AbsMem -> AbsMem -> AbsMem
 bothMems NoMem    x         = x
 bothMems x        NoMem     = x
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index f420e7d94e..d52c6a3a56 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -222,6 +222,8 @@ cmmRegOff reg byte_off = CmmRegOff reg byte_off
 cmmOffsetLit :: CmmLit -> Int -> CmmLit
 cmmOffsetLit (CmmLabel l)      byte_off = cmmLabelOff l byte_off
 cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff l (m+byte_off)
+cmmOffsetLit (CmmLabelDiffOff l1 l2 m) byte_off
+                                        = CmmLabelDiffOff l1 l2 (m+byte_off)
 cmmOffsetLit (CmmInt m rep)    byte_off = CmmInt (m + fromIntegral byte_off) rep
 cmmOffsetLit _                 byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
 
diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 0a9de800d5..3ba9c3c36a 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The University of Glasgow 2005-2006
+% (c) The University of Glasgow 2005-2012
 %
 \begin{code}
 -- | The dynamic linker for GHCi.
@@ -1239,7 +1239,7 @@ searchForLibUsingGcc dflags so dirs = do
       else return (Just file)
 
 -- ----------------------------------------------------------------------------
--- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
+-- Loading a dynamic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
 
 -- Darwin / MacOS X only: load a framework
 -- a framework is a dynamic library packaged inside a directory of the same
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 8a15e96e6a..6a2dd9c6f8 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1024,7 +1024,10 @@ wayGeneralFlags platform WayDyn =
             -- different from the current one.
             OSMinGW32 -> [Opt_PIC]
             OSDarwin  -> [Opt_PIC]
-            OSLinux   -> [Opt_PIC]
+            OSLinux   -> [Opt_PIC] -- This needs to be here for GHCi to work:
+                                   -- GHCi links objects into a .so before
+                                   -- loading the .so using the system linker.
+                                   -- Only PIC objects can be linked into a .so.
             _         -> []
 wayGeneralFlags _ WayProf     = [Opt_SccProfilingOn]
 wayGeneralFlags _ WayEventLog = []
@@ -2550,12 +2553,7 @@ defaultFlags settings
     ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
              -- The default -O0 options
 
-    ++ (case platformOS platform of
-        OSDarwin ->
-            case platformArch platform of
-            ArchX86_64         -> [Opt_PIC]
-            _                  -> []
-        _ -> [])
+    ++ default_PIC platform
 
     ++ (if pc_dYNAMIC_BY_DEFAULT (sPlatformConstants settings)
         then wayGeneralFlags platform WayDyn
@@ -2563,6 +2561,12 @@ defaultFlags settings
 
     where platform = sTargetPlatform settings
 
+default_PIC :: Platform -> [GeneralFlag]
+default_PIC platform =
+  case (platformOS platform, platformArch platform) of
+    (OSDarwin, ArchX86_64) -> [Opt_PIC]
+    _                      -> []
+
 impliedFlags :: [(ExtensionFlag, TurnOnFlag, ExtensionFlag)]
 impliedFlags
   = [ (Opt_RankNTypes,                turnOn, Opt_ExplicitForAll)
@@ -2831,7 +2835,14 @@ addWay w = do upd (\dfs -> dfs { ways = w : ways dfs })
               mapM_ setGeneralFlag $ wayGeneralFlags platform w
 
 removeWay :: Way -> DynP ()
-removeWay w = upd (\dfs -> dfs { ways = filter (w /=) (ways dfs) })
+removeWay w = do
+  upd (\dfs -> dfs { ways = filter (w /=) (ways dfs) })
+  dfs <- liftEwM getCmdLineState
+  let platform = targetPlatform dfs
+  -- XXX: wayExtras?
+  mapM_ unSetGeneralFlag $ wayGeneralFlags platform w
+  -- turn Opt_PIC back on if necessary for this platform:
+  mapM_ setGeneralFlag $ default_PIC platform
 
 --------------------------
 setGeneralFlag, unSetGeneralFlag :: GeneralFlag -> DynP ()
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 966d4e3613..3c184989b1 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -72,7 +72,13 @@ import Control.Monad    ( mplus )
 
 {-
 -----------------------------------------------------------------------------
-24 Februar 2006
+12 October 2012
+
+Conflicts: 43 shift/reduce
+           1 reduce/reduce
+
+-----------------------------------------------------------------------------
+24 February 2006
 
 Conflicts: 33 shift/reduce
            1 reduce/reduce
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 31749744e7..439430959e 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -270,6 +270,10 @@ basicKnownKeyNames
         andIntegerName, orIntegerName, xorIntegerName, complementIntegerName,
         shiftLIntegerName, shiftRIntegerName,
 
+        -- Float/Double
+        rationalToFloatName,
+        rationalToDoubleName,
+
         -- MonadFix
         monadFixClassName, mfixName,
 
@@ -932,6 +936,11 @@ floatingClassName, realFloatClassName :: Name
 floatingClassName  = clsQual  gHC_FLOAT (fsLit "Floating") floatingClassKey
 realFloatClassName = clsQual  gHC_FLOAT (fsLit "RealFloat") realFloatClassKey
 
+-- other GHC.Float functions
+rationalToFloatName, rationalToDoubleName :: Name
+rationalToFloatName  = varQual gHC_FLOAT (fsLit "rationalToFloat") rationalToFloatIdKey
+rationalToDoubleName = varQual gHC_FLOAT (fsLit "rationalToDouble") rationalToDoubleIdKey
+
 -- Class Ix
 ixClassName :: Name
 ixClassName = clsQual gHC_ARR (fsLit "Ix") ixClassKey
@@ -1614,6 +1623,10 @@ dollarIdKey           = mkPreludeMiscIdUnique 123
 coercionTokenIdKey :: Unique
 coercionTokenIdKey    = mkPreludeMiscIdUnique 124
 
+rationalToFloatIdKey, rationalToDoubleIdKey :: Unique
+rationalToFloatIdKey   = mkPreludeMiscIdUnique 130
+rationalToDoubleIdKey  = mkPreludeMiscIdUnique 131
+
 -- dotnet interop
 unmarshalObjectIdKey, marshalObjectIdKey, marshalStringIdKey,
     unmarshalStringIdKey, checkDotnetResNameIdKey :: Unique
diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index db02060b19..2ee14679b2 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -50,6 +50,7 @@ import Util
 import Control.Monad
 import Data.Bits as Bits
 import Data.Int
+import Data.Ratio
 import Data.Word
 \end{code}
 
@@ -840,6 +841,8 @@ builtinIntegerRules =
   rule_encodeFloat    "encodeDoubleInteger" encodeDoubleIntegerName mkDoubleLitDouble,
   rule_decodeDouble   "decodeDoubleInteger" decodeDoubleIntegerName,
   rule_convert        "doubleFromInteger"   doubleFromIntegerName   (\_ -> mkDoubleLitDouble),
+  rule_rationalTo     "rationalToFloat"     rationalToFloatName     mkFloatExpr,
+  rule_rationalTo     "rationalToDouble"    rationalToDoubleName    mkDoubleExpr,
   rule_binop          "gcdInteger"          gcdIntegerName          gcd,
   rule_binop          "lcmInteger"          lcmIntegerName          lcm,
   rule_binop          "andInteger"          andIntegerName          (.&.),
@@ -907,6 +910,9 @@ builtinIntegerRules =
           rule_smallIntegerTo str name primOp
            = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 1,
                            ru_try = match_smallIntegerTo primOp }
+          rule_rationalTo str name mkLit
+           = BuiltinRule { ru_name = fsLit str, ru_fn = name, ru_nargs = 2,
+                           ru_try = match_rationalTo mkLit }
 
 ---------------------------------------------------
 -- The rule is this:
@@ -1151,6 +1157,30 @@ match_Integer_Int_encodeFloat mkLit _ _ id_unf [xl,yl]
   = Just (mkLit $ encodeFloat x (fromInteger y))
 match_Integer_Int_encodeFloat _ _ _ _ _ = Nothing
 
+---------------------------------------------------
+-- constant folding for Float/Double
+--
+-- This turns
+--      rationalToFloat n d
+-- into a literal Float, and similarly for Doubles.
+--
+-- it's important to not match d == 0, because that may represent a
+-- literal "0/0" or similar, and we can't produce a literal value for
+-- NaN or +-Inf
+match_rationalTo :: RealFloat a
+                 => (a -> Expr CoreBndr)
+                 -> DynFlags
+                 -> Id
+                 -> IdUnfoldingFun
+                 -> [Expr CoreBndr]
+                 -> Maybe (Expr CoreBndr)
+match_rationalTo mkLit _ _ id_unf [xl, yl]
+  | Just (LitInteger x _) <- exprIsLiteral_maybe id_unf xl
+  , Just (LitInteger y _) <- exprIsLiteral_maybe id_unf yl
+  , y /= 0
+  = Just (mkLit (fromRational (x % y)))
+match_rationalTo _ _ _ _ _ = Nothing
+
 match_decodeDouble :: DynFlags
                    -> Id
                    -> IdUnfoldingFun
diff --git a/includes/Cmm.h b/includes/Cmm.h
index 9cb2dbce4b..2b5d93b2d1 100644
--- a/includes/Cmm.h
+++ b/includes/Cmm.h
@@ -381,6 +381,9 @@
     TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0); \
     CCCS_ALLOC(bytes);
 
+#define ALLOC_PRIM_(bytes,fun)                                  \
+    ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM(fun));
+
 #define ALLOC_PRIM_P(bytes,fun,arg)                             \
     ALLOC_PRIM_WITH_CUSTOM_FAILURE(bytes,GC_PRIM_P(fun,arg));
 
diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h
index 760a59da49..c94fdb388c 100644
--- a/includes/stg/MiscClosures.h
+++ b/includes/stg/MiscClosures.h
@@ -213,7 +213,7 @@ RTS_THUNK(stg_ap_5_upd);
 RTS_THUNK(stg_ap_6_upd);
 RTS_THUNK(stg_ap_7_upd);
 
-/* standard application routines (see also rts/gen_apply.py, 
+/* standard application routines (see also utils/genapply, 
  * and compiler/codeGen/CgStackery.lhs).
  */
 RTS_RET(stg_ap_v);
@@ -470,10 +470,10 @@ extern StgWord RTS_VAR(stable_ptr_table);
 // Profiling.c
 extern unsigned int RTS_VAR(era);
 extern unsigned int RTS_VAR(entering_PAP);
-extern StgWord      RTS_VAR(CC_LIST);               /* registered CC list */
+extern StgWord      RTS_VAR(CC_LIST);          /* registered CC list */
 extern StgWord      RTS_VAR(CCS_LIST);         /* registered CCS list */
 extern StgWord      CCS_SYSTEM[];
-extern unsigned int RTS_VAR(CC_ID);	/* global ids */
+extern unsigned int RTS_VAR(CC_ID);            /* global ids */
 extern unsigned int RTS_VAR(CCS_ID);
 
 #endif
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 6cba3f53fc..67a0a5a72a 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -252,7 +252,7 @@ stg_newMutVarzh ( gcptr init )
 {
     W_ mv;
 
-    ALLOC_PRIM (SIZEOF_StgMutVar);
+    ALLOC_PRIM_P (SIZEOF_StgMutVar, stg_newMutVarzh, init);
 
     mv = Hp - SIZEOF_StgMutVar + WDS(1);
     SET_HDR(mv,stg_MUT_VAR_DIRTY_info,CCCS);
@@ -1154,7 +1154,7 @@ stg_newMVarzh ()
 {
     W_ mvar;
 
-    ALLOC_PRIM (SIZEOF_StgMVar);
+    ALLOC_PRIM_ (SIZEOF_StgMVar, stg_newMVarzh);
   
     mvar = Hp - SIZEOF_StgMVar + WDS(1);
     SET_HDR(mvar,stg_MVAR_DIRTY_info,CCCS);
@@ -1365,7 +1365,7 @@ stg_putMVarzh ( P_ mvar, /* :: MVar a */
         ALLOC_PRIM_WITH_CUSTOM_FAILURE
             (SIZEOF_StgMVarTSOQueue,
              unlockClosure(mvar, stg_MVAR_DIRTY_info);
-             GC_PRIM_P(stg_putMVarzh, mvar));
+             GC_PRIM_PP(stg_putMVarzh, mvar, val));
 
         q = Hp - SIZEOF_StgMVarTSOQueue + WDS(1);
 
diff --git a/rts/Profiling.c b/rts/Profiling.c
index d43fc6ad54..1e7003e041 100644
--- a/rts/Profiling.c
+++ b/rts/Profiling.c
@@ -1078,8 +1078,10 @@ fprintCCS_stderr (CostCentreStack *ccs, StgClosure *exception, StgTSO *tso)
         case CONSTR_STATIC:
         case CONSTR_NOCAF_STATIC:
             desc = GET_CON_DESC(itbl_to_con_itbl(info));
-        default:
+            break;
+       default:
             desc = closure_type_names[info->type];
+            break;
         }
         fprintf(stderr, "*** Exception (reporting due to +RTS -xc): (%s), stack trace: \n  ", desc);
     }
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 9bd0b6c3ec..d44cf72400 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -459,11 +459,11 @@ run_thread:
         // conserve power (see #1623).  Re-enable it here.
         nat prev;
         prev = xchg((P_)&recent_activity, ACTIVITY_YES);
-#ifndef PROFILING
         if (prev == ACTIVITY_DONE_GC) {
+#ifndef PROFILING
             startTimer();
-        }
 #endif
+        }
         break;
     }
     case ACTIVITY_INACTIVE:
@@ -2777,7 +2777,7 @@ findRetryFrameHelper (Capability *cap, StgTSO *tso)
       
     case CATCH_RETRY_FRAME:
 	debugTrace(DEBUG_stm,
-		   "found CATCH_RETRY_FRAME at %p during retrry", p);
+                   "found CATCH_RETRY_FRAME at %p during retry", p);
         tso->stackobj->sp = p;
 	return CATCH_RETRY_FRAME;
       
diff --git a/rules/build-prog.mk b/rules/build-prog.mk
index 232844615f..6ce4d6f264 100644
--- a/rules/build-prog.mk
+++ b/rules/build-prog.mk
@@ -60,6 +60,8 @@ else ifneq "$$($1_$2_INSTALL_INPLACE)" "YES"
 $1_$2_WANT_INPLACE_WRAPPER = NO
 else ifeq "$$($1_$2_SHELL_WRAPPER)" "YES"
 $1_$2_WANT_INPLACE_WRAPPER = YES
+else ifeq "$$(DYNAMIC_BY_DEFAULT)" "YES"
+$1_$2_WANT_INPLACE_WRAPPER = YES
 else
 $1_$2_WANT_INPLACE_WRAPPER = NO
 endif
diff --git a/rules/shell-wrapper.mk b/rules/shell-wrapper.mk
index 395968a0d9..86af3ac8d5 100644
--- a/rules/shell-wrapper.mk
+++ b/rules/shell-wrapper.mk
@@ -1,6 +1,6 @@
 # -----------------------------------------------------------------------------
 #
-# (c) 2009 The University of Glasgow
+# (c) 2009-2012 The University of Glasgow
 #
 # This file is part of the GHC build system.
 #
@@ -46,9 +46,9 @@ $$(INPLACE_WRAPPER): $$($1_$2_INPLACE)
 	$$($1_$2_INPLACE_SHELL_WRAPPER_EXTRA)
 ifeq "$$(DYNAMIC_BY_DEFAULT)" "YES"
 ifeq "$$(TargetOS_CPP)" "linux"
-	echo 'export LD_LIBRARY_PATH="$$($1_$2_DEP_LIB_DIRS_SEARCHPATH)"'  >> $$@
+	echo 'export LD_LIBRARY_PATH="$$($1_$2_DEP_LIB_DIRS_SEARCHPATH):$$$$LD_LIBRARY_PATH"' >> $$@
 else ifeq "$$(TargetOS_CPP)" "darwin"
-	echo 'export DYLD_LIBRARY_PATH="$$($1_$2_DEP_LIB_DIRS_SEARCHPATH)"' >> $$@
+	echo 'export DYLD_LIBRARY_PATH="$$($1_$2_DEP_LIB_DIRS_SEARCHPATH):$$$$DYLD_LIBRARY_PATH"' >> $$@
 endif
 endif
 ifeq "$$($1_$2_SHELL_WRAPPER)" "YES"