@@ -43,6 +43,8 @@ static INTVAL smo_id = 0;
43
43
#define DEFINED_ONLY 1
44
44
#define UNDEFINED_ONLY 2
45
45
46
+ /* Register type. */
47
+ #define BIND_VAL_OBJ 4
46
48
47
49
/* Compares two types to see if the first is narrower than the second. */
48
50
static INTVAL is_narrower_type (PARROT_INTERP , PMC * a , PMC * b ) {
@@ -262,26 +264,182 @@ static PMC *get_dispatchees(PARROT_INTERP, PMC *dispatcher) {
262
264
}
263
265
}
264
266
267
+ /* Gets (creating if needed) a multi-dispatch cache. */
268
+ static NQP_md_cache * get_dispatch_cache (PARROT_INTERP , PMC * dispatcher ) {
269
+ PMC * cache_ptr ;
270
+ if (!smo_id )
271
+ smo_id = Parrot_pmc_get_type_str (interp , Parrot_str_new (interp , "SixModelObject" , 0 ));
272
+ if (dispatcher -> vtable -> base_type == enum_class_Sub && PARROT_SUB (dispatcher )-> multi_signature -> vtable -> base_type == smo_id ) {
273
+ NQP_Routine * r = (NQP_Routine * )PMC_data (PARROT_SUB (dispatcher )-> multi_signature );
274
+ if (PMC_IS_NULL (r -> dispatch_cache )) {
275
+ NQP_md_cache * c = mem_sys_allocate_zeroed (sizeof (NQP_md_cache ));
276
+ cache_ptr = Parrot_pmc_new (interp , enum_class_Pointer );
277
+ VTABLE_set_pointer (interp , cache_ptr , c );
278
+ r -> dispatch_cache = cache_ptr ;
279
+ PARROT_GC_WRITE_BARRIER (interp , PARROT_SUB (dispatcher )-> multi_signature );
280
+ }
281
+ else {
282
+ cache_ptr = r -> dispatch_cache ;
283
+ }
284
+ }
285
+ else {
286
+ if (PMC_IS_NULL (PARROT_DISPATCHERSUB (dispatcher )-> dispatch_cache )) {
287
+ NQP_md_cache * c = mem_sys_allocate_zeroed (sizeof (NQP_md_cache ));
288
+ cache_ptr = Parrot_pmc_new (interp , enum_class_Pointer );
289
+ VTABLE_set_pointer (interp , cache_ptr , c );
290
+ PARROT_DISPATCHERSUB (dispatcher )-> dispatch_cache = cache_ptr ;
291
+ PARROT_GC_WRITE_BARRIER (interp , dispatcher );
292
+ }
293
+ else {
294
+ cache_ptr = PARROT_DISPATCHERSUB (dispatcher )-> dispatch_cache ;
295
+ }
296
+ }
297
+ return (NQP_md_cache * )VTABLE_get_pointer (interp , cache_ptr );
298
+ }
299
+
300
+ /*
301
+
302
+ =item C<static PMC * find_in_cache(PARROT_INTERP, NQP_md_cache *cache, PMC *capture, INTVAL num_args)>
303
+
304
+ Looks for an entry in the multi-dispatch cache.
305
+
306
+ =cut
307
+
308
+ */
309
+ static PMC *
310
+ find_in_cache (PARROT_INTERP , NQP_md_cache * cache , PMC * capture , INTVAL num_args ) {
311
+ INTVAL arg_tup [MD_CACHE_MAX_ARITY ];
312
+ INTVAL i , j , entries , t_pos ;
313
+ struct Pcc_cell * pc_positionals ;
314
+
315
+ /* If it's zero-arity, return result right off. */
316
+ if (num_args == 0 )
317
+ return cache -> zero_arity ;
318
+
319
+ /* Create arg tuple. */
320
+ if (capture -> vtable -> base_type == enum_class_CallContext )
321
+ GETATTR_CallContext_positionals (interp , capture , pc_positionals );
322
+ else
323
+ return NULL ;
324
+ for (i = 0 ; i < num_args ; i ++ ) {
325
+ if (pc_positionals [i ].type == BIND_VAL_OBJ ) {
326
+ PMC * arg = pc_positionals [i ].u .p ;
327
+ if (arg -> vtable -> base_type != smo_id )
328
+ return NULL ;
329
+ arg_tup [i ] = STABLE (arg )-> type_cache_id | (IS_CONCRETE (arg ) ? 1 : 0 );
330
+ }
331
+ else {
332
+ arg_tup [i ] = (pc_positionals [i ].type << 1 ) | 1 ;
333
+ }
334
+ }
335
+
336
+ /* Look through entries. */
337
+ entries = cache -> arity_caches [num_args - 1 ].num_entries ;
338
+ t_pos = 0 ;
339
+ for (i = 0 ; i < entries ; i ++ ) {
340
+ INTVAL match = 1 ;
341
+ for (j = 0 ; j < num_args ; j ++ ) {
342
+ if (cache -> arity_caches [num_args - 1 ].type_ids [t_pos + j ] != arg_tup [j ]) {
343
+ match = 0 ;
344
+ break ;
345
+ }
346
+ }
347
+ if (match )
348
+ return cache -> arity_caches [num_args - 1 ].results [i ];
349
+ t_pos += num_args ;
350
+ }
351
+
352
+ return NULL ;
353
+ }
354
+
355
+
356
+ /*
357
+
358
+ =item C<static void add_to_cache(PARROT_INTERP, NQP_md_cache *cache, PMC *capture, INTVAL num_args)>
359
+
360
+ Adds an entry to the multi-dispatch cache.
361
+
362
+ =cut
363
+
364
+ */
365
+ static void
366
+ add_to_cache (PARROT_INTERP , NQP_md_cache * cache , PMC * capture , INTVAL num_args , PMC * result ) {
367
+ INTVAL arg_tup [MD_CACHE_MAX_ARITY ];
368
+ INTVAL i , entries , ins_type ;
369
+ struct Pcc_cell * pc_positionals ;
370
+
371
+ /* If it's zero arity, just stick it in that slot. */
372
+ if (num_args == 0 ) {
373
+ cache -> zero_arity = result ;
374
+ return ;
375
+ }
376
+
377
+ /* If the cache is saturated, don't do anything (we could instead do a random
378
+ * replacement). */
379
+ entries = cache -> arity_caches [num_args - 1 ].num_entries ;
380
+ if (entries == MD_CACHE_MAX_ENTRIES )
381
+ return ;
382
+
383
+ /* Create arg tuple. */
384
+ if (capture -> vtable -> base_type == enum_class_CallContext )
385
+ GETATTR_CallContext_positionals (interp , capture , pc_positionals );
386
+ else
387
+ return ;
388
+ for (i = 0 ; i < num_args ; i ++ ) {
389
+ if (pc_positionals [i ].type == BIND_VAL_OBJ ) {
390
+ PMC * arg = pc_positionals [i ].u .p ;
391
+ if (arg -> vtable -> base_type != smo_id )
392
+ return ;
393
+ arg_tup [i ] = STABLE (arg )-> type_cache_id | (IS_CONCRETE (arg ) ? 1 : 0 );
394
+ }
395
+ else {
396
+ arg_tup [i ] = (pc_positionals [i ].type << 1 ) | 1 ;
397
+ }
398
+ }
399
+
400
+ /* If there's no entries yet, need to do some allocation. */
401
+ if (entries == 0 ) {
402
+ cache -> arity_caches [num_args - 1 ].type_ids = mem_sys_allocate (num_args * sizeof (INTVAL ) * MD_CACHE_MAX_ENTRIES );
403
+ cache -> arity_caches [num_args - 1 ].results = mem_sys_allocate (sizeof (PMC * ) * MD_CACHE_MAX_ENTRIES );
404
+ }
405
+
406
+ /* Add entry. */
407
+ ins_type = entries * num_args ;
408
+ for (i = 0 ; i < num_args ; i ++ )
409
+ cache -> arity_caches [num_args - 1 ].type_ids [ins_type + i ] = arg_tup [i ];
410
+ cache -> arity_caches [num_args - 1 ].results [entries ] = result ;
411
+ cache -> arity_caches [num_args - 1 ].num_entries = entries + 1 ;
412
+ }
413
+
265
414
/* Performs a multiple dispatch using the candidates held in the passed
266
415
* dispatcher and using the arguments in the passed capture. */
267
416
PMC * nqp_multi_dispatch (PARROT_INTERP , PMC * dispatcher , PMC * capture ) {
268
- /* Get list and number of dispatchees. */
269
- PMC * dispatchees = get_dispatchees (interp , dispatcher );
270
- const INTVAL num_candidates = VTABLE_elements (interp , dispatchees );
417
+ NQP_md_cache * disp_cache ;
418
+ PMC * dispatchees , * cache_result ;
419
+ INTVAL type_mismatch , possibles_count , type_check_count ,
420
+ num_candidates , num_args ;
421
+ candidate_info * * possibles , * * candidates , * * cur_candidate ;
271
422
272
423
/* Count arguments. */
273
- const INTVAL num_args = VTABLE_elements (interp , capture );
424
+ num_args = VTABLE_elements (interp , capture );
425
+
426
+ /* See if the dispatcher cache will resolve it right off. */
427
+ disp_cache = get_dispatch_cache (interp , dispatcher );
428
+ cache_result = find_in_cache (interp , disp_cache , capture , num_args );
429
+ if (!PMC_IS_NULL (cache_result ))
430
+ return cache_result ;
431
+
432
+ /* Get list and number of dispatchees. */
433
+ dispatchees = get_dispatchees (interp , dispatcher );
434
+ num_candidates = VTABLE_elements (interp , dispatchees );
274
435
275
436
/* Initialize dispatcher state. */
276
- INTVAL type_mismatch ;
277
- INTVAL possibles_count = 0 ;
278
- candidate_info * * possibles = mem_allocate_n_typed (num_candidates , candidate_info * );
279
- INTVAL type_check_count ;
437
+ possibles_count = 0 ;
438
+ possibles = mem_allocate_n_typed (num_candidates , candidate_info * );
280
439
281
- /* Get sorted candidate list.
282
- * XXX We'll cache this in the future. */
283
- candidate_info * * candidates = sort_candidates (interp , dispatchees );
284
- candidate_info * * cur_candidate = candidates ;
440
+ /* Get sorted candidate list. */
441
+ candidates = sort_candidates (interp , dispatchees );
442
+ cur_candidate = candidates ;
285
443
286
444
/* Iterate over the candidates and collect best ones; terminate
287
445
* when we see two nulls (may break out earlier). */
@@ -350,12 +508,13 @@ PMC *nqp_multi_dispatch(PARROT_INTERP, PMC *dispatcher, PMC *capture) {
350
508
351
509
/* Cache the result if there's a single chosen one. */
352
510
if (possibles_count == 1 ) {
353
- /* XXX TODO: Cache entry. */
511
+ add_to_cache ( interp , disp_cache , capture , num_args , possibles [ 0 ] -> sub );
354
512
}
355
513
356
514
/* Need a unique candidate. */
357
515
if (possibles_count == 1 ) {
358
516
PMC * result = possibles [0 ]-> sub ;
517
+ mem_sys_free (candidates );
359
518
mem_sys_free (possibles );
360
519
return result ;
361
520
}
@@ -373,6 +532,7 @@ PMC *nqp_multi_dispatch(PARROT_INTERP, PMC *dispatcher, PMC *capture) {
373
532
cur_candidate ++ ;
374
533
}
375
534
535
+ mem_sys_free (candidates );
376
536
mem_sys_free (possibles );
377
537
Parrot_ex_throw_from_c_args (interp , NULL , 1 ,
378
538
"No applicable candidates found to dispatch to for '%Ss'. Available candidates are:\n%Ss" ,
@@ -386,6 +546,7 @@ PMC *nqp_multi_dispatch(PARROT_INTERP, PMC *dispatcher, PMC *capture) {
386
546
/* XXX TODO: sig dumping
387
547
for (i = 0; i < possibles_count; i++)
388
548
signatures = dump_signature(interp, signatures, possibles[i]->sub); */
549
+ mem_sys_free (candidates );
389
550
mem_sys_free (possibles );
390
551
Parrot_ex_throw_from_c_args (interp , NULL , 1 ,
391
552
"Ambiguous dispatch to multi '%Ss'. Ambiguous candidates had signatures:\n%Ss" ,
0 commit comments