X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FAsmCodeGen.lhs;h=93b385f63c632c54f4264c1f49c37ca4d44f5514;hb=9605d81c7c2fd3de0c07500a7f8a141eed89defc;hp=43eed1884eccfb9803479cb30d5554d1ebd719b1;hpb=b5d7fd266145bc09088d78e7d5dafbd45195ab31;p=ghc-hetmet.git

diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
index 43eed18..93b385f 100644
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ b/ghc/compiler/nativeGen/AsmCodeGen.lhs
@@ -111,15 +111,17 @@ The machine-dependent bits break down as follows:
 
 nativeCodeGen :: DynFlags -> [Cmm] -> UniqSupply -> IO Pretty.Doc
 nativeCodeGen dflags cmms us
-  = let ((ppr_cmms, insn_sdoc, imports), _) = initUs us $
+  = let (res, _) = initUs us $
 	   cgCmm (concat (map add_split cmms))
 
 	cgCmm :: [CmmTop] -> UniqSM (Cmm, Pretty.Doc, [CLabel])
 	cgCmm tops = 
 	   lazyMapUs (cmmNativeGen dflags) tops  `thenUs` \ results -> 
-	   let (cmms,docs,imps) = unzip3 results in
+	   case unzip3 results of { (cmms,docs,imps) ->
 	   returnUs (Cmm cmms, my_vcat docs, concat imps)
-    in do
+	   }
+    in 
+    case res of { (ppr_cmms, insn_sdoc, imports) -> do
     dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm" (pprCmms [ppr_cmms])
     return (insn_sdoc Pretty.$$ dyld_stubs imports
 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
@@ -129,6 +131,7 @@ nativeCodeGen dflags cmms us
             Pretty.$$ Pretty.text ".subsections_via_symbols"
 #endif
             )
+   }
 
   where
 
@@ -343,8 +346,14 @@ fixAssign (CmmAssign (CmmGlobal reg) src)
 
 fixAssign (CmmCall target results args vols)
   = mapAndUnzipUs fixResult results `thenUs` \ (results',stores) ->
-    returnUs (CmmCall target results' args vols : concat stores)
+    returnUs (caller_save ++
+	      CmmCall target results' args vols :
+	      caller_restore ++
+	      concat stores)
   where
+	-- we also save/restore any caller-saves STG registers here
+	(caller_save, caller_restore) = callerSaveVolatileRegs vols
+
 	fixResult g@(CmmGlobal reg,hint) = 
 	  case get_GlobalReg_reg_or_addr reg of
 		Left realreg -> returnUs (g, [])