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.199 by root, Sun Oct 7 13:53:37 2007 UTC vs.
Revision 1.202 by root, Mon Oct 8 02:50:23 2007 UTC

… …
130#else 130#else
131# define LOCK (void)0 131# define LOCK (void)0
132# define UNLOCK (void)0 132# define UNLOCK (void)0
133#endif 133#endif
134 134
135#define strpair(const) const, sizeof (const) - 1
136
135/* helper storage struct for Coro::AIO */ 137/* helper storage struct for Coro::AIO */
136struct io_state 138struct io_state
137{ 139{
138 int errorno; 140 int errorno;
139 I32 laststype; 141 I32 laststype;
… …
148static HV *coro_state_stash, *coro_stash; 150static HV *coro_state_stash, *coro_stash;
149static SV *coro_mortal; /* will be freed after next transfer */ 151static SV *coro_mortal; /* will be freed after next transfer */
150 152
151static GV *irsgv; /* $/ */ 153static GV *irsgv; /* $/ */
152static GV *stdoutgv; /* *STDOUT */ 154static GV *stdoutgv; /* *STDOUT */
155
156static HV *hv_sig; /* %SIG */
153static SV *sv_diehook; 157static SV *sv_diehook;
154static SV *sv_warnhook; 158static SV *sv_warnhook;
155 159
156/* async_pool helper stuff */ 160/* async_pool helper stuff */
157static SV *sv_pool_rss; 161static SV *sv_pool_rss;
… …
267 get_sv (name, create); 271 get_sv (name, create);
268#endif 272#endif
269 return get_sv (name, create); 273 return get_sv (name, create);
270} 274}
271 275
272static SV * 276static AV *
273coro_get_av (const char *name, int create) 277coro_get_av (const char *name, int create)
274{ 278{
275#if PERL_VERSION_ATLEAST (5,9,0) 279#if PERL_VERSION_ATLEAST (5,9,0)
276 /* silence stupid and wrong 5.10 warning that I am unable to switch off */ 280 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
277 get_av (name, create); 281 get_av (name, create);
278#endif 282#endif
279 return get_av (name, create); 283 return get_av (name, create);
284}
285
286static HV *
287coro_get_hv (const char *name, int create)
288{
289#if PERL_VERSION_ATLEAST (5,9,0)
290 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
291 get_hv (name, create);
292#endif
293 return get_hv (name, create);
280} 294}
281 295
282static AV * 296static AV *
283coro_clone_padlist (pTHX_ CV *cv) 297coro_clone_padlist (pTHX_ CV *cv)
284{ 298{
… …
439 453
440 #define VAR(name,type) PL_ ## name = slot->name; 454 #define VAR(name,type) PL_ ## name = slot->name;
441 # include "state.h" 455 # include "state.h"
442 #undef VAR 456 #undef VAR
443 457
458 /*hv_store (hv_sig, strpair ("__DIE__" ), SvREFCNT_inc (sv_diehook ), 0);*/
459 /*hv_store (hv_sig, strpair ("__WARN__"), SvREFCNT_inc (sv_warnhook), 0);*/
460
444 { 461 {
445 dSP; 462 dSP;
446 463
447 CV *cv; 464 CV *cv;
448 465
… …
507 524
508 PUTBACK; 525 PUTBACK;
509 } 526 }
510 527
511 /* allocate some space on the context stack for our purposes */ 528 /* allocate some space on the context stack for our purposes */
529 /* we manually unroll here, as usually 2 slots is enough */
530 if (SLOT_COUNT >= 1) CXINC;
531 if (SLOT_COUNT >= 2) CXINC;
532 if (SLOT_COUNT >= 3) CXINC;
512 { 533 {
513 /* we manually unroll here, as usually 2 slots is enough */
514 int i; 534 int i;
515 if (SLOT_COUNT >= 1) CXINC;
516 if (SLOT_COUNT >= 2) CXINC;
517 if (SLOT_COUNT >= 3) CXINC;
518 for (i = 3; i < SLOT_COUNT; ++i) 535 for (i = 3; i < SLOT_COUNT; ++i)
519 CXINC; 536 CXINC;
520
521 cxstack_ix -= SLOT_COUNT; /* undo allocation */
522 } 537 }
538 cxstack_ix -= SLOT_COUNT; /* undo allocation */
523 539
524 c->mainstack = PL_mainstack; 540 c->mainstack = PL_mainstack;
525 541
526 { 542 {
527 perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1); 543 perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);
… …
541 * allocate various perl stacks. This is an exact copy 557 * allocate various perl stacks. This is an exact copy
542 * of perl.c:init_stacks, except that it uses less memory 558 * of perl.c:init_stacks, except that it uses less memory
543 * on the (sometimes correct) assumption that coroutines do 559 * on the (sometimes correct) assumption that coroutines do
544 * not usually need a lot of stackspace. 560 * not usually need a lot of stackspace.
545 */ 561 */
546#if CORO_PREFER_PERL_FUNCTIONS 562#if 1
547# define coro_init_stacks init_stacks 563# define coro_init_stacks init_stacks
548#else 564#else
549static void 565static void
550coro_init_stacks (pTHX) 566coro_init_stacks (pTHX)
551{ 567{
… …
671 PL_curpm = 0; 687 PL_curpm = 0;
672 PL_curpad = 0; 688 PL_curpad = 0;
673 PL_localizing = 0; 689 PL_localizing = 0;
674 PL_dirty = 0; 690 PL_dirty = 0;
675 PL_restartop = 0; 691 PL_restartop = 0;
676 PL_diehook = SvREFCNT_inc (sv_diehook); 692 PL_diehook = 0; hv_store (hv_sig, strpair ("__DIE__" ), SvREFCNT_inc (sv_diehook ), 0);
677 PL_warnhook = SvREFCNT_inc (sv_warnhook); 693 PL_warnhook = 0; hv_store (hv_sig, strpair ("__WARN__"), SvREFCNT_inc (sv_warnhook), 0);
678 694
679 GvSV (PL_defgv) = newSV (0); 695 GvSV (PL_defgv) = newSV (0);
680 GvAV (PL_defgv) = coro->args; coro->args = 0; 696 GvAV (PL_defgv) = coro->args; coro->args = 0;
681 GvSV (PL_errgv) = newSV (0); 697 GvSV (PL_errgv) = newSV (0);
682 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0); 698 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
… …
791 PUSHMARK (SP); 807 PUSHMARK (SP);
792 PUSHs (&PL_sv_no); 808 PUSHs (&PL_sv_no);
793 PUSHs (fullname); 809 PUSHs (fullname);
794 PUSHs (sv_2mortal (newRV_noinc ((SV *)av))); 810 PUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
795 PUTBACK; 811 PUTBACK;
796 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0); 812 cb = hv_fetch ((HV *)SvRV (coro_current), strpair ("_trace_sub_cb"), 0);
797 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); 813 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
798 SPAGAIN; 814 SPAGAIN;
799 FREETMPS; 815 FREETMPS;
800 LEAVE; 816 LEAVE;
801 PL_runops = runops_trace; 817 PL_runops = runops_trace;
… …
830 PUSHMARK (SP); 846 PUSHMARK (SP);
831 PUSHs (&PL_sv_yes); 847 PUSHs (&PL_sv_yes);
832 PUSHs (fullname); 848 PUSHs (fullname);
833 PUSHs (cx->blk_sub.hasargs ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef); 849 PUSHs (cx->blk_sub.hasargs ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
834 PUTBACK; 850 PUTBACK;
835 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0); 851 cb = hv_fetch ((HV *)SvRV (coro_current), strpair ("_trace_sub_cb"), 0);
836 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); 852 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
837 SPAGAIN; 853 SPAGAIN;
838 FREETMPS; 854 FREETMPS;
839 LEAVE; 855 LEAVE;
840 PL_runops = runops_trace; 856 PL_runops = runops_trace;
… …
854 PL_runops = RUNOPS_DEFAULT; 870 PL_runops = RUNOPS_DEFAULT;
855 PUSHMARK (SP); 871 PUSHMARK (SP);
856 PUSHs (sv_2mortal (newSVpv (OutCopFILE (oldcop), 0))); 872 PUSHs (sv_2mortal (newSVpv (OutCopFILE (oldcop), 0)));
857 PUSHs (sv_2mortal (newSViv (CopLINE (oldcop)))); 873 PUSHs (sv_2mortal (newSViv (CopLINE (oldcop))));
858 PUTBACK; 874 PUTBACK;
859 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_line_cb", sizeof ("_trace_line_cb") - 1, 0); 875 cb = hv_fetch ((HV *)SvRV (coro_current), strpair ("_trace_line_cb"), 0);
860 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); 876 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
861 SPAGAIN; 877 SPAGAIN;
862 FREETMPS; 878 FREETMPS;
863 LEAVE; 879 LEAVE;
864 PL_runops = runops_trace; 880 PL_runops = runops_trace;
… …
874 890
875/* inject a fake call to Coro::State::_cctx_init into the execution */ 891/* inject a fake call to Coro::State::_cctx_init into the execution */
876/* _cctx_init should be careful, as it could be called at almost any time */ 892/* _cctx_init should be careful, as it could be called at almost any time */
877/* during execution of a perl program */ 893/* during execution of a perl program */
878static void NOINLINE 894static void NOINLINE
879prepare_cctx (pTHX_ coro_cctx *cctx) 895cctx_prepare (pTHX_ coro_cctx *cctx)
880{ 896{
881 dSP; 897 dSP;
882 LOGOP myop; 898 LOGOP myop;
883 899
884 PL_top_env = &PL_start_env; 900 PL_top_env = &PL_start_env;
… …
902 918
903/* 919/*
904 * this is a _very_ stripped down perl interpreter ;) 920 * this is a _very_ stripped down perl interpreter ;)
905 */ 921 */
906static void 922static void
907coro_run (void *arg) 923cctx_run (void *arg)
908{ 924{
909 dTHX; 925 dTHX;
910 926
911 /* coro_run is the alternative tail of transfer(), so unlock here. */ 927 /* cctx_run is the alternative tail of transfer(), so unlock here. */
912 UNLOCK; 928 UNLOCK;
913 929
914 /* we now skip the entersub that lead to transfer() */ 930 /* we now skip the entersub that lead to transfer() */
915 PL_op = PL_op->op_next; 931 PL_op = PL_op->op_next;
916 932
917 /* inject a fake subroutine call to cctx_init */ 933 /* inject a fake subroutine call to cctx_init */
918 prepare_cctx (aTHX_ (coro_cctx *)arg); 934 cctx_prepare (aTHX_ (coro_cctx *)arg);
919 935
920 /* somebody or something will hit me for both perl_run and PL_restartop */ 936 /* somebody or something will hit me for both perl_run and PL_restartop */
921 PL_restartop = PL_op; 937 PL_restartop = PL_op;
922 perl_run (PL_curinterp); 938 perl_run (PL_curinterp);
923 939
… …
942 ++cctx_count; 958 ++cctx_count;
943 959
944 Newz (0, cctx, 1, coro_cctx); 960 Newz (0, cctx, 1, coro_cctx);
945 961
946#if HAVE_MMAP 962#if HAVE_MMAP
947
948 cctx->ssize = ((coro_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE; 963 cctx->ssize = ((coro_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
949 /* mmap supposedly does allocate-on-write for us */ 964 /* mmap supposedly does allocate-on-write for us */
950 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 965 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
951 966
952 if (cctx->sptr != (void *)-1) 967 if (cctx->sptr != (void *)-1)
… …
973 stack_start = cctx->sptr; 988 stack_start = cctx->sptr;
974 stack_size = cctx->ssize; 989 stack_size = cctx->ssize;
975 } 990 }
976 991
977 REGISTER_STACK (cctx, (char *)stack_start, (char *)stack_start + stack_size); 992 REGISTER_STACK (cctx, (char *)stack_start, (char *)stack_start + stack_size);
978 coro_create (&cctx->cctx, coro_run, (void *)cctx, stack_start, stack_size); 993 coro_create (&cctx->cctx, cctx_run, (void *)cctx, stack_start, stack_size);
979 994
980 return cctx; 995 return cctx;
981} 996}
982 997
983static void 998static void
… …
1124 prev->cctx = 0; 1139 prev->cctx = 0;
1125 1140
1126 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */ 1141 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */
1127 /* without this the next cctx_get might destroy the prev__cctx while still in use */ 1142 /* without this the next cctx_get might destroy the prev__cctx while still in use */
1128 if (expect_false (CCTX_EXPIRED (prev__cctx))) 1143 if (expect_false (CCTX_EXPIRED (prev__cctx)))
1144 if (!next->cctx)
1129 next->cctx = cctx_get (aTHX); 1145 next->cctx = cctx_get (aTHX);
1130 1146
1131 cctx_put (prev__cctx); 1147 cctx_put (prev__cctx);
1132 } 1148 }
1133 1149
1134 ++next->usecount; 1150 ++next->usecount;
… …
1487 BOOT_PAGESIZE; 1503 BOOT_PAGESIZE;
1488 1504
1489 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV); 1505 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
1490 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); 1506 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
1491 1507
1508 hv_sig = coro_get_hv ("SIG", TRUE);
1492 sv_diehook = coro_get_sv ("Coro::State::DIEHOOK" , TRUE); 1509 sv_diehook = coro_get_sv ("Coro::State::DIEHOOK" , TRUE);
1493 sv_warnhook = coro_get_sv ("Coro::State::WARNHOOK", TRUE); 1510 sv_warnhook = coro_get_sv ("Coro::State::WARNHOOK", TRUE);
1494 1511
1495 if (!PL_diehook) PL_diehook = SvREFCNT_inc (sv_diehook); 1512 if (!PL_diehook ) hv_store (hv_sig, strpair ("__DIE__" ), SvREFCNT_inc (sv_diehook ), 0);
1496 if (!PL_warnhook) PL_warnhook = SvREFCNT_inc (sv_warnhook); 1513 if (!PL_warnhook) hv_store (hv_sig, strpair ("__WARN__"), SvREFCNT_inc (sv_warnhook), 0);
1497 1514
1498 coro_state_stash = gv_stashpv ("Coro::State", TRUE); 1515 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1499 1516
1500 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE)); 1517 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
1501 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB)); 1518 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
… …
1828 CODE: 1845 CODE:
1829{ 1846{
1830 struct coro *coro = SvSTATE (coro_current); 1847 struct coro *coro = SvSTATE (coro_current);
1831 HV *hv = (HV *)SvRV (coro_current); 1848 HV *hv = (HV *)SvRV (coro_current);
1832 AV *defav = GvAV (PL_defgv); 1849 AV *defav = GvAV (PL_defgv);
1833 SV *invoke = hv_delete (hv, "_invoke", sizeof ("_invoke") - 1, 0); 1850 SV *invoke = hv_delete (hv, strpair ("_invoke"), 0);
1834 AV *invoke_av; 1851 AV *invoke_av;
1835 int i, len; 1852 int i, len;
1836 1853
1837 if (!invoke) 1854 if (!invoke)
1838 croak ("\3async_pool terminate\2\n"); 1855 croak ("\3async_pool terminate\2\n");
1839 1856
1840 SvREFCNT_dec (coro->saved_deffh); 1857 SvREFCNT_dec (coro->saved_deffh);
1841 coro->saved_deffh = SvREFCNT_inc ((SV *)PL_defoutgv); 1858 coro->saved_deffh = SvREFCNT_inc ((SV *)PL_defoutgv);
1842 1859
1843 hv_store (hv, "desc", sizeof ("desc") - 1, 1860 hv_store (hv, "desc", sizeof ("desc") - 1,
1844 newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0); 1861 newSVpvn (strpair ("[async_pool]")), 0);
1845 1862
1846 invoke_av = (AV *)SvRV (invoke); 1863 invoke_av = (AV *)SvRV (invoke);
1847 len = av_len (invoke_av); 1864 len = av_len (invoke_av);
1848 1865
1849 sv_setsv (cb, AvARRAY (invoke_av)[0]); 1866 sv_setsv (cb, AvARRAY (invoke_av)[0]);
… …
1872 if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss) 1889 if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss)
1873 || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size)) 1890 || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
1874 croak ("\3async_pool terminate\2\n"); 1891 croak ("\3async_pool terminate\2\n");
1875 1892
1876 av_clear (GvAV (PL_defgv)); 1893 av_clear (GvAV (PL_defgv));
1877 hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1, 1894 hv_store ((HV *)SvRV (coro_current), strpair ("desc"),
1878 newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0); 1895 newSVpvn (strpair ("[async_pool idle]")), 0);
1879 1896
1880 coro->prio = 0; 1897 coro->prio = 0;
1881 1898
1882 if (coro->cctx && (coro->cctx->flags & CC_TRACE)) 1899 if (coro->cctx && (coro->cctx->flags & CC_TRACE))
1883 api_trace (coro_current, 0); 1900 api_trace (coro_current, 0);

Diff Legend

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