Commit 567b2505 authored by rrt's avatar rrt
Browse files

[project @ 2000-08-02 14:13:26 by rrt]

Many fixes to DLLisation. These were previously covered up because code was
leaking into the import libraries for DLLs, so the fact that some symbols
were thought of as local rather than in another DLL wasn't a problem.

The main problems addressed by this commit are:

1. Fixes RTS symbols working properly when DLLised. They didn't before.
2. Uses NULL instead of stg_error_entry, because DLL entry points can't be
   used as static initialisers.
3. PrelGHC.hi-boot changed to be in package RTS, and export of PrelNum and
   PrelErr moved to PrelBase, so that references to primops & the like
   are cross-DLL as they should be.
4. Pass imports around as Modules rather than ModuleNames, so that
   ModuleInitLabels can be checked to see if they're in a DLL or not.
parent c0339ba1
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: AbsCSyn.lhs,v 1.31 2000/07/06 14:08:31 simonmar Exp $
% $Id: AbsCSyn.lhs,v 1.32 2000/08/02 14:13:26 rrt Exp $
%
\section[AbstractC]{Abstract C: the last stop before machine code}
......@@ -238,6 +238,8 @@ data CStmtMacro
| REGISTER_FOREIGN_EXPORT -- register a foreign exported fun
| REGISTER_IMPORT -- register an imported module
| REGISTER_DIMPORT -- register an imported module from
-- another DLL
| GRAN_FETCH -- for GrAnSim only -- HWL
| GRAN_RESCHEDULE -- for GrAnSim only -- HWL
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CLabel.lhs,v 1.37 2000/07/03 14:59:25 simonmar Exp $
% $Id: CLabel.lhs,v 1.38 2000/08/02 14:13:26 rrt Exp $
%
\section[CLabel]{@CLabel@: Information to make C Labels}
......@@ -84,7 +84,7 @@ import {-# SOURCE #-} MachMisc ( underscorePrefix, fmtAsmLbl )
import CmdLineOpts ( opt_Static, opt_DoTickyProfiling )
import CStrings ( pp_cSEP )
import DataCon ( ConTag, DataCon )
import Module ( ModuleName )
import Module ( ModuleName, moduleName, Module, isLocalModule )
import Name ( Name, getName, isDllName, isExternallyVisibleName )
import TyCon ( TyCon )
import Unique ( pprUnique, Unique )
......@@ -124,7 +124,7 @@ data CLabel
| AsmTempLabel Unique
| ModuleInitLabel ModuleName
| ModuleInitLabel Module
| RtsLabel RtsLabelInfo
......@@ -242,7 +242,6 @@ mkModuleInitLabel = ModuleInitLabel
-- Some fixed runtime system labels
mkErrorStdEntryLabel = RtsLabel RtsShouldNeverHappenCode
mkStgUpdatePAPLabel = RtsLabel (Rts_Code "stg_update_PAP")
mkSplitMarkerLabel = RtsLabel (Rts_Code "__stg_split_marker")
mkUpdInfoLabel = RtsLabel RtsUpdInfo
......@@ -305,11 +304,11 @@ let-no-escapes, which can be recursive.
needsCDecl (IdLabel _ _) = True
needsCDecl (CaseLabel _ CaseReturnPt) = True
needsCDecl (DataConLabel _ _) = True
needsCDecl (CaseLabel _ _) = False
needsCDecl (TyConLabel _) = True
needsCDecl (ModuleInitLabel _) = True
needsCDecl (CaseLabel _ _) = False
needsCDecl (AsmTempLabel _) = False
needsCDecl (ModuleInitLabel _) = False
needsCDecl (RtsLabel _) = False
needsCDecl (ForeignLabel _ _) = False
needsCDecl (CC_Label _) = False
......@@ -354,6 +353,7 @@ labelType (CaseLabel _ CaseReturnInfo) = InfoTblType
labelType (CaseLabel _ CaseReturnPt) = CodeType
labelType (CaseLabel _ CaseVecTbl) = VecTblType
labelType (TyConLabel _) = ClosureTblType
labelType (ModuleInitLabel _ ) = CodeType
labelType (IdLabel _ info) =
case info of
......@@ -379,11 +379,15 @@ in a DLL, be it a data reference or not.
labelDynamic :: CLabel -> Bool
labelDynamic lbl =
case lbl of
-- The special case for RtsShouldNeverHappenCode is because the associated address is
-- NULL, i.e. not a DLL entry point
RtsLabel RtsShouldNeverHappenCode -> False
RtsLabel _ -> not opt_Static -- i.e., is the RTS in a DLL or not?
IdLabel n k -> isDllName n
DataConLabel n k -> isDllName n
TyConLabel tc -> isDllName (getName tc)
ForeignLabel _ d -> d
ModuleInitLabel m -> (not opt_Static) && (not (isLocalModule m))
_ -> False
\end{code}
......@@ -459,7 +463,9 @@ pprCLbl (CaseLabel u CaseDefault)
pprCLbl (CaseLabel u CaseBitmap)
= hcat [pprUnique u, pp_cSEP, ptext SLIT("btm")]
pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("stg_error_entry")
pprCLbl (RtsLabel RtsShouldNeverHappenCode) = ptext SLIT("NULL")
-- used to be stg_error_entry but Windows can't have DLL entry points as static
-- initialisers, and besides, this ShouldNeverHappen, right?
pprCLbl (RtsLabel RtsUpdInfo) = ptext SLIT("upd_frame_info")
pprCLbl (RtsLabel RtsSeqInfo) = ptext SLIT("seq_frame_info")
......@@ -519,7 +525,7 @@ pprCLbl (DataConLabel con flavor) = ppr con <> ppConFlavor flavor
pprCLbl (CC_Label cc) = ppr cc
pprCLbl (CCS_Label ccs) = ppr ccs
pprCLbl (ModuleInitLabel mod) = ptext SLIT("__init_") <> ptext mod
pprCLbl (ModuleInitLabel mod) = ptext SLIT("__init_") <> ptext (moduleName mod)
ppIdFlavor :: IdLabelInfo -> SDoc
......
......@@ -27,10 +27,10 @@ import AbsCUtils ( getAmodeRep, nonemptyAbsC,
import Constants ( mIN_UPD_SIZE )
import CallConv ( callConvAttribute )
import CLabel ( externallyVisibleCLabel, mkErrorStdEntryLabel,
import CLabel ( externallyVisibleCLabel,
needsCDecl, pprCLabel,
mkReturnInfoLabel, mkReturnPtLabel, mkClosureTblLabel,
mkClosureLabel,
mkClosureLabel, mkErrorStdEntryLabel,
CLabel, CLabelType(..), labelType, labelDynamic
)
......@@ -1162,6 +1162,7 @@ cStmtMacroText UPDATE_SU_FROM_UPD_FRAME = SLIT("UPDATE_SU_FROM_UPD_FRAME")
cStmtMacroText SET_TAG = SLIT("SET_TAG")
cStmtMacroText REGISTER_FOREIGN_EXPORT = SLIT("REGISTER_FOREIGN_EXPORT")
cStmtMacroText REGISTER_IMPORT = SLIT("REGISTER_IMPORT")
cStmtMacroText REGISTER_DIMPORT = SLIT("REGISTER_DIMPORT")
cStmtMacroText GRAN_FETCH = SLIT("GRAN_FETCH")
cStmtMacroText GRAN_RESCHEDULE = SLIT("GRAN_RESCHEDULE")
cStmtMacroText GRAN_FETCH_AND_RESCHEDULE= SLIT("GRAN_FETCH_AND_RESCHEDULE")
......@@ -1507,7 +1508,7 @@ ppr_decls_AbsC (CClosureInfoAndCode cl_info slow maybe_fast _)
Nothing -> mkErrorStdEntryLabel
Just _ -> entryLabelFromCI cl_info
ppr_decls_AbsC (CSRT lbl closure_lbls)
ppr_decls_AbsC (CSRT _ closure_lbls)
= mapTE labelSeenTE closure_lbls `thenTE` \ seen ->
returnTE (Nothing,
if and seen then Nothing
......
......@@ -457,6 +457,7 @@ isDllName :: Name -> Bool
isDllName nm = not opt_Static &&
not (isLocallyDefinedName nm) &&
not (isLocalModule (nameModule nm))
-- Why is the isLocallyDefinedName test needed?
nameSrcLoc name = provSrcLoc (n_prov name)
......
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
% $Id: CgCase.lhs,v 1.44 2000/07/14 08:14:53 simonpj Exp $
% $Id: CgCase.lhs,v 1.45 2000/08/02 14:13:27 rrt Exp $
%
%********************************************************
%* *
......@@ -946,7 +946,7 @@ mkReturnVector uniq tagged_alt_absCs deflt_absC srt liveness ret_conv
deflt_lbl =
case nonemptyAbsC deflt_absC of
-- the simplifier might have eliminated a case
Nothing -> CLbl mkErrorStdEntryLabel CodePtrRep
Nothing -> mkIntCLit 0 -- CLbl mkErrorStdEntryLabel CodePtrRep
Just absC@(CCodeBlock lbl _) -> CLbl lbl CodePtrRep
mk_vector_entry :: ConTag -> (CAddrMode, AbstractC)
......
......@@ -22,7 +22,8 @@ module CodeGen ( codeGen ) where
import StgSyn
import CgMonad
import AbsCSyn
import CLabel ( CLabel, mkSRTLabel, mkClosureLabel, mkModuleInitLabel )
import CLabel ( CLabel, mkSRTLabel, mkClosureLabel,
mkModuleInitLabel, labelDynamic )
import PprAbsC ( dumpRealC )
import AbsCUtils ( mkAbstractCs, flattenAbsC )
......@@ -53,7 +54,7 @@ import Panic ( assertPanic )
codeGen :: Module -- Module name
-> [ModuleName] -- Import names
-> [Module] -- Import names
-> ([CostCentre], -- Local cost-centres needing declaring/registering
[CostCentre], -- "extern" cost-centres needing declaring
[CostCentreStack]) -- Pre-defined "singleton" cost centre stacks
......@@ -105,7 +106,7 @@ codeGen mod_name imported_modules cost_centre_info fe_binders
mkModuleInit
:: [Id] -- foreign exported functions
-> Module -- module name
-> [ModuleName] -- import names
-> [Module] -- import names
-> ([CostCentre], -- cost centre info
[CostCentre],
[CostCentreStack])
......@@ -120,16 +121,16 @@ mkModuleInit fe_binders mod imps cost_centre_info
(cc_decls, cc_regs) = mkCostCentreStuff cost_centre_info
mk_import_register import_name
= CMacroStmt REGISTER_IMPORT [
CLbl (mkModuleInitLabel import_name) AddrRep
mk_import_register imp =
CMacroStmt REGISTER_IMPORT [
CLbl (mkModuleInitLabel imp) AddrRep
]
register_imports = map mk_import_register imps
in
mkAbstractCs [
cc_decls,
CModuleInitBlock (mkModuleInitLabel (Module.moduleName mod))
CModuleInitBlock (mkModuleInitLabel mod)
(mkAbstractCs (register_fes ++
cc_regs :
register_imports))
......
......@@ -76,7 +76,7 @@ type RenameResult = ( Module -- This module
, ParsedIface -- The new interface
, RnNameSupply -- Final env; for renaming derivings
, FixityEnv -- The fixity environment; for derivings
, [ModuleName]) -- Imported modules; for profiling
, [Module]) -- Imported modules
renameModule :: UniqSupply -> RdrNameHsModule -> IO (Maybe RenameResult)
renameModule us this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
......@@ -158,9 +158,15 @@ rename this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec l
-- RETURN THE RENAMED MODULE
getNameSupplyRn `thenRn` \ name_supply ->
getIfacesRn `thenRn` \ ifaces ->
let
direct_import_mods :: [Module]
direct_import_mods = [m | (_, _, Just (m, _, _, _, ImportByUser, _))
<- eltsFM (iImpModInfo ifaces)]
-- Pick just the non-back-edge imports
-- (Back edges are ImportByUserSource)
this_module = mkThisModule mod_name
direct_import_mods = [mod | ImportDecl mod _ _ _ _ _ <- imports]
-- Export only those fixities that are for names that are
-- (a) defined in this module
......@@ -657,7 +663,7 @@ rnDeprecs gbl_env mod_deprec decls
%*********************************************************
\begin{code}
reportUnusedNames :: ModuleName -> [ModuleName]
reportUnusedNames :: ModuleName -> [Module]
-> GlobalRdrEnv -> AvailEnv
-> Avails -> NameSet -> [RenamedHsDecl]
-> RnMG ()
......@@ -727,18 +733,18 @@ reportUnusedNames mod_name direct_import_mods
-- There's really no good way to detect this, so the error message
-- in RnEnv.warnUnusedModules is weakened instead
inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
let m = moduleName (nameModule dfun),
let m = nameModule dfun,
m `elem` direct_import_mods
]
minimal_imports :: FiniteMap ModuleName AvailEnv
minimal_imports :: FiniteMap Module AvailEnv
minimal_imports0 = emptyFM
minimal_imports1 = foldNameSet add_name minimal_imports0 really_used_names
minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
add_name n acc = case maybeUserImportedFrom n of
Nothing -> acc
Just m -> addToFM_C plusAvailEnv acc (moduleName m)
Just m -> addToFM_C plusAvailEnv acc m
(unitAvailEnv (mk_avail n))
add_inst_mod m acc
| m `elemFM` acc = acc -- We import something already
......@@ -760,7 +766,7 @@ reportUnusedNames mod_name direct_import_mods
module_unused :: Name -> Bool
-- Name is imported from a module that's completely unused,
-- so don't report stuff about the name (the module covers it)
module_unused n = moduleName (expectJust "module_unused" (maybeUserImportedFrom n))
module_unused n = expectJust "module_unused" (maybeUserImportedFrom n)
`elem` unused_imp_mods
-- module_unused is only called if it's user-imported
in
......@@ -793,7 +799,7 @@ printMinimalImports mod_name imps
parens (fsep (punctuate comma (map ppr ies)))
to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env) `thenRn` \ ies ->
returnRn (mod, ies)
returnRn (moduleName mod, ies)
to_ie :: AvailInfo -> RnMG (IE Name)
to_ie (Avail n) = returnRn (IEVar n)
......
......@@ -705,10 +705,10 @@ mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
\begin{code}
warnUnusedModules :: [ModuleName] -> RnM d ()
warnUnusedModules :: [Module] -> RnM d ()
warnUnusedModules mods
| not opt_WarnUnusedImports = returnRn ()
| otherwise = mapRn_ (addWarnRn . unused_mod) mods
| otherwise = mapRn_ (addWarnRn . unused_mod . moduleName) mods
where
unused_mod m = vcat [ptext SLIT("Module") <+> quotes (pprModuleName m) <+>
text "is imported, but nothing from it is used",
......
# -----------------------------------------------------------------------------
# $Id: Makefile,v 1.11 1998/12/02 13:21:15 simonm Exp $
# $Id: Makefile,v 1.12 2000/08/02 14:13:27 rrt Exp $
#
TOP = ..
......@@ -8,7 +8,7 @@ include $(TOP)/mk/boilerplate.mk
#
# All header files
#
H_FILES = $(wildcard *.h)
H_FILES = $(filter-out gmp.h,$(wildcard *.h)) gmp.h
#
# Header file built from the configure script's findings
......@@ -17,6 +17,10 @@ H_CONFIG = config.h
all :: $(H_CONFIG) NativeDefs.h
# gmp.h is copied from the GMP directory
gmp.h : $(FPTOOLS_TOP)/ghc/rts/gmp/gmp.h
$(CP) $< $@
# The fptools configure script creates the configuration header file
# and puts it in fptools/mk/config.h. We copy it down to here, prepending
# some make variables specifying cpp platform variables.
......
/* -----------------------------------------------------------------------------
* $Id: StgMacros.h,v 1.31 2000/07/21 09:48:47 rrt Exp $
* $Id: StgMacros.h,v 1.32 2000/08/02 14:13:27 rrt Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -378,11 +378,8 @@ EXTFUN_RTS(stg_gen_block);
We use a RET_DYN frame the same as for a dynamic heap check.
------------------------------------------------------------------------- */
#if COMPILING_RTS
EI_(stg_gen_chk_info);
#else
EDI_(stg_gen_chk_info);
#endif
EXTINFO_RTS(stg_gen_chk_info);
/* -----------------------------------------------------------------------------
Vectored Returns
......@@ -749,9 +746,7 @@ LoadThreadState (void)
STGCALL1(getStablePtr,reg_fe_binder)
#define REGISTER_IMPORT(reg_mod_name) \
do { EXTFUN_RTS(reg_mod_name); \
PUSH_INIT_STACK(reg_mod_name) ; \
} while (0)
PUSH_INIT_STACK(reg_mod_name)
#define END_MOD_INIT() \
}}; \
......
/* -----------------------------------------------------------------------------
* $Id: StgMiscClosures.h,v 1.17 2000/07/21 09:31:46 rrt Exp $
* $Id: StgMiscClosures.h,v 1.18 2000/08/02 14:13:27 rrt Exp $
*
* (c) The GHC Team, 1998-1999
*
......@@ -126,7 +126,7 @@ extern DLL_IMPORT_DATA StgIntCharlikeClosure INTLIKE_closure[];
/* standard entry points */
extern StgFun stg_error_entry;
/* EXTFUN_RTS(stg_error_entry); No longer used */
/* (see also below -- KSW 1998-12) */
......
......@@ -91,7 +91,7 @@ DLL_NAME = HSstd.dll
DLL_DESCRIPTION="GHC-compiled Haskell Prelude"
DLL_IMPLIB_NAME = libHSstd_imp.a
SRC_BLD_DLL_OPTS += --export-all --output-def=HSstd.def DllVersionInfo.o
SRC_BLD_DLL_OPTS += -lwinmm -lHSrts_imp -lHSstd_cbits_imp -lgmp -L. -L../../rts/gmp -L../../rts -Lcbits
SRC_BLD_DLL_OPTS += -lwinmm -lHSrts_imp -lHSstd_cbits_imp -lgmp_imp -L. -L../../rts/gmp -L../../rts -Lcbits
ifeq "$(way)" "dll"
HS_SRCS := $(filter-out PrelMain.lhs PrelHugs.lhs, $(HS_SRCS))
......
% -----------------------------------------------------------------------------
% $Id: PrelBase.lhs,v 1.33 2000/07/07 11:03:57 simonmar Exp $
% $Id: PrelBase.lhs,v 1.34 2000/08/02 14:13:27 rrt Exp $
%
% (c) The University of Glasgow, 1992-2000
%
......@@ -78,12 +78,15 @@ Other Prelude modules are much easier with fewer complex dependencies.
module PrelBase
(
module PrelBase,
module PrelGHC -- Re-export PrelGHC, to avoid lots of people
-- having to import it explicitly
module PrelGHC, -- Re-export PrelGHC, PrelErr & PrelNum, to avoid lots
module PrelErr, -- of people having to import it explicitly
module PrelNum
)
where
import PrelGHC
import {-# SOURCE #-} PrelErr
import {-# SOURCE #-} PrelNum
infixr 9 .
infixr 5 ++, :
......
......@@ -5,7 +5,7 @@
-- primitive operations and types that GHC knows about.
---------------------------------------------------------------------------
__interface "std" PrelGHC 1 0 where
__interface "rts" PrelGHC 1 0 where
__export PrelGHC
......@@ -344,13 +344,6 @@ __export PrelGHC
-- Export PrelErr.error, so that others don't have to import PrelErr
__export PrelErr error ;
--------------------------------------------------
-- These imports tell modules low down in the hierarchy that
-- PrelErr and PrelBase are in the same package and
-- should be read from their hi-boot files
import PrelErr @ ;
import PrelNum @ ;
--------------------------------------------------
instance {CCallable Charzh} = zdfCCallableCharzh;
......
/* -----------------------------------------------------------------------------
* $Id: StgMiscClosures.hc,v 1.46 2000/07/17 15:15:40 rrt Exp $
* $Id: StgMiscClosures.hc,v 1.47 2000/08/02 14:13:28 rrt Exp $
*
* (c) The GHC Team, 1998-2000
*
......@@ -583,7 +583,8 @@ NON_ENTERABLE_ENTRY_CODE(MUT_VAR);
This is used for filling in vector-table entries that can never happen,
for instance.
-------------------------------------------------------------------------- */
/* No longer used; we use NULL, because a) it never happens, right? and b)
Windows doesn't like DLL entry points being used as static initialisers
STGFUN(stg_error_entry) \
{ \
FB_ \
......@@ -592,7 +593,7 @@ STGFUN(stg_error_entry) \
return NULL; \
FE_ \
}
*/
/* -----------------------------------------------------------------------------
Dummy return closure
......
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