From: sof Date: Tue, 2 Mar 1999 16:44:28 +0000 (+0000) Subject: [project @ 1999-03-02 16:44:26 by sof] X-Git-Tag: Approximately_9120_patches~6463 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=be2b723f7927ad7927e9d187fd7efda049d6dc77;p=ghc-hetmet.git [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. --- diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs index 0dfdb1c..d3f3d65 100644 --- a/ghc/compiler/absCSyn/CLabel.lhs +++ b/ghc/compiler/absCSyn/CLabel.lhs @@ -1,7 +1,7 @@ % % (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 diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index 4901261..5aeb8b7 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/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} -----------------------------------------------------------------------------