merged master into late-dmdlate-dmd

14 files changed, 117 insertions, 92 deletions

diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 8fe8c3c874..1b86f3d6b4 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -398,13 +398,13 @@ mkConEntryLabel name        c     = IdLabel name c ConEntry
 mkStaticConEntryLabel name  c     = IdLabel name c StaticConEntry
 
 -- Constructing Cmm Labels
-mkSplitMarkerLabel, mkDirty_MUT_VAR_Label, mkUpdInfoLabel,
+mkDirty_MUT_VAR_Label, mkSplitMarkerLabel, mkUpdInfoLabel,
     mkBHUpdInfoLabel, mkIndStaticInfoLabel, mkMainCapabilityLabel,
     mkMAP_FROZEN_infoLabel, mkMAP_DIRTY_infoLabel,
     mkEMPTY_MVAR_infoLabel, mkTopTickyCtrLabel,
     mkCAFBlackHoleInfoTableLabel, mkCAFBlackHoleEntryLabel :: CLabel
+mkDirty_MUT_VAR_Label           = mkForeignLabel (fsLit "dirty_MUT_VAR") Nothing ForeignLabelInExternalPackage IsFunction
 mkSplitMarkerLabel              = CmmLabel rtsPackageId (fsLit "__stg_split_marker")    CmmCode
-mkDirty_MUT_VAR_Label           = CmmLabel rtsPackageId (fsLit "dirty_MUT_VAR")         CmmCode
 mkUpdInfoLabel                  = CmmLabel rtsPackageId (fsLit "stg_upd_frame")         CmmInfo
 mkBHUpdInfoLabel                = CmmLabel rtsPackageId (fsLit "stg_bh_upd_frame" )     CmmInfo
 mkIndStaticInfoLabel            = CmmLabel rtsPackageId (fsLit "stg_IND_STATIC")        CmmInfo
@@ -837,13 +837,13 @@ idInfoLabelType info =
 -- @labelDynamic@ returns @True@ if the label is located
 -- in a DLL, be it a data reference or not.
 
-labelDynamic :: DynFlags -> PackageId -> CLabel -> Bool
-labelDynamic dflags this_pkg lbl =
+labelDynamic :: DynFlags -> PackageId -> Module -> CLabel -> Bool
+labelDynamic dflags this_pkg this_mod lbl =
   case lbl of
    -- is the RTS in a DLL or not?
    RtsLabel _           -> not (gopt Opt_Static dflags) && (this_pkg /= rtsPackageId)
 
-   IdLabel n _ _        -> isDllName dflags this_pkg n
+   IdLabel n _ _        -> isDllName dflags this_pkg this_mod n
 
    -- When compiling in the "dyn" way, each package is to be linked into
    -- its own shared library.
@@ -1030,9 +1030,9 @@ pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> ptext (sLit "_fast")
 
 pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
   = hcat [ptext (sLit "stg_sel_"), text (show offset),
-                ptext (if upd_reqd
-                        then (sLit "_upd_info")
-                        else (sLit "_noupd_info"))
+          ptext (if upd_reqd
+                 then (sLit "_upd_info")
+                 else (sLit "_noupd_info"))
         ]
 
 pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
diff --git a/compiler/cmm/CmmCallConv.hs b/compiler/cmm/CmmCallConv.hs
index 1546dd4a60..eeca0b4a54 100644
--- a/compiler/cmm/CmmCallConv.hs
+++ b/compiler/cmm/CmmCallConv.hs
@@ -70,10 +70,10 @@ assignArgumentsPos dflags off conv arg_ty reps = (stk_off, assignments)
               float = case (w, regs) of
                         (W32, (vs, fs, ds, ls, s:ss)) -> k (RegisterParam (FloatReg s), (vs, fs, ds, ls, ss))
                         (W32, (vs, f:fs, ds, ls, ss))
-                            | not hasSseRegs          -> k (RegisterParam f, (vs, fs, ds, ls, ss))
+                            | not hasXmmRegs          -> k (RegisterParam f, (vs, fs, ds, ls, ss))
                         (W64, (vs, fs, ds, ls, s:ss)) -> k (RegisterParam (DoubleReg s), (vs, fs, ds, ls, ss))
                         (W64, (vs, fs, d:ds, ls, ss))
-                            | not hasSseRegs          -> k (RegisterParam d, (vs, fs, ds, ls, ss))
+                            | not hasXmmRegs          -> k (RegisterParam d, (vs, fs, ds, ls, ss))
                         (W80, _) -> panic "F80 unsupported register type"
                         _ -> (assts, (r:rs))
               int = case (w, regs) of
@@ -88,7 +88,7 @@ assignArgumentsPos dflags off conv arg_ty reps = (stk_off, assignments)
               w  = typeWidth ty
               gcp | isGcPtrType ty = VGcPtr
                   | otherwise      = VNonGcPtr
-              hasSseRegs = mAX_Real_SSE_REG dflags /= 0
+              hasXmmRegs = mAX_Real_XMM_REG dflags /= 0
 
 
 assignStack :: DynFlags -> ByteOff -> (a -> CmmType) -> [a]
@@ -113,7 +113,7 @@ type AvailRegs = ( [VGcPtr -> GlobalReg]   -- available vanilla regs.
                  , [GlobalReg]   -- floats
                  , [GlobalReg]   -- doubles
                  , [GlobalReg]   -- longs (int64 and word64)
-                 , [Int]         -- SSE (floats and doubles)
+                 , [Int]         -- XMM (floats and doubles)
                  )
 
 -- Vanilla registers can contain pointers, Ints, Chars.
@@ -128,7 +128,7 @@ getRegsWithoutNode dflags =
   , realFloatRegs dflags
   , realDoubleRegs dflags
   , realLongRegs dflags
-  , sseRegNos dflags)
+  , realXmmRegNos dflags)
 
 -- getRegsWithNode uses R1/node even if it isn't a register
 getRegsWithNode dflags =
@@ -138,28 +138,27 @@ getRegsWithNode dflags =
   , realFloatRegs dflags
   , realDoubleRegs dflags
   , realLongRegs dflags
-  , sseRegNos dflags)
+  , realXmmRegNos dflags)
 
 allFloatRegs, allDoubleRegs, allLongRegs :: DynFlags -> [GlobalReg]
 allVanillaRegs :: DynFlags -> [VGcPtr -> GlobalReg]
-allSseRegs :: DynFlags -> [Int]
+allXmmRegs :: DynFlags -> [Int]
 
 allVanillaRegs dflags = map VanillaReg $ regList (mAX_Vanilla_REG dflags)
 allFloatRegs   dflags = map FloatReg   $ regList (mAX_Float_REG   dflags)
 allDoubleRegs  dflags = map DoubleReg  $ regList (mAX_Double_REG  dflags)
 allLongRegs    dflags = map LongReg    $ regList (mAX_Long_REG    dflags)
-allSseRegs     dflags =                  regList (mAX_SSE_REG     dflags)
+allXmmRegs     dflags =                  regList (mAX_XMM_REG     dflags)
 
 realFloatRegs, realDoubleRegs, realLongRegs :: DynFlags -> [GlobalReg]
 realVanillaRegs :: DynFlags -> [VGcPtr -> GlobalReg]
+realXmmRegNos :: DynFlags -> [Int]
 
 realVanillaRegs dflags = map VanillaReg $ regList (mAX_Real_Vanilla_REG dflags)
 realFloatRegs   dflags = map FloatReg   $ regList (mAX_Real_Float_REG   dflags)
 realDoubleRegs  dflags = map DoubleReg  $ regList (mAX_Real_Double_REG  dflags)
 realLongRegs    dflags = map LongReg    $ regList (mAX_Real_Long_REG    dflags)
-
-sseRegNos :: DynFlags -> [Int]
-sseRegNos dflags =regList (mAX_SSE_REG dflags)
+realXmmRegNos   dflags =                  regList (mAX_Real_XMM_REG     dflags)
 
 regList :: Int -> [Int]
 regList n = [1 .. n]
@@ -169,7 +168,7 @@ allRegs dflags = (allVanillaRegs dflags,
                   allFloatRegs dflags,
                   allDoubleRegs dflags,
                   allLongRegs dflags,
-                  allSseRegs dflags)
+                  allXmmRegs dflags)
 
 nodeOnly :: AvailRegs
 nodeOnly = ([VanillaReg 1], [], [], [], [])
@@ -187,7 +186,7 @@ globalArgRegs dflags = map ($ VGcPtr) (allVanillaRegs dflags) ++
 -- only use this functionality in hand-written C-- code in the RTS.
 realArgRegsCover :: DynFlags -> [GlobalReg]
 realArgRegsCover dflags
-    | hasSseRegs = map ($VGcPtr) (realVanillaRegs dflags) ++
+    | hasXmmRegs = map ($VGcPtr) (realVanillaRegs dflags) ++
                    realDoubleRegs dflags ++
                    realLongRegs dflags
     | otherwise  = map ($VGcPtr) (realVanillaRegs dflags) ++
@@ -195,4 +194,4 @@ realArgRegsCover dflags
                    realDoubleRegs dflags ++
                    realLongRegs dflags
   where
-    hasSseRegs = mAX_Real_SSE_REG dflags /= 0
+    hasXmmRegs = mAX_Real_XMM_REG dflags /= 0
diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs
index 6312fb9c50..34e22cecfb 100644
--- a/compiler/cmm/CmmCommonBlockElim.hs
+++ b/compiler/cmm/CmmCommonBlockElim.hs
@@ -96,7 +96,7 @@ hash_block block =
         hash_node (CmmBranch _) = 23 -- NB. ignore the label
         hash_node (CmmCondBranch p _ _) = hash_e p
         hash_node (CmmCall e _ _ _ _ _) = hash_e e
-        hash_node (CmmForeignCall t _ _ _ _ _) = hash_tgt t
+        hash_node (CmmForeignCall t _ _ _ _ _ _) = hash_tgt t
         hash_node (CmmSwitch e _) = hash_e e
 
         hash_reg :: CmmReg -> Word32
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index a48d48742d..2b2dccdaed 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -6,13 +6,13 @@ module CmmLayoutStack (
 import StgCmmUtils      ( callerSaveVolatileRegs ) -- XXX layering violation
 import StgCmmForeign    ( saveThreadState, loadThreadState ) -- XXX layering violation
 
+import BasicTypes
 import Cmm
 import CmmInfo
 import BlockId
 import CLabel
 import CmmUtils
 import MkGraph
-import Module
 import ForeignCall
 import CmmLive
 import CmmProcPoint
@@ -264,7 +264,7 @@ collectContInfo blocks
         CmmCall { cml_cont = Just l, .. }
            -> (Just (l, cml_ret_args), cml_ret_off)
         CmmForeignCall { .. }
-           -> (Just (succ, 0), updfr) -- ??
+           -> (Just (succ, ret_args), ret_off)
         _other -> (Nothing, 0)
 
 
@@ -346,8 +346,8 @@ handleLastNode dflags procpoints liveness cont_info stackmaps
        return $ lastCall cont_lbl cml_args cml_ret_args cml_ret_off
 
     CmmForeignCall{ succ = cont_lbl, .. } -> do
-       return $ lastCall cont_lbl (wORD_SIZE dflags) (wORD_SIZE dflags) (sm_ret_off stack0)
-            -- one word each for args and results: the return address
+       return $ lastCall cont_lbl (wORD_SIZE dflags) ret_args ret_off
+            -- one word of args: the return address
 
     CmmBranch{..}     ->  handleBranches
     CmmCondBranch{..} ->  handleBranches
@@ -932,9 +932,10 @@ lowerSafeForeignCall dflags block
                   caller_load <*>
                   loadThreadState dflags load_tso load_stack
 
-        (ret_args, regs, copyout) = copyOutOflow dflags NativeReturn Jump (Young succ)
-                                           (map (CmmReg . CmmLocal) res)
-                                           updfr []
+        (_, regs, copyout) =
+             copyOutOflow dflags NativeReturn Jump (Young succ)
+                            (map (CmmReg . CmmLocal) res)
+                            ret_off []
 
         -- NB. after resumeThread returns, the top-of-stack probably contains
         -- the stack frame for succ, but it might not: if the current thread
@@ -947,7 +948,7 @@ lowerSafeForeignCall dflags block
                        , cml_args_regs = regs
                        , cml_args      = widthInBytes (wordWidth dflags)
                        , cml_ret_args  = ret_args
-                       , cml_ret_off   = updfr }
+                       , cml_ret_off   = ret_off }
 
     graph' <- lgraphOfAGraph $ suspend <*>
                                midCall <*>
