… | |
… | |
12 | #include "perl.h" |
12 | #include "perl.h" |
13 | #include "XSUB.h" |
13 | #include "XSUB.h" |
14 | #include "perliol.h" |
14 | #include "perliol.h" |
15 | |
15 | |
16 | #include "schmorp.h" |
16 | #include "schmorp.h" |
|
|
17 | |
|
|
18 | #define ECB_NO_THREADS 1 |
17 | #include "ecb.h" |
19 | #include "ecb.h" |
18 | |
20 | |
19 | #include <stddef.h> |
21 | #include <stddef.h> |
20 | #include <stdio.h> |
22 | #include <stdio.h> |
21 | #include <errno.h> |
23 | #include <errno.h> |
… | |
… | |
371 | time_init (pTHX) |
373 | time_init (pTHX) |
372 | { |
374 | { |
373 | SV **svp; |
375 | SV **svp; |
374 | |
376 | |
375 | require_pv ("Time/HiRes.pm"); |
377 | require_pv ("Time/HiRes.pm"); |
376 | |
378 | |
377 | svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0); |
379 | svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0); |
378 | |
380 | |
379 | if (!svp) croak ("Time::HiRes is required, but missing. Caught"); |
381 | if (!svp) croak ("Time::HiRes is required, but missing. Caught"); |
380 | if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer. Caught"); |
382 | if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer. Caught"); |
381 | |
383 | |
… | |
… | |
992 | { |
994 | { |
993 | SV **svp = 0; |
995 | SV **svp = 0; |
994 | |
996 | |
995 | if (strEQ (s, "__DIE__" )) svp = &PL_diehook; |
997 | if (strEQ (s, "__DIE__" )) svp = &PL_diehook; |
996 | if (strEQ (s, "__WARN__")) svp = &PL_warnhook; |
998 | if (strEQ (s, "__WARN__")) svp = &PL_warnhook; |
997 | |
999 | |
998 | if (svp) |
1000 | if (svp) |
999 | { |
1001 | { |
1000 | SV *ssv; |
1002 | SV *ssv; |
1001 | |
1003 | |
1002 | if (!*svp) |
1004 | if (!*svp) |
… | |
… | |
1108 | PL_hints = 0; |
1110 | PL_hints = 0; |
1109 | |
1111 | |
1110 | /* recreate the die/warn hooks */ |
1112 | /* recreate the die/warn hooks */ |
1111 | PL_diehook = SvREFCNT_inc (rv_diehook); |
1113 | PL_diehook = SvREFCNT_inc (rv_diehook); |
1112 | PL_warnhook = SvREFCNT_inc (rv_warnhook); |
1114 | PL_warnhook = SvREFCNT_inc (rv_warnhook); |
1113 | |
1115 | |
1114 | GvSV (PL_defgv) = newSV (0); |
1116 | GvSV (PL_defgv) = newSV (0); |
1115 | GvAV (PL_defgv) = coro->args; coro->args = 0; |
1117 | GvAV (PL_defgv) = coro->args; coro->args = 0; |
1116 | GvSV (PL_errgv) = newSV (0); |
1118 | GvSV (PL_errgv) = newSV (0); |
1117 | GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0); |
1119 | GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0); |
1118 | GvHV (PL_hintgv) = 0; |
1120 | GvHV (PL_hintgv) = 0; |
… | |
… | |
1416 | /* try to exit the same way perl's main function would do */ |
1418 | /* try to exit the same way perl's main function would do */ |
1417 | /* we do not bother resetting the environment or other things *7 |
1419 | /* we do not bother resetting the environment or other things *7 |
1418 | /* that are not, uhm, essential */ |
1420 | /* that are not, uhm, essential */ |
1419 | /* this obviously also doesn't work when perl is embedded */ |
1421 | /* this obviously also doesn't work when perl is embedded */ |
1420 | static void ecb_noinline ecb_cold |
1422 | static void ecb_noinline ecb_cold |
1421 | perlish_exit (void) |
1423 | perlish_exit (pTHX) |
1422 | { |
1424 | { |
1423 | int exitstatus = perl_destruct (PL_curinterp); |
1425 | int exitstatus = perl_destruct (PL_curinterp); |
1424 | perl_free (PL_curinterp); |
1426 | perl_free (PL_curinterp); |
1425 | exit (exitstatus); |
1427 | exit (exitstatus); |
1426 | } |
1428 | } |
… | |
… | |
1462 | * If perl-run returns we assume exit() was being called or the coro |
1464 | * If perl-run returns we assume exit() was being called or the coro |
1463 | * fell off the end, which seems to be the only valid (non-bug) |
1465 | * fell off the end, which seems to be the only valid (non-bug) |
1464 | * reason for perl_run to return. We try to mimic whatever perl is normally |
1466 | * reason for perl_run to return. We try to mimic whatever perl is normally |
1465 | * doing in that case. YMMV. |
1467 | * doing in that case. YMMV. |
1466 | */ |
1468 | */ |
1467 | perlish_exit (); |
1469 | perlish_exit (aTHX); |
1468 | } |
1470 | } |
1469 | } |
1471 | } |
1470 | |
1472 | |
1471 | static coro_cctx * |
1473 | static coro_cctx * |
1472 | cctx_new (void) |
1474 | cctx_new (void) |
… | |
… | |
1504 | size_t stack_size; |
1506 | size_t stack_size; |
1505 | |
1507 | |
1506 | #if HAVE_MMAP |
1508 | #if HAVE_MMAP |
1507 | cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE; |
1509 | cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE; |
1508 | /* mmap supposedly does allocate-on-write for us */ |
1510 | /* mmap supposedly does allocate-on-write for us */ |
1509 | cctx->sptr = mmap (0, cctx->ssize, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS, 0, 0); |
1511 | cctx->sptr = mmap (0, cctx->ssize, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS, -1, 0); |
1510 | |
1512 | |
1511 | if (cctx->sptr != (void *)-1) |
1513 | if (cctx->sptr != (void *)-1) |
1512 | { |
1514 | { |
1513 | #if CORO_STACKGUARD |
1515 | #if CORO_STACKGUARD |
1514 | mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE); |
1516 | mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE); |
… | |
… | |
1729 | return; |
1731 | return; |
1730 | |
1732 | |
1731 | slf_destroy (aTHX_ coro); |
1733 | slf_destroy (aTHX_ coro); |
1732 | |
1734 | |
1733 | coro->flags |= CF_ZOMBIE; |
1735 | coro->flags |= CF_ZOMBIE; |
1734 | |
1736 | |
1735 | if (coro->flags & CF_READY) |
1737 | if (coro->flags & CF_READY) |
1736 | { |
1738 | { |
1737 | /* reduce nready, as destroying a ready coro effectively unreadies it */ |
1739 | /* reduce nready, as destroying a ready coro effectively unreadies it */ |
1738 | /* alternative: look through all ready queues and remove the coro */ |
1740 | /* alternative: look through all ready queues and remove the coro */ |
1739 | --coro_nready; |
1741 | --coro_nready; |
… | |
… | |
2172 | |
2174 | |
2173 | static void |
2175 | static void |
2174 | coro_set_status (pTHX_ struct coro *coro, SV **arg, int items) |
2176 | coro_set_status (pTHX_ struct coro *coro, SV **arg, int items) |
2175 | { |
2177 | { |
2176 | AV *av; |
2178 | AV *av; |
2177 | |
2179 | |
2178 | if (coro->status) |
2180 | if (coro->status) |
2179 | { |
2181 | { |
2180 | av = coro->status; |
2182 | av = coro->status; |
2181 | av_clear (av); |
2183 | av_clear (av); |
2182 | } |
2184 | } |
… | |
… | |
2229 | |
2231 | |
2230 | coro = SvSTATE (arg [0]); |
2232 | coro = SvSTATE (arg [0]); |
2231 | coro_hv = coro->hv; |
2233 | coro_hv = coro->hv; |
2232 | |
2234 | |
2233 | coro_set_status (aTHX_ coro, arg + 1, items - 1); |
2235 | coro_set_status (aTHX_ coro, arg + 1, items - 1); |
2234 | |
2236 | |
2235 | if (ecb_expect_false (coro->flags & CF_NOCANCEL)) |
2237 | if (ecb_expect_false (coro->flags & CF_NOCANCEL)) |
2236 | { |
2238 | { |
2237 | /* coro currently busy cancelling something, so just notify it */ |
2239 | /* coro currently busy cancelling something, so just notify it */ |
2238 | coro->slf_frame.data = (void *)coro; |
2240 | coro->slf_frame.data = (void *)coro; |
2239 | |
2241 | |
… | |
… | |
2418 | |
2420 | |
2419 | static int |
2421 | static int |
2420 | slf_check_rouse_wait (pTHX_ struct CoroSLF *frame) |
2422 | slf_check_rouse_wait (pTHX_ struct CoroSLF *frame) |
2421 | { |
2423 | { |
2422 | SV *data = (SV *)frame->data; |
2424 | SV *data = (SV *)frame->data; |
2423 | |
2425 | |
2424 | if (CORO_THROW) |
2426 | if (CORO_THROW) |
2425 | return 0; |
2427 | return 0; |
2426 | |
2428 | |
2427 | if (SvTYPE (SvRV (data)) != SVt_PVAV) |
2429 | if (SvTYPE (SvRV (data)) != SVt_PVAV) |
2428 | return 1; |
2430 | return 1; |
… | |
… | |
2464 | cb = sv_2mortal (coro->rouse_cb); |
2466 | cb = sv_2mortal (coro->rouse_cb); |
2465 | coro->rouse_cb = 0; |
2467 | coro->rouse_cb = 0; |
2466 | } |
2468 | } |
2467 | |
2469 | |
2468 | if (!SvROK (cb) |
2470 | if (!SvROK (cb) |
2469 | || SvTYPE (SvRV (cb)) != SVt_PVCV |
2471 | || SvTYPE (SvRV (cb)) != SVt_PVCV |
2470 | || CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback) |
2472 | || CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback) |
2471 | croak ("Coro::rouse_wait called with illegal callback argument,"); |
2473 | croak ("Coro::rouse_wait called with illegal callback argument,"); |
2472 | |
2474 | |
2473 | { |
2475 | { |
2474 | CV *cv = (CV *)SvRV (cb); /* for S_GENSUB_ARG */ |
2476 | CV *cv = (CV *)SvRV (cb); /* for S_GENSUB_ARG */ |
… | |
… | |
3663 | RETVAL = boolSV (coro->flags & ix); |
3665 | RETVAL = boolSV (coro->flags & ix); |
3664 | OUTPUT: |
3666 | OUTPUT: |
3665 | RETVAL |
3667 | RETVAL |
3666 | |
3668 | |
3667 | void |
3669 | void |
3668 | throw (Coro::State self, SV *exception = &PL_sv_undef) |
3670 | throw (SV *self, SV *exception = &PL_sv_undef) |
3669 | PROTOTYPE: $;$ |
3671 | PROTOTYPE: $;$ |
3670 | CODE: |
3672 | CODE: |
3671 | { |
3673 | { |
|
|
3674 | struct coro *coro = SvSTATE (self); |
3672 | struct coro *current = SvSTATE_current; |
3675 | struct coro *current = SvSTATE_current; |
3673 | SV **exceptionp = self == current ? &CORO_THROW : &self->except; |
3676 | SV **exceptionp = coro == current ? &CORO_THROW : &coro->except; |
3674 | SvREFCNT_dec (*exceptionp); |
3677 | SvREFCNT_dec (*exceptionp); |
3675 | SvGETMAGIC (exception); |
3678 | SvGETMAGIC (exception); |
3676 | *exceptionp = SvOK (exception) ? newSVsv (exception) : 0; |
3679 | *exceptionp = SvOK (exception) ? newSVsv (exception) : 0; |
|
|
3680 | |
|
|
3681 | api_ready (aTHX_ self); |
3677 | } |
3682 | } |
3678 | |
3683 | |
3679 | void |
3684 | void |
3680 | api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB) |
3685 | api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB) |
3681 | PROTOTYPE: $;$ |
3686 | PROTOTYPE: $;$ |
… | |
… | |
3811 | |
3816 | |
3812 | sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle); |
3817 | sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle); |
3813 | sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro); |
3818 | sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro); |
3814 | cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler); |
3819 | cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler); |
3815 | CvNODEBUG_on (get_cv ("Coro::_pool_handler", 0)); /* work around a debugger bug */ |
3820 | CvNODEBUG_on (get_cv ("Coro::_pool_handler", 0)); /* work around a debugger bug */ |
3816 | |
3821 | |
3817 | coro_stash = gv_stashpv ("Coro", TRUE); |
3822 | coro_stash = gv_stashpv ("Coro", TRUE); |
3818 | |
3823 | |
3819 | newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (CORO_PRIO_MAX)); |
3824 | newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (CORO_PRIO_MAX)); |
3820 | newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (CORO_PRIO_HIGH)); |
3825 | newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (CORO_PRIO_HIGH)); |
3821 | newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (CORO_PRIO_NORMAL)); |
3826 | newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (CORO_PRIO_NORMAL)); |