ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/State.xs
(Generate patch)

Comparing Coro/Coro/State.xs (file contents):
Revision 1.328 by root, Tue Nov 25 09:49:43 2008 UTC vs.
Revision 1.332 by root, Thu Nov 27 12:20:31 2008 UTC

… …
133#else 133#else
134# define dSTACKLEVEL volatile void *stacklevel 134# define dSTACKLEVEL volatile void *stacklevel
135# define STACKLEVEL ((void *)&stacklevel) 135# define STACKLEVEL ((void *)&stacklevel)
136#endif 136#endif
137 137
138#define IN_DESTRUCT (PL_main_cv == Nullcv) 138#define IN_DESTRUCT PL_dirty
139 139
140#if __GNUC__ >= 3 140#if __GNUC__ >= 3
141# define attribute(x) __attribute__(x) 141# define attribute(x) __attribute__(x)
142# define expect(expr,value) __builtin_expect ((expr),(value)) 142# define expect(expr,value) __builtin_expect ((expr),(value))
143# define INLINE static inline 143# define INLINE static inline
… …
355 HV *st; 355 HV *st;
356 GV *gvp; 356 GV *gvp;
357 return sv_2cv (sv, &st, &gvp, 0); 357 return sv_2cv (sv, &st, &gvp, 0);
358} 358}
359 359
360/*****************************************************************************/
361/* magic glue */
362
363#define CORO_MAGIC_type_cv 26
364#define CORO_MAGIC_type_state PERL_MAGIC_ext
365
366#define CORO_MAGIC_NN(sv, type) \
367 (expect_true (SvMAGIC (sv)->mg_type == type) \
368 ? SvMAGIC (sv) \
369 : mg_find (sv, type))
370
371#define CORO_MAGIC(sv, type) \
372 (expect_true (SvMAGIC (sv)) \
373 ? CORO_MAGIC_NN (sv, type) \
374 : 0)
375
376#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
377#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
378
379INLINE struct coro *
380SvSTATE_ (pTHX_ SV *coro)
381{
382 HV *stash;
383 MAGIC *mg;
384
385 if (SvROK (coro))
386 coro = SvRV (coro);
387
388 if (expect_false (SvTYPE (coro) != SVt_PVHV))
389 croak ("Coro::State object required");
390
391 stash = SvSTASH (coro);
392 if (expect_false (stash != coro_stash && stash != coro_state_stash))
393 {
394 /* very slow, but rare, check */
395 if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
396 croak ("Coro::State object required");
397 }
398
399 mg = CORO_MAGIC_state (coro);
400 return (struct coro *)mg->mg_ptr;
401}
402
403#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
404
405/* faster than SvSTATE, but expects a coroutine hv */
406#define SvSTATE_hv(hv) ((struct coro *)CORO_MAGIC_NN ((SV *)hv, CORO_MAGIC_type_state)->mg_ptr)
407#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
408
409/*****************************************************************************/
410/* padlist management and caching */
411
360static AV * 412static AV *
361coro_derive_padlist (pTHX_ CV *cv) 413coro_derive_padlist (pTHX_ CV *cv)
362{ 414{
363 AV *padlist = CvPADLIST (cv); 415 AV *padlist = CvPADLIST (cv);
364 AV *newpadlist, *newpad; 416 AV *newpadlist, *newpad;
… …
371 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); 423 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
372#endif 424#endif
373 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; 425 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
374 --AvFILLp (padlist); 426 --AvFILLp (padlist);
375 427
376 av_store (newpadlist, 0, SvREFCNT_inc_NN (*av_fetch (padlist, 0, FALSE))); 428 av_store (newpadlist, 0, SvREFCNT_inc_NN (AvARRAY (padlist)[0]));
377 av_store (newpadlist, 1, (SV *)newpad); 429 av_store (newpadlist, 1, (SV *)newpad);
378 430
379 return newpadlist; 431 return newpadlist;
380} 432}
381 433
382static void 434static void
383free_padlist (pTHX_ AV *padlist) 435free_padlist (pTHX_ AV *padlist)
384{ 436{
385 /* may be during global destruction */ 437 /* may be during global destruction */
386 if (SvREFCNT (padlist)) 438 if (!IN_DESTRUCT)
387 { 439 {
388 I32 i = AvFILLp (padlist); 440 I32 i = AvFILLp (padlist);
389 while (i >= 0) 441
442 while (i > 0) /* special-case index 0 */
390 { 443 {
391 SV **svp = av_fetch (padlist, i--, FALSE); 444 /* we try to be extra-careful here */
392 if (svp) 445 AV *av = (AV *)AvARRAY (padlist)[i--];
393 { 446 I32 j = AvFILLp (av);
394 SV *sv; 447
395 while (&PL_sv_undef != (sv = av_pop ((AV *)*svp))) 448 while (j >= 0)
449 SvREFCNT_dec (AvARRAY (av)[j--]);
450
451 AvFILLp (av) = -1;
396 SvREFCNT_dec (sv); 452 SvREFCNT_dec (av);
397
398 SvREFCNT_dec (*svp);
399 }
400 } 453 }
401 454
455 SvREFCNT_dec (AvARRAY (padlist)[0]);
456
457 AvFILLp (padlist) = -1;
402 SvREFCNT_dec ((SV*)padlist); 458 SvREFCNT_dec ((SV*)padlist);
403 } 459 }
404} 460}
405 461
406static int 462static int
… …
415 471
416 SvREFCNT_dec (av); /* sv_magicext increased the refcount */ 472 SvREFCNT_dec (av); /* sv_magicext increased the refcount */
417 473
418 return 0; 474 return 0;
419} 475}
420
421#define CORO_MAGIC_type_cv 26
422#define CORO_MAGIC_type_state PERL_MAGIC_ext
423 476
424static MGVTBL coro_cv_vtbl = { 477static MGVTBL coro_cv_vtbl = {
425 0, 0, 0, 0, 478 0, 0, 0, 0,
426 coro_cv_free 479 coro_cv_free
427}; 480};
428
429#define CORO_MAGIC_NN(sv, type) \
430 (expect_true (SvMAGIC (sv)->mg_type == type) \
431 ? SvMAGIC (sv) \
432 : mg_find (sv, type))
433
434#define CORO_MAGIC(sv, type) \
435 (expect_true (SvMAGIC (sv)) \
436 ? CORO_MAGIC_NN (sv, type) \
437 : 0)
438
439#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
440#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
441
442INLINE struct coro *
443SvSTATE_ (pTHX_ SV *coro)
444{
445 HV *stash;
446 MAGIC *mg;
447
448 if (SvROK (coro))
449 coro = SvRV (coro);
450
451 if (expect_false (SvTYPE (coro) != SVt_PVHV))
452 croak ("Coro::State object required");
453
454 stash = SvSTASH (coro);
455 if (expect_false (stash != coro_stash && stash != coro_state_stash))
456 {
457 /* very slow, but rare, check */
458 if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
459 croak ("Coro::State object required");
460 }
461
462 mg = CORO_MAGIC_state (coro);
463 return (struct coro *)mg->mg_ptr;
464}
465
466#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
467
468/* faster than SvSTATE, but expects a coroutine hv */
469#define SvSTATE_hv(hv) ((struct coro *)CORO_MAGIC_NN ((SV *)hv, CORO_MAGIC_type_state)->mg_ptr)
470#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
471 481
472/* the next two functions merely cache the padlists */ 482/* the next two functions merely cache the padlists */
473static void 483static void
474get_padlist (pTHX_ CV *cv) 484get_padlist (pTHX_ CV *cv)
475{ 485{
… …
503 mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0); 513 mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
504 514
505 av = (AV *)mg->mg_obj; 515 av = (AV *)mg->mg_obj;
506 516
507 if (expect_false (AvFILLp (av) >= AvMAX (av))) 517 if (expect_false (AvFILLp (av) >= AvMAX (av)))
508 av_extend (av, AvMAX (av) + 1); 518 av_extend (av, AvFILLp (av) + 1);
509 519
510 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv); 520 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
511} 521}
512 522
513/** load & save, init *******************************************************/ 523/** load & save, init *******************************************************/
… …
2370 SV **ary; 2380 SV **ary;
2371 2381
2372 /* unfortunately, building manually saves memory */ 2382 /* unfortunately, building manually saves memory */
2373 Newx (ary, 2, SV *); 2383 Newx (ary, 2, SV *);
2374 AvALLOC (av) = ary; 2384 AvALLOC (av) = ary;
2385#if PERL_VERSION_ATLEAST (5,10,0)
2375 /*AvARRAY (av) = ary;*/ 2386 AvARRAY (av) = ary;
2387#else
2376 SvPVX ((SV *)av) = (char *)ary; /* 5.8.8 needs this syntax instead of AvARRAY = ary */ 2388 /* 5.8.8 needs this syntax instead of AvARRAY = ary, yet */
2389 /* -DDEBUGGING flags this as a bug, despite it perfectly working */
2390 SvPVX ((SV *)av) = (char *)ary;
2391#endif
2377 AvMAX (av) = 1; 2392 AvMAX (av) = 1;
2378 AvFILLp (av) = 0; 2393 AvFILLp (av) = 0;
2379 ary [0] = newSViv (count); 2394 ary [0] = newSViv (count);
2380 2395
2381 return newRV_noinc ((SV *)av); 2396 return newRV_noinc ((SV *)av);

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines