… | |
… | |
1766 | PerlIOBuf_set_ptrcnt, |
1766 | PerlIOBuf_set_ptrcnt, |
1767 | }; |
1767 | }; |
1768 | |
1768 | |
1769 | /*****************************************************************************/ |
1769 | /*****************************************************************************/ |
1770 | |
1770 | |
1771 | static const CV *slf_cv; /* for quick consistency check */ |
|
|
1772 | |
|
|
1773 | static UNOP slf_restore; /* restore stack as entersub did, for first-re-run */ |
1771 | static UNOP slf_restore; /* restore stack as entersub did, for first-re-run */ |
|
|
1772 | static const CV *slf_cv; |
1774 | static SV *slf_arg0; |
1773 | static SV *slf_arg0; |
1775 | static SV *slf_arg1; |
1774 | static SV *slf_arg1; |
1776 | static SV *slf_arg2; |
1775 | static SV *slf_arg2; |
|
|
1776 | static I32 slf_ax; /* top of stack, for restore */ |
1777 | |
1777 | |
1778 | /* this restores the stack in the case we patched the entersub, to */ |
1778 | /* this restores the stack in the case we patched the entersub, to */ |
1779 | /* recreate the stack frame as perl will on following calls */ |
1779 | /* recreate the stack frame as perl will on following calls */ |
1780 | /* since entersub cleared the stack */ |
1780 | /* since entersub cleared the stack */ |
1781 | static OP * |
1781 | static OP * |
1782 | pp_restore (pTHX) |
1782 | pp_restore (pTHX) |
1783 | { |
1783 | { |
1784 | dSP; |
1784 | SV **SP = PL_stack_base + slf_ax; |
1785 | |
1785 | |
1786 | PUSHMARK (SP); |
1786 | PUSHMARK (SP); |
1787 | |
1787 | |
1788 | EXTEND (SP, 3); |
1788 | EXTEND (SP, 3); |
1789 | if (slf_arg0) PUSHs (sv_2mortal (slf_arg0)); |
1789 | if (slf_arg0) PUSHs (sv_2mortal (slf_arg0)); |
… | |
… | |
1897 | AV *av = GvAV (PL_defgv); |
1897 | AV *av = GvAV (PL_defgv); |
1898 | arg = AvARRAY (av); |
1898 | arg = AvARRAY (av); |
1899 | items = AvFILLp (av) + 1; |
1899 | items = AvFILLp (av) + 1; |
1900 | } |
1900 | } |
1901 | |
1901 | |
1902 | PUTBACK; |
|
|
1903 | |
|
|
1904 | /* now call the init function, which needs to set up slf_frame */ |
1902 | /* now call the init function, which needs to set up slf_frame */ |
1905 | ((coro_slf_cb)CvXSUBANY (GvCV (gv)).any_ptr) |
1903 | ((coro_slf_cb)CvXSUBANY (GvCV (gv)).any_ptr) |
1906 | (aTHX_ &slf_frame, GvCV (gv), arg, items); |
1904 | (aTHX_ &slf_frame, GvCV (gv), arg, items); |
1907 | |
1905 | |
1908 | /* pop args */ |
1906 | /* pop args */ |
… | |
… | |
1960 | |
1958 | |
1961 | return NORMAL; |
1959 | return NORMAL; |
1962 | } |
1960 | } |
1963 | |
1961 | |
1964 | static void |
1962 | static void |
1965 | api_execute_slf (pTHX_ CV *cv, coro_slf_cb init_cb, SV **arg, int items) |
1963 | api_execute_slf (pTHX_ CV *cv, coro_slf_cb init_cb, I32 ax) |
1966 | { |
1964 | { |
|
|
1965 | SV **arg = PL_stack_base + ax; |
|
|
1966 | int items = PL_stack_sp - arg + 1; |
|
|
1967 | |
1967 | assert (("FATAL: SLF call with illegal CV value", !CvANON (cv))); |
1968 | assert (("FATAL: SLF call with illegal CV value", !CvANON (cv))); |
1968 | |
1969 | |
1969 | if (PL_op->op_ppaddr != PL_ppaddr [OP_ENTERSUB] |
1970 | if (PL_op->op_ppaddr != PL_ppaddr [OP_ENTERSUB] |
1970 | && PL_op->op_ppaddr != pp_slf) |
1971 | && PL_op->op_ppaddr != pp_slf) |
1971 | croak ("FATAL: Coro SLF calls can only be made normally, not via goto or any other means, caught"); |
1972 | croak ("FATAL: Coro SLF calls can only be made normally, not via goto or any other means, caught"); |
1972 | |
1973 | |
|
|
1974 | #if 0 |
1973 | if (items > 3) |
1975 | if (items > 3) |
1974 | croak ("Coro only supports up to three arguments to SLF functions currently (not %d), caught", items); |
1976 | croak ("Coro only supports up to three arguments to SLF functions currently (not %d), caught", items); |
|
|
1977 | #endif |
1975 | |
1978 | |
1976 | CvFLAGS (cv) |= CVf_SLF; |
1979 | CvFLAGS (cv) |= CVf_SLF; |
1977 | CvXSUBANY (cv).any_ptr = (void *)init_cb; |
1980 | CvXSUBANY (cv).any_ptr = (void *)init_cb; |
1978 | slf_cv = cv; |
1981 | slf_cv = cv; |
1979 | |
1982 | |
1980 | /* we patch the op, and then re-run the whole call */ |
1983 | /* we patch the op, and then re-run the whole call */ |
1981 | /* we have to put the same argument on the stack for this to work */ |
1984 | /* we have to put the same argument on the stack for this to work */ |
1982 | /* and this will be done by pp_restore */ |
1985 | /* and this will be done by pp_restore */ |
1983 | slf_restore.op_next = (OP *)&slf_restore; |
1986 | slf_restore.op_next = (OP *)&slf_restore; |
1984 | slf_restore.op_type = OP_CUSTOM; |
1987 | slf_restore.op_type = OP_CUSTOM; |
1985 | slf_restore.op_ppaddr = pp_restore; |
1988 | slf_restore.op_ppaddr = pp_restore; |
1986 | slf_restore.op_first = PL_op; |
1989 | slf_restore.op_first = PL_op; |
1987 | |
1990 | |
|
|
1991 | slf_ax = ax - 1; /* undo the ax++ inside dAXMARK */ |
1988 | slf_arg0 = items > 0 ? SvREFCNT_inc (arg [0]) : 0; |
1992 | slf_arg0 = items > 0 ? SvREFCNT_inc (arg [0]) : 0; |
1989 | slf_arg1 = items > 1 ? SvREFCNT_inc (arg [1]) : 0; |
1993 | slf_arg1 = items > 1 ? SvREFCNT_inc (arg [1]) : 0; |
1990 | slf_arg2 = items > 2 ? SvREFCNT_inc (arg [2]) : 0; |
1994 | slf_arg2 = items > 2 ? SvREFCNT_inc (arg [2]) : 0; |
1991 | |
1995 | |
1992 | PL_op->op_ppaddr = pp_slf; |
1996 | PL_op->op_ppaddr = pp_slf; |
|
|
1997 | PL_op->op_type = OP_CUSTOM; /* maybe we should leave it at entersub? */ |
1993 | |
1998 | |
1994 | PL_op = (OP *)&slf_restore; |
1999 | PL_op = (OP *)&slf_restore; |
1995 | } |
2000 | } |
1996 | |
2001 | |
1997 | /*****************************************************************************/ |
2002 | /*****************************************************************************/ |
… | |
… | |
2216 | RETVAL |
2221 | RETVAL |
2217 | |
2222 | |
2218 | void |
2223 | void |
2219 | _set_stacklevel (...) |
2224 | _set_stacklevel (...) |
2220 | CODE: |
2225 | CODE: |
2221 | api_execute_slf (aTHX_ cv, slf_init_set_stacklevel, &ST (0), items); |
2226 | CORO_EXECUTE_SLF_XS (slf_init_set_stacklevel); |
2222 | |
2227 | |
2223 | void |
2228 | void |
2224 | transfer (...) |
2229 | transfer (...) |
2225 | PROTOTYPE: $$ |
2230 | PROTOTYPE: $$ |
2226 | CODE: |
2231 | CODE: |
2227 | api_execute_slf (aTHX_ cv, slf_init_transfer, &ST (0), items); |
2232 | CORO_EXECUTE_SLF_XS (slf_init_transfer); |
2228 | |
2233 | |
2229 | bool |
2234 | bool |
2230 | _destroy (SV *coro_sv) |
2235 | _destroy (SV *coro_sv) |
2231 | CODE: |
2236 | CODE: |
2232 | RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv)); |
2237 | RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv)); |
… | |
… | |
2455 | } |
2460 | } |
2456 | |
2461 | |
2457 | void |
2462 | void |
2458 | schedule (...) |
2463 | schedule (...) |
2459 | CODE: |
2464 | CODE: |
2460 | api_execute_slf (aTHX_ cv, slf_init_schedule, &ST (0), 0); |
2465 | CORO_EXECUTE_SLF_XS (slf_init_schedule); |
2461 | |
2466 | |
2462 | void |
2467 | void |
2463 | cede (...) |
2468 | cede (...) |
2464 | CODE: |
2469 | CODE: |
2465 | api_execute_slf (aTHX_ cv, slf_init_cede, &ST (0), 0); |
2470 | CORO_EXECUTE_SLF_XS (slf_init_cede); |
2466 | |
2471 | |
2467 | void |
2472 | void |
2468 | cede_notself (...) |
2473 | cede_notself (...) |
2469 | CODE: |
2474 | CODE: |
2470 | api_execute_slf (aTHX_ cv, slf_init_cede_notself, &ST (0), 0); |
2475 | CORO_EXECUTE_SLF_XS (slf_init_cede_notself); |
2471 | |
2476 | |
2472 | void |
2477 | void |
2473 | _set_current (SV *current) |
2478 | _set_current (SV *current) |
2474 | PROTOTYPE: $ |
2479 | PROTOTYPE: $ |
2475 | CODE: |
2480 | CODE: |
… | |
… | |
2710 | coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1); |
2715 | coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1); |
2711 | |
2716 | |
2712 | void |
2717 | void |
2713 | down (SV *self) |
2718 | down (SV *self) |
2714 | CODE: |
2719 | CODE: |
2715 | api_execute_slf (aTHX_ cv, slf_init_semaphore_down, &ST (0), 1); |
2720 | CORO_EXECUTE_SLF_XS (slf_init_semaphore_down); |
2716 | |
2721 | |
2717 | void |
2722 | void |
2718 | try (SV *self) |
2723 | try (SV *self) |
2719 | PPCODE: |
2724 | PPCODE: |
2720 | { |
2725 | { |