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.101 by root, Mon Nov 27 00:08:18 2006 UTC vs.
Revision 1.102 by root, Mon Nov 27 01:28:03 2006 UTC

… …
10 (PERL_REVISION > (a) \ 10 (PERL_REVISION > (a) \
11 || (PERL_REVISION == (a) \ 11 || (PERL_REVISION == (a) \
12 && (PERL_VERSION > (b) \ 12 && (PERL_VERSION > (b) \
13 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c))))) 13 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
14 14
15#if !PERL_VERSION_ATLEAST (5,8,0) 15#if !PERL_VERSION_ATLEAST (5,6,0)
16# ifndef PL_ppaddr 16# ifndef PL_ppaddr
17# define PL_ppaddr ppaddr 17# define PL_ppaddr ppaddr
18# endif 18# endif
19# ifndef call_sv 19# ifndef call_sv
20# define call_sv perl_call_sv 20# define call_sv perl_call_sv
… …
491 491
492/* 492/*
493 * destroy the stacks, the callchain etc... 493 * destroy the stacks, the callchain etc...
494 */ 494 */
495static void 495static void
496destroy_stacks() 496coro_destroy_stacks()
497{ 497{
498 if (!IN_DESTRUCT) 498 if (!IN_DESTRUCT)
499 { 499 {
500 /* is this ugly, I ask? */ 500 /* is this ugly, I ask? */
501 LEAVE_SCOPE (0); 501 LEAVE_SCOPE (0);
… …
543setup_coro (struct coro *coro) 543setup_coro (struct coro *coro)
544{ 544{
545 /* 545 /*
546 * emulate part of the perl startup here. 546 * emulate part of the perl startup here.
547 */ 547 */
548 dTHX;
549 dSP;
550 UNOP myop;
551 SV *sub_init = (SV *)get_cv ("Coro::State::coro_init", FALSE);
552 548
553 coro_init_stacks (); 549 coro_init_stacks ();
550
551 {
552 dSP;
553 LOGOP myop;
554
554 /*PL_curcop = 0;*/ 555 /*PL_curcop = 0;*/
555 /*PL_in_eval = PL_in_eval;*/ /* inherit */ 556 PL_in_eval = 0;
556 SvREFCNT_dec (GvAV (PL_defgv)); 557 SvREFCNT_dec (GvAV (PL_defgv));
557 GvAV (PL_defgv) = coro->args; coro->args = 0; 558 GvAV (PL_defgv) = coro->args; coro->args = 0;
558 559
559 SPAGAIN; 560 SPAGAIN;
560 561
561 Zero (&myop, 1, UNOP); 562 Zero (&myop, 1, LOGOP);
562 myop.op_next = Nullop; 563 myop.op_next = Nullop;
563 myop.op_flags = OPf_WANT_VOID; 564 myop.op_flags = OPf_WANT_VOID;
564 565
565 PL_op = (OP *)&myop; 566 PL_op = (OP *)&myop;
566 567
567 PUSHMARK(SP); 568 PUSHMARK (SP);
568 XPUSHs (sub_init); 569 PUSHMARK (SP);
570 XPUSHs ((SV *)get_cv ("Coro::State::coro_init", FALSE));
569 PUTBACK; 571 PUTBACK;
570 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 572 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
571 SPAGAIN; 573 SPAGAIN;
572 574
573 ENTER; /* necessary e.g. for dounwind */ 575 ENTER; /* necessary e.g. for dounwind */
576 }
574} 577}
575 578
576static void 579static void
577free_coro_mortal () 580free_coro_mortal ()
578{ 581{
… …
585 588
586static void NOINLINE 589static void NOINLINE
587prepare_cctx (coro_stack *cctx) 590prepare_cctx (coro_stack *cctx)
588{ 591{
589 dSP; 592 dSP;
590 UNOP myop; 593 LOGOP myop;
591 594
592 Zero (&myop, 1, UNOP); 595 Zero (&myop, 1, LOGOP);
593 myop.op_next = PL_op; 596 myop.op_next = PL_op;
594 myop.op_flags = OPf_WANT_VOID | OPf_STACKED; 597 myop.op_flags = OPf_WANT_VOID;
595 598
599 sv_setiv (get_sv ("Coro::State::cctx_stack", FALSE), PTR2IV (cctx));
600
596 PUSHMARK(SP); 601 PUSHMARK (SP);
597 EXTEND (SP, 2);
598 PUSHs (newSViv (PTR2IV (cctx)));
599 PUSHs ((SV *)get_cv ("Coro::State::cctx_init", FALSE)); 602 XPUSHs ((SV *)get_cv ("Coro::State::cctx_init", FALSE));
600 PUTBACK; 603 PUTBACK;
601 PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX); 604 PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX);
602 SPAGAIN; 605 SPAGAIN;
603} 606}
604 607
605static void 608static void
606coro_run (void *arg) 609coro_run (void *arg)
607{ 610{
611 /* coro_run is the alternative epilogue of transfer() */
612 UNLOCK;
613
608 /* 614 /*
609 * this is a _very_ stripped down perl interpreter ;) 615 * this is a _very_ stripped down perl interpreter ;)
610 */ 616 */
611 UNLOCK;
612
613 PL_top_env = &PL_start_env; 617 PL_top_env = &PL_start_env;
618 /* inject call to cctx_init */
614 prepare_cctx ((coro_stack *)arg); 619 prepare_cctx ((coro_stack *)arg);
615 620
616 /* somebody will hit me for both perl_run and PL_restartop */ 621 /* somebody will hit me for both perl_run and PL_restartop */
617 perl_run (PERL_GET_CONTEXT); 622 perl_run (PL_curinterp);
618 623
619 fputs ("FATAL: C coroutine fell over the edge of the world, aborting.\n", stderr); 624 fputs ("FATAL: C coroutine fell over the edge of the world, aborting.\n", stderr);
620 abort (); 625 abort ();
621} 626}
622 627
… …
675 680
676 Safefree (stack); 681 Safefree (stack);
677} 682}
678 683
679static coro_stack *stack_first; 684static coro_stack *stack_first;
685static int cctx_count, cctx_idle;
680 686
681static coro_stack * 687static coro_stack *
682stack_get () 688stack_get ()
683{ 689{
684 coro_stack *stack; 690 coro_stack *stack;
685 691
686 if (stack_first) 692 if (stack_first)
687 { 693 {
694 --cctx_idle;
688 stack = stack_first; 695 stack = stack_first;
689 stack_first = stack->next; 696 stack_first = stack->next;
690 } 697 }
691 else 698 else
692 { 699 {
700 ++cctx_count;
693 stack = stack_new (); 701 stack = stack_new ();
694 PL_op = PL_op->op_next; 702 PL_op = PL_op->op_next;
695 } 703 }
696 704
697 return stack; 705 return stack;
698} 706}
699 707
700static void 708static void
701stack_put (coro_stack *stack) 709stack_put (coro_stack *stack)
702{ 710{
711 ++cctx_idle;
703 stack->next = stack_first; 712 stack->next = stack_first;
704 stack_first = stack; 713 stack_first = stack;
705} 714}
706 715
707/* never call directly, always through the coro_state_transfer global variable */ 716/* never call directly, always through the coro_state_transfer global variable */
… …
784 struct coro temp; 793 struct coro temp;
785 794
786 SAVE ((&temp), TRANSFER_SAVE_ALL); 795 SAVE ((&temp), TRANSFER_SAVE_ALL);
787 LOAD (coro); 796 LOAD (coro);
788 797
789 destroy_stacks (); 798 coro_destroy_stacks ();
790 799
791 LOAD ((&temp)); /* this will get rid of defsv etc.. */ 800 LOAD ((&temp)); /* this will get rid of defsv etc.. */
792 801
793 coro->mainstack = 0; 802 coro->mainstack = 0;
794 } 803 }
… …
823 0, 0, 0, 0, 832 0, 0, 0, 0,
824 coro_state_clear, 833 coro_state_clear,
825 0, 834 0,
826#ifdef MGf_DUP 835#ifdef MGf_DUP
827 coro_state_dup, 836 coro_state_dup,
837#else
838# define MGf_DUP 0
828#endif 839#endif
829}; 840};
830 841
831static struct coro * 842static struct coro *
832SvSTATE (SV *coro) 843SvSTATE (SV *coro)

Diff Legend

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