… | |
… | |
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 | */ |
495 | static void |
495 | static void |
496 | destroy_stacks() |
496 | coro_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); |
… | |
… | |
543 | setup_coro (struct coro *coro) |
543 | setup_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 | |
576 | static void |
579 | static void |
577 | free_coro_mortal () |
580 | free_coro_mortal () |
578 | { |
581 | { |
… | |
… | |
585 | |
588 | |
586 | static void NOINLINE |
589 | static void NOINLINE |
587 | prepare_cctx (coro_stack *cctx) |
590 | prepare_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 | |
605 | static void |
608 | static void |
606 | coro_run (void *arg) |
609 | coro_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 | |
679 | static coro_stack *stack_first; |
684 | static coro_stack *stack_first; |
|
|
685 | static int cctx_count, cctx_idle; |
680 | |
686 | |
681 | static coro_stack * |
687 | static coro_stack * |
682 | stack_get () |
688 | stack_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 | |
700 | static void |
708 | static void |
701 | stack_put (coro_stack *stack) |
709 | stack_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 | |
831 | static struct coro * |
842 | static struct coro * |
832 | SvSTATE (SV *coro) |
843 | SvSTATE (SV *coro) |