X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FcodeGen%2FStgCmmForeign.hs;h=7ddf597f4036f40fc5383277b3eeb1eb5bdb99e3;hb=f30d527344db528618f64a25250a3be557d9f287;hp=bda9e0fe1be85f1215376ee144c50d9dec27aaf2;hpb=7854ec4b11e117f8514553890851d14a66690fbb;p=ghc-hetmet.git

diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index bda9e0f..7ddf597 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -56,11 +56,17 @@ cgForeignCall results result_hints (CCall (CCallSpec target cconv safety)) stg_a
   = do	{ cmm_args <- getFCallArgs stg_args
         ; let ((call_args, arg_hints), cmm_target)
                 = case target of
-                    StaticTarget lbl ->
-                      (unzip cmm_args,
-                       CmmLit (CmmLabel (mkForeignLabel lbl (call_size cmm_args)
-                                                        ForeignLabelInThisPackage IsFunction)))
-                    DynamicTarget    ->  case cmm_args of
+                   StaticTarget lbl mPkgId 
+		     -> let labelSource
+				= case mPkgId of
+					Nothing		-> ForeignLabelInThisPackage
+					Just pkgId	-> ForeignLabelInPackage pkgId
+			    size	= call_size cmm_args
+			in  ( unzip cmm_args
+			    , CmmLit (CmmLabel 
+					(mkForeignLabel lbl size labelSource IsFunction)))
+ 
+                   DynamicTarget    ->  case cmm_args of
                                            (fn,_):rest -> (unzip rest, fn)
                                            [] -> panic "cgForeignCall []"
               fc = ForeignConvention cconv arg_hints result_hints
@@ -121,7 +127,7 @@ emitForeignCall safety results target args _srt _ret
   | otherwise = do
     updfr_off <- getUpdFrameOff
     temp_target <- load_target_into_temp target
-    emit $ mkSafeCall temp_target results args updfr_off
+    emit $ mkSafeCall temp_target results args updfr_off (playInterruptible safety)
 
 
 {-
@@ -237,10 +243,12 @@ nursery_bdescr_start  = cmmOffset stgCurrentNursery oFFSET_bdescr_start
 nursery_bdescr_blocks = cmmOffset stgCurrentNursery oFFSET_bdescr_blocks
 
 tso_SP, tso_STACK, tso_CCCS :: ByteOff
-tso_SP    = tsoFieldB     oFFSET_StgTSO_sp
-tso_STACK = tsoFieldB     oFFSET_StgTSO_stack
 tso_CCCS  = tsoProfFieldB oFFSET_StgTSO_CCCS
 
+ --ToDo: needs merging with changes to CgForeign
+tso_STACK = tsoFieldB     undefined
+tso_SP    = tsoFieldB     undefined
+
 -- The TSO struct has a variable header, and an optional StgTSOProfInfo in
 -- the middle.  The fields we're interested in are after the StgTSOProfInfo.
 tsoFieldB :: ByteOff -> ByteOff