Tag ForeignCalls with the package they correspond to

compiler/cmm/CLabel.hs

@@ -15,6 +15,8 @@
 
 module CLabel (
 	CLabel,	-- abstract type
+	ForeignLabelSource(..),
+	pprDebugCLabel,
 
 	mkClosureLabel,
 	mkSRTLabel,
@@ -175,12 +177,17 @@ data CLabel
   | RtsLabel 			
 	RtsLabelInfo
 
-  -- | A 'C' (or otherwise foreign) label
-  | ForeignLabel FastString     
+  -- | A 'C' (or otherwise foreign) label.
+  --
+  | ForeignLabel 
+  	FastString    		-- name of the imported label.
+
         (Maybe Int)		-- possible '@n' suffix for stdcall functions
 				-- When generating C, the '@n' suffix is omitted, but when
 				-- generating assembler we must add it to the label.
-        Bool                    -- True <=> is dynamic
+
+	ForeignLabelSource	-- what package the foreign label is in.
+	
         FunctionOrData
 
   -- | A family of labels related to a particular case expression.
@@ -247,6 +254,52 @@ data CLabel
 
   deriving (Eq, Ord)
 
+
+-- | Record where a foreign label is stored.
+data ForeignLabelSource
+
+   -- | Label is in a named package
+   = ForeignLabelInPackage	PackageId
+  
+   -- | Label is in some external, system package that doesn't also
+   --	contain compiled Haskell code, and is not associated with any .hi files.
+   --	We don't have to worry about Haskell code being inlined from
+   --	external packages. It is safe to treat the RTS package as "external".
+   | ForeignLabelInExternalPackage 
+
+   -- | Label is in the package currenly being compiled.
+   --	This is only used for creating hacky tmp labels during code generation.
+   --	Don't use it in any code that might be inlined across a package boundary
+   --	(ie, core code) else the information will be wrong relative to the
+   --	destination module.
+   | ForeignLabelInThisPackage
+      
+   deriving (Eq, Ord)   
+
+
+-- | For debugging problems with the CLabel representation.
+--	We can't make a Show instance for CLabel because lots of its components don't have instances.
+--	The regular Outputable instance only shows the label name, and not its other info.
+--
+pprDebugCLabel :: CLabel -> SDoc
+pprDebugCLabel lbl
+ = case lbl of
+ 	IdLabel{}	-> ppr lbl <> (parens $ text "IdLabel")
+	CmmLabel pkg name _info	
+	 -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
+
+	RtsLabel{}	-> ppr lbl <> (parens $ text "RtsLabel")
+
+	ForeignLabel name mSuffix src funOrData
+	 -> ppr lbl <> (parens 
+	 			$ text "ForeignLabel" 
+	 			<+> ppr mSuffix
+				<+> ppr src  
+				<+> ppr funOrData)
+
+	_		-> ppr lbl <> (parens $ text "other CLabel)")
+
+
 data IdLabelInfo
   = Closure		-- ^ Label for closure
   | SRT                 -- ^ Static reference table
@@ -301,6 +354,7 @@ data CmmLabelInfo
   | CmmData       		-- ^ misc rts data bits, eg CHARLIKE_closure
   | CmmCode       		-- ^ misc rts code
   | CmmGcPtr			-- ^ GcPtrs eg CHARLIKE_closure  
+  | CmmPrimCall			-- ^ a prim call to some hand written Cmm code
   deriving (Eq, Ord)
 
 data DynamicLinkerLabelInfo
@@ -378,22 +432,34 @@ mkApInfoTableLabel   upd off	= RtsLabel (RtsApInfoTable       upd off)
 mkApEntryLabel       upd off	= RtsLabel (RtsApEntry           upd off)
 
 
--- Constructing ForeignLabels
--- Primitive / cmm call labels
+-- A call to some primitive hand written Cmm code
 mkPrimCallLabel :: PrimCall -> CLabel
-mkPrimCallLabel (PrimCall str)  = ForeignLabel str Nothing False IsFunction
+mkPrimCallLabel (PrimCall str pkg)  
+	= CmmLabel pkg str CmmPrimCall
+
 
--- Foreign labels
-mkForeignLabel :: FastString -> Maybe Int -> Bool -> FunctionOrData -> CLabel
-mkForeignLabel str mb_sz is_dynamic fod
-    = ForeignLabel str mb_sz is_dynamic fod
+-- Constructing ForeignLabels
 
+-- | Make a foreign label
+mkForeignLabel 
+	:: FastString 		-- name
+	-> Maybe Int 		-- size prefix
+	-> ForeignLabelSource	-- what package it's in
+	-> FunctionOrData 	
+	-> CLabel
+
+mkForeignLabel str mb_sz src fod
+    = ForeignLabel str mb_sz src  fod
+
+
+-- | Update the label size field in a ForeignLabel
 addLabelSize :: CLabel -> Int -> CLabel
-addLabelSize (ForeignLabel str _ is_dynamic fod) sz
-    = ForeignLabel str (Just sz) is_dynamic fod
+addLabelSize (ForeignLabel str _ src  fod) sz
+    = ForeignLabel str (Just sz) src fod
 addLabelSize label _
     = label
 
+-- | Get the label size field from a ForeignLabel
 foreignLabelStdcallInfo :: CLabel -> Maybe Int
 foreignLabelStdcallInfo (ForeignLabel _ info _ _) = info
 foreignLabelStdcallInfo _lbl = Nothing
@@ -530,8 +596,8 @@ needsCDecl ModuleRegdLabel		= False
 needsCDecl (StringLitLabel _)		= False
 needsCDecl (AsmTempLabel _)		= False
 needsCDecl (RtsLabel _)			= False
-needsCDecl (CmmLabel _ _ _)		= False
-needsCDecl l@(ForeignLabel _ _ _ _)	= not (isMathFun l)
+needsCDecl (CmmLabel _ _ _)		= True
+needsCDecl l@(ForeignLabel{})		= not (isMathFun l)
 needsCDecl (CC_Label _)			= True
 needsCDecl (CCS_Label _)		= True
 needsCDecl (HpcTicksLabel _)            = True
@@ -551,12 +617,12 @@ maybeAsmTemp (AsmTempLabel uq) 		= Just uq
 maybeAsmTemp _ 	    	       		= Nothing
 
 
--- Check whether a label corresponds to a C function that has 
+-- | Check whether a label corresponds to a C function that has 
 --      a prototype in a system header somehere, or is built-in
 --      to the C compiler. For these labels we abovoid generating our
 --      own C prototypes.
 isMathFun :: CLabel -> Bool
-isMathFun (ForeignLabel fs _ _ _) = fs `elementOfUniqSet` math_funs
+isMathFun (ForeignLabel fs _ _ _) 	= fs `elementOfUniqSet` math_funs
 isMathFun _ = False
 
 math_funs = mkUniqSet [
@@ -640,12 +706,10 @@ math_funs = mkUniqSet [
     ]
 
 -- -----------------------------------------------------------------------------
--- Is a CLabel visible outside this object file or not?
-
--- From the point of view of the code generator, a name is
--- externally visible if it has to be declared as exported
--- in the .o file's symbol table; that is, made non-static.
-
+-- | Is a CLabel visible outside this object file or not?
+-- 	From the point of view of the code generator, a name is
+-- 	externally visible if it has to be declared as exported
+-- 	in the .o file's symbol table; that is, made non-static.
 externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
 externallyVisibleCLabel (CaseLabel _ _)		= False
 externallyVisibleCLabel (StringLitLabel _)	= False
@@ -656,7 +720,7 @@ externallyVisibleCLabel (ModuleInitTableLabel _)= False
 externallyVisibleCLabel ModuleRegdLabel		= False
 externallyVisibleCLabel (RtsLabel _)		= True
 externallyVisibleCLabel (CmmLabel _ _ _)	= True
-externallyVisibleCLabel (ForeignLabel _ _ _ _)	= True
+externallyVisibleCLabel (ForeignLabel{})	= True
 externallyVisibleCLabel (IdLabel name _ _)	= isExternalName name
 externallyVisibleCLabel (CC_Label _)		= True
 externallyVisibleCLabel (CCS_Label _)		= True
@@ -707,7 +771,7 @@ labelType (PlainModuleInitLabel _)              = CodeLabel
 labelType (ModuleInitTableLabel _)              = DataLabel
 labelType (LargeSRTLabel _)                     = DataLabel
 labelType (LargeBitmapLabel _)                  = DataLabel
-labelType (ForeignLabel _ _ _ IsFunction)       = CodeLabel
+labelType (ForeignLabel _ _ _ IsFunction)	= CodeLabel
 labelType (IdLabel _ _ info)                    = idInfoLabelType info
 labelType _                                     = DataLabel
 
@@ -733,15 +797,32 @@ idInfoLabelType info =
 labelDynamic :: PackageId -> CLabel -> Bool
 labelDynamic this_pkg lbl =
   case lbl of
-   RtsLabel _  	     	-> not opt_Static && (this_pkg /= rtsPackageId) -- i.e., is the RTS in a DLL or not?
-   CmmLabel pkg _ _	-> not opt_Static && (this_pkg /= pkg)
+   -- is the RTS in a DLL or not?
+   RtsLabel _  	     	-> not opt_Static && (this_pkg /= rtsPackageId)
+
+   -- When compiling in the "dyn" way, eack package is to be linked into its own shared library.
+   CmmLabel pkg _ _
+    -> not opt_Static && (this_pkg /= pkg)
+
    IdLabel n _ k     	-> isDllName this_pkg n
+
 #if mingw32_TARGET_OS
-   ForeignLabel _ _ d _ -> d
+   -- Foreign label is in some un-named foreign package (or DLL)
+   ForeignLabel _ _ ForeignLabelInExternalPackage _  -> True
+
+   -- Foreign label is linked into the same package as the source file currently being compiled.
+   ForeignLabel _ _ ForeignLabelInThisPackage  _     -> False
+      
+   -- Foreign label is in some named package.
+   --	When compiling in the "dyn" way, each package is to be linked into its own DLL.
+   ForeignLabel _ _ (ForeignLabelInPackage pkgId) _
+    -> (not opt_Static) && (this_pkg /= pkgId)
+
 #else
    -- On Mac OS X and on ELF platforms, false positives are OK,
    -- so we claim that all foreign imports come from dynamic libraries
    ForeignLabel _ _ _ _ -> True
+
 #endif
    ModuleInitLabel m _    -> not opt_Static && this_pkg /= (modulePackageId m)
    PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
@@ -864,6 +945,7 @@ pprCLbl (LargeBitmapLabel u)  = text "b" <> pprUnique u <> pp_cSEP <> ptext (sLi
 pprCLbl (CmmLabel _ str CmmCode)	= ftext str
 pprCLbl (CmmLabel _ str CmmData)	= ftext str
 pprCLbl (CmmLabel _ str CmmGcPtr)	= ftext str
+pprCLbl (CmmLabel _ str CmmPrimCall)	= ftext str
 
 pprCLbl (RtsLabel (RtsApFast str))   = ftext str <> ptext (sLit "_fast")
 
@@ -959,6 +1041,14 @@ ppIdFlavor x = pp_cSEP <>
 
 pp_cSEP = char '_'
 
+
+instance Outputable ForeignLabelSource where
+ ppr fs
+  = case fs of
+  	ForeignLabelInPackage pkgId	-> parens $ text "package: " <> ppr pkgId 
+	ForeignLabelInThisPackage	-> parens $ text "this package"
+	ForeignLabelInExternalPackage	-> parens $ text "external package"
+
 -- -----------------------------------------------------------------------------
 -- Machine-dependent knowledge about labels.
 

compiler/cmm/CmmParse.y

@@ -214,7 +214,7 @@ static 	:: { ExtFCode [CmmStatic] }
 	| 'CLOSURE' '(' NAME lits ')'
 		{ do lits <- sequence $4;
 		     return $ map CmmStaticLit $
-                       mkStaticClosure (mkForeignLabel $3 Nothing True IsData)
+                       mkStaticClosure (mkForeignLabel $3 Nothing ForeignLabelInExternalPackage IsData)
                          -- mkForeignLabel because these are only used
                          -- for CHARLIKE and INTLIKE closures in the RTS.
 			 dontCareCCS (map getLit lits) [] [] [] }
@@ -346,14 +346,21 @@ decl	:: { ExtCode }
 
 -- an imported function name, with optional packageId
 importNames  
-	:: { [(Maybe PackageId, FastString)] }
+	:: { [(FastString, CLabel)] }
 	: importName			{ [$1] }
 	| importName ',' importNames	{ $1 : $3 }		
 	
 importName
-	:: { (Maybe PackageId, FastString) }
-	: NAME				{ (Nothing, $1) }
-	| STRING NAME			{ (Just (fsToPackageId (mkFastString $1)), $2) }
+	:: { (FastString,  CLabel) }
+
+	-- A label imported without an explicit packageId.
+	--	These are taken to come frome some foreign, unnamed package.
+	: NAME	
+	{ ($1, mkForeignLabel $1 Nothing ForeignLabelInExternalPackage IsFunction) }
+
+	-- A label imported with an explicit packageId.
+	| STRING NAME
+	{ ($2, mkCmmCodeLabel (fsToPackageId (mkFastString $1)) $2) }
 	
 	
 names 	:: { [FastString] }

compiler/cmm/PprCmm.hs

@@ -272,11 +272,16 @@ pprStmt stmt = case stmt of
 		      CmmCallConv -> empty
 		      _           -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv)
 
+    -- Call a CallishMachOp, like sin or cos that might be implemented as a library call.
     CmmCall (CmmPrim op) results args safety ret ->
         pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv)
                         results args safety ret)
         where
-          lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False IsFunction)
+	  -- HACK: A CallishMachOp doesn't really correspond to a ForeignLabel, but we
+	  --	   use one to get the label printed.
+          lbl = CmmLabel (mkForeignLabel 
+	  			(mkFastString (show op)) 
+	  			Nothing ForeignLabelInThisPackage IsFunction)
 
     CmmBranch ident          -> genBranch ident
     CmmCondBranch expr ident -> genCondBranch expr ident

compiler/cmm/ZipCfgCmmRep.hs

@@ -484,8 +484,12 @@ ppr_safety Unsafe         = text "unsafe"
 
 ppr_call_target :: MidCallTarget -> SDoc
 ppr_call_target (ForeignTarget fn c) = ppr_fc c <+> ppr_target fn
-ppr_call_target (PrimTarget op) =
-  ppr (CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False IsFunction))
+ppr_call_target (PrimTarget op) 
+ -- HACK: We're just using a ForeignLabel to get this printed, the label
+ --	  might not really be foreign.
+ = ppr (CmmLabel (mkForeignLabel
+ 			(mkFastString (show op)) 
+			Nothing ForeignLabelInThisPackage IsFunction))
 
 ppr_target :: CmmExpr -> SDoc
 ppr_target t@(CmmLit _) = ppr t

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 

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 []"

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

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

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 []"

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)

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

compiler/main/StaticFlags.hs

@@ -407,7 +407,14 @@ way_details =
 
     Way WayDyn "dyn" False "Dynamic"
 	[ "-DDYNAMIC"
-	, "-optc-DDYNAMIC" ],
+	, "-optc-DDYNAMIC" 
+#if defined(mingw32_TARGET_OS)
+	-- On Windows, code that is to be linked into a dynamic library must be compiled
+	--	with -fPIC. Labels not in the current package are assumed to be in a DLL 
+	--	different from the current one.
+	, "-fPIC"
+#endif
+	],
 
     Way WayProf "p" False "Profiling"
 	[ "-fscc-profiling"

compiler/nativeGen/PIC.hs

@@ -64,12 +64,12 @@ import NCGMonad
 
 
 import Cmm
-import CLabel           ( CLabel, pprCLabel,
+import CLabel           ( CLabel, ForeignLabelSource(..), pprCLabel,
                           mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
                           dynamicLinkerLabelInfo, mkPicBaseLabel,
                           labelDynamic, externallyVisibleCLabel )
 
-import CLabel           ( mkForeignLabel )
+import CLabel           ( mkForeignLabel, pprDebugCLabel )
 
 
 import StaticFlags	( opt_PIC, opt_Static )
@@ -83,6 +83,7 @@ import DynFlags
 import FastString
 
 
+
 --------------------------------------------------------------------------------
 -- It gets called by the cmmToCmm pass for every CmmLabel in the Cmm
 -- code. It does The Right Thing(tm) to convert the CmmLabel into a
@@ -110,8 +111,12 @@ cmmMakeDynamicReference
              -> ReferenceKind     -- whether this is the target of a jump
              -> CLabel            -- the label
              -> m CmmExpr
-  
+
 cmmMakeDynamicReference dflags addImport referenceKind lbl
+   = cmmMakeDynamicReference' dflags addImport referenceKind lbl
+
+  
+cmmMakeDynamicReference' dflags addImport referenceKind lbl
   | Just _ <- dynamicLinkerLabelInfo lbl
   = return $ CmmLit $ CmmLabel lbl   -- already processed it, pass through
 
@@ -450,8 +455,10 @@ needImportedSymbols arch os
 -- position-independent code.
 gotLabel :: CLabel
 gotLabel 
-	= mkForeignLabel -- HACK: it's not really foreign
-        	(fsLit ".LCTOC1") Nothing False IsData
+	-- HACK: this label isn't really foreign
+	= mkForeignLabel 
+		(fsLit ".LCTOC1") 
+		Nothing ForeignLabelInThisPackage IsData
 
 
 

compiler/nativeGen/SPARC/CodeGen/CCall.hs

@@ -263,7 +263,7 @@ outOfLineFloatOp mop
 	
  	dflags	<- getDynFlagsNat
 	mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference 
-		$  mkForeignLabel functionName Nothing True IsFunction
+		$  mkForeignLabel functionName Nothing ForeignLabelInExternalPackage IsFunction
 
 	let mopLabelOrExpr 
 		= case mopExpr of

compiler/nativeGen/X86/CodeGen.hs

@@ -1882,7 +1882,10 @@ outOfLineFloatOp mop res args
           code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
           return (code1 `appOL` code2)
   where
-	lbl = mkForeignLabel fn Nothing False IsFunction
+	-- Assume we can call these functions directly, and that they're not in a dynamic library.
+	-- TODO: Why is this ok? Under linux this code will be in libm.so
+	--	 Is is because they're really implemented as a primitive instruction by the assembler??  -- BL 2009/12/31 
+	lbl = mkForeignLabel fn Nothing ForeignLabelInThisPackage IsFunction
 
 	fn = case mop of
 	      MO_F32_Sqrt  -> fsLit "sqrtf"

compiler/parser/RdrHsSyn.lhs

@@ -985,9 +985,10 @@ mkImport :: CCallConv
 	 -> P (HsDecl RdrName)
 mkImport cconv safety (L loc entity, v, ty)
   | cconv == PrimCallConv                      = do
-    let funcTarget = CFunction (StaticTarget entity)
-        importSpec = CImport PrimCallConv safety nilFS funcTarget
-    return (ForD (ForeignImport v ty importSpec))
+  let funcTarget = CFunction (PackageTarget entity Nothing)
+      importSpec = CImport PrimCallConv safety nilFS funcTarget
+  return (ForD (ForeignImport v ty importSpec))
+
   | otherwise = do
     case parseCImport cconv safety (mkExtName (unLoc v)) (unpackFS entity) of
       Nothing         -> parseError loc "Malformed entity string"
@@ -1022,7 +1023,7 @@ parseCImport cconv safety nm str =
    id_char  c = isAlphaNum c || c == '_'
 
    cimp nm = (ReadP.char '&' >> skipSpaces >> CLabel <$> cid)
-             +++ ((CFunction . StaticTarget) <$> cid)
+             +++ ((\c -> CFunction (PackageTarget c Nothing)) <$> cid)
           where 
             cid = return nm +++
                   (do c  <- satisfy (\c -> isAlpha c || c == '_')

compiler/prelude/ForeignCall.lhs

@@ -24,6 +24,7 @@ module ForeignCall (
 import FastString
 import Binary
 import Outputable
+import Module
 
 import Data.Char
 \end{code}
@@ -101,9 +102,19 @@ data CCallSpec
 The call target:
 
 \begin{code}
+
+-- | How to call a particular function in C land.
 data CCallTarget
-  = StaticTarget  CLabelString  -- An "unboxed" ccall# to `fn'.
-  | DynamicTarget 		-- First argument (an Addr#) is the function pointer
+  -- An "unboxed" ccall# to named function
+  = StaticTarget  CLabelString  
+
+  -- The first argument of the import is the name of a function pointer (an Addr#).
+  --	Used when importing a label as "foreign import ccall "dynamic" ..."
+  | DynamicTarget
+
+  -- An "unboxed" ccall# to a named function from a particular package.
+  | PackageTarget CLabelString (Maybe PackageId)
+  
   deriving( Eq )
   {-! derive: Binary !-}
 
@@ -186,8 +197,17 @@ instance Outputable CCallSpec where
       gc_suf | playSafe safety = text "_GC"
 	     | otherwise       = empty
 
-      ppr_fun DynamicTarget     = text "__dyn_ccall" <> gc_suf <+> text "\"\""
-      ppr_fun (StaticTarget fn) = text "__ccall"     <> gc_suf <+> pprCLabelString fn
+      ppr_fun DynamicTarget     
+        = text "__dyn_ccall" <> gc_suf <+> text "\"\""
+
+      ppr_fun (PackageTarget fn Nothing)
+     	= text "__pkg_ccall" <> gc_suf <+> pprCLabelString fn
+
+      ppr_fun (PackageTarget fn (Just pkgId))
+     	= text "__pkg_ccall" <> gc_suf <+> ppr pkgId <+> pprCLabelString fn
+
+      ppr_fun (StaticTarget fn) 
+        = text "__ccall"     <> gc_suf <+> pprCLabelString fn
 \end{code}
 
 
@@ -242,12 +262,19 @@ instance Binary CCallTarget where
 	    put_ bh aa
     put_ bh DynamicTarget = do
 	    putByte bh 1
+    put_ bh (PackageTarget aa ab) = do
+    	    putByte bh 2
+	    put_ bh aa
+	    put_ bh ab
     get bh = do
 	    h <- getByte bh
 	    case h of
 	      0 -> do aa <- get bh
 		      return (StaticTarget aa)
-	      _ -> do return DynamicTarget
+	      1 -> do return DynamicTarget
+	      _ -> do aa <- get bh
+	      	      ab <- get bh
+		      return (PackageTarget aa ab)
 
 instance Binary CCallConv where
     put_ bh CCallConv = do

compiler/prelude/PrimOp.lhs

@@ -43,6 +43,7 @@ import Unique		( Unique, mkPrimOpIdUnique )
 import Outputable
 import FastTypes
 import FastString
+import Module		( PackageId )
 \end{code}
 
 %************************************************************************
@@ -517,9 +518,10 @@ pprPrimOp other_op = pprOccName (primOpOcc other_op)
 %************************************************************************
 
 \begin{code}
-newtype PrimCall = PrimCall CLabelString
+data PrimCall = PrimCall CLabelString PackageId
 
 instance Outputable PrimCall where
-  ppr (PrimCall lbl) = ppr lbl
+  ppr (PrimCall lbl pkgId) 
+  	= text "__primcall" <+> ppr pkgId <+> ppr lbl