[project @ 1999-03-02 16:44:26 by sof]

Win32 only: emit code that declares the DLLness of a label we're
making use of.

ghc/compiler/absCSyn/CLabel.lhs

 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CLabel.lhs,v 1.23 1999/01/20 16:07:43 simonm Exp $
+% $Id: CLabel.lhs,v 1.24 1999/03/02 16:44:26 sof Exp $
 %
 \section[CLabel]{@CLabel@: Information to make C Labels}
 
@@ -46,7 +46,7 @@ module CLabel (
 	
 	needsCDecl, isReadOnly, isAsmTemp, externallyVisibleCLabel,
 
-	CLabelType(..), labelType,
+	CLabelType(..), labelType, labelDynamic,
 
 	pprCLabel
 #if ! OMIT_NATIVE_CODEGEN
@@ -61,9 +61,11 @@ module CLabel (
 import {-# SOURCE #-} MachMisc ( underscorePrefix, fmtAsmLbl )
 #endif
 
+import CmdLineOpts      ( opt_Static )
 import CStrings		( pp_cSEP )
 import DataCon		( ConTag, DataCon )
-import Name		( Name, isExternallyVisibleName )
+import Module		( isDynamicModule )
+import Name		( Name, getName, isExternallyVisibleName, nameModule, isLocallyDefinedName )
 import TyCon		( TyCon )
 import Unique		( pprUnique, Unique )
 import PrimOp		( PrimOp, pprPrimOp )
@@ -319,6 +321,24 @@ labelType (DataConLabel _ info) =
 labelType _        = DataType
 \end{code}
 
+When referring to data in code, we need to know whether
+that data resides in a DLL or not. [Win32 only.]
+@labelDynamic@ returns @True@ if the label is located
+in a DLL, be it a data reference or not.
+
+\begin{code}
+labelDynamic :: CLabel -> Bool
+labelDynamic lbl = 
+  case lbl of
+   RtsLabel _  -> not opt_Static  -- i.e., is the RTS in a DLL or not?
+   IdLabel n k      | not (isLocallyDefinedName n) -> isDynamicModule (nameModule n)
+   DataConLabel n k | not (isLocallyDefinedName n) -> isDynamicModule (nameModule n)
+   TyConLabel tc    | not (isLocallyDefinedName (getName tc)) -> isDynamicModule (nameModule (getName tc))
+   _ -> False
+
+\end{code}
+
+
 OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
 right places. It is used to detect when the abstractC statement of an
 CCodeBlock actually contains the code for a slow entry point.  -- HWL

ghc/compiler/absCSyn/PprAbsC.lhs

@@ -30,7 +30,7 @@ import CallConv		( CallConv, callConvAttribute, cCallConv )
 import CLabel		( externallyVisibleCLabel, mkErrorStdEntryLabel,
 			  isReadOnly, needsCDecl, pprCLabel,
 			  mkReturnInfoLabel, mkReturnPtLabel,
-			  CLabel, CLabelType(..), labelType
+			  CLabel, CLabelType(..), labelType, labelDynamic
 			)
 
 import CmdLineOpts	( opt_SccProfilingOn, opt_EmitCExternDecls, opt_GranMacros )
@@ -251,7 +251,10 @@ pprAbsC stmt@(CSRT lbl closures) c
       $$ nest 2 (hcat (punctuate comma (map pp_closure_lbl closures)))
          <> ptext SLIT("};")
   }
-  where pp_closure_lbl lbl = char '&' <> pprCLabel lbl
+  where 
+    pp_closure_lbl lbl
+      | labelDynamic lbl = text "DLL_SRT_ENTRY" <> parens (pprCLabel lbl)
+      | otherwise	 = char '&' <> pprCLabel lbl
 
 pprAbsC stmt@(CBitmap lbl mask) c
   = vcat [
@@ -353,7 +356,7 @@ pprAbsC stmt@(CStaticClosure closure_lbl cl_info cost_centre amodes) _
 		pprCLabel info_lbl,				comma,
 		if_profiling (pprAmode cost_centre), 		comma,
 		ppLocalness closure_lbl,			comma,
-		ppLocalnessMacro info_lbl,
+		ppLocalnessMacro True{-include dyn-} info_lbl,
 		char ')'
 		],
 	nest 2 (ppr_payload (amodes ++ padding_wds)),
@@ -400,8 +403,8 @@ pprAbsC stmt@(CClosureInfoAndCode cl_info slow maybe_fast srt cl_descr) _
 	    pprCLabel slow_lbl,				comma,
 	    pp_rest, {- ptrs,nptrs,[srt,]type,-}	comma,
 
-	    ppLocalness info_lbl,			comma,
-	    ppLocalnessMacro slow_lbl,			comma,
+	    ppLocalness info_lbl,			   comma,
+	    ppLocalnessMacro True{-include dyn-} slow_lbl, comma,
 
 	    if_profiling pp_descr, comma,
 	    if_profiling pp_type,
@@ -465,7 +468,7 @@ pprAbsC stmt@(CRetDirect uniq code srt liveness) _
 	  pp_srt_info srt,			  -- SRT
 	  ptext type_str,		comma,	  -- closure type
 	  ppLocalness info_lbl, 	comma,	  -- info table storage class
-	  ppLocalnessMacro entry_lbl, 	comma,    -- entry pt storage class
+	  ppLocalnessMacro True{-include dyn-} entry_lbl, 	comma,    -- entry pt storage class
 	  int 0, comma,
 	  int 0, text ");"
       ],
@@ -535,18 +538,33 @@ ppLocalness label
 -- Horrible macros for declaring the types and locality of labels (see
 -- StgMacros.h).
 
-ppLocalnessMacro clabel =
+ppLocalnessMacro include_dyn_prefix clabel =
      hcat [
-       char (if externallyVisibleCLabel clabel then 'E' else 'I'),
-       case labelType clabel of
-	  InfoTblType -> ptext SLIT("I_")
+        visiblity_prefix,
+	dyn_prefix,
+        case label_type of
 	  ClosureType -> ptext SLIT("C_")
 	  CodeType    -> ptext SLIT("F_")
+	  InfoTblType -> ptext SLIT("I_")
 	  DataType    -> ptext SLIT("D_") <>
 				   if isReadOnly clabel 
 				      then ptext SLIT("RO_") 
 				      else empty 
      ]
+  where
+   is_visible = externallyVisibleCLabel clabel
+   label_type = labelType clabel
+   is_dynamic = labelDynamic clabel
+
+   visiblity_prefix
+     | is_visible = char 'E'
+     | otherwise  = char 'I'
+
+   dyn_prefix
+     | not include_dyn_prefix = empty
+     | is_dynamic	      = char 'D'
+     | otherwise	      = empty
+
 \end{code}
 
 \begin{code}
@@ -1115,7 +1133,7 @@ ppr_amode (CReg magic_id) = pprMagicId magic_id
 
 ppr_amode (CTemp uniq kind) = char '_' <> pprUnique uniq <> char '_'
 
-ppr_amode (CLbl label kind) = pprCLabelAddr label
+ppr_amode (CLbl label kind) = pprCLabelAddr label 
 
 ppr_amode (CCharLike ch)
   = hcat [ptext SLIT("CHARLIKE_CLOSURE"), char '(', pprAmode ch, rparen ]
@@ -1365,14 +1383,17 @@ pprTempDecl :: Unique -> PrimRep -> SDoc
 pprTempDecl uniq kind
   = hcat [ pprPrimKind kind, space, char '_', pprUnique uniq, ptext SLIT("_;") ]
 
-pprExternDecl :: CLabel -> PrimRep -> SDoc
+pprExternDecl :: Bool -> CLabel -> SDoc
+pprExternDecl in_srt clabel
+  | not (needsCDecl clabel) = empty -- do not print anything for "known external" things
+  | otherwise		    = 
+	hcat [ ppLocalnessMacro (not in_srt) clabel, 
+	       lparen, dyn_wrapper (pprCLabel clabel), pp_paren_semi ]
+ where
+  dyn_wrapper d
+    | in_srt && labelDynamic clabel = text "DLL_IMPORT_DATA_VAR" <> parens d
+    | otherwise			    = d
 
-pprExternDecl clabel kind
-  = if not (needsCDecl clabel) then
-	empty -- do not print anything for "known external" things
-    else 
-	hcat [ ppLocalnessMacro clabel, 
-	       lparen, pprCLabel clabel, pp_paren_semi ]
 \end{code}
 
 \begin{code}
@@ -1416,7 +1437,7 @@ ppr_decls_AbsC (CInitHdr cl_info reg_rel cost_centre)
 	      if label_seen then
 		  Nothing
 	      else
-		  Just (pprExternDecl info_lbl PtrRep))
+		  Just (pprExternDecl False{-not in an SRT decl-} info_lbl))
   where
     info_lbl = infoTableLabelFromCI cl_info
 
@@ -1457,7 +1478,7 @@ ppr_decls_AbsC (CSRT lbl closure_lbls)
   = mapTE labelSeenTE closure_lbls		`thenTE` \ seen ->
     returnTE (Nothing, 
 	      if and seen then Nothing
-		else Just (vcat [ pprExternDecl l PtrRep
+		else Just (vcat [ pprExternDecl True{-in SRT decl-} l
 				| (l,False) <- zip closure_lbls seen ]))
 
 ppr_decls_AbsC (CRetDirect     _ code _ _)   = ppr_decls_AbsC code
@@ -1495,7 +1516,7 @@ ppr_decls_Amode (CLbl label VoidRep)
 ppr_decls_Amode (CLbl label kind)
   = labelSeenTE label `thenTE` \ label_seen ->
     returnTE (Nothing,
-	      if label_seen then Nothing else Just (pprExternDecl label kind))
+	      if label_seen then Nothing else Just (pprExternDecl False{-not in an SRT decl-} label))
 
 ppr_decls_Amode (CTableEntry base index _)
   = ppr_decls_Amode base    `thenTE` \ p1 ->
@@ -1542,6 +1563,7 @@ pprCLabelAddr clabel =
   where
     addr_of_label = ptext SLIT("(P_)&") <> pp_label
     pp_label = pprCLabel clabel
+
 \end{code}
 
 -----------------------------------------------------------------------------