StaticFlags.hs 17 KB
Newer Older
1
2
3
{-# OPTIONS -fno-cse #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly

4
5
6
7
8
9
10
11
12
13
14
15
16
-----------------------------------------------------------------------------
--
-- 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,
17
        initStaticOpts,
18
19

	-- Ways
20
	WayName(..), Way(..), v_Ways, isRTSWay, mkBuildTag,
21
22
23

	-- Output style options
	opt_PprUserLength,
benl's avatar
benl committed
24
	opt_PprCols,
25
	opt_PprCaseAsLet,
benl's avatar
benl committed
26
	opt_PprStyle_Debug, opt_TraceLevel,
27
        opt_NoDebugOutput, 
benl's avatar
benl committed
28
29

	-- Suppressing boring aspects of core dumps
benl's avatar
benl committed
30
	opt_SuppressAll,
31
	opt_SuppressUniques,
32
        opt_SuppressCoercions,
33
	opt_SuppressModulePrefixes,
benl's avatar
benl committed
34
35
	opt_SuppressTypeApplications,
	opt_SuppressIdInfo,
benl's avatar
benl committed
36
	opt_SuppressTypeSignatures,
37
38
39
40

	-- profiling opts
	opt_SccProfilingOn,

andy@galois.com's avatar
andy@galois.com committed
41
42
43
        -- Hpc opts
	opt_Hpc,

44
45
46
47
48
49
50
	-- language opts
	opt_DictsStrict,
	opt_IrrefutableTuples,
	opt_Parallel,

	-- optimisation opts
	opt_NoStateHack,
51
        opt_SimpleListLiterals,
52
53
54
	opt_CprOff,
	opt_SimplNoPreInlining,
	opt_SimplExcessPrecision,
55
	opt_NoOptCoercion,
56
57
58
59
60
61
	opt_MaxWorkerArgs,

	-- Unfolding control
	opt_UF_CreationThreshold,
	opt_UF_UseThreshold,
	opt_UF_FunAppDiscount,
62
	opt_UF_DictDiscount,
63
64
65
	opt_UF_KeenessFactor,
	opt_UF_DearOp,

dias@eecs.harvard.edu's avatar
dias@eecs.harvard.edu committed
66
67
68
	-- Optimization fuel controls
	opt_Fuel,

69
70
71
72
	-- Related to linking
	opt_PIC,
	opt_Static,

73
74
	-- misc opts
	opt_IgnoreDotGhci,
75
	opt_GhciScripts,
76
77
78
79
80
81
82
	opt_ErrorSpans,
	opt_GranMacros,
	opt_HiVersion,
	opt_HistorySize,
	opt_OmitBlackHoling,
	opt_Unregisterised,
	v_Ld_inputs,
83
	tablesNextToCode,
84
        opt_StubDeadValues,
85
        opt_Ticky,
86
87

    -- For the parser
88
89
90
91
    addOpt, removeOpt, addWay, getWayFlags, v_opt_C_ready,
    
    -- Saving/restoring globals
    saveStaticFlagGlobals, restoreStaticFlagGlobals
92
93
94
95
  ) where

#include "HsVersions.h"

96
import Config
97
import FastString
98
import Util
99
import Maybes		( firstJusts, catMaybes )
100
import Panic
101

102
import Control.Monad    ( liftM3 )
103
import Data.Maybe       ( listToMaybe )
Simon Marlow's avatar
Simon Marlow committed
104
105
import Data.IORef
import System.IO.Unsafe	( unsafePerformIO )
106
import Data.List
107
108
109
110

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

111
112
initStaticOpts :: IO ()
initStaticOpts = writeIORef v_opt_C_ready True
113

Ian Lynagh's avatar
Ian Lynagh committed
114
addOpt :: String -> IO ()
115
116
addOpt = consIORef v_opt_C

Ian Lynagh's avatar
Ian Lynagh committed
117
addWay :: WayName -> IO ()
118
addWay = consIORef v_Ways . lkupWay
119

Ian Lynagh's avatar
Ian Lynagh committed
120
removeOpt :: String -> IO ()
121
122
123
124
125
126
127
128
removeOpt f = do
  fs <- readIORef v_opt_C
  writeIORef v_opt_C $! filter (/= f) fs    

lookUp	       	 :: FastString -> Bool
lookup_def_int   :: String -> Int -> Int
lookup_def_float :: String -> Float -> Float
lookup_str       :: String -> Maybe String
129
lookup_all_str   :: String -> [String]
130
131
132
133

-- 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])
134
GLOBAL_VAR(v_opt_C_ready, False, Bool)
Ian Lynagh's avatar
Ian Lynagh committed
135
136

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

-- -static is the default
Ian Lynagh's avatar
Ian Lynagh committed
144
defaultStaticOpts :: [String]
145
146
defaultStaticOpts = ["-static"]

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

lookUp     sw = sw `elem` packed_static_opts
	
-- (lookup_str "foo") looks for the flag -foo=X or -fooX, 
-- and returns the string X
lookup_str sw 
155
   = case firstJusts (map (stripPrefix sw) staticFlags) of
156
157
158
159
	Just ('=' : str) -> Just str
	Just str         -> Just str
	Nothing		 -> Nothing	

160
161
162
163
lookup_all_str sw = map f $ catMaybes (map (stripPrefix sw) staticFlags) where
   f ('=' : str) = str
   f str = str

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")
202
203
204
 
opt_GhciScripts :: [String]
opt_GhciScripts = lookup_all_str "-ghci-script"
205

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

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

benl's avatar
benl committed
220
-- | Suppress module id prefixes on variables.
221
opt_SuppressModulePrefixes :: Bool
benl's avatar
benl committed
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
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
opt_SuppressIdInfo 
	=  lookUp  (fsLit "-dsuppress-all")
	|| lookUp  (fsLit "-dsuppress-idinfo")
benl's avatar
benl committed
237

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

244
245
246
247
248
249
-- | 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")
250

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

-- | Set the maximum width of the dumps
256
257
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
--   won't be initialized yet, so we must check for this case explicitly 
--   and return the default value.
benl's avatar
benl committed
260
opt_PprCols :: Int
261
262
263
264
265
266
opt_PprCols 
 = 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
267

268

dias@eecs.harvard.edu's avatar
dias@eecs.harvard.edu committed
269
opt_PprStyle_Debug  :: Bool
270
271
272
273
274
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
275

dias@eecs.harvard.edu's avatar
dias@eecs.harvard.edu committed
276
opt_PprUserLength   :: Int
277
opt_PprUserLength	        = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
benl@ouroborus.net's avatar
benl@ouroborus.net committed
278

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

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

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

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

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

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

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

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

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

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

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

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

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

Ian Lynagh's avatar
Ian Lynagh committed
324
opt_OmitBlackHoling :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
325
opt_OmitBlackHoling		= lookUp  (fsLit "-dno-black-holing")
326

327
328
opt_StubDeadValues  :: Bool
opt_StubDeadValues		= lookUp  (fsLit "-dstub-dead-values")
329
330

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

338
339
340
opt_NoOptCoercion :: Bool
opt_NoOptCoercion    	        = lookUp  (fsLit "-fno-opt-coercion")

341
-- Unfolding control
342
343
344
345
-- 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
346
opt_UF_KeenessFactor :: Float
347

348
349
350
opt_UF_CreationThreshold = lookup_def_int "-funfolding-creation-threshold" (450::Int)
opt_UF_UseThreshold      = lookup_def_int "-funfolding-use-threshold"      (60::Int)
opt_UF_FunAppDiscount    = lookup_def_int "-funfolding-fun-discount"       (60::Int)
351

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

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

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

-- Related to linking
Ian Lynagh's avatar
Ian Lynagh committed
361
opt_PIC :: Bool
362
363
#if darwin_TARGET_OS && x86_64_TARGET_ARCH
opt_PIC                         = True
364
365
#elif darwin_TARGET_OS
opt_PIC                         = lookUp (fsLit "-fPIC") || not opt_Static
366
#else
Ian Lynagh's avatar
Ian Lynagh committed
367
opt_PIC                         = lookUp (fsLit "-fPIC")
368
#endif
Ian Lynagh's avatar
Ian Lynagh committed
369
opt_Static :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
370
opt_Static			= lookUp  (fsLit "-static")
Ian Lynagh's avatar
Ian Lynagh committed
371
opt_Unregisterised :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
372
opt_Unregisterised		= lookUp  (fsLit "-funregisterised")
373
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
-- indirection to the entry code.  See TABLES_NEXT_TO_CODE in 
Simon Marlow's avatar
Simon Marlow committed
377
-- includes/rts/storage/InfoTables.h.
Ian Lynagh's avatar
Ian Lynagh committed
378
tablesNextToCode :: Bool
379
380
381
tablesNextToCode 		= not opt_Unregisterised
		 		  && cGhcEnableTablesNextToCode == "YES"

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

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

-- 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
404
-- are building - this might be a combination way, eg. profiling+threaded.
405
406
407
408
409
410
411
412
413

-- 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
414
  | WayEventLog
415
416
417
  | WayPar
  | WayGran
  | WayNDP
418
  | WayDyn
419
420
  deriving (Eq,Ord)

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

Ian Lynagh's avatar
Ian Lynagh committed
423
allowed_combination :: [WayName] -> Bool
424
425
426
427
428
429
430
allowed_combination way = and [ x `allowedWith` y 
			      | 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.

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

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

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


445
446
447
448
449
450
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
451

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

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

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

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

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

480
way_details :: [ Way ]
481
way_details =
482
  [ Way WayThreaded "thr" True "Threaded" [
483
#if defined(freebsd_TARGET_OS)
484
485
486
487
488
489
490
--	  "-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"
kili's avatar
kili committed
491
492
493
#elif defined(openbsd_TARGET_OS)
	  "-optc-pthread"
	, "-optl-pthread"
494
495
#elif defined(solaris2_TARGET_OS)
          "-optl-lrt"
496
#endif
497
498
499
	],

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

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

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

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

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

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

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

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

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

-----------------------------------------------------------------------------
-- 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