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.324 by root, Sat Nov 22 07:02:28 2008 UTC vs.
Revision 1.329 by root, Tue Nov 25 20:48:41 2008 UTC

175static HV *coro_state_stash, *coro_stash; 175static HV *coro_state_stash, *coro_stash;
176static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */ 176static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */
177 177
178static AV *av_destroy; /* destruction queue */ 178static AV *av_destroy; /* destruction queue */
179static SV *sv_manager; /* the manager coro */ 179static SV *sv_manager; /* the manager coro */
180static SV *sv_idle; /* $Coro::idle */
180 181
181static GV *irsgv; /* $/ */ 182static GV *irsgv; /* $/ */
182static GV *stdoutgv; /* *STDOUT */ 183static GV *stdoutgv; /* *STDOUT */
183static SV *rv_diehook; 184static SV *rv_diehook;
184static SV *rv_warnhook; 185static SV *rv_warnhook;
246{ 247{
247 SV *defsv; 248 SV *defsv;
248 AV *defav; 249 AV *defav;
249 SV *errsv; 250 SV *errsv;
250 SV *irsgv; 251 SV *irsgv;
252 HV *hinthv;
251#define VAR(name,type) type name; 253#define VAR(name,type) type name;
252# include "state.h" 254# include "state.h"
253#undef VAR 255#undef VAR
254} perl_slots; 256} perl_slots;
255 257
516 perl_slots *slot = c->slot; 518 perl_slots *slot = c->slot;
517 c->slot = 0; 519 c->slot = 0;
518 520
519 PL_mainstack = c->mainstack; 521 PL_mainstack = c->mainstack;
520 522
521 GvSV (PL_defgv) = slot->defsv; 523 GvSV (PL_defgv) = slot->defsv;
522 GvAV (PL_defgv) = slot->defav; 524 GvAV (PL_defgv) = slot->defav;
523 GvSV (PL_errgv) = slot->errsv; 525 GvSV (PL_errgv) = slot->errsv;
524 GvSV (irsgv) = slot->irsgv; 526 GvSV (irsgv) = slot->irsgv;
527 GvHV (PL_hintgv) = slot->hinthv;
525 528
526 #define VAR(name,type) PL_ ## name = slot->name; 529 #define VAR(name,type) PL_ ## name = slot->name;
527 # include "state.h" 530 # include "state.h"
528 #undef VAR 531 #undef VAR
529 532
615 c->mainstack = PL_mainstack; 618 c->mainstack = PL_mainstack;
616 619
617 { 620 {
618 perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1); 621 perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);
619 622
620 slot->defav = GvAV (PL_defgv); 623 slot->defav = GvAV (PL_defgv);
621 slot->defsv = DEFSV; 624 slot->defsv = DEFSV;
622 slot->errsv = ERRSV; 625 slot->errsv = ERRSV;
623 slot->irsgv = GvSV (irsgv); 626 slot->irsgv = GvSV (irsgv);
627 slot->hinthv = GvHV (PL_hintgv);
624 628
625 #define VAR(name,type) slot->name = PL_ ## name; 629 #define VAR(name,type) slot->name = PL_ ## name;
626 # include "state.h" 630 # include "state.h"
627 #undef VAR 631 #undef VAR
628 } 632 }
864 868
865 PL_runops = RUNOPS_DEFAULT; 869 PL_runops = RUNOPS_DEFAULT;
866 PL_curcop = &PL_compiling; 870 PL_curcop = &PL_compiling;
867 PL_in_eval = EVAL_NULL; 871 PL_in_eval = EVAL_NULL;
868 PL_comppad = 0; 872 PL_comppad = 0;
873 PL_comppad_name = 0;
874 PL_comppad_name_fill = 0;
875 PL_comppad_name_floor = 0;
869 PL_curpm = 0; 876 PL_curpm = 0;
870 PL_curpad = 0; 877 PL_curpad = 0;
871 PL_localizing = 0; 878 PL_localizing = 0;
872 PL_dirty = 0; 879 PL_dirty = 0;
873 PL_restartop = 0; 880 PL_restartop = 0;
874#if PERL_VERSION_ATLEAST (5,10,0) 881#if PERL_VERSION_ATLEAST (5,10,0)
875 PL_parser = 0; 882 PL_parser = 0;
876#endif 883#endif
884 PL_hints = 0;
877 885
878 /* recreate the die/warn hooks */ 886 /* recreate the die/warn hooks */
879 PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook ); 887 PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );
880 PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook); 888 PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);
881 889
882 GvSV (PL_defgv) = newSV (0); 890 GvSV (PL_defgv) = newSV (0);
883 GvAV (PL_defgv) = coro->args; coro->args = 0; 891 GvAV (PL_defgv) = coro->args; coro->args = 0;
884 GvSV (PL_errgv) = newSV (0); 892 GvSV (PL_errgv) = newSV (0);
885 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0); 893 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
894 GvHV (PL_hintgv) = 0;
886 PL_rs = newSVsv (GvSV (irsgv)); 895 PL_rs = newSVsv (GvSV (irsgv));
887 PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv); 896 PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);
888 897
889 { 898 {
890 dSP; 899 dSP;
944 SvREFCNT_dec (GvAV (PL_defgv)); 953 SvREFCNT_dec (GvAV (PL_defgv));
945 SvREFCNT_dec (GvSV (PL_errgv)); 954 SvREFCNT_dec (GvSV (PL_errgv));
946 SvREFCNT_dec (PL_defoutgv); 955 SvREFCNT_dec (PL_defoutgv);
947 SvREFCNT_dec (PL_rs); 956 SvREFCNT_dec (PL_rs);
948 SvREFCNT_dec (GvSV (irsgv)); 957 SvREFCNT_dec (GvSV (irsgv));
958 SvREFCNT_dec (GvHV (PL_hintgv));
949 959
950 SvREFCNT_dec (PL_diehook); 960 SvREFCNT_dec (PL_diehook);
951 SvREFCNT_dec (PL_warnhook); 961 SvREFCNT_dec (PL_warnhook);
952 962
953 SvREFCNT_dec (coro->saved_deffh); 963 SvREFCNT_dec (coro->saved_deffh);
1168 /* 1178 /*
1169 * If perl-run returns we assume exit() was being called or the coro 1179 * If perl-run returns we assume exit() was being called or the coro
1170 * fell off the end, which seems to be the only valid (non-bug) 1180 * fell off the end, which seems to be the only valid (non-bug)
1171 * reason for perl_run to return. We try to exit by jumping to the 1181 * reason for perl_run to return. We try to exit by jumping to the
1172 * bootstrap-time "top" top_env, as we cannot restore the "main" 1182 * bootstrap-time "top" top_env, as we cannot restore the "main"
1173 * coroutine as Coro has no such concept 1183 * coroutine as Coro has no such concept.
1184 * This actually isn't valid with the pthread backend, but OSes requiring
1185 * that backend are too broken to do it in a standards-compliant way.
1174 */ 1186 */
1175 PL_top_env = main_top_env; 1187 PL_top_env = main_top_env;
1176 JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */ 1188 JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
1177 } 1189 }
1178} 1190}
1329 /* TODO: throwing up here is considered harmful */ 1341 /* TODO: throwing up here is considered harmful */
1330 1342
1331 if (expect_true (prev != next)) 1343 if (expect_true (prev != next))
1332 { 1344 {
1333 if (expect_false (!(prev->flags & (CF_RUNNING | CF_NEW)))) 1345 if (expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))
1334 croak ("Coro::State::transfer called with non-running/new prev Coro::State, but can only transfer from running or new states,"); 1346 croak ("Coro::State::transfer called with a suspended prev Coro::State, but can only transfer from running or new states,");
1335 1347
1336 if (expect_false (next->flags & CF_RUNNING)) 1348 if (expect_false (next->flags & CF_RUNNING))
1337 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states,"); 1349 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states,");
1338 1350
1339 if (expect_false (next->flags & CF_DESTROYED)) 1351 if (expect_false (next->flags & CF_DESTROYED))
1582{ 1594{
1583 struct coro *coro; 1595 struct coro *coro;
1584 SV *sv_hook; 1596 SV *sv_hook;
1585 void (*xs_hook)(void); 1597 void (*xs_hook)(void);
1586 1598
1587 if (SvROK (coro_sv))
1588 coro_sv = SvRV (coro_sv);
1589
1590 coro = SvSTATE (coro_sv); 1599 coro = SvSTATE (coro_sv);
1591 1600
1592 if (coro->flags & CF_READY) 1601 if (coro->flags & CF_READY)
1593 return 0; 1602 return 0;
1594 1603
1668 } 1677 }
1669 } 1678 }
1670 else 1679 else
1671 { 1680 {
1672 /* nothing to schedule: call the idle handler */ 1681 /* nothing to schedule: call the idle handler */
1682 if (SvROK (sv_idle)
1683 && SvOBJECT (SvRV (sv_idle)))
1684 {
1685 ++coro_nready; /* hack so that api_ready doesn't invoke ready hook */
1686 api_ready (aTHX_ SvRV (sv_idle));
1687 --coro_nready;
1688 }
1689 else
1690 {
1673 dSP; 1691 dSP;
1674 1692
1675 ENTER; 1693 ENTER;
1676 SAVETMPS; 1694 SAVETMPS;
1677 1695
1678 PUSHMARK (SP); 1696 PUSHMARK (SP);
1679 PUTBACK; 1697 PUTBACK;
1680 call_sv (get_sv ("Coro::idle", FALSE), G_VOID | G_DISCARD); 1698 call_sv (sv_idle, G_VOID | G_DISCARD);
1681 1699
1682 FREETMPS; 1700 FREETMPS;
1683 LEAVE; 1701 LEAVE;
1702 }
1684 } 1703 }
1685 } 1704 }
1686} 1705}
1687 1706
1688INLINE void 1707INLINE void
2351 SV **ary; 2370 SV **ary;
2352 2371
2353 /* unfortunately, building manually saves memory */ 2372 /* unfortunately, building manually saves memory */
2354 Newx (ary, 2, SV *); 2373 Newx (ary, 2, SV *);
2355 AvALLOC (av) = ary; 2374 AvALLOC (av) = ary;
2375#if PERL_VERSION_ATLEAST (5,10,0)
2356 /*AvARRAY (av) = ary;*/ 2376 AvARRAY (av) = ary;
2377#else
2357 SvPVX ((SV *)av) = (char *)ary; /* 5.8.8 needs this syntax instead of AvARRAY = ary */ 2378 /* 5.8.8 needs this syntax instead of AvARRAY = ary, yet */
2379 /* -DDEBUGGING flags this as a bug, despite it perfectly working */
2380 SvPVX ((SV *)av) = (char *)ary;
2381#endif
2358 AvMAX (av) = 1; 2382 AvMAX (av) = 1;
2359 AvFILLp (av) = 0; 2383 AvFILLp (av) = 0;
2360 ary [0] = newSViv (count); 2384 ary [0] = newSViv (count);
2361 2385
2362 return newRV_noinc ((SV *)av); 2386 return newRV_noinc ((SV *)av);
3098 cv_coro_terminate = get_cv ( "Coro::terminate" , GV_ADD); 3122 cv_coro_terminate = get_cv ( "Coro::terminate" , GV_ADD);
3099 coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current); 3123 coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);
3100 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE); 3124 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
3101 av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE); 3125 av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);
3102 sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE); 3126 sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);
3127 sv_idle = coro_get_sv (aTHX_ "Coro::idle" , TRUE);
3103 3128
3104 sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle); 3129 sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);
3105 sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro); 3130 sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);
3106 cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler); 3131 cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);
3107 cv_coro_state_new = get_cv ("Coro::State::new", 0); SvREADONLY_on (cv_coro_state_new); 3132 cv_coro_state_new = get_cv ("Coro::State::new", 0); SvREADONLY_on (cv_coro_state_new);

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines