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.198 by root, Sun Oct 7 03:58:37 2007 UTC vs.
Revision 1.203 by root, Mon Oct 8 03:02:00 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 */
157static SV *sv_diehook;
158static SV *sv_warnhook;
153 159
154/* async_pool helper stuff */ 160/* async_pool helper stuff */
155static SV *sv_pool_rss; 161static SV *sv_pool_rss;
156static SV *sv_pool_size; 162static SV *sv_pool_size;
157static AV *av_async_pool; 163static AV *av_async_pool;
215 221
216 /* process data */ 222 /* process data */
217 AV *mainstack; 223 AV *mainstack;
218 perl_slots *slot; /* basically the saved sp */ 224 perl_slots *slot; /* basically the saved sp */
219 225
220 /* data associated with this coroutine (initial args) */ 226 AV *args; /* data associated with this coroutine (initial args) */
221 AV *args; 227 int refcnt; /* coroutines are refcounted, yes */
222 int refcnt;
223 int flags; /* CF_ flags */ 228 int flags; /* CF_ flags */
229 HV *hv; /* the perl hash associated with this coro, if any */
224 230
225 /* statistics */ 231 /* statistics */
226 int usecount; /* number of transfers to this coro */ 232 int usecount; /* number of transfers to this coro */
227 233
228 /* coro process data */ 234 /* coro process data */
229 int prio; 235 int prio;
230 SV *throw; 236 SV *throw; /* exception to be thrown */
231 237
232 /* async_pool */ 238 /* async_pool */
233 SV *saved_deffh; 239 SV *saved_deffh;
234 240
235 /* linked list */ 241 /* linked list */
236 struct coro *next, *prev; 242 struct coro *next, *prev;
237 HV *hv; /* the perl hash associated with this coro, if any */
238}; 243};
239 244
240typedef struct coro *Coro__State; 245typedef struct coro *Coro__State;
241typedef struct coro *Coro__State_or_hashref; 246typedef struct coro *Coro__State_or_hashref;
242 247
254static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; 259static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
255static int coro_nready; 260static int coro_nready;
256static struct coro *coro_first; 261static struct coro *coro_first;
257 262
258/** lowlevel stuff **********************************************************/ 263/** lowlevel stuff **********************************************************/
264
265static SV *
266coro_get_sv (const char *name, int create)
267{
268#if PERL_VERSION_ATLEAST (5,9,0)
269 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
270 get_sv (name, create);
271#endif
272 return get_sv (name, create);
273}
274
275static AV *
276coro_get_av (const char *name, int create)
277{
278#if PERL_VERSION_ATLEAST (5,9,0)
279 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
280 get_av (name, create);
281#endif
282 return get_av (name, create);
283}
284
285static HV *
286coro_get_hv (const char *name, int create)
287{
288#if PERL_VERSION_ATLEAST (5,9,0)
289 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
290 get_hv (name, create);
291#endif
292 return get_hv (name, create);
293}
259 294
260static AV * 295static AV *
261coro_clone_padlist (pTHX_ CV *cv) 296coro_clone_padlist (pTHX_ CV *cv)
262{ 297{
263 AV *padlist = CvPADLIST (cv); 298 AV *padlist = CvPADLIST (cv);
417 452
418 #define VAR(name,type) PL_ ## name = slot->name; 453 #define VAR(name,type) PL_ ## name = slot->name;
419 # include "state.h" 454 # include "state.h"
420 #undef VAR 455 #undef VAR
421 456
457 /*hv_store (hv_sig, strpair ("__DIE__" ), SvREFCNT_inc (sv_diehook ), 0);*/
458 /*hv_store (hv_sig, strpair ("__WARN__"), SvREFCNT_inc (sv_warnhook), 0);*/
459
422 { 460 {
423 dSP; 461 dSP;
424 462
425 CV *cv; 463 CV *cv;
426 464
485 523
486 PUTBACK; 524 PUTBACK;
487 } 525 }
488 526
489 /* allocate some space on the context stack for our purposes */ 527 /* allocate some space on the context stack for our purposes */
528 /* we manually unroll here, as usually 2 slots is enough */
529 if (SLOT_COUNT >= 1) CXINC;
530 if (SLOT_COUNT >= 2) CXINC;
531 if (SLOT_COUNT >= 3) CXINC;
490 { 532 {
491 /* we manually unroll here, as usually 2 slots is enough */
492 int i; 533 int i;
493 if (SLOT_COUNT >= 1) CXINC;
494 if (SLOT_COUNT >= 2) CXINC;
495 if (SLOT_COUNT >= 3) CXINC;
496 for (i = 3; i < SLOT_COUNT; ++i) 534 for (i = 3; i < SLOT_COUNT; ++i)
497 CXINC; 535 CXINC;
498
499 cxstack_ix -= SLOT_COUNT; /* undo allocation */
500 } 536 }
537 cxstack_ix -= SLOT_COUNT; /* undo allocation */
501 538
502 c->mainstack = PL_mainstack; 539 c->mainstack = PL_mainstack;
503 540
504 { 541 {
505 perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1); 542 perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);
519 * allocate various perl stacks. This is an exact copy 556 * allocate various perl stacks. This is an exact copy
520 * of perl.c:init_stacks, except that it uses less memory 557 * of perl.c:init_stacks, except that it uses less memory
521 * on the (sometimes correct) assumption that coroutines do 558 * on the (sometimes correct) assumption that coroutines do
522 * not usually need a lot of stackspace. 559 * not usually need a lot of stackspace.
523 */ 560 */
524#if CORO_PREFER_PERL_FUNCTIONS 561#if 1
525# define coro_init_stacks init_stacks 562# define coro_init_stacks init_stacks
526#else 563#else
527static void 564static void
528coro_init_stacks (pTHX) 565coro_init_stacks (pTHX)
529{ 566{
649 PL_curpm = 0; 686 PL_curpm = 0;
650 PL_curpad = 0; 687 PL_curpad = 0;
651 PL_localizing = 0; 688 PL_localizing = 0;
652 PL_dirty = 0; 689 PL_dirty = 0;
653 PL_restartop = 0; 690 PL_restartop = 0;
654 PL_diehook = 0; 691 PL_diehook = 0; hv_store (hv_sig, strpair ("__DIE__" ), SvREFCNT_inc (sv_diehook ), 0);
655 PL_warnhook = 0; 692 PL_warnhook = 0; hv_store (hv_sig, strpair ("__WARN__"), SvREFCNT_inc (sv_warnhook), 0);
656 693
657 GvSV (PL_defgv) = newSV (0); 694 GvSV (PL_defgv) = newSV (0);
658 GvAV (PL_defgv) = coro->args; coro->args = 0; 695 GvAV (PL_defgv) = coro->args; coro->args = 0;
659 GvSV (PL_errgv) = newSV (0); 696 GvSV (PL_errgv) = newSV (0);
660 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0); 697 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
769 PUSHMARK (SP); 806 PUSHMARK (SP);
770 PUSHs (&PL_sv_no); 807 PUSHs (&PL_sv_no);
771 PUSHs (fullname); 808 PUSHs (fullname);
772 PUSHs (sv_2mortal (newRV_noinc ((SV *)av))); 809 PUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
773 PUTBACK; 810 PUTBACK;
774 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0); 811 cb = hv_fetch ((HV *)SvRV (coro_current), strpair ("_trace_sub_cb"), 0);
775 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); 812 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
776 SPAGAIN; 813 SPAGAIN;
777 FREETMPS; 814 FREETMPS;
778 LEAVE; 815 LEAVE;
779 PL_runops = runops_trace; 816 PL_runops = runops_trace;
808 PUSHMARK (SP); 845 PUSHMARK (SP);
809 PUSHs (&PL_sv_yes); 846 PUSHs (&PL_sv_yes);
810 PUSHs (fullname); 847 PUSHs (fullname);
811 PUSHs (cx->blk_sub.hasargs ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef); 848 PUSHs (cx->blk_sub.hasargs ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
812 PUTBACK; 849 PUTBACK;
813 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0); 850 cb = hv_fetch ((HV *)SvRV (coro_current), strpair ("_trace_sub_cb"), 0);
814 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); 851 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
815 SPAGAIN; 852 SPAGAIN;
816 FREETMPS; 853 FREETMPS;
817 LEAVE; 854 LEAVE;
818 PL_runops = runops_trace; 855 PL_runops = runops_trace;
832 PL_runops = RUNOPS_DEFAULT; 869 PL_runops = RUNOPS_DEFAULT;
833 PUSHMARK (SP); 870 PUSHMARK (SP);
834 PUSHs (sv_2mortal (newSVpv (OutCopFILE (oldcop), 0))); 871 PUSHs (sv_2mortal (newSVpv (OutCopFILE (oldcop), 0)));
835 PUSHs (sv_2mortal (newSViv (CopLINE (oldcop)))); 872 PUSHs (sv_2mortal (newSViv (CopLINE (oldcop))));
836 PUTBACK; 873 PUTBACK;
837 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_line_cb", sizeof ("_trace_line_cb") - 1, 0); 874 cb = hv_fetch ((HV *)SvRV (coro_current), strpair ("_trace_line_cb"), 0);
838 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); 875 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
839 SPAGAIN; 876 SPAGAIN;
840 FREETMPS; 877 FREETMPS;
841 LEAVE; 878 LEAVE;
842 PL_runops = runops_trace; 879 PL_runops = runops_trace;
852 889
853/* inject a fake call to Coro::State::_cctx_init into the execution */ 890/* inject a fake call to Coro::State::_cctx_init into the execution */
854/* _cctx_init should be careful, as it could be called at almost any time */ 891/* _cctx_init should be careful, as it could be called at almost any time */
855/* during execution of a perl program */ 892/* during execution of a perl program */
856static void NOINLINE 893static void NOINLINE
857prepare_cctx (pTHX_ coro_cctx *cctx) 894cctx_prepare (pTHX_ coro_cctx *cctx)
858{ 895{
859 dSP; 896 dSP;
860 LOGOP myop; 897 LOGOP myop;
861 898
862 PL_top_env = &PL_start_env; 899 PL_top_env = &PL_start_env;
880 917
881/* 918/*
882 * this is a _very_ stripped down perl interpreter ;) 919 * this is a _very_ stripped down perl interpreter ;)
883 */ 920 */
884static void 921static void
885coro_run (void *arg) 922cctx_run (void *arg)
886{ 923{
887 dTHX; 924 dTHX;
888 925
889 /* coro_run is the alternative tail of transfer(), so unlock here. */ 926 /* cctx_run is the alternative tail of transfer(), so unlock here. */
890 UNLOCK; 927 UNLOCK;
891 928
892 /* we now skip the entersub that lead to transfer() */ 929 /* we now skip the entersub that lead to transfer() */
893 PL_op = PL_op->op_next; 930 PL_op = PL_op->op_next;
894 931
895 /* inject a fake subroutine call to cctx_init */ 932 /* inject a fake subroutine call to cctx_init */
896 prepare_cctx (aTHX_ (coro_cctx *)arg); 933 cctx_prepare (aTHX_ (coro_cctx *)arg);
897 934
898 /* somebody or something will hit me for both perl_run and PL_restartop */ 935 /* somebody or something will hit me for both perl_run and PL_restartop */
899 PL_restartop = PL_op; 936 PL_restartop = PL_op;
900 perl_run (PL_curinterp); 937 perl_run (PL_curinterp);
901 938
920 ++cctx_count; 957 ++cctx_count;
921 958
922 Newz (0, cctx, 1, coro_cctx); 959 Newz (0, cctx, 1, coro_cctx);
923 960
924#if HAVE_MMAP 961#if HAVE_MMAP
925
926 cctx->ssize = ((coro_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE; 962 cctx->ssize = ((coro_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
927 /* mmap supposedly does allocate-on-write for us */ 963 /* mmap supposedly does allocate-on-write for us */
928 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 964 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
929 965
930 if (cctx->sptr != (void *)-1) 966 if (cctx->sptr != (void *)-1)
951 stack_start = cctx->sptr; 987 stack_start = cctx->sptr;
952 stack_size = cctx->ssize; 988 stack_size = cctx->ssize;
953 } 989 }
954 990
955 REGISTER_STACK (cctx, (char *)stack_start, (char *)stack_start + stack_size); 991 REGISTER_STACK (cctx, (char *)stack_start, (char *)stack_start + stack_size);
956 coro_create (&cctx->cctx, coro_run, (void *)cctx, stack_start, stack_size); 992 coro_create (&cctx->cctx, cctx_run, (void *)cctx, stack_start, stack_size);
957 993
958 return cctx; 994 return cctx;
959} 995}
960 996
961static void 997static void
1102 prev->cctx = 0; 1138 prev->cctx = 0;
1103 1139
1104 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */ 1140 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */
1105 /* without this the next cctx_get might destroy the prev__cctx while still in use */ 1141 /* without this the next cctx_get might destroy the prev__cctx while still in use */
1106 if (expect_false (CCTX_EXPIRED (prev__cctx))) 1142 if (expect_false (CCTX_EXPIRED (prev__cctx)))
1143 if (!next->cctx)
1107 next->cctx = cctx_get (aTHX); 1144 next->cctx = cctx_get (aTHX);
1108 1145
1109 cctx_put (prev__cctx); 1146 cctx_put (prev__cctx);
1110 } 1147 }
1111 1148
1112 ++next->usecount; 1149 ++next->usecount;
1464#endif 1501#endif
1465 BOOT_PAGESIZE; 1502 BOOT_PAGESIZE;
1466 1503
1467 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV); 1504 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
1468 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); 1505 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
1506
1507 hv_sig = coro_get_hv ("SIG", TRUE);
1508 sv_diehook = coro_get_sv ("Coro::State::DIEHOOK" , TRUE);
1509 sv_warnhook = coro_get_sv ("Coro::State::WARNHOOK", TRUE);
1510
1511 if (!PL_diehook ) hv_store (hv_sig, strpair ("__DIE__" ), SvREFCNT_inc (sv_diehook ), 0);
1512 if (!PL_warnhook) hv_store (hv_sig, strpair ("__WARN__"), SvREFCNT_inc (sv_warnhook), 0);
1469 1513
1470 coro_state_stash = gv_stashpv ("Coro::State", TRUE); 1514 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1471 1515
1472 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE)); 1516 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
1473 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB)); 1517 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
1703 1747
1704BOOT: 1748BOOT:
1705{ 1749{
1706 int i; 1750 int i;
1707 1751
1708 sv_pool_rss = get_sv ("Coro::POOL_RSS" , TRUE); 1752 sv_pool_rss = coro_get_sv ("Coro::POOL_RSS" , TRUE);
1709 get_sv ("Coro::POOL_RSS" , TRUE); /* silence stupid 5.10 warning */
1710 sv_pool_size = get_sv ("Coro::POOL_SIZE" , TRUE); 1753 sv_pool_size = coro_get_sv ("Coro::POOL_SIZE" , TRUE);
1711 get_sv ("Coro::POOL_SIZE" , TRUE); /* silence stupid 5.10 warning */
1712 av_async_pool = get_av ("Coro::async_pool", TRUE); 1754 av_async_pool = coro_get_av ("Coro::async_pool", TRUE);
1713 get_av ("Coro::async_pool", TRUE); /* silence stupid 5.10 warning */
1714 1755
1715 coro_current = get_sv ("Coro::current", FALSE); 1756 coro_current = coro_get_sv ("Coro::current", FALSE);
1716 SvREADONLY_on (coro_current); 1757 SvREADONLY_on (coro_current);
1717 1758
1718 coro_stash = gv_stashpv ("Coro", TRUE); 1759 coro_stash = gv_stashpv ("Coro", TRUE);
1719 1760
1720 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX)); 1761 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
1803 CODE: 1844 CODE:
1804{ 1845{
1805 struct coro *coro = SvSTATE (coro_current); 1846 struct coro *coro = SvSTATE (coro_current);
1806 HV *hv = (HV *)SvRV (coro_current); 1847 HV *hv = (HV *)SvRV (coro_current);
1807 AV *defav = GvAV (PL_defgv); 1848 AV *defav = GvAV (PL_defgv);
1808 SV *invoke = hv_delete (hv, "_invoke", sizeof ("_invoke") - 1, 0); 1849 SV *invoke = hv_delete (hv, strpair ("_invoke"), 0);
1809 AV *invoke_av; 1850 AV *invoke_av;
1810 int i, len; 1851 int i, len;
1811 1852
1812 if (!invoke) 1853 if (!invoke)
1813 croak ("\3async_pool terminate\2\n"); 1854 croak ("\3async_pool terminate\2\n");
1814 1855
1815 SvREFCNT_dec (coro->saved_deffh); 1856 SvREFCNT_dec (coro->saved_deffh);
1816 coro->saved_deffh = SvREFCNT_inc ((SV *)PL_defoutgv); 1857 coro->saved_deffh = SvREFCNT_inc ((SV *)PL_defoutgv);
1817 1858
1818 hv_store (hv, "desc", sizeof ("desc") - 1, 1859 hv_store (hv, "desc", sizeof ("desc") - 1,
1819 newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0); 1860 newSVpvn (strpair ("[async_pool]")), 0);
1820 1861
1821 invoke_av = (AV *)SvRV (invoke); 1862 invoke_av = (AV *)SvRV (invoke);
1822 len = av_len (invoke_av); 1863 len = av_len (invoke_av);
1823 1864
1824 sv_setsv (cb, AvARRAY (invoke_av)[0]); 1865 sv_setsv (cb, AvARRAY (invoke_av)[0]);
1847 if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss) 1888 if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss)
1848 || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size)) 1889 || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
1849 croak ("\3async_pool terminate\2\n"); 1890 croak ("\3async_pool terminate\2\n");
1850 1891
1851 av_clear (GvAV (PL_defgv)); 1892 av_clear (GvAV (PL_defgv));
1852 hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1, 1893 hv_store ((HV *)SvRV (coro_current), strpair ("desc"),
1853 newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0); 1894 newSVpvn (strpair ("[async_pool idle]")), 0);
1854 1895
1855 coro->prio = 0; 1896 coro->prio = 0;
1856 1897
1857 if (coro->cctx && (coro->cctx->flags & CC_TRACE)) 1898 if (coro->cctx && (coro->cctx->flags & CC_TRACE))
1858 api_trace (coro_current, 0); 1899 api_trace (coro_current, 0);

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines