StaticFlags.hs 16.4 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
Ian Lynagh's avatar
Ian Lynagh committed
30
	opt_PprStyle_Debug,
dterei's avatar
dterei committed
31
        opt_NoDebugOutput,
benl's avatar
benl committed
32
33

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

	-- profiling opts
	opt_SccProfilingOn,

andy@galois.com's avatar
andy@galois.com committed
46
47
48
        -- Hpc opts
	opt_Hpc,

49
50
51
52
53
54
55
	-- language opts
	opt_DictsStrict,
	opt_IrrefutableTuples,
	opt_Parallel,

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

	-- Unfolding control
	opt_UF_CreationThreshold,
	opt_UF_UseThreshold,
	opt_UF_FunAppDiscount,
67
	opt_UF_DictDiscount,
68
69
70
	opt_UF_KeenessFactor,
	opt_UF_DearOp,

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

74
75
76
77
	-- Related to linking
	opt_PIC,
	opt_Static,

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

    -- For the parser
91
    addOpt, removeOpt, addWay, getWayFlags, v_opt_C_ready,
dterei's avatar
dterei committed
92

93
94
    -- Saving/restoring globals
    saveStaticFlagGlobals, restoreStaticFlagGlobals
95
96
97
98
  ) where

#include "HsVersions.h"

99
import Config
100
import FastString
101
import Util
102
import Maybes		( firstJusts )
103
import Panic
104

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

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

114
115
initStaticOpts :: IO ()
initStaticOpts = writeIORef v_opt_C_ready True
116

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

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

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

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

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

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

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

lookUp     sw = sw `elem` packed_static_opts
dterei's avatar
dterei committed
153
154

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

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
178
			-- ToDo: hack alert. We should really parse the arguments
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
			-- 	 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
198
opt_IgnoreDotGhci :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
199
opt_IgnoreDotGhci		= lookUp (fsLit "-ignore-dot-ghci")
dterei's avatar
dterei committed
200

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

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

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

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
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
234
opt_SuppressIdInfo
benl's avatar
benl committed
235
236
	=  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

dias@eecs.harvard.edu's avatar
dias@eecs.harvard.edu committed
252
opt_PprStyle_Debug  :: Bool
253
254
opt_PprStyle_Debug              = lookUp  (fsLit "-dppr-debug")

dias@eecs.harvard.edu's avatar
dias@eecs.harvard.edu committed
255
256
opt_Fuel            :: Int
opt_Fuel                        = lookup_def_int "-dopt-fuel" maxBound
benl@ouroborus.net's avatar
benl@ouroborus.net committed
257

Simon Marlow's avatar
Simon Marlow committed
258
259
260
opt_NoDebugOutput   :: Bool
opt_NoDebugOutput               = lookUp  (fsLit "-dno-debug-output")

261
-- profiling opts
Ian Lynagh's avatar
Ian Lynagh committed
262
opt_SccProfilingOn :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
263
opt_SccProfilingOn		= lookUp  (fsLit "-fscc-profiling")
andy@galois.com's avatar
andy@galois.com committed
264

265
-- Hpc opts
Ian Lynagh's avatar
Ian Lynagh committed
266
opt_Hpc :: Bool
dterei's avatar
dterei committed
267
opt_Hpc				= lookUp (fsLit "-fhpc")
andy@galois.com's avatar
andy@galois.com committed
268

269
-- language opts
Ian Lynagh's avatar
Ian Lynagh committed
270
opt_DictsStrict :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
271
opt_DictsStrict			= lookUp  (fsLit "-fdicts-strict")
272

Ian Lynagh's avatar
Ian Lynagh committed
273
opt_IrrefutableTuples :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
274
opt_IrrefutableTuples		= lookUp  (fsLit "-firrefutable-tuples")
275

Ian Lynagh's avatar
Ian Lynagh committed
276
opt_Parallel :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
277
opt_Parallel			= lookUp  (fsLit "-fparallel")
278

279
280
281
opt_SimpleListLiterals :: Bool
opt_SimpleListLiterals	        = lookUp  (fsLit "-fsimple-list-literals")

Ian Lynagh's avatar
Ian Lynagh committed
282
opt_NoStateHack :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
283
opt_NoStateHack			= lookUp  (fsLit "-fno-state-hack")
284

Ian Lynagh's avatar
Ian Lynagh committed
285
opt_CprOff :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
286
opt_CprOff			= lookUp  (fsLit "-fcpr-off")
287
	-- Switch off CPR analysis in the new demand analyser
Ian Lynagh's avatar
Ian Lynagh committed
288
opt_MaxWorkerArgs :: Int
289
290
opt_MaxWorkerArgs		= lookup_def_int "-fmax-worker-args" (10::Int)

Ian Lynagh's avatar
Ian Lynagh committed
291
opt_GranMacros :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
292
opt_GranMacros			= lookUp  (fsLit "-fgransim")
293

Ian Lynagh's avatar
Ian Lynagh committed
294
opt_HiVersion :: Integer
295
opt_HiVersion			= read (cProjectVersionInt ++ cProjectPatchLevel) :: Integer
296

Ian Lynagh's avatar
Ian Lynagh committed
297
opt_HistorySize :: Int
298
opt_HistorySize			= lookup_def_int "-fhistory-size" 20
299

300
301
opt_StubDeadValues  :: Bool
opt_StubDeadValues		= lookUp  (fsLit "-dstub-dead-values")
302
303

-- Simplifier switches
Ian Lynagh's avatar
Ian Lynagh committed
304
opt_SimplNoPreInlining :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
305
opt_SimplNoPreInlining		= lookUp  (fsLit "-fno-pre-inlining")
306
307
	-- NoPreInlining is there just to see how bad things
	-- get if you don't do it!
Ian Lynagh's avatar
Ian Lynagh committed
308
opt_SimplExcessPrecision :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
309
opt_SimplExcessPrecision	= lookUp  (fsLit "-fexcess-precision")
310

311
312
313
opt_NoOptCoercion :: Bool
opt_NoOptCoercion    	        = lookUp  (fsLit "-fno-opt-coercion")

314
-- Unfolding control
315
316
317
318
-- 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
319
opt_UF_KeenessFactor :: Float
320

321
322
323
324
325
326
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.)

327
328
opt_UF_UseThreshold      = lookup_def_int "-funfolding-use-threshold"      (60::Int)
opt_UF_FunAppDiscount    = lookup_def_int "-funfolding-fun-discount"       (60::Int)
329

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

334
opt_UF_KeenessFactor	 = lookup_def_float "-funfolding-keeness-factor"   (1.5::Float)
335
opt_UF_DearOp            = ( 40 :: Int)
Ian Lynagh's avatar
Ian Lynagh committed
336

dias@eecs.harvard.edu's avatar
dias@eecs.harvard.edu committed
337
338

-- Related to linking
Ian Lynagh's avatar
Ian Lynagh committed
339
opt_PIC :: Bool
340
341
#if darwin_TARGET_OS && x86_64_TARGET_ARCH
opt_PIC                         = True
342
343
#elif darwin_TARGET_OS
opt_PIC                         = lookUp (fsLit "-fPIC") || not opt_Static
344
#else
Ian Lynagh's avatar
Ian Lynagh committed
345
opt_PIC                         = lookUp (fsLit "-fPIC")
346
#endif
Ian Lynagh's avatar
Ian Lynagh committed
347
opt_Static :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
348
opt_Static			= lookUp  (fsLit "-static")
Ian Lynagh's avatar
Ian Lynagh committed
349
opt_Unregisterised :: Bool
Ian Lynagh's avatar
Ian Lynagh committed
350
opt_Unregisterised		= lookUp  (fsLit "-funregisterised")
351
352
353

-- 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
354
-- indirection to the entry code.  See TABLES_NEXT_TO_CODE in
Simon Marlow's avatar
Simon Marlow committed
355
-- includes/rts/storage/InfoTables.h.
Ian Lynagh's avatar
Ian Lynagh committed
356
tablesNextToCode :: Bool
357
358
359
tablesNextToCode 		= not opt_Unregisterised
		 		  && cGhcEnableTablesNextToCode == "YES"

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

364
365
opt_Ticky :: Bool
opt_Ticky                       = lookUp (fsLit "-ticky")
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381

-- 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
382
-- are building - this might be a combination way, eg. profiling+threaded.
383
384
385
386
387
388
389
390
391

-- 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
392
  | WayEventLog
393
394
395
  | WayPar
  | WayGran
  | WayNDP
396
  | WayDyn
397
398
  deriving (Eq,Ord)

399
GLOBAL_VAR(v_Ways, [] ,[Way])
400

