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.117 by root, Fri Dec 1 19:41:06 2006 UTC vs.
Revision 1.126 by root, Tue Dec 12 04:19:56 2006 UTC

… …
38# ifndef IS_PADCONST 38# ifndef IS_PADCONST
39# define IS_PADCONST(v) 0 39# define IS_PADCONST(v) 0
40# endif 40# endif
41#endif 41#endif
42 42
43/* 5.8.7 */
44#ifndef SvRV_set
45# define SvRV_set(s,v) SvRV(s) = (v)
46#endif
47
43#include <stdio.h> 48#include <stdio.h>
44#include <errno.h> 49#include <errno.h>
50#include <assert.h>
45 51
46#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64 52#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
47# undef STACKGUARD 53# undef STACKGUARD
48#endif 54#endif
49 55
… …
90 96
91#define NOINLINE attribute ((noinline)) 97#define NOINLINE attribute ((noinline))
92 98
93#include "CoroAPI.h" 99#include "CoroAPI.h"
94 100
95#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */
96
97#ifdef USE_ITHREADS 101#ifdef USE_ITHREADS
98static perl_mutex coro_mutex; 102static perl_mutex coro_mutex;
99# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0) 103# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)
100# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0) 104# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)
101#else 105#else
102# define LOCK (void)0 106# define LOCK (void)0
103# define UNLOCK (void)0 107# define UNLOCK (void)0
104#endif 108#endif
105 109
110struct io_state
111{
112 int errorno;
113 I32 laststype;
114 int laststatval;
115 Stat_t statcache;
116};
117
106static struct CoroAPI coroapi; 118static struct CoroAPI coroapi;
107static AV *main_mainstack; /* used to differentiate between $main and others */ 119static AV *main_mainstack; /* used to differentiate between $main and others */
108static HV *coro_state_stash, *coro_stash; 120static HV *coro_state_stash, *coro_stash;
109static SV *coro_mortal; /* will be freed after next transfer */ 121static SV *coro_mortal; /* will be freed after next transfer */
110 122
… …
143 coro_cctx *cctx; 155 coro_cctx *cctx;
144 156
145 /* data associated with this coroutine (initial args) */ 157 /* data associated with this coroutine (initial args) */
146 AV *args; 158 AV *args;
147 int refcnt; 159 int refcnt;
148 int flags; 160 int save; /* CORO_SAVE flags */
161 int flags; /* CF_ flags */
149 162
150 /* optionally saved, might be zero */ 163 /* optionally saved, might be zero */
151 AV *defav; 164 AV *defav; /* @_ */
152 SV *defsv; 165 SV *defsv; /* $_ */
153 SV *errsv; 166 SV *errsv; /* $@ */
167 SV *irssv; /* $/ */
168 SV *irssv_sv; /* real $/ cache */
154 169
155#define VAR(name,type) type name; 170#define VAR(name,type) type name;
156# include "state.h" 171# include "state.h"
157#undef VAR 172#undef VAR
158 173
… …
281} 296}
282 297
283#define SB do { 298#define SB do {
284#define SE } while (0) 299#define SE } while (0)
285 300
286#define LOAD(state) load_state ((state))
287#define SAVE(state,flags) save_state ((state),(flags))
288
289#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE 301#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE
290 302
291static void 303static void
292load_state (Coro__State c) 304load_perl (Coro__State c)
293{ 305{
294#define VAR(name,type) PL_ ## name = c->name; 306#define VAR(name,type) PL_ ## name = c->name;
295# include "state.h" 307# include "state.h"
296#undef VAR 308#undef VAR
297 309
298 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav); 310 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
299 if (c->defsv) REPLACE_SV (DEFSV , c->defsv); 311 if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
300 if (c->errsv) REPLACE_SV (ERRSV , c->errsv); 312 if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
313 if (c->irssv)
314 {
315 if (c->irssv == PL_rs || sv_eq (PL_rs, c->irssv))
316 SvREFCNT_dec (c->irssv);
317 else
318 {
319 REPLACE_SV (PL_rs, c->irssv);
320 if (!c->irssv_sv) c->irssv_sv = get_sv ("/", 0);
321 sv_setsv (c->irssv_sv, PL_rs);
322 }
323 }
301 324
302 { 325 {
303 dSP; 326 dSP;
304 CV *cv; 327 CV *cv;
305 328
… …
314 PUTBACK; 337 PUTBACK;
315 } 338 }
316} 339}
317 340
318static void 341static void
319save_state (Coro__State c, int flags) 342save_perl (Coro__State c)
320{ 343{
321 { 344 {
322 dSP; 345 dSP;
323 I32 cxix = cxstack_ix; 346 I32 cxix = cxstack_ix;
324 PERL_CONTEXT *ccstk = cxstack; 347 PERL_CONTEXT *ccstk = cxstack;
… …
327 /* 350 /*
328 * the worst thing you can imagine happens first - we have to save 351 * the worst thing you can imagine happens first - we have to save
329 * (and reinitialize) all cv's in the whole callchain :( 352 * (and reinitialize) all cv's in the whole callchain :(
330 */ 353 */
331 354
355 EXTEND (SP, 3 + 1);
332 PUSHs (Nullsv); 356 PUSHs (Nullsv);
333 /* this loop was inspired by pp_caller */ 357 /* this loop was inspired by pp_caller */
334 for (;;) 358 for (;;)
335 { 359 {
336 while (cxix >= 0) 360 while (cxix >= 0)
… …
342 CV *cv = cx->blk_sub.cv; 366 CV *cv = cx->blk_sub.cv;
343 367
344 if (CvDEPTH (cv)) 368 if (CvDEPTH (cv))
345 { 369 {
346 EXTEND (SP, 3); 370 EXTEND (SP, 3);
347
348 PUSHs ((SV *)CvPADLIST (cv)); 371 PUSHs ((SV *)CvPADLIST (cv));
349 PUSHs (INT2PTR (SV *, CvDEPTH (cv))); 372 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
350 PUSHs ((SV *)cv); 373 PUSHs ((SV *)cv);
351 374
352 CvDEPTH (cv) = 0; 375 CvDEPTH (cv) = 0;
353 get_padlist (cv); 376 get_padlist (cv);
354 } 377 }
355 } 378 }
356#ifdef CXt_FORMAT
357 else if (CxTYPE (cx) == CXt_FORMAT)
358 {
359 /* I never used formats, so how should I know how these are implemented? */
360 /* my bold guess is as a simple, plain sub... */
361 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
362 }
363#endif
364 } 379 }
365 380
366 if (top_si->si_type == PERLSI_MAIN) 381 if (top_si->si_type == PERLSI_MAIN)
367 break; 382 break;
368 383
… …
372 } 387 }
373 388
374 PUTBACK; 389 PUTBACK;
375 } 390 }
376 391
377 c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0; 392 c->defav = c->save & CORO_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
378 c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0; 393 c->defsv = c->save & CORO_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
379 c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0; 394 c->errsv = c->save & CORO_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
395 c->irssv = c->save & CORO_SAVE_IRSSV ? SvREFCNT_inc (PL_rs) : 0;
380 396
381#define VAR(name,type)c->name = PL_ ## name; 397#define VAR(name,type)c->name = PL_ ## name;
382# include "state.h" 398# include "state.h"
383#undef VAR 399#undef VAR
384} 400}
… …
387 * allocate various perl stacks. This is an exact copy 403 * allocate various perl stacks. This is an exact copy
388 * of perl.c:init_stacks, except that it uses less memory 404 * of perl.c:init_stacks, except that it uses less memory
389 * on the (sometimes correct) assumption that coroutines do 405 * on the (sometimes correct) assumption that coroutines do
390 * not usually need a lot of stackspace. 406 * not usually need a lot of stackspace.
391 */ 407 */
408#if USE_PERL_INIT_STACKS
409# define coro_init_stacks init_stacks
410#else
411
392static void 412static void
393coro_init_stacks () 413coro_init_stacks ()
394{ 414{
395 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT)); 415 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));
396 PL_curstackinfo->si_type = PERLSI_MAIN; 416 PL_curstackinfo->si_type = PERLSI_MAIN;
… …
435static void 455static void
436coro_destroy_stacks () 456coro_destroy_stacks ()
437{ 457{
438 if (!IN_DESTRUCT) 458 if (!IN_DESTRUCT)
439 { 459 {
440 /* is this ugly, I ask? */ 460 /* restore all saved variables and stuff */
441 LEAVE_SCOPE (0); 461 LEAVE_SCOPE (0);
462 assert (PL_tmps_floor == -1);
442 463
443 /* sure it is, but more important: is it correct?? :/ */ 464 /* free all temporaries */
444 FREETMPS; 465 FREETMPS;
466 assert (PL_tmps_ix == -1);
445 467
446 /*POPSTACK_TO (PL_mainstack);*//*D*//*use*/ 468 POPSTACK_TO (PL_mainstack);
447 } 469 }
448 470
449 while (PL_curstackinfo->si_next) 471 while (PL_curstackinfo->si_next)
450 PL_curstackinfo = PL_curstackinfo->si_next; 472 PL_curstackinfo = PL_curstackinfo->si_next;
451 473
452 while (PL_curstackinfo) 474 while (PL_curstackinfo)
453 { 475 {
454 PERL_SI *p = PL_curstackinfo->si_prev; 476 PERL_SI *p = PL_curstackinfo->si_prev;
455 477
456 { /*D*//*remove*/
457 dSP;
458 SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
459 PUTBACK; /* possibly superfluous */
460 }
461
462 if (!IN_DESTRUCT) 478 if (!IN_DESTRUCT)
463 {
464 dounwind (-1);/*D*//*remove*/
465 SvREFCNT_dec (PL_curstackinfo->si_stack); 479 SvREFCNT_dec (PL_curstackinfo->si_stack);
466 }
467 480
468 Safefree (PL_curstackinfo->si_cxstack); 481 Safefree (PL_curstackinfo->si_cxstack);
469 Safefree (PL_curstackinfo); 482 Safefree (PL_curstackinfo);
470 PL_curstackinfo = p; 483 PL_curstackinfo = p;
471 } 484 }
… …
476 Safefree (PL_savestack); 489 Safefree (PL_savestack);
477#if !PERL_VERSION_ATLEAST (5,9,0) 490#if !PERL_VERSION_ATLEAST (5,9,0)
478 Safefree (PL_retstack); 491 Safefree (PL_retstack);
479#endif 492#endif
480} 493}
494#endif
481 495
482static void 496static void
483setup_coro (struct coro *coro) 497setup_coro (struct coro *coro)
484{ 498{
485 /* 499 /*
… …
497 511
498 { 512 {
499 dSP; 513 dSP;
500 LOGOP myop; 514 LOGOP myop;
501 515
502 /* I have no idea why this is needed, but it is */
503 PUSHMARK (SP);
504
505 SvREFCNT_dec (GvAV (PL_defgv)); 516 SvREFCNT_dec (GvAV (PL_defgv));
506 GvAV (PL_defgv) = coro->args; coro->args = 0; 517 GvAV (PL_defgv) = coro->args; coro->args = 0;
507 518
508 Zero (&myop, 1, LOGOP); 519 Zero (&myop, 1, LOGOP);
509 myop.op_next = Nullop; 520 myop.op_next = Nullop;
510 myop.op_flags = OPf_WANT_VOID; 521 myop.op_flags = OPf_WANT_VOID;
511 522
512 PL_op = (OP *)&myop;
513
514 PUSHMARK (SP); 523 PUSHMARK (SP);
515 XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE)); 524 XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE));
516 PUTBACK; 525 PUTBACK;
526 PL_op = (OP *)&myop;
517 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 527 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
518 SPAGAIN; 528 SPAGAIN;
519 } 529 }
520 530
521 ENTER; /* necessary e.g. for dounwind */ 531 ENTER; /* necessary e.g. for dounwind */
… …
529 SvREFCNT_dec (coro_mortal); 539 SvREFCNT_dec (coro_mortal);
530 coro_mortal = 0; 540 coro_mortal = 0;
531 } 541 }
532} 542}
533 543
544/* inject a fake call to Coro::State::_cctx_init into the execution */
534static void NOINLINE 545static void NOINLINE
535prepare_cctx (coro_cctx *cctx) 546prepare_cctx (coro_cctx *cctx)
536{ 547{
537 dSP; 548 dSP;
538 LOGOP myop; 549 LOGOP myop;
539 550
540 Zero (&myop, 1, LOGOP); 551 Zero (&myop, 1, LOGOP);
541 myop.op_next = PL_op; 552 myop.op_next = PL_op;
542 myop.op_flags = OPf_WANT_VOID; 553 myop.op_flags = OPf_WANT_VOID | OPf_STACKED;
543
544 sv_setiv (get_sv ("Coro::State::_cctx", FALSE), PTR2IV (cctx));
545 554
546 PUSHMARK (SP); 555 PUSHMARK (SP);
556 EXTEND (SP, 2);
557 PUSHs (sv_2mortal (newSViv (PTR2IV (cctx))));
547 XPUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE)); 558 PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE));
548 PUTBACK; 559 PUTBACK;
560 PL_op = (OP *)&myop;
549 PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX); 561 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
550 SPAGAIN; 562 SPAGAIN;
551} 563}
552 564
553static void 565static void
554coro_run (void *arg) 566coro_run (void *arg)
555{ 567{
556 /* coro_run is the alternative epilogue of transfer() */ 568 /* coro_run is the alternative tail of transfer(), so unlock here. */
557 UNLOCK; 569 UNLOCK;
558 570
559 /* 571 /*
560 * this is a _very_ stripped down perl interpreter ;) 572 * this is a _very_ stripped down perl interpreter ;)
561 */ 573 */
… …
563 575
564 /* inject call to cctx_init */ 576 /* inject call to cctx_init */
565 prepare_cctx ((coro_cctx *)arg); 577 prepare_cctx ((coro_cctx *)arg);
566 578
567 /* somebody will hit me for both perl_run and PL_restartop */ 579 /* somebody will hit me for both perl_run and PL_restartop */
580 PL_restartop = PL_op;
568 perl_run (PL_curinterp); 581 perl_run (PL_curinterp);
569 582
570 fputs ("FATAL: C coroutine fell over the edge of the world, aborting. Did you call exit in a coroutine?\n", stderr); 583 fputs ("FATAL: C coroutine fell over the edge of the world, aborting. Did you call exit in a coroutine?\n", stderr);
571 abort (); 584 abort ();
572} 585}
… …
576{ 589{
577 coro_cctx *cctx; 590 coro_cctx *cctx;
578 591
579 ++cctx_count; 592 ++cctx_count;
580 593
581 New (0, cctx, 1, coro_cctx); 594 Newz (0, cctx, 1, coro_cctx);
582 595
583#if HAVE_MMAP 596#if HAVE_MMAP
584 597
585 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; 598 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE;
586 /* mmap suppsedly does allocate-on-write for us */ 599 /* mmap supposedly does allocate-on-write for us */
587 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 600 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
588 601
589 if (cctx->sptr == (void *)-1) 602 if (cctx->sptr == (void *)-1)
590 { 603 {
591 perror ("FATAL: unable to mmap stack for coroutine"); 604 perror ("FATAL: unable to mmap stack for coroutine");
… …
681 cctx_first = cctx; 694 cctx_first = cctx;
682} 695}
683 696
684/* never call directly, always through the coro_state_transfer global variable */ 697/* never call directly, always through the coro_state_transfer global variable */
685static void NOINLINE 698static void NOINLINE
686transfer (struct coro *prev, struct coro *next, int flags) 699transfer (struct coro *prev, struct coro *next)
687{ 700{
688 dSTACKLEVEL; 701 dSTACKLEVEL;
689 702
690 /* sometimes transfer is only called to set idle_sp */ 703 /* sometimes transfer is only called to set idle_sp */
691 if (flags == TRANSFER_SET_STACKLEVEL) 704 if (!next)
705 {
692 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 706 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
707 assert (((coro_cctx *)prev)->top_env = PL_top_env); /* just for the side effetc when assert is enabled */
708 }
693 else if (prev != next) 709 else if (prev != next)
694 { 710 {
695 coro_cctx *prev__cctx; 711 coro_cctx *prev__cctx;
696 712
697 if (prev->flags & CF_NEW) 713 if (prev->flags & CF_NEW)
… …
713 prev->flags &= ~CF_RUNNING; 729 prev->flags &= ~CF_RUNNING;
714 next->flags |= CF_RUNNING; 730 next->flags |= CF_RUNNING;
715 731
716 LOCK; 732 LOCK;
717 733
718 if (next->mainstack) 734 if (next->flags & CF_NEW)
719 { 735 {
720 /* coroutine already started */ 736 /* need to start coroutine */
721 SAVE (prev, flags); 737 next->flags &= ~CF_NEW;
722 LOAD (next); 738 /* first get rid of the old state */
739 save_perl (prev);
740 /* setup coroutine call */
741 setup_coro (next);
742 /* need a new stack */
743 assert (!next->cctx);
723 } 744 }
724 else 745 else
725 { 746 {
726 /* need to start coroutine */ 747 /* coroutine already started */
727 assert (next->flags & CF_NEW); 748 save_perl (prev);
728 next->flags &= ~CF_NEW; 749 load_perl (next);
729 /* first get rid of the old state */
730 SAVE (prev, -1);
731 /* setup coroutine call */
732 setup_coro (next);
733 /* need a new stack */
734 assert (!next->stack);
735 } 750 }
736 751
737 prev__cctx = prev->cctx; 752 prev__cctx = prev->cctx;
738 753
739 /* possibly "free" the cctx */ 754 /* possibly "free" the cctx */
740 if (prev__cctx->idle_sp == STACKLEVEL && 0) 755 if (prev__cctx->idle_sp == STACKLEVEL)
741 { 756 {
742 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ 757 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
743 assert (PL_top_env == prev__cctx->top_env); 758 assert (PL_top_env == prev__cctx->top_env);
744 759
745 prev->cctx = 0; 760 prev->cctx = 0;
… …
769} 784}
770 785
771struct transfer_args 786struct transfer_args
772{ 787{
773 struct coro *prev, *next; 788 struct coro *prev, *next;
774 int flags;
775}; 789};
776 790
777#define TRANSFER(ta) transfer ((ta).prev, (ta).next, (ta).flags) 791#define TRANSFER(ta) transfer ((ta).prev, (ta).next)
778 792
779static void 793static void
780coro_state_destroy (struct coro *coro) 794coro_state_destroy (struct coro *coro)
781{ 795{
782 if (coro->refcnt--) 796 if (coro->refcnt--)
783 return; 797 return;
784 798
785 if (coro->mainstack && coro->mainstack != main_mainstack) 799 if (coro->mainstack && coro->mainstack != main_mainstack)
786 { 800 {
787 struct coro temp; 801 struct coro temp;
802 Zero (&temp, 1, struct coro);
803 temp.save = CORO_SAVE_ALL;
788 804
789 if (coro->flags & CF_RUNNING) 805 if (coro->flags & CF_RUNNING)
790 croak ("FATAL: tried to destroy currently running coroutine"); 806 croak ("FATAL: tried to destroy currently running coroutine");
791 807
792 SAVE ((&temp), TRANSFER_SAVE_ALL); 808 save_perl (&temp);
793 LOAD (coro); 809 load_perl (coro);
794 810
795 coro_destroy_stacks (); 811 coro_destroy_stacks ();
796 812
797 LOAD ((&temp)); /* this will get rid of defsv etc.. */ 813 load_perl (&temp); /* this will get rid of defsv etc.. */
798 814
799 coro->mainstack = 0; 815 coro->mainstack = 0;
800 } 816 }
801 817
802 cctx_destroy (coro->cctx); 818 cctx_destroy (coro->cctx);
… …
857 assert (mg->mg_type == PERL_MAGIC_ext); 873 assert (mg->mg_type == PERL_MAGIC_ext);
858 return (struct coro *)mg->mg_ptr; 874 return (struct coro *)mg->mg_ptr;
859} 875}
860 876
861static void 877static void
862prepare_transfer (struct transfer_args *ta, SV *prev, SV *next, int flags) 878prepare_transfer (struct transfer_args *ta, SV *prev_sv, SV *next_sv)
863{ 879{
864 ta->prev = SvSTATE (prev); 880 ta->prev = SvSTATE (prev_sv);
865 ta->next = SvSTATE (next); 881 ta->next = SvSTATE (next_sv);
866 ta->flags = flags;
867} 882}
868 883
869static void 884static void
870api_transfer (SV *prev, SV *next, int flags) 885api_transfer (SV *prev_sv, SV *next_sv)
871{ 886{
872 struct transfer_args ta; 887 struct transfer_args ta;
873 888
874 prepare_transfer (&ta, prev, next, flags); 889 prepare_transfer (&ta, prev_sv, next_sv);
875 TRANSFER (ta); 890 TRANSFER (ta);
891}
892
893static int
894api_save (SV *coro_sv, int new_save)
895{
896 struct coro *coro = SvSTATE (coro_sv);
897 int old_save = coro->save;
898
899 if (new_save >= 0)
900 coro->save = new_save;
901
902 return old_save;
876} 903}
877 904
878/** Coro ********************************************************************/ 905/** Coro ********************************************************************/
879 906
880#define PRIO_MAX 3 907#define PRIO_MAX 3
… …
989 assert (!SvROK(prev));//D 1016 assert (!SvROK(prev));//D
990 assert (!SvROK(next));//D 1017 assert (!SvROK(next));//D
991 1018
992 ta->prev = SvSTATE (prev); 1019 ta->prev = SvSTATE (prev);
993 ta->next = SvSTATE (next); 1020 ta->next = SvSTATE (next);
994 ta->flags = TRANSFER_SAVE_ALL;
995 1021
996 assert (ta->flags & CF_READY); 1022 assert (ta->next->flags & CF_READY);
997 ta->next->flags &= ~CF_READY; 1023 ta->next->flags &= ~CF_READY;
998} 1024}
999 1025
1000static void 1026static void
1001prepare_cede (struct transfer_args *ta) 1027prepare_cede (struct transfer_args *ta)
… …
1034#endif 1060#endif
1035 BOOT_PAGESIZE; 1061 BOOT_PAGESIZE;
1036 1062
1037 coro_state_stash = gv_stashpv ("Coro::State", TRUE); 1063 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1038 1064
1039 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV)); 1065 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (CORO_SAVE_DEFAV));
1040 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV)); 1066 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (CORO_SAVE_DEFSV));
1041 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV)); 1067 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (CORO_SAVE_ERRSV));
1068 newCONSTSUB (coro_state_stash, "SAVE_IRSSV", newSViv (CORO_SAVE_IRSSV));
1069 newCONSTSUB (coro_state_stash, "SAVE_ALL", newSViv (CORO_SAVE_ALL));
1042 1070
1043 main_mainstack = PL_mainstack; 1071 main_mainstack = PL_mainstack;
1044 1072
1045 coroapi.ver = CORO_API_VERSION; 1073 coroapi.ver = CORO_API_VERSION;
1046 coroapi.transfer = api_transfer; 1074 coroapi.transfer = api_transfer;
… …
1056 HV *hv; 1084 HV *hv;
1057 int i; 1085 int i;
1058 1086
1059 Newz (0, coro, 1, struct coro); 1087 Newz (0, coro, 1, struct coro);
1060 coro->args = newAV (); 1088 coro->args = newAV ();
1089 coro->save = CORO_SAVE_ALL;
1061 coro->flags = CF_NEW; 1090 coro->flags = CF_NEW;
1062 1091
1063 hv = newHV (); 1092 hv = newHV ();
1064 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; 1093 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
1065 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 1094 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1066 1095
1067 for (i = 1; i < items; i++) 1096 for (i = 1; i < items; i++)
1068 av_push (coro->args, newSVsv (ST (i))); 1097 av_push (coro->args, newSVsv (ST (i)));
1069} 1098}
1070 OUTPUT: 1099 OUTPUT:
1100 RETVAL
1101
1102int
1103save (SV *coro, int new_save = -1)
1104 CODE:
1105 RETVAL = api_save (coro, new_save);
1106 OUTPUT:
1071 RETVAL 1107 RETVAL
1072 1108
1073void 1109void
1074_set_stacklevel (...) 1110_set_stacklevel (...)
1075 ALIAS: 1111 ALIAS:
1076 Coro::State::transfer = 1 1112 Coro::State::transfer = 1
1077 Coro::schedule = 2 1113 Coro::schedule = 2
1078 Coro::cede = 3 1114 Coro::cede = 3
1079 Coro::Cont::yield = 4
1080 CODE: 1115 CODE:
1081{ 1116{
1082 struct transfer_args ta; 1117 struct transfer_args ta;
1083 1118
1084 switch (ix) 1119 switch (ix)
1085 { 1120 {
1086 case 0: 1121 case 0:
1087 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0))); 1122 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0)));
1088 ta.next = 0; 1123 ta.next = 0;
1089 ta.flags = TRANSFER_SET_STACKLEVEL;
1090 break; 1124 break;
1091 1125
1092 case 1: 1126 case 1:
1093 if (items != 3) 1127 if (items != 2)
1094 croak ("Coro::State::transfer (prev,next,flags) expects three arguments, not %d", items); 1128 croak ("Coro::State::transfer (prev,next) expects two arguments, not %d", items);
1095 1129
1096 prepare_transfer (&ta, ST (0), ST (1), SvIV (ST (2))); 1130 prepare_transfer (&ta, ST (0), ST (1));
1097 break; 1131 break;
1098 1132
1099 case 2: 1133 case 2:
1100 prepare_schedule (&ta); 1134 prepare_schedule (&ta);
1101 break; 1135 break;
1102 1136
1103 case 3: 1137 case 3:
1104 prepare_cede (&ta); 1138 prepare_cede (&ta);
1105 break; 1139 break;
1106
1107 case 4:
1108 {
1109 SV *yieldstack;
1110 SV *sv;
1111 AV *defav = GvAV (PL_defgv);
1112
1113 yieldstack = *hv_fetch (
1114 (HV *)SvRV (coro_current),
1115 "yieldstack", sizeof ("yieldstack") - 1,
1116 0
1117 );
1118
1119 /* set up @_ -- ugly */
1120 av_clear (defav);
1121 av_fill (defav, items - 1);
1122 while (items--)
1123 av_store (defav, items, SvREFCNT_inc (ST(items)));
1124
1125 sv = av_pop ((AV *)SvRV (yieldstack));
1126 ta.prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0));
1127 ta.next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0));
1128 ta.flags = 0;
1129 SvREFCNT_dec (sv);
1130 }
1131 break;
1132
1133 } 1140 }
1134 1141
1135 TRANSFER (ta); 1142 TRANSFER (ta);
1136} 1143}
1137 1144
… …
1191 1198
1192 { 1199 {
1193 SV *sv = perl_get_sv("Coro::API", 1); 1200 SV *sv = perl_get_sv("Coro::API", 1);
1194 1201
1195 coroapi.schedule = api_schedule; 1202 coroapi.schedule = api_schedule;
1203 coroapi.save = api_save;
1196 coroapi.cede = api_cede; 1204 coroapi.cede = api_cede;
1197 coroapi.ready = api_ready; 1205 coroapi.ready = api_ready;
1198 coroapi.is_ready = api_is_ready; 1206 coroapi.is_ready = api_is_ready;
1199 coroapi.nready = &coro_nready; 1207 coroapi.nready = &coro_nready;
1200 coroapi.current = coro_current; 1208 coroapi.current = coro_current;
… …
1202 GCoroAPI = &coroapi; 1210 GCoroAPI = &coroapi;
1203 sv_setiv (sv, (IV)&coroapi); 1211 sv_setiv (sv, (IV)&coroapi);
1204 SvREADONLY_on (sv); 1212 SvREADONLY_on (sv);
1205 } 1213 }
1206} 1214}
1215
1216void
1217_set_current (SV *current)
1218 PROTOTYPE: $
1219 CODE:
1220 SvREFCNT_dec (SvRV (coro_current));
1221 SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1207 1222
1208int 1223int
1209prio (Coro::State coro, int newprio = 0) 1224prio (Coro::State coro, int newprio = 0)
1210 ALIAS: 1225 ALIAS:
1211 nice = 1 1226 nice = 1
… …
1247 CODE: 1262 CODE:
1248 RETVAL = coro_nready; 1263 RETVAL = coro_nready;
1249 OUTPUT: 1264 OUTPUT:
1250 RETVAL 1265 RETVAL
1251 1266
1252void
1253_set_current (SV *current)
1254 PROTOTYPE: $
1255 CODE:
1256 SvREFCNT_dec (SvRV (coro_current));
1257 SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1258
1259MODULE = Coro::State PACKAGE = Coro::AIO 1267MODULE = Coro::State PACKAGE = Coro::AIO
1260 1268
1261SV * 1269SV *
1262_get_state () 1270_get_state ()
1263 CODE: 1271 CODE:
1264{ 1272{
1265 struct { 1273 struct io_state *data;
1266 int errorno;
1267 int laststype;
1268 int laststatval;
1269 Stat_t statcache;
1270 } data;
1271 1274
1275 RETVAL = newSV (sizeof (struct io_state));
1276 data = (struct io_state *)SvPVX (RETVAL);
1277 SvCUR_set (RETVAL, sizeof (struct io_state));
1278 SvPOK_only (RETVAL);
1279
1272 data.errorno = errno; 1280 data->errorno = errno;
1273 data.laststype = PL_laststype; 1281 data->laststype = PL_laststype;
1274 data.laststatval = PL_laststatval; 1282 data->laststatval = PL_laststatval;
1275 data.statcache = PL_statcache; 1283 data->statcache = PL_statcache;
1276
1277 RETVAL = newSVpvn ((char *)&data, sizeof data);
1278} 1284}
1279 OUTPUT: 1285 OUTPUT:
1280 RETVAL 1286 RETVAL
1281 1287
1282void 1288void
1283_set_state (char *data_) 1289_set_state (char *data_)
1284 PROTOTYPE: $ 1290 PROTOTYPE: $
1285 CODE: 1291 CODE:
1286{ 1292{
1287 struct { 1293 struct io_state *data = (void *)data_;
1288 int errorno;
1289 int laststype;
1290 int laststatval;
1291 Stat_t statcache;
1292 } *data = (void *)data_;
1293 1294
1294 errno = data->errorno; 1295 errno = data->errorno;
1295 PL_laststype = data->laststype; 1296 PL_laststype = data->laststype;
1296 PL_laststatval = data->laststatval; 1297 PL_laststatval = data->laststatval;
1297 PL_statcache = data->statcache; 1298 PL_statcache = data->statcache;
1298} 1299}
1300

Diff Legend

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