X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcodeGen%2FCgForeignCall.hs;h=ce689c42f79c9e81b785c25f7bf8f471e3d63e9e;hp=593de4e829577f1e7a841c0652b15d7419f0e57f;hb=49a8e5c021009430d373d6224b29004c7d18c408;hpb=984a288119983912d40a80845c674ee4b83a19ce

diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 593de4e..ce689c4 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -33,6 +33,7 @@ import ClosureInfo
 import Constants
 import StaticFlags
 import Outputable
+import Module
 import FastString
 import BasicTypes
 
@@ -77,8 +78,20 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
   where
       (call_args, cmm_target)
 	= case target of
-	   StaticTarget lbl -> (args, CmmLit (CmmLabel 
-					(mkForeignLabel lbl call_size False IsFunction)))
+	   -- If the packageId is Nothing then the label is taken to be in the
+	   --	package currently being compiled.
+	   StaticTarget lbl mPkgId
+	    -> let labelSource 
+	    		= case mPkgId of
+				Nothing		-> ForeignLabelInThisPackage
+				Just pkgId	-> ForeignLabelInPackage pkgId
+	       in ( args
+	          , CmmLit (CmmLabel 
+			   	(mkForeignLabel lbl call_size labelSource IsFunction)))
+
+	   -- A label imported with "foreign import ccall "dynamic" ..."
+	   --	Note: "dynamic" here doesn't mean "dynamic library".
+	   --	Read the FFI spec for details.
 	   DynamicTarget    ->  case args of
 	                        (CmmHinted fn _):rest -> (rest, fn)
 	                        [] -> panic "emitForeignCall: DynamicTarget []"
@@ -109,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
@@ -144,8 +158,8 @@ emitForeignCall' safety results target args vols _srt ret
     emitLoadThreadState
 
 suspendThread, resumeThread :: CmmExpr
-suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "suspendThread")))
-resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel (fsLit "resumeThread")))
+suspendThread = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "suspendThread")))
+resumeThread  = CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "resumeThread")))
 
 
 -- we might need to load arguments into temporaries before