Ian Lynagh's avatar
Ian Lynagh committed
401
allowed_combination :: [WayName] -> Bool
dterei's avatar
dterei committed
402
allowed_combination way = and [ x `allowedWith` y
403
404
405
406
407
408
			      | 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.

409
410
411
412
	-- dyn is allowed with everything
	_ `allowedWith` WayDyn  		= True
	WayDyn `allowedWith` _		        = True

413
414
415
416
417
	-- debug is allowed with everything
	_ `allowedWith` WayDebug		= True
	WayDebug `allowedWith` _		= True

	WayProf `allowedWith` WayNDP		= True
Simon Marlow's avatar
Simon Marlow committed
418
	WayThreaded `allowedWith` WayProf	= True
Simon Marlow's avatar
Simon Marlow committed
419
	WayThreaded `allowedWith` WayEventLog	= True
420
421
422
	_ `allowedWith` _ 			= False


423
424
425
426
427
428
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
429

430
  if not (allowed_combination (map wayName ways))
431
      then ghcError (CmdLineError $
432
      		    "combination not supported: "  ++
dterei's avatar
dterei committed
433
      		    foldr1 (\a b -> a ++ '/':b)
434
435
436
      		    (map wayDesc ways))
      else
      	   return (concatMap wayOpts ways)
437

438
439
440
mkBuildTag :: [Way] -> String
mkBuildTag ways = concat (intersperse "_" (map wayTag ways))

Ian Lynagh's avatar
Ian Lynagh committed
441
lkupWay :: WayName -> Way
dterei's avatar
dterei committed
442
lkupWay w =
443
   case listToMaybe (filter ((==) w . wayName) way_details) of
444
445
446
	Nothing -> error "findBuildTag"
	Just details -> details

Ian Lynagh's avatar
Ian Lynagh committed
447
isRTSWay :: WayName -> Bool
dterei's avatar
dterei committed
448
isRTSWay = wayRTSOnly . lkupWay
449

450
data Way = Way {
451
  wayName    :: WayName,
452
453
  wayTag     :: String,
  wayRTSOnly :: Bool,
454
  wayDesc    :: String,
455
456
457
  wayOpts    :: [String]
  }

458
way_details :: [ Way ]
459
way_details =
460
  [ Way WayThreaded "thr" True "Threaded" [
461
#if defined(freebsd_TARGET_OS)
462
463
464
465
466
467
468
--	  "-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
469
#elif defined(openbsd_TARGET_OS) || defined(netbsd_TARGET_OS)
kili's avatar
kili committed
470
471
	  "-optc-pthread"
	, "-optl-pthread"
472
473
#elif defined(solaris2_TARGET_OS)
          "-optl-lrt"
474
#endif
475
476
477
	],

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

479
480
    Way WayDyn "dyn" False "Dynamic"
	[ "-DDYNAMIC"
dterei's avatar
dterei committed
481
	, "-optc-DDYNAMIC"
482
483
#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
484
	--	with -fPIC. Labels not in the current package are assumed to be in a DLL
485
486
	--	different from the current one.
	, "-fPIC"
Ian Lynagh's avatar
Ian Lynagh committed
487
#elif defined(openbsd_TARGET_OS) || defined(netbsd_TARGET_OS)
kili's avatar
kili committed
488
489
490
	-- Without this, linking the shared libHSffi fails because
	-- it uses pthread mutexes.
	, "-optl-pthread"
491
492
#endif
	],
493

494
    Way WayProf "p" False "Profiling"
495
496
	[ "-fscc-profiling"
	, "-DPROFILING"
497
	, "-optc-DPROFILING" ],
498

499
    Way WayEventLog "l" True "RTS Event Logging"
500
501
	[ "-DTRACING"
	, "-optc-DTRACING" ],
Simon Marlow's avatar
Simon Marlow committed
502

dterei's avatar
dterei committed
503
    Way WayPar "mp" False "Parallel"
504
505
506
507
508
509
510
	[ "-fparallel"
	, "-D__PARALLEL_HASKELL__"
	, "-optc-DPAR"
	, "-package concurrent"
        , "-optc-w"
        , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
        , "-optl-lpvm3"
511
        , "-optl-lgpvm3" ],
512
513

    -- at the moment we only change the RTS and could share compiler and libs!
dterei's avatar
dterei committed
514
    Way WayPar "mt" False "Parallel ticky profiling"
515
516
517
518
519
520
521
522
	[ "-fparallel"
	, "-D__PARALLEL_HASKELL__"
	, "-optc-DPAR"
	, "-optc-DPAR_TICKY"
	, "-package concurrent"
        , "-optc-w"
        , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
        , "-optl-lpvm3"
523
        , "-optl-lgpvm3" ],
524

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

537
    Way WayGran "mg" False "GranSim"
538
539
540
	[ "-fgransim"
	, "-D__GRANSIM__"
	, "-optc-DGRAN"
541
	, "-package concurrent" ],
542

543
    Way WayNDP "ndp" False "Nested data parallelism"
544
	[ "-XParr"
545
	, "-fvectorise"]
546
  ]
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564

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