Commit be2b723f authored by sof's avatar sof
Browse files

[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.
parent 7f083558
%
% (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
......
......@@ -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}
-----------------------------------------------------------------------------
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment