1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-cse #-}
-- -fno-cse is needed for GLOBAL_VAR's to behave properly
module GHC.Utils.GlobalVars
( v_unsafeHasPprDebug
, v_unsafeHasNoDebugOutput
, v_unsafeHasNoStateHack
, unsafeHasPprDebug
, unsafeHasNoDebugOutput
, unsafeHasNoStateHack
, global
, consIORef
, globalM
, sharedGlobal
, sharedGlobalM
)
where
#include "HsVersions.h"
import GHC.Prelude
import GHC.Conc.Sync ( sharedCAF )
import System.IO.Unsafe
import Data.IORef
import Foreign (Ptr)
--------------------------------------------------------------------------
-- Do not use global variables!
--
-- Global variables are a hack. Do not use them if you can help it.
#if GHC_STAGE < 2
GLOBAL_VAR(v_unsafeHasPprDebug, False, Bool)
GLOBAL_VAR(v_unsafeHasNoDebugOutput, False, Bool)
GLOBAL_VAR(v_unsafeHasNoStateHack, False, Bool)
#else
SHARED_GLOBAL_VAR( v_unsafeHasPprDebug
, getOrSetLibHSghcGlobalHasPprDebug
, "getOrSetLibHSghcGlobalHasPprDebug"
, False
, Bool )
SHARED_GLOBAL_VAR( v_unsafeHasNoDebugOutput
, getOrSetLibHSghcGlobalHasNoDebugOutput
, "getOrSetLibHSghcGlobalHasNoDebugOutput"
, False
, Bool )
SHARED_GLOBAL_VAR( v_unsafeHasNoStateHack
, getOrSetLibHSghcGlobalHasNoStateHack
, "getOrSetLibHSghcGlobalHasNoStateHack"
, False
, Bool )
#endif
unsafeHasPprDebug :: Bool
unsafeHasPprDebug = unsafePerformIO $ readIORef v_unsafeHasPprDebug
unsafeHasNoDebugOutput :: Bool
unsafeHasNoDebugOutput = unsafePerformIO $ readIORef v_unsafeHasNoDebugOutput
unsafeHasNoStateHack :: Bool
unsafeHasNoStateHack = unsafePerformIO $ readIORef v_unsafeHasNoStateHack
{-
************************************************************************
* *
Globals and the RTS
* *
************************************************************************
When a plugin is loaded, it currently gets linked against a *newly
loaded* copy of the GHC package. This would not be a problem, except
that the new copy has its own mutable state that is not shared with
that state that has already been initialized by the original GHC
package.
(Note that if the GHC executable was dynamically linked this
wouldn't be a problem, because we could share the GHC library it
links to; this is only a problem if DYNAMIC_GHC_PROGRAMS=NO.)
The solution is to make use of @sharedCAF@ through @sharedGlobal@
for globals that are shared between multiple copies of ghc packages.
-}
-- Global variables:
global :: a -> IORef a
global a = unsafePerformIO (newIORef a)
consIORef :: IORef [a] -> a -> IO ()
consIORef var x = do
atomicModifyIORef' var (\xs -> (x:xs,()))
globalM :: IO a -> IORef a
globalM ma = unsafePerformIO (ma >>= newIORef)
-- Shared global variables:
sharedGlobal :: a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
sharedGlobal a get_or_set = unsafePerformIO $
newIORef a >>= flip sharedCAF get_or_set
sharedGlobalM :: IO a -> (Ptr (IORef a) -> IO (Ptr (IORef a))) -> IORef a
sharedGlobalM ma get_or_set = unsafePerformIO $
ma >>= newIORef >>= flip sharedCAF get_or_set
|