@@ -965,7 +966,7 @@ lowerSafeForeignCall dflags block
 
 
 foreignLbl :: FastString -> CmmExpr
-foreignLbl name = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId name))
+foreignLbl name = CmmLit (CmmLabel (mkForeignLabel name Nothing ForeignLabelInExternalPackage IsFunction))
 
 newTemp :: CmmType -> UniqSM LocalReg
 newTemp rep = getUniqueM >>= \u -> return (LocalReg u rep)
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index da7b094643..92a137b98b 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -178,7 +178,7 @@ lintCmmLast labels node = case node of
           _ <- lintCmmExpr target
           maybe (return ()) checkTarget cont
 
-  CmmForeignCall tgt _ args succ _ _ -> do
+  CmmForeignCall tgt _ args succ _ _ _ -> do
           lintTarget tgt
           mapM_ lintCmmExpr args
           checkTarget succ
diff --git a/compiler/cmm/CmmMachOp.hs b/compiler/cmm/CmmMachOp.hs
index fae84e5d53..8d42bbd2cb 100644
--- a/compiler/cmm/CmmMachOp.hs
+++ b/compiler/cmm/CmmMachOp.hs
@@ -529,6 +529,7 @@ data CallishMachOp
   | MO_Memmove
 
   | MO_PopCnt Width
+  | MO_BSwap Width
   deriving (Eq, Show)
 
 pprCallishMachOp :: CallishMachOp -> SDoc
diff --git a/compiler/cmm/CmmNode.hs b/compiler/cmm/CmmNode.hs
index 61c0b80179..47811bcd7f 100644
--- a/compiler/cmm/CmmNode.hs
+++ b/compiler/cmm/CmmNode.hs
@@ -4,13 +4,6 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module CmmNode (
      CmmNode(..), CmmFormal, CmmActual,
      UpdFrameOffset, Convention(..),
@@ -50,13 +43,13 @@ data CmmNode e x where
     -- Assign to memory location.  Size is
     -- given by cmmExprType of the rhs.
 
-  CmmUnsafeForeignCall ::         -- An unsafe foreign call;
-                                  -- see Note [Foreign calls]
-  		       		  -- Like a "fat machine instruction"; can occur
-				  -- in the middle of a block
-      ForeignTarget ->            -- call target
-      [CmmFormal] ->               -- zero or more results
-      [CmmActual] ->               -- zero or more arguments
+  CmmUnsafeForeignCall ::       -- An unsafe foreign call;
+                                -- see Note [Foreign calls]
+                                -- Like a "fat machine instruction"; can occur
+                                -- in the middle of a block
+      ForeignTarget ->          -- call target
+      [CmmFormal] ->            -- zero or more results
+      [CmmActual] ->            -- zero or more arguments
       CmmNode O O
       -- Semantics: clobbers any GlobalRegs for which callerSaves r == True
       -- See Note [foreign calls clobber GlobalRegs]
@@ -124,12 +117,13 @@ data CmmNode e x where
   } -> CmmNode O C
 
   CmmForeignCall :: {           -- A safe foreign call; see Note [Foreign calls]
-  		    		-- Always the last node of a block
+                                -- Always the last node of a block
       tgt   :: ForeignTarget,   -- call target and convention
       res   :: [CmmFormal],     -- zero or more results
       args  :: [CmmActual],     -- zero or more arguments; see Note [Register parameter passing]
       succ  :: ULabel,          -- Label of continuation
-      updfr :: UpdFrameOffset,  -- where the update frame is (for building infotable)
+      ret_args :: ByteOff,      -- same as cml_ret_args
+      ret_off :: ByteOff,       -- same as cml_ret_off
       intrbl:: Bool             -- whether or not the call is interruptible
   } -> CmmNode O C
 
@@ -143,14 +137,14 @@ instruction".  In particular, they do *not* kill all live registers,
 just the registers they return to (there was a bit of code in GHC that
 conservatively assumed otherwise.)  However, see [Register parameter passing].
 
-Safe ones are trickier.  A safe foreign call 
+Safe ones are trickier.  A safe foreign call
      r = f(x)
 ultimately expands to
-     push "return address"	-- Never used to return to; 
-     	  	  		-- just points an info table
+     push "return address"      -- Never used to return to;
+                                -- just points an info table
      save registers into TSO
      call suspendThread
-     r = f(x)			-- Make the call
+     r = f(x)                   -- Make the call
      call resumeThread
      restore registers
      pop "return address"
@@ -354,7 +348,7 @@ instance DefinerOfRegs GlobalReg (CmmNode e x) where
 -----------------------------------
 -- mapping Expr in CmmNode
 
-mapForeignTarget :: (CmmExpr -> CmmExpr) -> ForeignTarget -> ForeignTarget 
+mapForeignTarget :: (CmmExpr -> CmmExpr) -> ForeignTarget -> ForeignTarget
 mapForeignTarget exp   (ForeignTarget e c) = ForeignTarget (exp e) c
 mapForeignTarget _   m@(PrimTarget _)      = m
 
@@ -374,7 +368,7 @@ mapExp _ l@(CmmBranch _)                         = l
 mapExp f   (CmmCondBranch e ti fi)               = CmmCondBranch (f e) ti fi
 mapExp f   (CmmSwitch e tbl)                     = CmmSwitch (f e) tbl
 mapExp f   n@CmmCall {cml_target=tgt}            = n{cml_target = f tgt}
-mapExp f   (CmmForeignCall tgt fs as succ updfr intrbl) = CmmForeignCall (mapForeignTarget f tgt) fs (map f as) succ updfr intrbl
+mapExp f   (CmmForeignCall tgt fs as succ ret_args updfr intrbl) = CmmForeignCall (mapForeignTarget f tgt) fs (map f as) succ ret_args updfr intrbl
 
 mapExpDeep :: (CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
 mapExpDeep f = mapExp $ wrapRecExp f
@@ -404,10 +398,10 @@ mapExpM f (CmmUnsafeForeignCall tgt fs as)
     = case mapForeignTargetM f tgt of
         Just tgt' -> Just (CmmUnsafeForeignCall tgt' fs (mapListJ f as))
         Nothing   -> (\xs -> CmmUnsafeForeignCall tgt fs xs) `fmap` mapListM f as
-mapExpM f (CmmForeignCall tgt fs as succ updfr intrbl)
+mapExpM f (CmmForeignCall tgt fs as succ ret_args updfr intrbl)
     = case mapForeignTargetM f tgt of
-        Just tgt' -> Just (CmmForeignCall tgt' fs (mapListJ f as) succ updfr intrbl)
-        Nothing   -> (\xs -> CmmForeignCall tgt fs xs succ updfr intrbl) `fmap` mapListM f as
+        Just tgt' -> Just (CmmForeignCall tgt' fs (mapListJ f as) succ ret_args updfr intrbl)
+        Nothing   -> (\xs -> CmmForeignCall tgt fs xs succ ret_args updfr intrbl) `fmap` mapListM f as
 
 -- share as much as possible
 mapListM :: (a -> Maybe a) -> [a] -> Maybe [a]
@@ -430,7 +424,7 @@ mapExpDeepM f = mapExpM $ wrapRecExpM f
 -----------------------------------
 -- folding Expr in CmmNode
 
-foldExpForeignTarget :: (CmmExpr -> z -> z) -> ForeignTarget -> z -> z 
+foldExpForeignTarget :: (CmmExpr -> z -> z) -> ForeignTarget -> z -> z
 foldExpForeignTarget exp (ForeignTarget e _) z = exp e z
 foldExpForeignTarget _   (PrimTarget _)      z = z
 
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index cb3bf0c829..8c36deafbb 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -557,7 +557,7 @@ stmt    :: { CmmParse () }
         -- we tweak the syntax to avoid the conflict.  The later
         -- option is taken here because the other way would require
         -- multiple levels of expanding and get unwieldy.
