From 567b2505b2d3d5874f3bf3641fd8d82b3207ea94 Mon Sep 17 00:00:00 2001 From: rrt Date: Wed, 2 Aug 2000 14:13:28 +0000 Subject: [PATCH] [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. --- ghc/compiler/absCSyn/AbsCSyn.lhs | 4 +++- ghc/compiler/absCSyn/CLabel.lhs | 36 +++++++++++++++++++++--------------- ghc/compiler/absCSyn/PprAbsC.lhs | 7 ++++--- ghc/compiler/basicTypes/Name.lhs | 1 + ghc/compiler/codeGen/CgCase.lhs | 4 ++-- ghc/compiler/codeGen/CodeGen.lhs | 15 ++++++++------- ghc/compiler/rename/Rename.lhs | 24 +++++++++++++++--------- ghc/compiler/rename/RnEnv.lhs | 4 ++-- ghc/includes/Makefile | 8 ++++++-- ghc/includes/StgMacros.h | 17 ++++++----------- ghc/includes/StgMiscClosures.h | 4 ++-- ghc/lib/std/Makefile | 2 +- ghc/lib/std/PrelBase.lhs | 9 ++++++--- ghc/lib/std/PrelGHC.hi-boot | 9 +-------- ghc/rts/StgMiscClosures.hc | 7 ++++--- 15 files changed, 82 insertions(+), 69 deletions(-) diff --git a/ghc/compiler/absCSyn/AbsCSyn.lhs b/ghc/compiler/absCSyn/AbsCSyn.lhs index 4f4c114..eac8a27 100644 --- a/ghc/compiler/absCSyn/AbsCSyn.lhs +++ b/ghc/compiler/absCSyn/AbsCSyn.lhs @@ -1,7 +1,7 @@ % % (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 diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs index 7d925e6..ac71fe6 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.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 @@ -241,8 +241,7 @@ mkModuleInitLabel = ModuleInitLabel -- Some fixed runtime system labels -mkErrorStdEntryLabel = RtsLabel RtsShouldNeverHappenCode - +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,12 +379,16 @@ in a DLL, be it a data reference or not. 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 -> isDllName n - DataConLabel n k -> isDllName n - TyConLabel tc -> isDllName (getName tc) - ForeignLabel _ d -> d - _ -> False + -- 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 diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index d4379e8..d98048c 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -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 diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs index 7ee54d5..60a5727 100644 --- a/ghc/compiler/basicTypes/Name.lhs +++ b/ghc/compiler/basicTypes/Name.lhs @@ -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) diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs index 339569b..d2fb33a 100644 --- a/ghc/compiler/codeGen/CgCase.lhs +++ b/ghc/compiler/codeGen/CgCase.lhs @@ -1,7 +1,7 @@ % % (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) diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs index 80fd8f9..0cbb76f 100644 --- a/ghc/compiler/codeGen/CodeGen.lhs +++ b/ghc/compiler/codeGen/CodeGen.lhs @@ -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)) diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs index c601856..8adfdf3 100644 --- a/ghc/compiler/rename/Rename.lhs +++ b/ghc/compiler/rename/Rename.lhs @@ -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) @@ -157,10 +157,16 @@ rename this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec l mkImportExportInfo mod_name export_avails exports `thenRn` \ (my_exports, my_usages) -> -- RETURN THE RENAMED MODULE - getNameSupplyRn `thenRn` \ name_supply -> + 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) diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index 7bd630c..4a8b0d3 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -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", diff --git a/ghc/includes/Makefile b/ghc/includes/Makefile index bf4e43e..d9c2d1e 100644 --- a/ghc/includes/Makefile +++ b/ghc/includes/Makefile @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $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. diff --git a/ghc/includes/StgMacros.h b/ghc/includes/StgMacros.h index 55ddab5..3cbcf8e 100644 --- a/ghc/includes/StgMacros.h +++ b/ghc/includes/StgMacros.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -49,7 +49,7 @@ #define EXTINFO_RTS extern DLL_IMPORT_RTS INFO_TBL_CONST StgInfoTable #define ED_ extern -#define EDD_ extern DLLIMPORT +#define EDD_ extern DLLIMPORT #define ED_RO_ extern const #define ID_ static #define ID_RO_ static const @@ -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,10 +746,8 @@ 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() \ }}; \ JMP_(POP_INIT_STACK()); \ diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h index f3283f9..476f265 100644 --- a/ghc/includes/StgMiscClosures.h +++ b/ghc/includes/StgMiscClosures.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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) */ diff --git a/ghc/lib/std/Makefile b/ghc/lib/std/Makefile index 5ca3ab6..cce4638 100644 --- a/ghc/lib/std/Makefile +++ b/ghc/lib/std/Makefile @@ -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)) diff --git a/ghc/lib/std/PrelBase.lhs b/ghc/lib/std/PrelBase.lhs index 5f6bd26..235c41b 100644 --- a/ghc/lib/std/PrelBase.lhs +++ b/ghc/lib/std/PrelBase.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $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 ++, : diff --git a/ghc/lib/std/PrelGHC.hi-boot b/ghc/lib/std/PrelGHC.hi-boot index af92064..084c561 100644 --- a/ghc/lib/std/PrelGHC.hi-boot +++ b/ghc/lib/std/PrelGHC.hi-boot @@ -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; diff --git a/ghc/rts/StgMiscClosures.hc b/ghc/rts/StgMiscClosures.hc index 76ab898..4d626ad 100644 --- a/ghc/rts/StgMiscClosures.hc +++ b/ghc/rts/StgMiscClosures.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 -- 1.7.10.4