1 /*
2 * dispatch.c - method dispatch accelerator
3 *
4 * Copyright (c) 2017-2020 Shiro Kawai <shiro@acm.org>
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 */
33
34 #define LIBGAUCHE_BODY
35 #include "gauche.h"
36 #include "gauche/priv/atomicP.h"
37 #include "gauche/priv/dispatchP.h"
38
39 /*
40 * Method dispatch acceleration
41 *
42 * gf->dispatcher may contain a structure that accelerates method dispatch.
43 * The structure must be treated as opaque from other parts.
44 *
45 * In the current implementation, we use special open-addressing hash table.
46 * We don't use ScmHashCore for a few reasons:
47 *
48 * - We mutex modification of the table by gf->mutex, but we don't want
49 * to lock for searching it. ScmHashCore doesn't guarantee consistency
50 * of reading while modifying.
51 * - It is in performance critical path, and we can take advantage of
52 * domain knowledge to make it faster than generic implementation.
53 *
54 * At this moment, the dispatch accelerator isn't built automatically.
55 * You need to call gauche.object#generic-build-dispatcher! explicitly
56 * on a generic function. The effect varies depending on the methods
57 * the GF has, so we selectively turn on this feature for speed-sensitive
58 * GFs and see how it goes. If it is proven to be effective enough,
59 * we might implement an automated mechanism when GF meets certain
60 * criteria.
61 *
62 * We take advantage of the following facts:
63 *
64 * - Once we hit the leaf method we don't need to find less-specific
65 * methods at all.
66 * - Some generic functions has methods most of which are leaf methods,
67 * and can be mostly specialized by a single argument. The typical
68 * example is `ref'.
69 *
70 * When methods are mostly specilized by N-th argument, we call the N
71 * as AXIS (zero based). Typically, methods tend to be specialized by
72 * the first argument, in which case axis is 0.
73 *
74 * The method dispatcher contains a hash table, where each key is
75 * a tuple (<class>, <number-of-args>), and its value is a list of
76 * methods, whose axis specializer is <class> and which can take
77 * <number-of-args>.
78 *
79 * When a GF with dispatch accelerator is called, we retrieve the class
80 * of the axis of the actual argument, and lookup the hash table with
81 * that class and the number of actual arguments. If we have a hit,
82 * and the entry solely consists of leaf methods,
83 * the list of methods are the list of applicable methods---since there
84 * are no more specific methods, and we don't need to look for less specific
85 * methods. This means...
86 *
87 * - We don't need to go through the entire method list to find
88 * all applicable methods.
89 * - We don't need to allocate to construct the list of applicable
90 * methods.
91 *
92 * Note that if the entry has at least one non-leaf methods, we have to
93 * fall back to the normal path, since there may be other applicable
94 * methods that might be called via next-method. To cut the overhead
95 * of checking, we keep the list of leaf methods and the one of non-leaf
96 * methods separately.
97 */
98
99 /* On concurrent access:
100 *
101 * We don't want to lock the method hash for every invocation of GF.
102 * So we employ some atomic pointer operations so that readers can
103 * see the consistent state even another thread is modifying it.
104 *
105 * We still acquire GF lock whenever we modify the mhash, so there's
106 * at most one thread that's modifying it. Modification is only required
107 * when a new method is added to the GF or any one of classes that
108 * specializes one of the methods is redefined.
109 *
110 * The modification is done by making a modified copy of (sub)structure
111 * and then swap the pointer atomically, thus the concurrent reader
112 * won't see inconsistent state.
113 *
114 * The locking on GF is done in class.c.
115 */
116
117 struct ScmMethodDispatcherRec {
118 int axis; /* Which argument we look at?
119 This is immutable. */
120 ScmAtomicVar methodHash; /* mhash. In case mhash is extended,
121 we atomically swap reference. */
122 };
123
124 typedef struct mhash_entry_rec {
125 ScmClass *klass;
126 int nargs;
127 ScmObj leaves; /* list of matching leaf methods */
128 ScmObj nonleaves; /* list of matching non-leaf methods */
129 } mhash_entry;
130
131 typedef struct mhash_rec {
132 int size; /* # of bins. power of 2. */
133 int num_entries; /* # of active entries. */
134 ScmAtomicVar bins[1]; /* Table. Each entry may have one of:
135 0 - free
136 1 - deleted
137 mhash_entry
138 We might atomically change the bin value,
139 which shouldn't affect concurrently reading
140 threads.
141 */
142 } mhash;
143
144
mhashfn(ScmClass * k,int nargs)145 static inline u_long mhashfn(ScmClass *k, int nargs)
146 {
147 return (((SCM_WORD(k) >> 3) + nargs) * 2654435761UL) >> 20;
148 }
149
make_mhash(int size)150 static mhash *make_mhash(int size)
151 {
152 mhash *mh = SCM_NEW2(mhash*, sizeof(mhash)+(sizeof(ScmAtomicWord)*(size-1)));
153 mh->size = size;
154 mh->num_entries = 0;
155 for (int i=0; i<size; i++) mh->bins[i] = 0;
156 return mh;
157 }
158
mhash_probe(const mhash * h,ScmClass * k,int nargs)159 static ScmObj mhash_probe(const mhash *h, ScmClass *k, int nargs)
160 {
161 /* Quadratic probing
162 j = H_i(k,nargs) + (i + i^2)/2
163 H_{i+1} - H_i = ((i+1) + (i+1)^2 - (i + i^2))/2 = i + 1
164 */
165 u_long j = mhashfn(k, nargs) & (h->size - 1);
166 int i = 0;
167 for (; i < h->size; i++) {
168 /* Need to strip 'const', because of C11 error
169 http://www.open-std.org/jtc1/sc22/wg14/www/docs/summary.htm#dr_459 */
170 ScmAtomicVar *loc = (ScmAtomicVar*)&h->bins[j];
171 ScmWord w = SCM_WORD(AO_load(loc));
172 if (w == 0) break;
173 if (w != 1) {
174 mhash_entry *e = (mhash_entry*)w;
175 if (e->klass == k && e->nargs == nargs) {
176 if (SCM_NULLP(e->nonleaves)) return e->leaves;
177 else return SCM_FALSE;
178 }
179 }
180 j = (j + i + 1) & (h->size - 1);
181 }
182 return SCM_FALSE;
183 }
184
mhash_insert_1(mhash * h,ScmClass * k,int nargs,ScmMethod * m)185 static mhash *mhash_insert_1(mhash *h, ScmClass *k, int nargs, ScmMethod *m)
186 {
187 u_long j = mhashfn(k, nargs) & (h->size - 1);
188 long free_slot = -1;
189 ScmObj ltail = SCM_NIL, ntail = SCM_NIL;
190 int i = 0;
191 for (; i < h->size; i++) {
192 ScmWord w = SCM_WORD(AO_load(&h->bins[j]));
193 if (w == 0) { /* end of chain */
194 if (free_slot < 0) free_slot = j;
195 break;
196 }
197 if (w == 1) {
198 if (free_slot < 0) free_slot = j;
199 continue;
200 }
201 mhash_entry *e = (mhash_entry*)w;
202 if (e->klass == k && e->nargs == nargs) {
203 free_slot = j;
204 ltail = e->leaves;
205 ntail = e->nonleaves;
206 h->num_entries--;
207 break;
208 }
209 j = (j + i + 1) & (h->size - 1);
210
211 }
212 SCM_ASSERT(free_slot >= 0);
213 mhash_entry *e = SCM_NEW(mhash_entry);
214 e->klass = k;
215 e->nargs = nargs;
216 e->leaves = SCM_METHOD_LEAF_P(m)? Scm_Cons(SCM_OBJ(m), ltail) : ltail;
217 e->nonleaves = SCM_METHOD_LEAF_P(m) ? ntail : Scm_Cons(SCM_OBJ(m), ntail);
218 AO_store_full(&h->bins[free_slot], (ScmAtomicWord)e);
219 h->num_entries++;
220 return h;
221 }
222
mhash_insert(mhash * h,ScmClass * k,int nargs,ScmMethod * m)223 static mhash *mhash_insert(mhash *h, ScmClass *k, int nargs, ScmMethod *m)
224 {
225 if (h->size <= h->num_entries*2) {
226 /* extend */
227 mhash *nh = make_mhash(h->size*2);
228 nh->num_entries = h->num_entries;
229 for (int i = 0; i < h->size; i++) {
230 ScmWord w = h->bins[i];
231 if (w == 0 || w == 1) continue;
232 mhash_entry *e = (mhash_entry*)w;
233 u_long j = mhashfn(e->klass, e->nargs) & (nh->size - 1);
234 int k = 0;
235 for (; k < nh->size; k++) {
236 if (SCM_WORD(nh->bins[j]) == 0) {
237 nh->bins[j] = w;
238 break;
239 }
240 j = (j + k + 1) & (nh->size - 1);
241 }
242 SCM_ASSERT(k < nh->size);
243 }
244 h = nh;
245 }
246 return mhash_insert_1(h, k, nargs, m);
247 }
248
mhash_delete(mhash * h,ScmClass * k,int nargs,ScmMethod * m)249 static mhash *mhash_delete(mhash *h, ScmClass *k, int nargs, ScmMethod *m)
250 {
251 u_long j = mhashfn(k, nargs) & (h->size - 1);
252
253 int i = 0;
254 for (; i < h->size; i++) {
255 ScmWord w = SCM_WORD(AO_load(&h->bins[j]));
256 if (w == 0) break;
257 if (w == 1) continue;
258 mhash_entry *e = (mhash_entry*)w;
259 if (e->klass == k && e->nargs == nargs) {
260 ScmObj ml = e->leaves;
261 ScmObj mn = e->nonleaves;
262 if (SCM_PAIRP(ml) && SCM_EQ(SCM_CAR(ml), SCM_OBJ(m))) {
263 ml = SCM_CDR(ml); /* fast path */
264 } else {
265 ml = Scm_Delete(SCM_OBJ(m), ml, SCM_CMP_EQ);
266 }
267 if (SCM_PAIRP(mn) && SCM_EQ(SCM_CAR(mn), SCM_OBJ(m))) {
268 mn = SCM_CDR(mn); /* fast path */
269 } else {
270 mn = Scm_Delete(SCM_OBJ(m), mn, SCM_CMP_EQ);
271 }
272
273 if (SCM_NULLP(ml) && SCM_NULLP(ml)) {
274 h->num_entries--;
275 AO_store(&h->bins[j], 1); /* mark as deleted */
276 } else {
277 mhash_entry *e = SCM_NEW(mhash_entry);
278 e->klass = k;
279 e->nargs = nargs;
280 e->leaves = ml;
281 e->nonleaves = mn;
282 AO_store_full(&h->bins[j], (ScmAtomicWord)e);
283 }
284 break;
285 }
286 j = (j + i + 1) & (h->size - 1);
287 }
288 return h;
289 }
290
mhash_print(mhash * h,ScmPort * out)291 static void mhash_print(mhash *h, ScmPort *out)
292 {
293 Scm_Printf(out, "mhash size=%d num_entries=%d\n", h->size, h->num_entries);
294 for (int i=0; i<h->size; i++) {
295 ScmWord w = SCM_WORD(h->bins[i]);
296 if (w == 0) {
297 Scm_Printf(out, "[%3d] empty\n\n\n", i);
298 } else if (w == 1) {
299 Scm_Printf(out, "[%3d] deleted\n\n\n", i);
300 } else {
301 mhash_entry *e = (mhash_entry*)w;
302 Scm_Printf(out, "[%3d] %lu %S(%d)\n", i,
303 (mhashfn(e->klass, e->nargs) % h->size),
304 e->klass, e->nargs);
305 Scm_Printf(out, " Leaves: %S\n", e->leaves);
306 Scm_Printf(out, " NonLeaves:%S\n", e->nonleaves);
307 }
308 }
309 }
310
add_method_to_dispatcher(mhash * h,int axis,ScmMethod * m)311 static mhash *add_method_to_dispatcher(mhash *h, int axis, ScmMethod *m)
312 {
313 int req = SCM_PROCEDURE_REQUIRED(m);
314 if (req >= axis) {
315 ScmClass *klass = m->specializers[axis];
316 if (SCM_PROCEDURE_OPTIONAL(m)) {
317 for (int k = req; k < SCM_DISPATCHER_MAX_NARGS; k++)
318 h = mhash_insert(h, klass, k, m);
319 } else {
320 h = mhash_insert(h, klass, req, m);
321 }
322 }
323 return h;
324 }
325
delete_method_from_dispatcher(mhash * h,int axis,ScmMethod * m)326 static mhash *delete_method_from_dispatcher(mhash *h, int axis, ScmMethod *m)
327 {
328 int req = SCM_PROCEDURE_REQUIRED(m);
329 if (req >= axis) {
330 ScmClass *klass = m->specializers[axis];
331 if (SCM_PROCEDURE_OPTIONAL(m)) {
332 for (int k = req; k < SCM_DISPATCHER_MAX_NARGS; k++)
333 h = mhash_delete(h, klass, k, m);
334 } else {
335 h = mhash_delete(h, klass, req, m);
336 }
337 }
338 return h;
339 }
340
341 /*
342 NB: We run through the method list twice, first process the
343 leaf methods, and then process non-leaf methods. Non-leaf methods
344 cancels the dispatcher entry and forces to go through normal route.
345 */
Scm__BuildMethodDispatcher(ScmObj methods,int axis)346 ScmMethodDispatcher *Scm__BuildMethodDispatcher(ScmObj methods, int axis)
347 {
348 mhash *mh = make_mhash(32);
349 ScmObj mm;
350 for (int i = 0; i < 2; i++) {
351 SCM_FOR_EACH(mm, methods) {
352 ScmMethod *m = SCM_METHOD(SCM_CAR(mm));
353 if ((i == 0 && SCM_METHOD_LEAF_P(m))
354 || (i == 1 && !SCM_METHOD_LEAF_P(m))) {
355 mh = add_method_to_dispatcher(mh, axis, m);
356 }
357 }
358 }
359 ScmMethodDispatcher *dis = SCM_NEW(ScmMethodDispatcher);
360 dis->axis = axis;
361 dis->methodHash = (ScmAtomicWord)mh;
362 return dis;
363 }
364
Scm__MethodDispatcherAdd(ScmMethodDispatcher * dis,ScmMethod * m)365 void Scm__MethodDispatcherAdd(ScmMethodDispatcher *dis, ScmMethod *m)
366 {
367 mhash *h = (mhash*)AO_load(&dis->methodHash);
368 mhash *h2 = add_method_to_dispatcher(h, dis->axis, m);
369 if (h != h2) AO_store(&dis->methodHash, (ScmAtomicWord)h2);
370 }
371
Scm__MethodDispatcherDelete(ScmMethodDispatcher * dis,ScmMethod * m)372 void Scm__MethodDispatcherDelete(ScmMethodDispatcher *dis, ScmMethod *m)
373 {
374 mhash *h = (mhash*)AO_load(&dis->methodHash);
375 mhash *h2 = delete_method_from_dispatcher(h, dis->axis, m);
376 if (h != h2) AO_store(&dis->methodHash, (ScmAtomicWord)h2);
377 }
378
Scm__MethodDispatcherLookup(ScmMethodDispatcher * dis,ScmClass ** typev,int argc)379 ScmObj Scm__MethodDispatcherLookup(ScmMethodDispatcher *dis,
380 ScmClass **typev, int argc)
381 {
382 if (dis->axis <= argc) {
383 ScmClass *selector = typev[dis->axis];
384 mhash *h = (mhash*)AO_load(&dis->methodHash);
385 return mhash_probe(h, selector, argc);
386 } else {
387 return SCM_FALSE;
388 }
389 }
390
Scm__MethodDispatcherInfo(const ScmMethodDispatcher * dis)391 ScmObj Scm__MethodDispatcherInfo(const ScmMethodDispatcher *dis)
392 {
393 ScmObj h = SCM_NIL, t = SCM_NIL;
394 /* Need to strip 'const', because of C11 error
395 http://www.open-std.org/jtc1/sc22/wg14/www/docs/summary.htm#dr_459 */
396 ScmAtomicVar *loc = (ScmAtomicVar*)&dis->methodHash;
397 const mhash *mh = (const mhash*)AO_load(loc);
398 SCM_APPEND1(h, t, SCM_MAKE_KEYWORD("axis"));
399 SCM_APPEND1(h, t, SCM_MAKE_INT(dis->axis));
400 SCM_APPEND1(h, t, SCM_MAKE_KEYWORD("num-entries"));
401 SCM_APPEND1(h, t, SCM_MAKE_INT(mh->num_entries));
402 return h;
403 }
404
Scm__MethodDispatcherDump(ScmMethodDispatcher * dis,ScmPort * port)405 void Scm__MethodDispatcherDump(ScmMethodDispatcher *dis, ScmPort *port)
406 {
407 Scm_Printf(port, "MethodDispatcher axis=%d\n", dis->axis);
408 mhash_print((mhash*)dis->methodHash, port);
409 }
410
411