-        | foreign_results 'foreign' STRING expr '(' cmm_hint_exprs0 ')' safety opt_never_returns ';'
+        | foreign_results 'foreign' STRING foreignLabel '(' cmm_hint_exprs0 ')' safety opt_never_returns ';'
                 {% foreignCall $3 $1 $4 $6 $8 $9 }
         | foreign_results 'prim' '%' NAME '(' exprs0 ')' ';'
                 {% primCall $1 $4 $6 }
@@ -588,6 +588,9 @@ stmt    :: { CmmParse () }
         | 'push' '(' exprs0 ')' maybe_body
                 { pushStackFrame $3 $5 }
 
+foreignLabel     :: { CmmParse CmmExpr }
+        : NAME                          { return (CmmLit (CmmLabel (mkForeignLabel $1 Nothing ForeignLabelInThisPackage IsFunction))) }
+
 opt_never_returns :: { CmmReturnInfo }
         :                               { CmmMayReturn }
         | 'never' 'returns'             { CmmNeverReturns }
@@ -1002,8 +1005,7 @@ stmtMacros = listToUFM [
                                         tickyAllocPAP goods slop ),
   ( fsLit "TICK_ALLOC_UP_THK",     \[goods,slop] ->
                                         tickyAllocThunk goods slop ),
-  ( fsLit "UPD_BH_UPDATABLE",      \[reg] -> emitBlackHoleCode False reg ),
-  ( fsLit "UPD_BH_SINGLE_ENTRY",   \[reg] -> emitBlackHoleCode True  reg )
+  ( fsLit "UPD_BH_UPDATABLE",      \[reg] -> emitBlackHoleCode reg )
  ]
 
 emitPushUpdateFrame :: CmmExpr -> CmmExpr -> FCode ()
diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs
index 5e9bca30e3..50d02de04e 100644
--- a/compiler/cmm/CmmPipeline.hs
+++ b/compiler/cmm/CmmPipeline.hs
@@ -70,7 +70,7 @@ cpsTop hsc_env proc =
        ----------- Eliminate common blocks -------------------------------------
        g <- {-# SCC "elimCommonBlocks" #-}
             condPass Opt_CmmElimCommonBlocks elimCommonBlocks g
-                     Opt_D_dump_cmm_cbe "Post common block elimination"
+                          Opt_D_dump_cmm_cbe "Post common block elimination"
 
        -- Any work storing block Labels must be performed _after_
        -- elimCommonBlocks
diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs
index 2a080c2e58..9f8a3975e7 100644
--- a/compiler/cmm/CmmSink.hs
+++ b/compiler/cmm/CmmSink.hs
@@ -390,7 +390,7 @@ tryToInline dflags live node assigs = go usages node [] assigs
         occurs_once = not (l `elemRegSet` live)
                       && lookupUFM usages l == Just 1
 
-        inl_node = mapExpDeep inline node
+        inl_node = mapExpDeep inline node   -- mapExpDeep is where the inlining actually takes place!
            where inline (CmmReg    (CmmLocal l'))     | l == l' = rhs
                  inline (CmmRegOff (CmmLocal l') off) | l == l'
                     = cmmOffset dflags rhs off
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index 78e5562d81..a5acffb2f7 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -424,7 +424,7 @@ ofBlockMap entry bodyMap = CmmGraph {g_entry=entry, g_graph=GMany NothingO bodyM
 
 insertBlock :: CmmBlock -> BlockEnv CmmBlock -> BlockEnv CmmBlock
 insertBlock block map =
-  ASSERT (isNothing $ mapLookup id map)
+  ASSERT(isNothing $ mapLookup id map)
   mapInsert id block map
   where id = entryLabel block
 
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 45c415f35a..b0c9bd3f2f 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -189,7 +189,6 @@ pprStmt stmt =
           rep = cmmExprType dflags src
 
     CmmUnsafeForeignCall target@(ForeignTarget fn conv) results args ->
-        maybe_proto $$
         fnCall
         where
         (res_hints, arg_hints) = foreignTargetHints target
@@ -200,40 +199,29 @@ pprStmt stmt =
 
         cast_fn = parens (cCast (pprCFunType (char '*') cconv hresults hargs) fn)
 
-        real_fun_proto lbl = char ';' <>
-                        pprCFunType (ppr lbl) cconv hresults hargs <>
-                        noreturn_attr <> semi
-
-        noreturn_attr = case ret of
-                          CmmNeverReturns -> text "__attribute__ ((noreturn))"
-                          CmmMayReturn    -> empty
-
         -- See wiki:Commentary/Compiler/Backends/PprC#Prototypes
-        (maybe_proto, fnCall) =
+        fnCall =
             case fn of
               CmmLit (CmmLabel lbl)
                 | StdCallConv <- cconv ->
-                    let myCall = pprCall (ppr lbl) cconv hresults hargs
-                    in (real_fun_proto lbl, myCall)
+                    pprCall (ppr lbl) cconv hresults hargs
                         -- stdcall functions must be declared with
                         -- a function type, otherwise the C compiler
                         -- doesn't add the @n suffix to the label.  We
                         -- can't add the @n suffix ourselves, because
                         -- it isn't valid C.
                 | CmmNeverReturns <- ret ->
-                    let myCall = pprCall (ppr lbl) cconv hresults hargs
-                    in (real_fun_proto lbl, myCall)
+                    pprCall cast_fn cconv hresults hargs <> semi
                 | not (isMathFun lbl) ->
                     pprForeignCall (ppr lbl) cconv hresults hargs
               _ ->
-                   (empty {- no proto -},
-                    pprCall cast_fn cconv hresults hargs <> semi)
+                    pprCall cast_fn cconv hresults hargs <> semi
                         -- for a dynamic call, no declaration is necessary.
 
     CmmUnsafeForeignCall (PrimTarget MO_Touch) _results _args -> empty
 
     CmmUnsafeForeignCall target@(PrimTarget op) results args ->
-        proto $$ fn_call
+        fn_call
       where
         cconv = CCallConv
         fn = pprCallishMachOp_for_C op
@@ -242,15 +230,16 @@ pprStmt stmt =
         hresults = zip results res_hints
         hargs    = zip args arg_hints
 
-        (proto, fn_call)
+        fn_call
           -- The mem primops carry an extra alignment arg, must drop it.
           -- We could maybe emit an alignment directive using this info.
           -- We also need to cast mem primops to prevent conflicts with GCC
           -- builtins (see bug #5967).
           | op `elem` [MO_Memcpy, MO_Memset, MO_Memmove]
-          = pprForeignCall fn cconv hresults (init hargs)
+          = (ptext (sLit ";EF_(") <> fn <> char ')' <> semi) $$
+            pprForeignCall fn cconv hresults (init hargs)
           | otherwise
-          = (empty, pprCall fn cconv hresults hargs)
+          = pprCall fn cconv hresults hargs
 
     CmmBranch ident          -> pprBranch ident
     CmmCondBranch expr yes no -> pprCondBranch expr yes no
@@ -263,8 +252,8 @@ pprStmt stmt =
 type Hinted a = (a, ForeignHint)
 
 pprForeignCall :: SDoc -> CCallConv -> [Hinted CmmFormal] -> [Hinted CmmActual]
-               -> (SDoc, SDoc)
-pprForeignCall fn cconv results args = (proto, fn_call)
+               -> SDoc
+pprForeignCall fn cconv results args = fn_call
   where
     fn_call = braces (
                  pprCFunType (char '*' <> text "ghcFunPtr") cconv results args <> semi
@@ -272,7 +261,6 @@ pprForeignCall fn cconv results args = (proto, fn_call)
               $$ pprCall (text "ghcFunPtr") cconv results args <> semi
              )
     cast_fn = parens (parens (pprCFunType (char '*') cconv results args) <> fn)
-    proto = ptext (sLit ";EF_(") <> fn <> char ')' <> semi
 
 pprCFunType :: SDoc -> CCallConv -> [Hinted CmmFormal] -> [Hinted CmmActual] -> SDoc
 pprCFunType ppr_fn cconv ress args
@@ -750,6 +738,7 @@ pprCallishMachOp_for_C mop
         MO_Memcpy       -> ptext (sLit "memcpy")
         MO_Memset       -> ptext (sLit "memset")
         MO_Memmove      -> ptext (sLit "memmove")
+        (MO_BSwap w)    -> ptext (sLit $ bSwapLabel w)
         (MO_PopCnt w)   -> ptext (sLit $ popCntLabel w)
         (MO_UF_Conv w)  -> ptext (sLit $ word2FloatLabel w)
 
diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index f3e2a02737..46257b4188 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -247,14 +247,15 @@ pprNode node = pp_node <+> pp_debug
                   | Just r <- k = ptext (sLit "returns to") <+> ppr r <> comma
                   | otherwise   = empty
 
-      CmmForeignCall {tgt=t, res=rs, args=as, succ=s, updfr=u, intrbl=i} ->
+      CmmForeignCall {tgt=t, res=rs, args=as, succ=s, ret_args=a, ret_off=u, intrbl=i} ->
           hcat $ if i then [ptext (sLit "interruptible"), space] else [] ++
                [ ptext (sLit "foreign call"), space
                , ppr t, ptext (sLit "(...)"), space
                , ptext (sLit "returns to") <+> ppr s
                     <+> ptext (sLit "args:") <+> parens (ppr as)
                     <+> ptext (sLit "ress:") <+> parens (ppr rs)
-               , ptext (sLit "upd:") <+> ppr u
+               , ptext (sLit "ret_args:") <+> ppr a
+               , ptext (sLit "ret_off:") <+> ppr u
                , semi ]
 
     pp_debug :: SDoc
diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs
index 6f569ef6fa..c54f6d5f9d 100644
--- a/compiler/cmm/SMRep.lhs
+++ b/compiler/cmm/SMRep.lhs
@@ -16,6 +16,11 @@ module SMRep (
         WordOff, ByteOff,
         roundUpToWords,
 
+#if __GLASGOW_HASKELL__ > 706
+        -- ** Immutable arrays of StgWords
+        UArrayStgWord, listArray, toByteArray,
+#endif
+
         -- * Closure repesentation
         SMRep(..), -- CmmInfo sees the rep; no one else does
         IsStatic,
@@ -49,8 +54,13 @@ import DynFlags
 import Outputable
 import Platform
 import FastString
+import qualified Data.Array.Base as Array
+
+#if __GLASGOW_HASKELL__ > 706
+import GHC.Base ( ByteArray# )
+import Data.Ix
+#endif
 
-import Data.Array.Base
 import Data.Char( ord )
 import Data.Word
 import Data.Bits
@@ -80,7 +90,11 @@ newtype StgWord = StgWord Word64
 #if __GLASGOW_HASKELL__ < 706
               Num,
 #endif
-              Bits, IArray UArray)
+
+#if __GLASGOW_HASKELL__ <= 706
+              Array.IArray Array.UArray,
+#endif
+              Bits)
 
 fromStgWord :: StgWord -> Integer
 fromStgWord (StgWord i) = toInteger i
@@ -125,6 +139,30 @@ hALF_WORD_SIZE_IN_BITS :: DynFlags -> Int
 hALF_WORD_SIZE_IN_BITS dflags = platformWordSize (targetPlatform dflags) `shiftL` 2
 \end{code}
 
+%************************************************************************
+%*                                                                      *
+                Immutable arrays of StgWords
+%*                                                                      *
+%************************************************************************
+
+\begin{code}
+
+#if __GLASGOW_HASKELL__ > 706
+-- TODO: Improve with newtype coercions!
+
+newtype UArrayStgWord i = UArrayStgWord (Array.UArray i Word64)
+
+listArray :: Ix i => (i, i) -> [StgWord] -> UArrayStgWord i
+listArray (i,j) words
+  = UArrayStgWord $ Array.listArray (i,j) (map unStgWord words)
+  where unStgWord (StgWord w64) = w64
+
+toByteArray :: UArrayStgWord i -> ByteArray#
+toByteArray (UArrayStgWord (Array.UArray _ _ _ b)) = b
+
+#endif
+
+\end{code}
 
 %************************************************************************
 %*                                                                      *