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
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
/* ----------------------------------------------------------------------------
*
* (c) The GHC Team, 2005-2013
*
* Macros for THREADED_RTS support
*
* -------------------------------------------------------------------------- */
#pragma once
#include "BeginPrivate.h"
#if defined(CMINUSMINUS)
/* Lock closure, equivalent to ccall lockClosure but the condition is inlined.
* Arguments are swapped for uniformity with unlockClosure. */
#if defined(THREADED_RTS)
#define LOCK_CLOSURE(closure, info) \
if (CInt[n_capabilities] == 1 :: CInt) { \
info = GET_INFO(closure); \
} else { \
("ptr" info) = ccall reallyLockClosure(closure "ptr"); \
}
#else
#define LOCK_CLOSURE(closure, info) info = GET_INFO(closure)
#endif
#define unlockClosure(ptr,info) \
prim_write_barrier; \
StgHeader_info(ptr) = info;
#else
INLINE_HEADER StgInfoTable *lockClosure(StgClosure *p);
EXTERN_INLINE StgInfoTable *reallyLockClosure(StgClosure *p);
EXTERN_INLINE StgInfoTable *tryLockClosure(StgClosure *p);
EXTERN_INLINE void unlockClosure(StgClosure *p, const StgInfoTable *info);
#if defined(THREADED_RTS)
#if defined(PROF_SPIN)
extern volatile StgWord64 whitehole_lockClosure_spin;
extern volatile StgWord64 whitehole_lockClosure_yield;
#endif
/* -----------------------------------------------------------------------------
* Locking/unlocking closures
*
* This is used primarily in the implementation of MVars.
* -------------------------------------------------------------------------- */
// We want a callable copy of reallyLockClosure() so that we can refer to it
// from .cmm files compiled using the native codegen, so these are given
// EXTERN_INLINE. C-- should use LOCK_CLOSURE not lockClosure, so we've
// kept it INLINE_HEADER.
EXTERN_INLINE StgInfoTable *reallyLockClosure(StgClosure *p)
{
StgWord info;
do {
uint32_t i = 0;
do {
info = xchg((P_)(void *)&p->header.info, (W_)&stg_WHITEHOLE_info);
if (info != (W_)&stg_WHITEHOLE_info) return (StgInfoTable *)info;
#if defined(PROF_SPIN)
++whitehole_lockClosure_spin;
#endif
busy_wait_nop();
} while (++i < SPIN_COUNT);
#if defined(PROF_SPIN)
++whitehole_lockClosure_yield;
#endif
yieldThread();
} while (1);
}
INLINE_HEADER StgInfoTable *lockClosure(StgClosure *p)
{
if (n_capabilities == 1) {
return (StgInfoTable *)p->header.info;
}
else {
return reallyLockClosure(p);
}
}
// ToDo: consider splitting tryLockClosure into reallyTryLockClosure,
// same as lockClosure
EXTERN_INLINE StgInfoTable *tryLockClosure(StgClosure *p)
{
StgWord info;
if (n_capabilities == 1) {
return (StgInfoTable *)p->header.info;
}
else {
info = xchg((P_)(void *)&p->header.info, (W_)&stg_WHITEHOLE_info);
if (info != (W_)&stg_WHITEHOLE_info) {
return (StgInfoTable *)info;
} else {
return NULL;
}
}
}
#else /* !THREADED_RTS */
EXTERN_INLINE StgInfoTable *
reallyLockClosure(StgClosure *p)
{ return (StgInfoTable *)p->header.info; }
INLINE_HEADER StgInfoTable *
lockClosure(StgClosure *p)
{ return (StgInfoTable *)p->header.info; }
EXTERN_INLINE StgInfoTable *
tryLockClosure(StgClosure *p)
{ return (StgInfoTable *)p->header.info; }
#endif /* THREADED_RTS */
EXTERN_INLINE void unlockClosure(StgClosure *p, const StgInfoTable *info)
{
// This is a strictly ordered write, so we need a write_barrier():
write_barrier();
p->header.info = info;
}
// Handy specialised versions of lockClosure()/unlockClosure()
INLINE_HEADER void lockTSO(StgTSO *tso);
INLINE_HEADER void lockTSO(StgTSO *tso)
{ lockClosure((StgClosure *)tso); }
INLINE_HEADER void unlockTSO(StgTSO *tso);
INLINE_HEADER void unlockTSO(StgTSO *tso)
{ unlockClosure((StgClosure*)tso, (const StgInfoTable *)&stg_TSO_info); }
#endif /* CMINUSMINUS */
#include "EndPrivate.h"
|
