ec34a8ca25d359fa4a98c9d789a26576768bdafe
[ghc-hetmet.git] / rts / parallel / WSDeque.c
1 /* -----------------------------------------------------------------------------
2  *
3  * (c) The GHC Team, 2009
4  *
5  * Work-stealing Deque data structure
6  * 
7  * The implementation uses Double-Ended Queues with lock-free access
8  * (thereby often called "deque") as described in
9  *
10  * D.Chase and Y.Lev, Dynamic Circular Work-Stealing Deque.
11  * SPAA'05, July 2005, Las Vegas, USA.
12  * ACM 1-58113-986-1/05/0007
13  *
14  * Author: Jost Berthold MSRC 07-09/2008
15  *
16  * The DeQue is held as a circular array with known length. Positions
17  * of top (read-end) and bottom (write-end) always increase, and the
18  * array is accessed with indices modulo array-size. While this bears
19  * the risk of overflow, we assume that (with 64 bit indices), a
20  * program must run very long to reach that point.
21  * 
22  * The write end of the queue (position bottom) can only be used with
23  * mutual exclusion, i.e. by exactly one caller at a time.  At this
24  * end, new items can be enqueued using pushBottom()/newSpark(), and
25  * removed using popBottom()/reclaimSpark() (the latter implying a cas
26  * synchronisation with potential concurrent readers for the case of
27  * just one element).
28  * 
29  * Multiple readers can steal from the read end (position top), and
30  * are synchronised without a lock, based on a cas of the top
31  * position. One reader wins, the others return NULL for a failure.
32  * 
33  * Both popBottom and steal also return NULL when the queue is empty.
34  * 
35  * ---------------------------------------------------------------------------*/
36
37 #include "Rts.h"
38 #include "RtsUtils.h"
39 #include "WSDeque.h"
40 #include "SMP.h" // for cas
41
42 #if defined(THREADED_RTS)
43
44 #define CASTOP(addr,old,new) ((old) == cas(((StgPtr)addr),(old),(new)))
45
46 /* -----------------------------------------------------------------------------
47  * newWSDeque
48  * -------------------------------------------------------------------------- */
49
50 /* internal helpers ... */
51
52 static StgWord
53 roundUp2(StgWord val)
54 {
55     StgWord rounded = 1;
56     
57     /* StgWord is unsigned anyway, only catch 0 */
58     if (val == 0) {
59         barf("DeQue,roundUp2: invalid size 0 requested");
60     }
61     /* at least 1 bit set, shift up to its place */
62     do {
63         rounded = rounded << 1;
64     } while (0 != (val = val>>1));
65     return rounded;
66 }
67
68 WSDeque *
69 newWSDeque (nat size)
70 {
71     StgWord realsize; 
72     WSDeque *q;
73     
74     realsize = roundUp2(size); /* to compute modulo as a bitwise & */
75     
76     q = (WSDeque*) stgMallocBytes(sizeof(WSDeque),   /* admin fields */
77                                   "newWSDeque");
78     q->elements = stgMallocBytes(realsize * sizeof(StgClosurePtr), /* dataspace */
79                                  "newWSDeque:data space");
80     q->top=0;
81     q->bottom=0;
82     q->topBound=0; /* read by writer, updated each time top is read */
83     
84     q->size = realsize;  /* power of 2 */
85     q->moduloSize = realsize - 1; /* n % size == n & moduloSize  */
86     
87     ASSERT_WSDEQUE_INVARIANTS(q); 
88     return q;
89 }
90
91 /* -----------------------------------------------------------------------------
92  * freeWSDeque
93  * -------------------------------------------------------------------------- */
94
95 void
96 freeWSDeque (WSDeque *q)
97 {
98     stgFree(q->elements);
99     stgFree(q);
100 }
101
102 /* -----------------------------------------------------------------------------
103  * 
104  * popWSDeque: remove an element from the write end of the queue.
105  * Returns the removed spark, and NULL if a race is lost or the pool
106  * empty.
107  *
108  * If only one spark is left in the pool, we synchronise with
109  * concurrently stealing threads by using cas to modify the top field.
110  * This routine should NEVER be called by a task which does not own
111  * this deque.
112  *
113  * -------------------------------------------------------------------------- */
114
115 void *
116 popWSDeque (WSDeque *q)
117 {
118     /* also a bit tricky, has to avoid concurrent steal() calls by
119        accessing top with cas, when there is only one element left */
120     StgWord t, b;
121     void ** pos;
122     long  currSize;
123     void * removed;
124     
125     ASSERT_WSDEQUE_INVARIANTS(q); 
126     
127     b = q->bottom;
128     /* "decrement b as a test, see what happens" */
129     q->bottom = --b; 
130     pos = (q->elements) + (b & (q->moduloSize));
131     t = q->top; /* using topBound would give an *upper* bound, we
132                    need a lower bound. We use the real top here, but
133                    can update the topBound value */
134     q->topBound = t;
135     currSize = b - t;
136     if (currSize < 0) { /* was empty before decrementing b, set b
137                            consistently and abort */
138         q->bottom = t;
139         return NULL;
140     }
141     removed = *pos;
142     if (currSize > 0) { /* no danger, still elements in buffer after b-- */
143         return removed;
144     } 
145     /* otherwise, has someone meanwhile stolen the same (last) element?
146        Check and increment top value to know  */
147     if ( !(CASTOP(&(q->top),t,t+1)) ) {
148         removed = NULL; /* no success, but continue adjusting bottom */
149     }
150     q->bottom = t+1; /* anyway, empty now. Adjust bottom consistently. */
151     q->topBound = t+1; /* ...and cached top value as well */
152     
153     ASSERT_WSDEQUE_INVARIANTS(q); 
154     ASSERT(q->bottom >= q->top);
155     
156     return removed;
157 }
158
159 /* -----------------------------------------------------------------------------
160  * stealWSDeque
161  * -------------------------------------------------------------------------- */
162
163 void *
164 stealWSDeque_ (WSDeque *q)
165 {
166     void ** pos;
167     void ** arraybase;
168     StgWord sz;
169     void * stolen;
170     StgWord b,t; 
171     
172 // Can't do this on someone else's spark pool:
173 // ASSERT_WSDEQUE_INVARIANTS(q); 
174     
175     b = q->bottom;
176     t = q->top;
177     
178     // NB. b and t are unsigned; we need a signed value for the test
179     // below.
180     if ((long)b - (long)t <= 0 ) { 
181         return NULL; /* already looks empty, abort */
182   }
183     
184     /* now access array, see pushBottom() */
185     arraybase = q->elements;
186     sz = q->moduloSize;
187     pos = arraybase + (t & sz);  
188     stolen = *pos;
189     
190     /* now decide whether we have won */
191     if ( !(CASTOP(&(q->top),t,t+1)) ) {
192         /* lost the race, someon else has changed top in the meantime */
193         return NULL;
194     }  /* else: OK, top has been incremented by the cas call */
195
196 // Can't do this on someone else's spark pool:
197 // ASSERT_WSDEQUE_INVARIANTS(q); 
198     
199     return stolen;
200 }
201
202 void *
203 stealWSDeque (WSDeque *q)
204 {
205     void *stolen;
206     
207     do { 
208         stolen = stealWSDeque_(q);
209     } while (stolen == NULL && !looksEmptyWSDeque(q));
210     
211     return stolen;
212 }
213
214
215 #define DISCARD_NEW
216
217 /* enqueue an element. Should always succeed by resizing the array
218    (not implemented yet, silently fails in that case). */
219 rtsBool
220 pushWSDeque (WSDeque* q, void * elem)
221 {
222     StgWord t;
223     void ** pos;
224     StgWord sz = q->moduloSize; 
225     StgWord b = q->bottom;
226     
227     ASSERT_WSDEQUE_INVARIANTS(q); 
228     
229     /* we try to avoid reading q->top (accessed by all) and use
230        q->topBound (accessed only by writer) instead. 
231        This is why we do not just call empty(q) here.
232     */
233     t = q->topBound;
234     if ( (StgInt)b - (StgInt)t >= (StgInt)sz ) { 
235         /* NB. 1. sz == q->size - 1, thus ">="
236            2. signed comparison, it is possible that t > b
237         */
238         /* could be full, check the real top value in this case */
239         t = q->top;
240         q->topBound = t;
241         if (b - t >= sz) { /* really no space left :-( */
242             /* reallocate the array, copying the values. Concurrent steal()s
243                will in the meantime use the old one and modify only top.
244                This means: we cannot safely free the old space! Can keep it
245                on a free list internally here...
246                
247                Potential bug in combination with steal(): if array is
248                replaced, it is unclear which one concurrent steal operations
249                use. Must read the array base address in advance in steal().
250             */
251 #if defined(DISCARD_NEW)
252             ASSERT_WSDEQUE_INVARIANTS(q); 
253             return rtsFalse; // we didn't push anything
254 #else
255             /* could make room by incrementing the top position here.  In
256              * this case, should use CASTOP. If this fails, someone else has
257              * removed something, and new room will be available.
258              */
259             ASSERT_WSDEQUE_INVARIANTS(q); 
260 #endif
261         }
262     }
263     pos = (q->elements) + (b & sz);
264     *pos = elem;
265     (q->bottom)++;
266     
267     ASSERT_WSDEQUE_INVARIANTS(q); 
268     return rtsTrue;
269 }
270
271 #endif