… | |
… | |
79 | |
79 | |
80 | /* 5.8.8 */ |
80 | /* 5.8.8 */ |
81 | #ifndef GV_NOTQUAL |
81 | #ifndef GV_NOTQUAL |
82 | # define GV_NOTQUAL 0 |
82 | # define GV_NOTQUAL 0 |
83 | #endif |
83 | #endif |
|
|
84 | #ifndef newSV |
|
|
85 | # define newSV(l) NEWSV(0,l) |
|
|
86 | #endif |
84 | |
87 | |
85 | #if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64 |
88 | #if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64 |
86 | # undef CORO_STACKGUARD |
89 | # undef CORO_STACKGUARD |
87 | #endif |
90 | #endif |
88 | |
91 | |
… | |
… | |
604 | PL_curpm = 0; |
607 | PL_curpm = 0; |
605 | PL_localizing = 0; |
608 | PL_localizing = 0; |
606 | PL_dirty = 0; |
609 | PL_dirty = 0; |
607 | PL_restartop = 0; |
610 | PL_restartop = 0; |
608 | |
611 | |
609 | GvSV (PL_defgv) = NEWSV (0, 0); |
612 | GvSV (PL_defgv) = newSV (0); |
610 | GvAV (PL_defgv) = coro->args; coro->args = 0; |
613 | GvAV (PL_defgv) = coro->args; coro->args = 0; |
611 | GvSV (PL_errgv) = NEWSV (0, 0); |
614 | GvSV (PL_errgv) = newSV (0); |
612 | GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0); |
615 | GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0); |
613 | PL_rs = newSVsv (GvSV (irsgv)); |
616 | PL_rs = newSVsv (GvSV (irsgv)); |
614 | PL_defoutgv = SvREFCNT_inc (stdoutgv); |
617 | PL_defoutgv = SvREFCNT_inc (stdoutgv); |
615 | |
618 | |
|
|
619 | ENTER; /* necessary e.g. for dounwind */ |
|
|
620 | |
616 | { |
621 | { |
617 | dSP; |
622 | dSP; |
618 | LOGOP myop; |
623 | LOGOP myop; |
619 | |
624 | |
620 | Zero (&myop, 1, LOGOP); |
625 | Zero (&myop, 1, LOGOP); |
621 | myop.op_next = Nullop; |
626 | myop.op_next = Nullop; |
622 | myop.op_flags = OPf_WANT_VOID; |
627 | myop.op_flags = OPf_WANT_VOID; |
623 | |
628 | |
624 | PUSHMARK (SP); |
629 | PUSHMARK (SP); |
625 | XPUSHs (av_shift (GvAV (PL_defgv))); |
630 | XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv)))); |
626 | PUTBACK; |
631 | PUTBACK; |
627 | PL_op = (OP *)&myop; |
632 | PL_op = (OP *)&myop; |
628 | PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); |
633 | PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); |
629 | SPAGAIN; |
634 | SPAGAIN; |
630 | } |
635 | } |
631 | |
|
|
632 | ENTER; /* necessary e.g. for dounwind */ |
|
|
633 | } |
636 | } |
634 | |
637 | |
635 | static void |
638 | static void |
636 | coro_destroy (pTHX_ struct coro *coro) |
639 | coro_destroy (pTHX_ struct coro *coro) |
637 | { |
640 | { |
… | |
… | |
705 | bot = PL_stack_base + cx->blk_oldsp + 1; |
708 | bot = PL_stack_base + cx->blk_oldsp + 1; |
706 | top = cx->blk_gimme == G_ARRAY ? SP + 1 |
709 | top = cx->blk_gimme == G_ARRAY ? SP + 1 |
707 | : cx->blk_gimme == G_SCALAR ? bot + 1 |
710 | : cx->blk_gimme == G_SCALAR ? bot + 1 |
708 | : bot; |
711 | : bot; |
709 | |
712 | |
|
|
713 | av_extend (av, top - bot); |
710 | while (bot < top) |
714 | while (bot < top) |
711 | av_push (av, SvREFCNT_inc (*bot++)); |
715 | av_push (av, SvREFCNT_inc (*bot++)); |
712 | |
716 | |
713 | PL_runops = RUNOPS_DEFAULT; |
717 | PL_runops = RUNOPS_DEFAULT; |
714 | ENTER; |
718 | ENTER; |
… | |
… | |
926 | Safefree (cctx->sptr); |
930 | Safefree (cctx->sptr); |
927 | |
931 | |
928 | Safefree (cctx); |
932 | Safefree (cctx); |
929 | } |
933 | } |
930 | |
934 | |
|
|
935 | /* wether this cctx should be destructed */ |
|
|
936 | #define CCTX_EXPIRED(cctx) ((cctx)->ssize < coro_stacksize || ((cctx)->flags & CC_NOREUSE)) |
|
|
937 | |
931 | static coro_cctx * |
938 | static coro_cctx * |
932 | cctx_get (pTHX) |
939 | cctx_get (pTHX) |
933 | { |
940 | { |
934 | while (cctx_first) |
941 | while (cctx_first) |
935 | { |
942 | { |
936 | coro_cctx *cctx = cctx_first; |
943 | coro_cctx *cctx = cctx_first; |
937 | cctx_first = cctx->next; |
944 | cctx_first = cctx->next; |
938 | --cctx_idle; |
945 | --cctx_idle; |
939 | |
946 | |
940 | if (cctx->ssize >= coro_stacksize && !(cctx->flags & CC_NOREUSE)) |
947 | if (!CCTX_EXPIRED (cctx)) |
941 | return cctx; |
948 | return cctx; |
942 | |
949 | |
943 | cctx_destroy (cctx); |
950 | cctx_destroy (cctx); |
944 | } |
951 | } |
945 | |
952 | |
… | |
… | |
1038 | /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ |
1045 | /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ |
1039 | assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te)); |
1046 | assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te)); |
1040 | |
1047 | |
1041 | prev->cctx = 0; |
1048 | prev->cctx = 0; |
1042 | |
1049 | |
|
|
1050 | /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */ |
|
|
1051 | if (CCTX_EXPIRED (prev__cctx)) |
|
|
1052 | next->cctx = cctx_get (aTHX); |
|
|
1053 | |
1043 | cctx_put (prev__cctx); |
1054 | cctx_put (prev__cctx); |
1044 | } |
1055 | } |
1045 | |
1056 | |
1046 | ++next->usecount; |
1057 | ++next->usecount; |
1047 | |
1058 | |
… | |
… | |
1425 | |
1436 | |
1426 | coro->hv = hv = newHV (); |
1437 | coro->hv = hv = newHV (); |
1427 | sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; |
1438 | sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; |
1428 | RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); |
1439 | RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); |
1429 | |
1440 | |
|
|
1441 | av_extend (coro->args, items - 1); |
1430 | for (i = 1; i < items; i++) |
1442 | for (i = 1; i < items; i++) |
1431 | av_push (coro->args, newSVsv (ST (i))); |
1443 | av_push (coro->args, newSVsv (ST (i))); |
1432 | } |
1444 | } |
1433 | OUTPUT: |
1445 | OUTPUT: |
1434 | RETVAL |
1446 | RETVAL |