X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FCgForeignCall.hs;h=8e8e34d77bbe440785b8727b5a3064feef12c050;hb=2d367f855c3556166d24cf538d5c34d0ff596a2f;hp=879d04332949709de68a82fbdca58bacf0539170;hpb=7854ec4b11e117f8514553890851d14a66690fbb;p=ghc-hetmet.git

diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 879d043..8e8e34d 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -78,16 +78,9 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
   where
       (call_args, cmm_target)
 	= case target of
-
-	   -- A target label known to be in the current package.
-	   StaticTarget lbl 
-	    -> ( args
-	       , CmmLit (CmmLabel 
-			(mkForeignLabel lbl call_size ForeignLabelInThisPackage IsFunction)))
-
 	   -- If the packageId is Nothing then the label is taken to be in the
 	   --	package currently being compiled.
-	   PackageTarget lbl mPkgId
+	   StaticTarget lbl mPkgId
 	    -> let labelSource 
 	    		= case mPkgId of
 				Nothing		-> ForeignLabelInThisPackage
@@ -129,9 +122,10 @@ emitForeignCall' safety results target args vols _srt ret
   | not (playSafe safety) = do
     temp_args <- load_args_into_temps args
     let (caller_save, caller_load) = callerSaveVolatileRegs vols
+    let caller_load' = if ret == CmmNeverReturns then [] else caller_load
     stmtsC caller_save
     stmtC (CmmCall target results temp_args CmmUnsafe ret)
-    stmtsC caller_load
+    stmtsC caller_load'
 
   | otherwise = do
     -- Both 'id' and 'new_base' are GCKindNonPtr because they're
@@ -150,7 +144,8 @@ emitForeignCall' safety results target args vols _srt ret
     -- to this sequence of three CmmUnsafe calls.
     stmtC (CmmCall (CmmCallee suspendThread CCallConv) 
 			[ CmmHinted id AddrHint ]
-			[ CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint ] 
+			[ CmmHinted (CmmReg (CmmGlobal BaseReg)) AddrHint
+			, CmmHinted (CmmLit (CmmInt (fromIntegral (fromEnum (playInterruptible safety))) wordWidth)) NoHint]
 			CmmUnsafe ret)
     stmtC (CmmCall temp_target results temp_args CmmUnsafe ret)
     stmtC (CmmCall (CmmCallee resumeThread CCallConv)