diff options
| -rw-r--r-- | compiler/ghc.mk | 6 | ||||
| -rw-r--r-- | compiler/ghci/Linker.lhs | 14 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 22 | ||||
| -rw-r--r-- | includes/Rts.h | 10 | ||||
| -rw-r--r-- | includes/rts/prof/CCS.h | 3 | ||||
| -rw-r--r-- | rts/RtsUtils.c | 11 | ||||
| -rw-r--r-- | rts/ghc.mk | 1 |
7 files changed, 48 insertions, 19 deletions
diff --git a/compiler/ghc.mk b/compiler/ghc.mk index 810b11a287..a5a20345a1 100644 --- a/compiler/ghc.mk +++ b/compiler/ghc.mk @@ -111,12 +111,6 @@ ifeq "$(UseLibFFIForAdjustors)" "YES" else @echo 'cLibFFI = False' >> $@ endif - @echo 'cDYNAMIC_GHC_PROGRAMS :: Bool' >> $@ -ifeq "$(DYNAMIC_GHC_PROGRAMS)" "YES" - @echo 'cDYNAMIC_GHC_PROGRAMS = True' >> $@ -else - @echo 'cDYNAMIC_GHC_PROGRAMS = False' >> $@ -endif # Note that GhcThreaded just reflects the Makefile variable setting. # In particular, the stage1 compiler is never actually compiled with # -threaded, but it will nevertheless have cGhcThreaded = True. diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index edc0db1295..62f7a701c1 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -413,14 +413,14 @@ preloadLib dflags lib_paths framework_paths lib_spec preload_static _paths name = do b <- doesFileExist name if not b then return False - else do if cDYNAMIC_GHC_PROGRAMS + else do if dynamicGhc then dynLoadObjs dflags [name] else loadObj name return True preload_static_archive _paths name = do b <- doesFileExist name if not b then return False - else do if cDYNAMIC_GHC_PROGRAMS + else do if dynamicGhc then panic "Loading archives not supported" else loadArchive name return True @@ -496,7 +496,7 @@ checkNonStdWay dflags srcspan = -- whereas we have __stginit_base_Prelude_. else if objectSuf dflags == normalObjectSuffix && not (null haskellWays) then failNonStd dflags srcspan - else return $ Just $ if cDYNAMIC_GHC_PROGRAMS + else return $ Just $ if dynamicGhc then "dyn_o" else "o" where haskellWays = filter (not . wayRTSOnly) (ways dflags) @@ -509,7 +509,7 @@ failNonStd dflags srcspan = dieWith dflags srcspan $ ptext (sLit "Dynamic linking required, but this is a non-standard build (eg. prof).") $$ ptext (sLit "You need to build the program twice: once the") <+> ghciWay <+> ptext (sLit "way, and then") $$ ptext (sLit "in the desired way using -osuf to set the object file suffix.") - where ghciWay = if cDYNAMIC_GHC_PROGRAMS + where ghciWay = if dynamicGhc then ptext (sLit "dynamic") else ptext (sLit "normal") @@ -783,7 +783,7 @@ dynLinkObjs dflags pls objs = do unlinkeds = concatMap linkableUnlinked new_objs wanted_objs = map nameOfObject unlinkeds - if cDYNAMIC_GHC_PROGRAMS + if dynamicGhc then do dynLoadObjs dflags wanted_objs return (pls1, Succeeded) else do mapM_ loadObj wanted_objs @@ -970,7 +970,7 @@ unload_wkr _ linkables pls | linkableInSet lnk keep_linkables = return True -- We don't do any cleanup when linking objects with the dynamic linker. -- Doing so introduces extra complexity for not much benefit. - | cDYNAMIC_GHC_PROGRAMS = return False + | dynamicGhc = return False | otherwise = do mapM_ unloadObj [f | DotO f <- linkableUnlinked lnk] -- The components of a BCO linkable may contain @@ -1182,7 +1182,7 @@ locateLib dflags is_hs dirs lib -- = findDll `orElse` findArchive `orElse` tryGcc `orElse` assumeDll - | not cDYNAMIC_GHC_PROGRAMS + | not dynamicGhc -- When the GHC package was not compiled as dynamic library -- (=DYNAMIC not set), we search for .o libraries or, if they -- don't exist, .a libraries. diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0dcad39200..522e7613aa 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -117,6 +117,7 @@ module DynFlags ( -- Only in stage 2 can we be sure that the RTS -- exposes the appropriate runtime boolean rtsIsProfiled, + dynamicGhc, #endif #include "../includes/dist-derivedconstants/header/GHCConstantsHaskellExports.hs" @@ -166,6 +167,7 @@ import FastString import Outputable #ifdef GHCI import Foreign.C ( CInt(..) ) +import System.IO.Unsafe ( unsafeDupablePerformIO ) #endif import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessage ) @@ -1444,7 +1446,7 @@ defaultWays settings = if pc_DYNAMIC_BY_DEFAULT (sPlatformConstants settings) else [] interpWays :: [Way] -interpWays = if cDYNAMIC_GHC_PROGRAMS +interpWays = if dynamicGhc then [WayDyn] else [] @@ -3069,7 +3071,21 @@ glasgowExtsFlags = [ foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt rtsIsProfiled :: Bool -rtsIsProfiled = unsafePerformIO rtsIsProfiledIO /= 0 +rtsIsProfiled = unsafeDupablePerformIO rtsIsProfiledIO /= 0 +#endif + +#ifdef GHCI +-- Consult the RTS to find whether GHC itself has been built with +-- dynamic linking. This can't be statically known at compile-time, +-- because we build both the static and dynamic versions together with +-- -dynamic-too. +foreign import ccall unsafe "rts_isDynamic" rtsIsDynamicIO :: IO CInt + +dynamicGhc :: Bool +dynamicGhc = unsafeDupablePerformIO rtsIsDynamicIO /= 0 +#else +dynamicGhc :: Bool +dynamicGhc = False #endif setWarnSafe :: Bool -> DynP () @@ -3535,7 +3551,7 @@ compilerInfo dflags ("Support parallel --make", "YES"), ("Dynamic by default", if dYNAMIC_BY_DEFAULT dflags then "YES" else "NO"), - ("GHC Dynamic", if cDYNAMIC_GHC_PROGRAMS + ("GHC Dynamic", if dynamicGhc then "YES" else "NO"), ("Leading underscore", cLeadingUnderscore), ("Debug on", show debugIsOn), diff --git a/includes/Rts.h b/includes/Rts.h index 86555147ab..96dc6a5c30 100644 --- a/includes/Rts.h +++ b/includes/Rts.h @@ -259,6 +259,16 @@ int stg_sig_install (int, int, void *); #endif /* ----------------------------------------------------------------------------- + Ways + -------------------------------------------------------------------------- */ + +// Returns non-zero if the RTS is a profiling version +int rts_isProfiled(void); + +// Returns non-zero if the RTS is a dynamically-linked version +int rts_isDynamic(void); + +/* ----------------------------------------------------------------------------- RTS Exit codes -------------------------------------------------------------------------- */ diff --git a/includes/rts/prof/CCS.h b/includes/rts/prof/CCS.h index dbd0717d4d..b121b0361e 100644 --- a/includes/rts/prof/CCS.h +++ b/includes/rts/prof/CCS.h @@ -14,9 +14,6 @@ #ifndef RTS_PROF_CCS_H #define RTS_PROF_CCS_H -// Returns non-zero if the RTS is a profiling version -int rts_isProfiled(void); - /* ----------------------------------------------------------------------------- * Data Structures * ---------------------------------------------------------------------------*/ diff --git a/rts/RtsUtils.c b/rts/RtsUtils.c index cb9002c361..b06b6af962 100644 --- a/rts/RtsUtils.c +++ b/rts/RtsUtils.c @@ -304,6 +304,17 @@ int rts_isProfiled(void) #endif } +// Provides a way for Haskell programs to tell whether they're +// dynamically-linked or not. +int rts_isDynamic(void) +{ +#ifdef DYNAMIC + return 1; +#else + return 0; +#endif +} + // Used for detecting a non-empty FPU stack on x86 (see #4914) void checkFPUStack(void) { diff --git a/rts/ghc.mk b/rts/ghc.mk index 401fe21eec..9f36811d41 100644 --- a/rts/ghc.mk +++ b/rts/ghc.mk @@ -139,6 +139,7 @@ ifneq "$$(findstring dyn, $1)" "" ifeq "$$(HostOS_CPP)" "mingw32" rts_dist_$1_CC_OPTS += -DCOMPILING_WINDOWS_DLL endif +rts_dist_$1_CC_OPTS += -DDYNAMIC endif ifneq "$$(findstring thr, $1)" "" |