%
% (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}
needsCDecl, isReadOnly, isAsmTemp, externallyVisibleCLabel,
- CLabelType(..), labelType,
+ CLabelType(..), labelType, labelDynamic,
pprCLabel
#if ! OMIT_NATIVE_CODEGEN
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 )
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
import CLabel ( externallyVisibleCLabel, mkErrorStdEntryLabel,
isReadOnly, needsCDecl, pprCLabel,
mkReturnInfoLabel, mkReturnPtLabel,
- CLabel, CLabelType(..), labelType
+ CLabel, CLabelType(..), labelType, labelDynamic
)
import CmdLineOpts ( opt_SccProfilingOn, opt_EmitCExternDecls, opt_GranMacros )
$$ 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 [
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)),
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,
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 ");"
],
-- 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}
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 ]
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}
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
= 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
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 ->
where
addr_of_label = ptext SLIT("(P_)&") <> pp_label
pp_label = pprCLabel clabel
+
\end{code}
-----------------------------------------------------------------------------
projects / ghc-hetmet.git / commitdiff