Tag ForeignCalls with the package they correspond to

7 files changed, 42 insertions, 21 deletions

diff --git a/compiler/codeGen/CgExtCode.hs b/compiler/codeGen/CgExtCode.hs
index 03ac75e0ba..0e0a802445 100644
--- a/compiler/codeGen/CgExtCode.hs
+++ b/compiler/codeGen/CgExtCode.hs
@@ -21,7 +21,6 @@ module CgExtCode (
 	newLabel,
 	newFunctionName,
 	newImport,
-
 	lookupLabel,
 	lookupName,
 
@@ -42,7 +41,7 @@ import CgMonad
 import CLabel
 import Cmm
 
-import BasicTypes
+-- import BasicTypes
 import BlockId
 import FastString
 import Module
@@ -146,14 +145,13 @@ newFunctionName name pkg
 -- | Add an imported foreign label to the list of local declarations.
 --	If this is done at the start of the module the declaration will scope
 --	over the whole module.
---	CLabel's labelDynamic classifies these labels as dynamic, hence the
---	code generator emits PIC code for them.
-newImport :: (Maybe PackageId, FastString) -> ExtFCode ()
-newImport (Nothing, name)
-   = addVarDecl name (CmmLit (CmmLabel (mkForeignLabel name Nothing True IsFunction)))
-
-newImport (Just pkg, name)
-   = addVarDecl name (CmmLit (CmmLabel (mkCmmCodeLabel pkg name)))
+newImport 
+	:: (FastString, CLabel) 
+	-> ExtFCode ()
+
+newImport (name, cmmLabel) 
+   = addVarDecl name (CmmLit (CmmLabel cmmLabel))
+
 
 -- | Lookup the BlockId bound to the label with this name.
 --	If one hasn't been bound yet, create a fresh one based on the 
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 809e10b875..879d043329 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -78,8 +78,27 @@ 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)))
+
+	   -- 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
+	    -> 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 []"
diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs
index c66af03672..3d300eda53 100644
--- a/compiler/codeGen/CgHpc.hs
+++ b/compiler/codeGen/CgHpc.hs
@@ -67,7 +67,7 @@ initHpc this_mod (HpcInfo tickCount hashNo)
                PlayRisky
                [CmmHinted id NoHint]
                (CmmCallee
-                 (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False IsFunction)
+                 (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing ForeignLabelInThisPackage IsFunction)
                   CCallConv
                )
                [ CmmHinted (mkLblExpr mkHpcModuleNameLabel) AddrHint
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 75f6b19292..8ce1ffc0b4 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -111,9 +111,11 @@ mkSimpleLit (MachWord i)      = CmmInt i wordWidth
 mkSimpleLit (MachWord64 i)    = CmmInt i W64
 mkSimpleLit (MachFloat r)     = CmmFloat r W32
 mkSimpleLit (MachDouble r)    = CmmFloat r W64
-mkSimpleLit (MachLabel fs ms fod) = CmmLabel (mkForeignLabel fs ms is_dyn fod)
-			      where
-				is_dyn = False	-- ToDo: fix me
+mkSimpleLit (MachLabel fs ms fod) 
+	= CmmLabel (mkForeignLabel fs ms labelSrc fod)
+	where
+		-- TODO: Literal labels might not actually be in the current package...
+		labelSrc = ForeignLabelInThisPackage	
 	
 mkLtOp :: Literal -> MachOp
 -- On signed literals we must do a signed comparison
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index 89a2b27833..bda9e0fe1b 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -59,7 +59,7 @@ cgForeignCall results result_hints (CCall (CCallSpec target cconv safety)) stg_a
                     StaticTarget lbl ->
                       (unzip cmm_args,
                        CmmLit (CmmLabel (mkForeignLabel lbl (call_size cmm_args)
-                                                        False IsFunction)))
+                                                        ForeignLabelInThisPackage IsFunction)))
                     DynamicTarget    ->  case cmm_args of
                                            (fn,_):rest -> (unzip rest, fn)
                                            [] -> panic "cgForeignCall []"
diff --git a/compiler/codeGen/StgCmmHpc.hs b/compiler/codeGen/StgCmmHpc.hs
index e78acb78b7..8bf1fbfbc3 100644
--- a/compiler/codeGen/StgCmmHpc.hs
+++ b/compiler/codeGen/StgCmmHpc.hs
@@ -55,7 +55,7 @@ initHpc this_mod (HpcInfo tickCount hashNo)
     	; id <- newTemp bWord -- TODO FIXME NOW
         ; emitCCall
                [(id,NoHint)]
-               (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False IsFunction)
+               (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing ForeignLabelInThisPackage IsFunction)
                [ (mkLblExpr mkHpcModuleNameLabel,AddrHint)
                , (CmmLit $ mkIntCLit tickCount,NoHint)
                , (CmmLit $ mkIntCLit hashNo,NoHint)
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 73b3052349..9cfb241d1e 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -98,9 +98,11 @@ mkSimpleLit (MachWord i)      = CmmInt i wordWidth
 mkSimpleLit (MachWord64 i)    = CmmInt i W64
 mkSimpleLit (MachFloat r)     = CmmFloat r W32
 mkSimpleLit (MachDouble r)    = CmmFloat r W64
-mkSimpleLit (MachLabel fs ms fod) = CmmLabel (mkForeignLabel fs ms is_dyn fod)
-			      where
-				is_dyn = False	-- ToDo: fix me
+mkSimpleLit (MachLabel fs ms fod) 
+	= CmmLabel (mkForeignLabel fs ms labelSrc fod)
+	where
+		-- TODO: Literal labels might not actually be in the current package...
+		labelSrc = ForeignLabelInThisPackage	
 mkSimpleLit other	      = pprPanic "mkSimpleLit" (ppr other)
 
 mkLtOp :: Literal -> MachOp