replace sparc-specific Int64 code with calls to platform-independent macros
[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 popWSDeque and stealWSDeque also return NULL when the queue is empty.
34  *
35  * Testing: see testsuite/tests/ghc-regress/rts/testwsdeque.c.  If
36  * there's anything wrong with the deque implementation, this test
37  * will probably catch it.
38  * 
39  * ---------------------------------------------------------------------------*/
40
41 #include "Rts.h"
42 #include "RtsUtils.h"
43 #include "WSDeque.h"
44 #include "SMP.h" // for cas
45
46 #define CASTOP(addr,old,new) ((old) == cas(((StgPtr)addr),(old),(new)))
47
48 /* -----------------------------------------------------------------------------
49  * newWSDeque
50  * -------------------------------------------------------------------------- */
51
52 /* internal helpers ... */
53
54 static StgWord
55 roundUp2(StgWord val)
56 {
57     StgWord rounded = 1;
58     
59     /* StgWord is unsigned anyway, only catch 0 */
60     if (val == 0) {
61         barf("DeQue,roundUp2: invalid size 0 requested");
62     }
63     /* at least 1 bit set, shift up to its place */
64     do {
65         rounded = rounded << 1;
66     } while (0 != (val = val>>1));
67     return rounded;
68 }
69
70 WSDeque *
71 newWSDeque (nat size)
72 {
73     StgWord realsize; 
74     WSDeque *q;
75     
76     realsize = roundUp2(size); /* to compute modulo as a bitwise & */
77     
78     q = (WSDeque*) stgMallocBytes(sizeof(WSDeque),   /* admin fields */
79                                   "newWSDeque");
80     q->elements = stgMallocBytes(realsize * sizeof(StgClosurePtr), /* dataspace */
81                                  "newWSDeque:data space");
82     q->top=0;
83     q->bottom=0;
84     q->topBound=0; /* read by writer, updated each time top is read */
85     
86     q->size = realsize;  /* power of 2 */
87     q->moduloSize = realsize - 1; /* n % size == n & moduloSize  */
88     
89     ASSERT_WSDEQUE_INVARIANTS(q); 
90     return q;
91 }
92
93 /* -----------------------------------------------------------------------------
94  * freeWSDeque
95  * -------------------------------------------------------------------------- */
96
97 void
98 freeWSDeque (WSDeque *q)
99 {
100     stgFree(q->elements);
101     stgFree(q);
102 }
103
104 /* -----------------------------------------------------------------------------
105  * 
106  * popWSDeque: remove an element from the write end of the queue.
107  * Returns the removed spark, and NULL if a race is lost or the pool
108  * empty.
109  *
110  * If only one spark is left in the pool, we synchronise with
111  * concurrently stealing threads by using cas to modify the top field.
112  * This routine should NEVER be called by a task which does not own
113  * this deque.
114  *
115  * -------------------------------------------------------------------------- */
116
117 void *
118 popWSDeque (WSDeque *q)
119 {
120     /* also a bit tricky, has to avoid concurrent steal() calls by
121        accessing top with cas, when there is only one element left */
122     StgWord t, b;
123     long  currSize;
124     void * removed;
125     
126     ASSERT_WSDEQUE_INVARIANTS(q); 
127     
128     b = q->bottom;
129
130     // "decrement b as a test, see what happens"
131     b--;
132     q->bottom = b;
133
134     // very important that the following read of q->top does not occur
135     // before the earlier write to q->bottom.
136     store_load_barrier();
137
138     t = q->top; /* using topBound would give an *upper* bound, we
139                    need a lower bound. We use the real top here, but
140                    can update the topBound value */
141     q->topBound = t;
142     currSize = (long)b - (long)t;
143     if (currSize < 0) { /* was empty before decrementing b, set b
144                            consistently and abort */
145         q->bottom = t;
146         return NULL;
147     }
148
149     // read the element at b
150     removed = q->elements[b & q->moduloSize];
151
152     if (currSize > 0) { /* no danger, still elements in buffer after b-- */
153         // debugBelch("popWSDeque: t=%ld b=%ld = %ld\n", t, b, removed);
154         return removed;
155     } 
156     /* otherwise, has someone meanwhile stolen the same (last) element?
157        Check and increment top value to know  */
158     if ( !(CASTOP(&(q->top),t,t+1)) ) {
159         removed = NULL; /* no success, but continue adjusting bottom */
160     }
161     q->bottom = t+1; /* anyway, empty now. Adjust bottom consistently. */
162     q->topBound = t+1; /* ...and cached top value as well */
163     
164     ASSERT_WSDEQUE_INVARIANTS(q); 
165     ASSERT(q->bottom >= q->top);
166     
167     // debugBelch("popWSDeque: t=%ld b=%ld = %ld\n", t, b, removed);
168
169     return removed;
170 }
171
172 /* -----------------------------------------------------------------------------
173  * stealWSDeque
174  * -------------------------------------------------------------------------- */
175
176 void *
177 stealWSDeque_ (WSDeque *q)
178 {
179     void * stolen;
180     StgWord b,t; 
181     
182 // Can't do this on someone else's spark pool:
183 // ASSERT_WSDEQUE_INVARIANTS(q); 
184     
185     // NB. these loads must be ordered, otherwise there is a race
186     // between steal and pop.
187     t = q->top;
188     load_load_barrier();
189     b = q->bottom;
190     
191     // NB. b and t are unsigned; we need a signed value for the test
192     // below, because it is possible that t > b during a
193     // concurrent popWSQueue() operation.
194     if ((long)b - (long)t <= 0 ) { 
195         return NULL; /* already looks empty, abort */
196   }
197     
198     /* now access array, see pushBottom() */
199     stolen = q->elements[t & q->moduloSize];
200     
201     /* now decide whether we have won */
202     if ( !(CASTOP(&(q->top),t,t+1)) ) {
203         /* lost the race, someon else has changed top in the meantime */
204         return NULL;
205     }  /* else: OK, top has been incremented by the cas call */
206
207     // debugBelch("stealWSDeque_: t=%d b=%d\n", t, b);
208
209 // Can't do this on someone else's spark pool:
210 // ASSERT_WSDEQUE_INVARIANTS(q); 
211     
212     return stolen;
213 }
214
215 void *
216 stealWSDeque (WSDeque *q)
217 {
218     void *stolen;
219     
220     do { 
221         stolen = stealWSDeque_(q);
222     } while (stolen == NULL && !looksEmptyWSDeque(q));
223     
224     return stolen;
225 }
226
227 /* -----------------------------------------------------------------------------
228  * pushWSQueue
229  * -------------------------------------------------------------------------- */
230
231 #define DISCARD_NEW
232
233 /* enqueue an element. Should always succeed by resizing the array
234    (not implemented yet, silently fails in that case). */
235 rtsBool
236 pushWSDeque (WSDeque* q, void * elem)
237 {
238     StgWord t;
239     StgWord b;
240     StgWord sz = q->moduloSize; 
241     
242     ASSERT_WSDEQUE_INVARIANTS(q); 
243     
244     /* we try to avoid reading q->top (accessed by all) and use
245        q->topBound (accessed only by writer) instead. 
246        This is why we do not just call empty(q) here.
247     */
248     b = q->bottom;
249     t = q->topBound;
250     if ( (StgInt)b - (StgInt)t >= (StgInt)sz ) { 
251         /* NB. 1. sz == q->size - 1, thus ">="
252            2. signed comparison, it is possible that t > b
253         */
254         /* could be full, check the real top value in this case */
255         t = q->top;
256         q->topBound = t;
257         if (b - t >= sz) { /* really no space left :-( */
258             /* reallocate the array, copying the values. Concurrent steal()s
259                will in the meantime use the old one and modify only top.
260                This means: we cannot safely free the old space! Can keep it
261                on a free list internally here...
262                
263                Potential bug in combination with steal(): if array is
264                replaced, it is unclear which one concurrent steal operations
265                use. Must read the array base address in advance in steal().
266             */
267 #if defined(DISCARD_NEW)
268             ASSERT_WSDEQUE_INVARIANTS(q); 
269             return rtsFalse; // we didn't push anything
270 #else
271             /* could make room by incrementing the top position here.  In
272              * this case, should use CASTOP. If this fails, someone else has
273              * removed something, and new room will be available.
274              */
275             ASSERT_WSDEQUE_INVARIANTS(q); 
276 #endif
277         }
278     }
279
280     q->elements[b & sz] = elem;
281     q->bottom = b + 1;
282     
283     ASSERT_WSDEQUE_INVARIANTS(q); 
284     return rtsTrue;
285 }