StaticFlags.hs 17.2 KB
Newer Older
Ian Lynagh's avatar
Ian Lynagh committed
1 2 3 4 5 6 7
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

8 9 10
{-# OPTIONS -fno-cse #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly

11 12 13 14 15 16 17 18 19 20 21 22 23
-----------------------------------------------------------------------------
--
-- Static flags
--
-- Static flags can only be set once, on the command-line.  Inside GHC,
-- each static flag corresponds to a top-level value, usually of type Bool.
--
-- (c) The University of Glasgow 2005
--
-----------------------------------------------------------------------------

module StaticFlags (
	staticFlags,
24
        initStaticOpts,
25 26

	-- Ways
27
	WayName(..), Way(..), v_Ways, isRTSWay, mkBuildTag,
28 29

	-- Output style options
benl's avatar
benl committed
30
	opt_PprCols,
31
	opt_PprCaseAsLet,
benl's avatar
benl committed
32
	opt_PprStyle_Debug, opt_TraceLevel,
dterei's avatar
dterei committed
33
        opt_NoDebugOutput,
benl's avatar
benl committed
34 35

	-- Suppressing boring aspects of core dumps
benl's avatar
benl committed
36
	opt_SuppressAll,
37
	opt_SuppressUniques,
38
        opt_SuppressCoercions,
39
	opt_SuppressModulePrefixes,
benl's avatar
benl committed
40 41
	opt_SuppressTypeApplications,
	opt_SuppressIdInfo,
benl's avatar
benl committed
42
	opt_SuppressTypeSignatures,
43
        opt_SuppressVarKinds,
44 45 46 47

	-- profiling opts
	opt_SccProfilingOn,

andy@galois.com's avatar
andy@galois.com committed
48 49 50
        -- Hpc opts
	opt_Hpc,

51 52 53 54 55 56 57
	-- language opts
	opt_DictsStrict,
	opt_IrrefutableTuples,
	opt_Parallel,

	-- optimisation opts
	opt_NoStateHack,
58
        opt_SimpleListLiterals,
59 60 61
	opt_CprOff,
	opt_SimplNoPreInlining,
	opt_SimplExcessPrecision,
62
	opt_NoOptCoercion,
63 64 65 66 67 68
	opt_MaxWorkerArgs,

	-- Unfolding control
	opt_UF_CreationThreshold,
	opt_UF_UseThreshold,
	opt_UF_FunAppDiscount,
69
	opt_UF_DictDiscount,
70 71 72
	opt_UF_KeenessFactor,
	opt_UF_DearOp,

dias@eecs.harvard.edu's avatar
dias@eecs.harvard.edu committed
73 74 75
	-- Optimization fuel controls
	opt_Fuel,

76 77 78 79
	-- Related to linking
	opt_PIC,
	opt_Static,

80 81 82 83 84 85
	-- misc opts
	opt_IgnoreDotGhci,
	opt_ErrorSpans,
	opt_GranMacros,
	opt_HiVersion,
	opt_HistorySize,
86
        opt_Unregisterised,
87
	v_Ld_inputs,
88
	tablesNextToCode,
89
        opt_StubDeadValues,
90
        opt_Ticky,
91 92

    -- For the parser
93
    addOpt, removeOpt, addWay, getWayFlags, v_opt_C_ready,
dterei's avatar
dterei committed
94

95 96
    -- Saving/restoring globals
    saveStaticFlagGlobals, restoreStaticFlagGlobals
97 98 99 100
  ) where

#include "HsVersions.h"

101
import Config
102
import FastString
103
import Util
104
import Maybes		( firstJusts )
105
import Panic
106

107
import Control.Monad    ( liftM3 )
108
import Data.Maybe       ( listToMaybe )
Simon Marlow's avatar
Simon Marlow committed
109 110
import Data.IORef
import System.IO.Unsafe	( unsafePerformIO )
111
import Data.List
112 113 114 115

-----------------------------------------------------------------------------
-- Static flags

116 117
initStaticOpts :: IO ()
initStaticOpts = writeIORef v_opt_C_ready True
118

Ian Lynagh's avatar
Ian Lynagh committed
119
addOpt :: String -> IO ()
120 121
addOpt = consIORef v_opt_C

Ian Lynagh's avatar
Ian Lynagh committed
122
addWay :: WayName -> IO ()
123
addWay = consIORef v_Ways . lkupWay
124

Ian Lynagh's avatar
Ian Lynagh committed
125
removeOpt :: String -> IO ()
126 127
removeOpt f = do
  fs <- readIORef v_opt_C
dterei's avatar
dterei committed
128
  writeIORef v_opt_C $! filter (/= f) fs
129 130 131 132 133 134 135 136 137

lookUp	       	 :: FastString -> Bool
lookup_def_int   :: String -> Int -> Int
lookup_def_float :: String -> Float -> Float
lookup_str       :: String -> Maybe String

-- holds the static opts while they're being collected, before
-- being unsafely read by unpacked_static_opts below.
GLOBAL_VAR(v_opt_C, defaultStaticOpts, [String])
138
GLOBAL_VAR(v_opt_C_ready, False, Bool)
Ian Lynagh's avatar
Ian Lynagh committed
139 140

staticFlags :: [String]
141 142 143
staticFlags = unsafePerformIO $ do
  ready <- readIORef v_opt_C_ready
  if (not ready)
144
        then panic "Static flags have not been initialised!\n        Please call GHC.newSession or GHC.parseStaticFlags early enough."
145
        else readIORef v_opt_C
146 147

-- -static is the default
Ian Lynagh's avatar
Ian Lynagh committed
148
defaultStaticOpts :: [String]
149 150
defaultStaticOpts = ["-static"]

Ian Lynagh's avatar
Ian Lynagh committed
151
packed_static_opts :: [FastString]
152 153 154
packed_static_opts   = map mkFastString staticFlags

lookUp     sw = sw `elem` packed_static_opts
dterei's avatar
dterei committed
155 156

-- (lookup_str "foo") looks for the flag -foo=X or -fooX,
157
-- and returns the string X
dterei's avatar
dterei committed
158
lookup_str sw
159
   = case firstJusts (map (stripPrefix sw) staticFlags) of
160 161
	Just ('=' : str) -> Just str
	Just str         -> Just str
dterei's avatar
dterei committed
162
	Nothing		 -> Nothing
163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179

lookup_def_int sw def = case (lookup_str sw) of
			    Nothing -> def		-- Use default
		  	    Just xx -> try_read sw xx

lookup_def_float sw def = case (lookup_str sw) of
			    Nothing -> def		-- Use default
		  	    Just xx -> try_read sw xx


try_read :: Read a => String -> String -> a
-- (try_read sw str) tries to read s; if it fails, it
-- bleats about flag sw
try_read sw str
  = case reads str of
	((x,_):_) -> x	-- Be forgiving: ignore trailing goop, and alternative parses
	[]	  -> ghcError (UsageError ("Malformed argument " ++ str ++ " for flag " ++ sw))
Ian Lynagh's avatar
Ian Lynagh committed
180
			-- ToDo: hack alert. We should really parse the arguments
181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199
			-- 	 and announce errors in a more civilised way.


{-
 Putting the compiler options into temporary at-files
 may turn out to be necessary later on if we turn hsc into
 a pure Win32 application where I think there's a command-line
 length limit of 255. unpacked_opts understands the @ option.

unpacked_opts :: [String]
unpacked_opts =
  concat $
  map (expandAts) $
  map unpackFS argv  -- NOT ARGV any more: v_Static_hsc_opts
  where
   expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
   expandAts l = [l]
-}

Ian Lynagh's avatar
Ian Lynagh committed
200
opt_IgnoreDotGhci :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
201
opt_IgnoreDotGhci		= lookUp (fsLit "-ignore-dot-ghci")
dterei's avatar
dterei committed
202

benl's avatar
benl committed
203 204
-- debugging options
-- | Suppress all that is suppressable in core dumps.
205 206
--   Except for uniques, as some simplifier phases introduce new varibles that
--   have otherwise identical names.
benl's avatar
benl committed
207
opt_SuppressAll :: Bool
dterei's avatar
dterei committed
208
opt_SuppressAll
benl's avatar
benl committed
209 210 211
	= lookUp  (fsLit "-dsuppress-all")

-- | Suppress all coercions, them replacing with '...'
212
opt_SuppressCoercions :: Bool
benl's avatar
benl committed
213
opt_SuppressCoercions
dterei's avatar
dterei committed
214
	=  lookUp  (fsLit "-dsuppress-all")
benl's avatar
benl committed
215
	|| lookUp  (fsLit "-dsuppress-coercions")
benl@ouroborus.net's avatar
benl@ouroborus.net committed
216

217 218 219 220 221
opt_SuppressVarKinds :: Bool
opt_SuppressVarKinds
	=  lookUp  (fsLit "-dsuppress-all")
	|| lookUp  (fsLit "-dsuppress-var-kinds")

benl's avatar
benl committed
222
-- | Suppress module id prefixes on variables.
223
opt_SuppressModulePrefixes :: Bool
benl's avatar
benl committed
224 225 226 227 228 229 230 231 232 233 234 235
opt_SuppressModulePrefixes
	=  lookUp  (fsLit "-dsuppress-all")
	|| lookUp  (fsLit "-dsuppress-module-prefixes")

-- | Suppress type applications.
opt_SuppressTypeApplications :: Bool
opt_SuppressTypeApplications
	=  lookUp  (fsLit "-dsuppress-all")
	|| lookUp  (fsLit "-dsuppress-type-applications")

-- | Suppress info such as arity and unfoldings on identifiers.
opt_SuppressIdInfo :: Bool
dterei's avatar
dterei committed
236
opt_SuppressIdInfo
benl's avatar
benl committed
237 238
	=  lookUp  (fsLit "-dsuppress-all")
	|| lookUp  (fsLit "-dsuppress-idinfo")
benl's avatar
benl committed
239

Simon Peyton Jones's avatar
Simon Peyton Jones committed
240
-- | Suppress separate type signatures in core, but leave types on lambda bound vars
benl's avatar
benl committed
241 242 243 244 245
opt_SuppressTypeSignatures :: Bool
opt_SuppressTypeSignatures
	=  lookUp  (fsLit "-dsuppress-all")
	|| lookUp  (fsLit "-dsuppress-type-signatures")

246 247 248 249 250 251
-- | Suppress unique ids on variables.
--   Except for uniques, as some simplifier phases introduce new variables that
--   have otherwise identical names.
opt_SuppressUniques :: Bool
opt_SuppressUniques
	=  lookUp  (fsLit "-dsuppress-uniques")
252

253 254
-- | Display case expressions with a single alternative as strict let bindings
opt_PprCaseAsLet :: Bool
255
opt_PprCaseAsLet	= lookUp   (fsLit "-dppr-case-as-let")
benl's avatar
benl committed
256 257

-- | Set the maximum width of the dumps
258 259
--   If GHC's command line options are bad then the options parser uses the
--   pretty printer display the error message. In this case the staticFlags
dterei's avatar
dterei committed
260
--   won't be initialized yet, so we must check for this case explicitly
261
--   and return the default value.
benl's avatar
benl committed
262
opt_PprCols :: Int
dterei's avatar
dterei committed
263
opt_PprCols
264 265 266 267 268
 = unsafePerformIO
 $ do	ready <- readIORef v_opt_C_ready
	if (not ready)
		then return 100
		else return $ lookup_def_int "-dppr-cols" 100
benl's avatar
benl committed
269

270

dias@eecs.harvard.edu's avatar
dias@eecs.harvard.edu committed
271
opt_PprStyle_Debug  :: Bool
272 273 274 275 276
opt_PprStyle_Debug              = lookUp  (fsLit "-dppr-debug")

opt_TraceLevel :: Int
opt_TraceLevel = lookup_def_int "-dtrace-level" 1  	-- Standard level is 1
	       	 			    	        -- Less verbose is 0
benl@ouroborus.net's avatar
benl@ouroborus.net committed
277

dias@eecs.harvard.edu's avatar
dias@eecs.harvard.edu committed
278 279
opt_Fuel            :: Int
opt_Fuel                        = lookup_def_int "-dopt-fuel" maxBound
benl@ouroborus.net's avatar
benl@ouroborus.net committed
280

Simon Marlow's avatar
Simon Marlow committed
281 282 283
opt_NoDebugOutput   :: Bool
opt_NoDebugOutput               = lookUp  (fsLit "-dno-debug-output")

284
-- profiling opts
Ian Lynagh's avatar
Ian Lynagh committed
285
opt_SccProfilingOn :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
286
opt_SccProfilingOn		= lookUp  (fsLit "-fscc-profiling")
andy@galois.com's avatar
andy@galois.com committed
287

288
-- Hpc opts
Ian Lynagh's avatar
Ian Lynagh committed
289
opt_Hpc :: Bool
dterei's avatar
dterei committed
290
opt_Hpc				= lookUp (fsLit "-fhpc")
andy@galois.com's avatar
andy@galois.com committed
291

292
-- language opts
Ian Lynagh's avatar
Ian Lynagh committed
293
opt_DictsStrict :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
294
opt_DictsStrict			= lookUp  (fsLit "-fdicts-strict")
295

Ian Lynagh's avatar
Ian Lynagh committed
296
opt_IrrefutableTuples :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
297
opt_IrrefutableTuples		= lookUp  (fsLit "-firrefutable-tuples")
298

Ian Lynagh's avatar
Ian Lynagh committed
299
opt_Parallel :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
300
opt_Parallel			= lookUp  (fsLit "-fparallel")
301

302 303 304
opt_SimpleListLiterals :: Bool
opt_SimpleListLiterals	        = lookUp  (fsLit "-fsimple-list-literals")

Ian Lynagh's avatar
Ian Lynagh committed
305
opt_NoStateHack :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
306
opt_NoStateHack			= lookUp  (fsLit "-fno-state-hack")
307

Ian Lynagh's avatar
Ian Lynagh committed
308
opt_CprOff :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
309
opt_CprOff			= lookUp  (fsLit "-fcpr-off")
310
	-- Switch off CPR analysis in the new demand analyser
Ian Lynagh's avatar
Ian Lynagh committed
311
opt_MaxWorkerArgs :: Int
312 313
opt_MaxWorkerArgs		= lookup_def_int "-fmax-worker-args" (10::Int)

Ian Lynagh's avatar
Ian Lynagh committed
314
opt_GranMacros :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
315
opt_GranMacros			= lookUp  (fsLit "-fgransim")
316

Ian Lynagh's avatar
Ian Lynagh committed
317
opt_HiVersion :: Integer
318
opt_HiVersion			= read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer
319

Ian Lynagh's avatar
Ian Lynagh committed
320
opt_HistorySize :: Int
321
opt_HistorySize			= lookup_def_int "-fhistory-size" 20
322

323 324
opt_StubDeadValues  :: Bool
opt_StubDeadValues		= lookUp  (fsLit "-dstub-dead-values")
325 326

-- Simplifier switches
Ian Lynagh's avatar
Ian Lynagh committed
327
opt_SimplNoPreInlining :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
328
opt_SimplNoPreInlining		= lookUp  (fsLit "-fno-pre-inlining")
329 330
	-- NoPreInlining is there just to see how bad things
	-- get if you don't do it!
Ian Lynagh's avatar
Ian Lynagh committed
331
opt_SimplExcessPrecision :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
332
opt_SimplExcessPrecision	= lookUp  (fsLit "-fexcess-precision")
333

334 335 336
opt_NoOptCoercion :: Bool
opt_NoOptCoercion    	        = lookUp  (fsLit "-fno-opt-coercion")

337
-- Unfolding control
338 339 340 341
-- See Note [Discounts and thresholds] in CoreUnfold

opt_UF_CreationThreshold, opt_UF_UseThreshold :: Int
opt_UF_DearOp, opt_UF_FunAppDiscount, opt_UF_DictDiscount :: Int
Ian Lynagh's avatar
Ian Lynagh committed
342
opt_UF_KeenessFactor :: Float
343

344 345 346 347 348 349
opt_UF_CreationThreshold = lookup_def_int "-funfolding-creation-threshold" (750::Int)
  -- This threshold must be reasonably high to take 
  -- account of possible discounts.  
  -- E.g. 450 is not enough in 'fulsom' for Interval.sqr to inline into Csg.calc
  --      (The unfolding for sqr never makes it into the interface file.)

350 351
opt_UF_UseThreshold      = lookup_def_int "-funfolding-use-threshold"      (60::Int)
opt_UF_FunAppDiscount    = lookup_def_int "-funfolding-fun-discount"       (60::Int)
352

353
opt_UF_DictDiscount      = lookup_def_int "-funfolding-dict-discount"      (30::Int)
354 355 356
   -- Be fairly keen to inline a fuction if that means
   -- we'll be able to pick the right method from a dictionary

357
opt_UF_KeenessFactor	 = lookup_def_float "-funfolding-keeness-factor"   (1.5::Float)
358
opt_UF_DearOp            = ( 40 :: Int)
Ian Lynagh's avatar
Ian Lynagh committed
359

dias@eecs.harvard.edu's avatar
dias@eecs.harvard.edu committed
360 361

-- Related to linking
Ian Lynagh's avatar
Ian Lynagh committed
362
opt_PIC :: Bool
363 364
#if darwin_TARGET_OS && x86_64_TARGET_ARCH
opt_PIC                         = True
365 366
#elif darwin_TARGET_OS
opt_PIC                         = lookUp (fsLit "-fPIC") || not opt_Static
367
#else
Ian Lynagh's avatar
Ian Lynagh committed
368
opt_PIC                         = lookUp (fsLit "-fPIC")
369
#endif
Ian Lynagh's avatar
Ian Lynagh committed
370
opt_Static :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
371
opt_Static			= lookUp  (fsLit "-static")
Ian Lynagh's avatar
Ian Lynagh committed
372
opt_Unregisterised :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
373
opt_Unregisterised		= lookUp  (fsLit "-funregisterised")
374 375 376

-- Derived, not a real option.  Determines whether we will be compiling
-- info tables that reside just before the entry code, or with an
dterei's avatar
dterei committed
377
-- indirection to the entry code.  See TABLES_NEXT_TO_CODE in
Simon Marlow's avatar
Simon Marlow committed
378
-- includes/rts/storage/InfoTables.h.
Ian Lynagh's avatar
Ian Lynagh committed
379
tablesNextToCode :: Bool
380 381 382
tablesNextToCode 		= not opt_Unregisterised
		 		  && cGhcEnableTablesNextToCode == "YES"

383
-- Include full span info in error messages, instead of just the start position.
Ian Lynagh's avatar
Ian Lynagh committed
384
opt_ErrorSpans :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
385
opt_ErrorSpans			= lookUp (fsLit "-ferror-spans")
386

387 388
opt_Ticky :: Bool
opt_Ticky                       = lookUp (fsLit "-ticky")
389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404

-- object files and libraries to be linked in are collected here.
-- ToDo: perhaps this could be done without a global, it wasn't obvious
-- how to do it though --SDM.
GLOBAL_VAR(v_Ld_inputs,	[],      [String])

-----------------------------------------------------------------------------
-- Ways

-- The central concept of a "way" is that all objects in a given
-- program must be compiled in the same "way".  Certain options change
-- parameters of the virtual machine, eg. profiling adds an extra word
-- to the object header, so profiling objects cannot be linked with
-- non-profiling objects.

-- After parsing the command-line options, we determine which "way" we
405
-- are building - this might be a combination way, eg. profiling+threaded.
406 407 408 409 410 411 412 413 414

-- We then find the "build-tag" associated with this way, and this
-- becomes the suffix used to find .hi files and libraries used in
-- this compilation.

data WayName
  = WayThreaded
  | WayDebug
  | WayProf
Simon Marlow's avatar
Simon Marlow committed
415
  | WayEventLog
416 417 418
  | WayPar
  | WayGran
  | WayNDP
419
  | WayDyn
420 421
  deriving (Eq,Ord)

422
GLOBAL_VAR(v_Ways, [] ,[Way])
423

Ian Lynagh's avatar
Ian Lynagh committed
424
allowed_combination :: [WayName] -> Bool
dterei's avatar
dterei committed
425
allowed_combination way = and [ x `allowedWith` y
426 427 428 429 430 431
			      | x <- way, y <- way, x < y ]
  where
	-- Note ordering in these tests: the left argument is
	-- <= the right argument, according to the Ord instance
	-- on Way above.

432 433 434 435
	-- dyn is allowed with everything
	_ `allowedWith` WayDyn  		= True
	WayDyn `allowedWith` _		        = True

436 437 438 439 440
	-- debug is allowed with everything
	_ `allowedWith` WayDebug		= True
	WayDebug `allowedWith` _		= True

	WayProf `allowedWith` WayNDP		= True
Simon Marlow's avatar
Simon Marlow committed
441
	WayThreaded `allowedWith` WayProf	= True
Simon Marlow's avatar
Simon Marlow committed
442
	WayThreaded `allowedWith` WayEventLog	= True
443 444 445
	_ `allowedWith` _ 			= False


446 447 448 449 450 451
getWayFlags :: IO [String]  -- new options
getWayFlags = do
  unsorted <- readIORef v_Ways
  let ways = sortBy (compare `on` wayName) $
             nubBy  ((==) `on` wayName) $ unsorted
  writeIORef v_Ways ways
452

453
  if not (allowed_combination (map wayName ways))
454
      then ghcError (CmdLineError $
455
      		    "combination not supported: "  ++
dterei's avatar
dterei committed
456
      		    foldr1 (\a b -> a ++ '/':b)
457 458 459
      		    (map wayDesc ways))
      else
      	   return (concatMap wayOpts ways)
460

461 462 463
mkBuildTag :: [Way] -> String
mkBuildTag ways = concat (intersperse "_" (map wayTag ways))

Ian Lynagh's avatar
Ian Lynagh committed
464
lkupWay :: WayName -> Way
dterei's avatar
dterei committed
465
lkupWay w =
466
   case listToMaybe (filter ((==) w . wayName) way_details) of
467 468 469
	Nothing -> error "findBuildTag"
	Just details -> details

Ian Lynagh's avatar
Ian Lynagh committed
470
isRTSWay :: WayName -> Bool
dterei's avatar
dterei committed
471
isRTSWay = wayRTSOnly . lkupWay
472

473
data Way = Way {
474
  wayName    :: WayName,
475 476
  wayTag     :: String,
  wayRTSOnly :: Bool,
477
  wayDesc    :: String,
478 479 480
  wayOpts    :: [String]
  }

481
way_details :: [ Way ]
482
way_details =
483
  [ Way WayThreaded "thr" True "Threaded" [
484
#if defined(freebsd_TARGET_OS)
485 486 487 488 489 490 491
--	  "-optc-pthread"
--      , "-optl-pthread"
	-- FreeBSD's default threading library is the KSE-based M:N libpthread,
	-- which GHC has some problems with.  It's currently not clear whether
	-- the problems are our fault or theirs, but it seems that using the
	-- alternative 1:1 threading library libthr works around it:
	  "-optl-lthr"
Ian Lynagh's avatar
Ian Lynagh committed
492
#elif defined(openbsd_TARGET_OS) || defined(netbsd_TARGET_OS)
kili's avatar
kili committed
493 494
	  "-optc-pthread"
	, "-optl-pthread"
495 496
#elif defined(solaris2_TARGET_OS)
          "-optl-lrt"
497
#endif
498 499 500
	],

    Way WayDebug "debug" True "Debug" [],
501

502 503
    Way WayDyn "dyn" False "Dynamic"
	[ "-DDYNAMIC"
dterei's avatar
dterei committed
504
	, "-optc-DDYNAMIC"
505 506
#if defined(mingw32_TARGET_OS)
	-- On Windows, code that is to be linked into a dynamic library must be compiled
dterei's avatar
dterei committed
507
	--	with -fPIC. Labels not in the current package are assumed to be in a DLL
508 509
	--	different from the current one.
	, "-fPIC"
Ian Lynagh's avatar
Ian Lynagh committed
510
#elif defined(openbsd_TARGET_OS) || defined(netbsd_TARGET_OS)
kili's avatar
kili committed
511 512 513
	-- Without this, linking the shared libHSffi fails because
	-- it uses pthread mutexes.
	, "-optl-pthread"
514 515
#endif
	],
516

517
    Way WayProf "p" False "Profiling"
518 519
	[ "-fscc-profiling"
	, "-DPROFILING"
520
	, "-optc-DPROFILING" ],
521

522
    Way WayEventLog "l" True "RTS Event Logging"
523 524
	[ "-DTRACING"
	, "-optc-DTRACING" ],
Simon Marlow's avatar
Simon Marlow committed
525

dterei's avatar
dterei committed
526
    Way WayPar "mp" False "Parallel"
527 528 529 530 531 532 533
	[ "-fparallel"
	, "-D__PARALLEL_HASKELL__"
	, "-optc-DPAR"
	, "-package concurrent"
        , "-optc-w"
        , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
        , "-optl-lpvm3"
534
        , "-optl-lgpvm3" ],
535 536

    -- at the moment we only change the RTS and could share compiler and libs!
dterei's avatar
dterei committed
537
    Way WayPar "mt" False "Parallel ticky profiling"
538 539 540 541 542 543 544 545
	[ "-fparallel"
	, "-D__PARALLEL_HASKELL__"
	, "-optc-DPAR"
	, "-optc-DPAR_TICKY"
	, "-package concurrent"
        , "-optc-w"
        , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
        , "-optl-lpvm3"
546
        , "-optl-lgpvm3" ],
547

dterei's avatar
dterei committed
548
    Way WayPar "md" False "Distributed"
549 550 551 552 553 554 555 556 557
	[ "-fparallel"
	, "-D__PARALLEL_HASKELL__"
	, "-D__DISTRIBUTED_HASKELL__"
	, "-optc-DPAR"
	, "-optc-DDIST"
	, "-package concurrent"
        , "-optc-w"
        , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
        , "-optl-lpvm3"
558
        , "-optl-lgpvm3" ],
559

560
    Way WayGran "mg" False "GranSim"
561 562 563
	[ "-fgransim"
	, "-D__GRANSIM__"
	, "-optc-DGRAN"
564
	, "-package concurrent" ],
565

566
    Way WayNDP "ndp" False "Nested data parallelism"
567
	[ "-XParr"
568
	, "-fvectorise"]
569
  ]
570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587

-----------------------------------------------------------------------------
-- Tunneling our global variables into a new instance of the GHC library

-- Ignore the v_Ld_inputs global because:
--  a) It is mutated even once GHC has been initialised, which means that I'd
--     have to add another layer of indirection to truly share the value
--  b) We can get away without sharing it because it only affects the link,
--     and is mutated by the GHC exe. Users who load up a new copy of the GHC
--     library while another is running almost certainly won't actually access it.
saveStaticFlagGlobals :: IO (Bool, [String], [Way])
saveStaticFlagGlobals = liftM3 (,,) (readIORef v_opt_C_ready) (readIORef v_opt_C) (readIORef v_Ways)

restoreStaticFlagGlobals :: (Bool, [String], [Way]) -> IO ()
restoreStaticFlagGlobals (c_ready, c, ways) = do
    writeIORef v_opt_C_ready c_ready
    writeIORef v_opt_C c
    writeIORef v_Ways ways
dterei's avatar
dterei committed
588