Commit cd20fd58 authored by simonmar's avatar simonmar

[project @ 2004-02-24 17:33:32 by simonmar]

Experimental support for RTS-only "ways"

HEADS UP!  This changes the way that the threaded RTS is used, and
also the use of debugging RTSs:

  - We always build threaded and debugging variants of the RTS now.
    The --enable-threaded-rts configure option is ignored (and will
    be removed at some point).

  - New option:  -debug     enables the debugging RTS

  - New option:  -threaded  enables the threaded RTS.  When the threaded
    RTS is stable enough, we might make it the default.

The new options just cause a different variant of the RTS to be linked
in, and they cause one or two extra options to be enabled too.  The
implementation is via the usual ways machinery in the compiler, except
that these ways are labelled as RTS-only, and so don't require
rebuilding all the libraries too.

All of this means we can ship threaded and debugging RTSs with GHC, so
that users don't need to fetch and build a GHC source tree to use
them.

I'd like to get this functionality into 6.2.1 if possible, so please
test (I'm willing to stretch the definition of "interface change" to
accomodate this, since having a threaded RTS available without having
to build GHC will be a big win for the Visual Studio project).
parent f8f297af
......@@ -201,8 +201,11 @@ static_flags =
, ( "smp" , NoArg (addNoDups v_Ways WaySMP) )
, ( "debug" , NoArg (addNoDups v_Ways WayDebug) )
, ( "ndp" , NoArg (addNoDups v_Ways WayNDP) )
, ( "threaded" , NoArg (addNoDups v_Ways WayThreaded) )
-- ToDo: user ways
------ RTS ways -----------------------------------------------------
------ Debugging ----------------------------------------------------
, ( "dppr-noprags", PassFlag (add v_Opt_C) )
, ( "dppr-debug", PassFlag (add v_Opt_C) )
......
......@@ -1027,6 +1027,30 @@ staticLink o_files dep_packages = do
[rts_pkg, std_pkg] <- getPackageDetails [rtsPackage, basePackage]
ways <- readIORef v_Ways
-- Here are some libs that need to be linked at the *end* of
-- the command line, because they contain symbols that are referred to
-- by the RTS. We can't therefore use the ordinary way opts for these.
let
debug_opts | WayDebug `elem` ways = [
#if defined(HAVE_LIBBFD)
"-lbfd", "-liberty"
#endif
]
| otherwise = []
let
thread_opts | WayThreaded `elem` ways = [
#if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS)
"-lpthread"
#endif
#if defined(osf3_TARGET_OS)
, "-lexc"
#endif
]
| otherwise = []
let extra_os = if static || no_hs_main
then []
else [ head (library_dirs rts_pkg) ++ "/Main.dll_o",
......@@ -1054,6 +1078,8 @@ staticLink o_files dep_packages = do
++ pkg_framework_path_opts
++ pkg_framework_opts
#endif
++ debug_opts
++ thread_opts
))
-- parallel only: move binary to another dir -- HWL
......
-----------------------------------------------------------------------------
-- $Id: DriverState.hs,v 1.97 2003/09/23 14:33:00 simonmar Exp $
-- $Id: DriverState.hs,v 1.98 2004/02/24 17:33:34 simonmar Exp $
--
-- Settings for the driver
--
......@@ -379,16 +379,23 @@ getPackageLinkOpts :: [PackageName] -> IO [String]
getPackageLinkOpts pkgs = do
ps <- getExplicitPackagesAnd pkgs
tag <- readIORef v_Build_tag
rts_tag <- readIORef v_RTS_Build_tag
static <- readIORef v_Static
let
imp = if static then "" else "_imp"
suffix = if null tag then "" else '_':tag
libs p = map (++suffix) (hACK (hs_libraries p)) ++ extra_libraries p
libs p = map addSuffix (hACK (hs_libraries p)) ++ extra_libraries p
imp_libs p = map (++imp) (libs p)
all_opts p = map ("-l" ++) (imp_libs p) ++ extra_ld_opts p
suffix = if null tag then "" else '_':tag
rts_suffix = if null rts_tag then "" else '_':rts_tag
addSuffix rts@"HSrts" = rts ++ rts_suffix
addSuffix other_lib = other_lib ++ suffix
return (concat (map all_opts ps))
where
-- This is a totally horrible (temporary) hack, for Win32. Problem is
-- that package.conf for Win32 says that the main prelude lib is
-- split into HSbase1, HSbase2 and HSbase3, which is needed due to a bug
......@@ -476,15 +483,20 @@ getExplicitAndAutoPackageConfigs = do
GLOBAL_VAR(v_Build_tag, "", String)
-- The RTS has its own build tag, because there are some ways that
-- affect the RTS only.
GLOBAL_VAR(v_RTS_Build_tag, "", String)
data WayName
= WayProf
= WayThreaded
| WayDebug
| WayProf
| WayUnreg
| WayTicky
| WayPar
| WayGran
| WaySMP
| WayNDP
| WayDebug
| WayUser_a
| WayUser_b
| WayUser_c
......@@ -506,35 +518,36 @@ data WayName
GLOBAL_VAR(v_Ways, [] ,[WayName])
allowed_combination way = way `elem` combs
where -- the sub-lists must be ordered according to WayName,
-- because findBuildTag sorts them
combs = [ [WayProf, WayUnreg],
[WayProf, WaySMP] ,
[WayProf, WayNDP] ]
allowed_combination way = and [ x `allowedWith` y
| x <- way, y <- way, x < y ]
where
-- debug is allowed with everything
_ `allowedWith` WayDebug = True
WayDebug `allowedWith` _ = True
WayProf `allowedWith` WayThreaded = True
WayProf `allowedWith` WayUnreg = True
WayProf `allowedWith` WaySMP = True
WayProf `allowedWith` WayNDP = True
findBuildTag :: IO [String] -- new options
findBuildTag = do
way_names <- readIORef v_Ways
case sort way_names of
[] -> do -- writeIORef v_Build_tag ""
return []
[w] -> do let details = lkupWay w
writeIORef v_Build_tag (wayTag details)
return (wayOpts details)
ws -> if not (allowed_combination ws)
then throwDyn (CmdLineError $
"combination not supported: " ++
foldr1 (\a b -> a ++ '/':b)
(map (wayName . lkupWay) ws))
else let stuff = map lkupWay ws
tag = concat (map wayTag stuff)
flags = map wayOpts stuff
in do
writeIORef v_Build_tag tag
return (concat flags)
let ws = sort way_names
if not (allowed_combination ws)
then throwDyn (CmdLineError $
"combination not supported: " ++
foldr1 (\a b -> a ++ '/':b)
(map (wayName . lkupWay) ws))
else let stuff = map lkupWay ws
tag = concat [ wayTag w | w <- stuff, not (wayRTSOnly w) ]
rts_tag = concat (map wayTag stuff)
flags = map wayOpts stuff
in do
writeIORef v_Build_tag tag
writeIORef v_RTS_Build_tag rts_tag
return (concat flags)
lkupWay w =
case lookup w way_details of
......@@ -542,30 +555,39 @@ lkupWay w =
Just details -> details
data Way = Way {
wayTag :: String,
wayName :: String,
wayOpts :: [String]
wayTag :: String,
wayRTSOnly :: Bool,
wayName :: String,
wayOpts :: [String]
}
way_details :: [ (WayName, Way) ]
way_details =
[ (WayProf, Way "p" "Profiling"
[ (WayThreaded, Way "thr" True "Threaded" [
#if defined(freebsd_TARGET_OS)
, "-optc-pthread"
#endif
] ),
(WayDebug, Way "debug" True "Debug" [] ),
(WayProf, Way "p" False "Profiling"
[ "-fscc-profiling"
, "-DPROFILING"
, "-optc-DPROFILING"
, "-fvia-C" ]),
(WayTicky, Way "t" "Ticky-ticky Profiling"
(WayTicky, Way "t" False "Ticky-ticky Profiling"
[ "-fticky-ticky"
, "-DTICKY_TICKY"
, "-optc-DTICKY_TICKY"
, "-fvia-C" ]),
(WayUnreg, Way "u" "Unregisterised"
(WayUnreg, Way "u" False "Unregisterised"
unregFlags ),
-- optl's below to tell linker where to find the PVM library -- HWL
(WayPar, Way "mp" "Parallel"
(WayPar, Way "mp" False "Parallel"
[ "-fparallel"
, "-D__PARALLEL_HASKELL__"
, "-optc-DPAR"
......@@ -577,7 +599,7 @@ way_details =
, "-fvia-C" ]),
-- at the moment we only change the RTS and could share compiler and libs!
(WayPar, Way "mt" "Parallel ticky profiling"
(WayPar, Way "mt" False "Parallel ticky profiling"
[ "-fparallel"
, "-D__PARALLEL_HASKELL__"
, "-optc-DPAR"
......@@ -589,7 +611,7 @@ way_details =
, "-optl-lgpvm3"
, "-fvia-C" ]),
(WayPar, Way "md" "Distributed"
(WayPar, Way "md" False "Distributed"
[ "-fparallel"
, "-D__PARALLEL_HASKELL__"
, "-D__DISTRIBUTED_HASKELL__"
......@@ -602,14 +624,14 @@ way_details =
, "-optl-lgpvm3"
, "-fvia-C" ]),
(WayGran, Way "mg" "GranSim"
(WayGran, Way "mg" False "GranSim"
[ "-fgransim"
, "-D__GRANSIM__"
, "-optc-DGRAN"
, "-package concurrent"
, "-fvia-C" ]),
(WaySMP, Way "s" "SMP"
(WaySMP, Way "s" False "SMP"
[ "-fsmp"
, "-optc-pthread"
#ifndef freebsd_TARGET_OS
......@@ -618,27 +640,27 @@ way_details =
, "-optc-DSMP"
, "-fvia-C" ]),
(WayNDP, Way "ndp" "Nested data parallelism"
(WayNDP, Way "ndp" False "Nested data parallelism"
[ "-fparr"
, "-fflatten"]),
(WayUser_a, Way "a" "User way 'a'" ["$WAY_a_REAL_OPTS"]),
(WayUser_b, Way "b" "User way 'b'" ["$WAY_b_REAL_OPTS"]),
(WayUser_c, Way "c" "User way 'c'" ["$WAY_c_REAL_OPTS"]),
(WayUser_d, Way "d" "User way 'd'" ["$WAY_d_REAL_OPTS"]),
(WayUser_e, Way "e" "User way 'e'" ["$WAY_e_REAL_OPTS"]),
(WayUser_f, Way "f" "User way 'f'" ["$WAY_f_REAL_OPTS"]),
(WayUser_g, Way "g" "User way 'g'" ["$WAY_g_REAL_OPTS"]),
(WayUser_h, Way "h" "User way 'h'" ["$WAY_h_REAL_OPTS"]),
(WayUser_i, Way "i" "User way 'i'" ["$WAY_i_REAL_OPTS"]),
(WayUser_j, Way "j" "User way 'j'" ["$WAY_j_REAL_OPTS"]),
(WayUser_k, Way "k" "User way 'k'" ["$WAY_k_REAL_OPTS"]),
(WayUser_l, Way "l" "User way 'l'" ["$WAY_l_REAL_OPTS"]),
(WayUser_m, Way "m" "User way 'm'" ["$WAY_m_REAL_OPTS"]),
(WayUser_n, Way "n" "User way 'n'" ["$WAY_n_REAL_OPTS"]),
(WayUser_o, Way "o" "User way 'o'" ["$WAY_o_REAL_OPTS"]),
(WayUser_A, Way "A" "User way 'A'" ["$WAY_A_REAL_OPTS"]),
(WayUser_B, Way "B" "User way 'B'" ["$WAY_B_REAL_OPTS"])
(WayUser_a, Way "a" False "User way 'a'" ["$WAY_a_REAL_OPTS"]),
(WayUser_b, Way "b" False "User way 'b'" ["$WAY_b_REAL_OPTS"]),
(WayUser_c, Way "c" False "User way 'c'" ["$WAY_c_REAL_OPTS"]),
(WayUser_d, Way "d" False "User way 'd'" ["$WAY_d_REAL_OPTS"]),
(WayUser_e, Way "e" False "User way 'e'" ["$WAY_e_REAL_OPTS"]),
(WayUser_f, Way "f" False "User way 'f'" ["$WAY_f_REAL_OPTS"]),
(WayUser_g, Way "g" False "User way 'g'" ["$WAY_g_REAL_OPTS"]),
(WayUser_h, Way "h" False "User way 'h'" ["$WAY_h_REAL_OPTS"]),
(WayUser_i, Way "i" False "User way 'i'" ["$WAY_i_REAL_OPTS"]),
(WayUser_j, Way "j" False "User way 'j'" ["$WAY_j_REAL_OPTS"]),
(WayUser_k, Way "k" False "User way 'k'" ["$WAY_k_REAL_OPTS"]),
(WayUser_l, Way "l" False "User way 'l'" ["$WAY_l_REAL_OPTS"]),
(WayUser_m, Way "m" False "User way 'm'" ["$WAY_m_REAL_OPTS"]),
(WayUser_n, Way "n" False "User way 'n'" ["$WAY_n_REAL_OPTS"]),
(WayUser_o, Way "o" False "User way 'o'" ["$WAY_o_REAL_OPTS"]),
(WayUser_A, Way "A" False "User way 'A'" ["$WAY_A_REAL_OPTS"]),
(WayUser_B, Way "B" False "User way 'B'" ["$WAY_B_REAL_OPTS"])
]
unregFlags =
......
......@@ -24,11 +24,41 @@ UseGhcForCc = YES
include $(TOP)/mk/boilerplate.mk
PACKAGE = rts
HC=$(GHC_INPLACE)
WAYS=$(GhcLibWays)
# -----------------------------------------------------------------------------
# RTS ways
PACKAGE = rts
WAYS=$(GhcLibWays) thr debug
ifneq "$(findstring p, $(GhcLibWays))" ""
WAYS += thr_p debug_p
endif
# Way 'thr':
WAY_thr_NAME=threaded
WAY_thr_HC_OPTS=-optc-DTHREADED_RTS
# Way 'thr_p':
WAY_thr_p_NAME=threaded profiled
WAY_thr_p_HC_OPTS=-optc-DTHREADED_RTS -prof
# Way 'debug':
WAY_debug_NAME=debug
WAY_debug_HC_OPTS=-optc-DDEBUG
# Way 'debug_p':
WAY_debug_p_NAME=debug profiled
WAY_debug_p_HC_OPTS=-optc-DDEBUG -prof
ifneq "$(findstring $(way), debug debug_p)" ""
GhcRtsHcOpts=
GhcRtsCcOpts=-g
endif
# -----------------------------------------------------------------------------
# Tells the build system not to add various Haskellish options to $(SRC_HC_OPTS)
NON_HS_PACKAGE = YES
......@@ -110,21 +140,6 @@ ifeq "$(way)" "mp"
SRC_HC_OPTS += -I$$PVM_ROOT/include
endif
# You get 'threads support' in the normal
# and profiling ways.
ifeq "$(GhcRtsThreaded)" "YES"
ifeq "$(way)" ""
SRC_CC_OPTS += -DTHREADED_RTS
SRC_HC_OPTS += -optc-DTHREADED_RTS
PACKAGE_CPP_OPTS += -DTHREADED_RTS
endif
ifeq "$(way)" "p"
SRC_CC_OPTS += -DTHREADED_RTS
SRC_HC_OPTS += -optc-DTHREADED_RTS
PACKAGE_CPP_OPTS += -DTHREADED_RTS
endif
endif
# If -DDEBUG is in effect, adjust package conf accordingly..
ifneq "$(strip $(filter -optc-DDEBUG,$(GhcRtsHcOpts)))" ""
PACKAGE_CPP_OPTS += -DDEBUG
......
#include "config.h"
#include "Derived.h"
/* The RTS is just another package! */
Package {
name = "rts", /* The RTS is just another package! */
#ifdef THREADED_RTS
name = "rts_thr",
#elif defined(DEBUG)
name = "rts_debug",
#else
name = "rts",
#endif
import_dirs = [],
source_dirs = [],
......@@ -20,7 +27,13 @@ Package {
#endif
],
#ifdef THREADED_RTS
hs_libraries = [ "HSrts_thr" ],
#elif defined(DEBUG)
hs_libraries = [ "HSrts_debug" ],
#else
hs_libraries = [ "HSrts" ],
#endif
extra_libraries = [
"m" /* for ldexp() */
#ifndef HAVE_FRAMEWORK_HASKELLSUPPORT
......
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