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.259 by root, Mon Nov 10 00:02:29 2008 UTC vs.
Revision 1.260 by root, Mon Nov 10 04:37:23 2008 UTC

… …
181static struct CoroAPI coroapi; 181static struct CoroAPI coroapi;
182static AV *main_mainstack; /* used to differentiate between $main and others */ 182static AV *main_mainstack; /* used to differentiate between $main and others */
183static JMPENV *main_top_env; 183static JMPENV *main_top_env;
184static HV *coro_state_stash, *coro_stash; 184static HV *coro_state_stash, *coro_stash;
185static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */ 185static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */
186static volatile char next_has_throw; /* speedup flag for next->throw check */ 186static volatile struct coro *transfer_next;
187
188struct transfer_args
189{
190 struct coro *prev, *next;
191};
187 192
188static GV *irsgv; /* $/ */ 193static GV *irsgv; /* $/ */
189static GV *stdoutgv; /* *STDOUT */ 194static GV *stdoutgv; /* *STDOUT */
190static SV *rv_diehook; 195static SV *rv_diehook;
191static SV *rv_warnhook; 196static SV *rv_warnhook;
… …
835 PL_rs = newSVsv (GvSV (irsgv)); 840 PL_rs = newSVsv (GvSV (irsgv));
836 PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv); 841 PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);
837 842
838 { 843 {
839 dSP; 844 dSP;
840 LOGOP myop; 845 UNOP myop;
841 846
842 Zero (&myop, 1, LOGOP); 847 Zero (&myop, 1, UNOP);
843 myop.op_next = Nullop; 848 myop.op_next = Nullop;
844 myop.op_flags = OPf_WANT_VOID; 849 myop.op_flags = OPf_WANT_VOID;
845 850
846 PUSHMARK (SP); 851 PUSHMARK (SP);
847 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv)))); 852 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv))));
… …
852 } 857 }
853 858
854 /* this newly created coroutine might be run on an existing cctx which most 859 /* this newly created coroutine might be run on an existing cctx which most
855 * likely was suspended in set_stacklevel, called from entersub. 860 * likely was suspended in set_stacklevel, called from entersub.
856 * set_stacklevl doesn't do anything on return, but entersub does LEAVE, 861 * set_stacklevl doesn't do anything on return, but entersub does LEAVE,
857 * so we ENTER here for symmetry 862 * so we ENTER here for symmetry.
858 */ 863 */
859 ENTER; 864 ENTER;
860} 865}
861 866
862static void 867static void
… …
1027 1032
1028 TAINT_NOT; 1033 TAINT_NOT;
1029 return 0; 1034 return 0;
1030} 1035}
1031 1036
1037static void
1038prepare_set_stacklevel (struct transfer_args *ta, struct coro_cctx *cctx)
1039{
1040 ta->prev = (struct coro *)cctx;
1041 ta->next = 0;
1042}
1043
1032/* inject a fake call to Coro::State::_cctx_init into the execution */ 1044/* inject a fake call to Coro::State::_cctx_init into the execution */
1033/* _cctx_init should be careful, as it could be called at almost any time */ 1045/* _cctx_init should be careful, as it could be called at almost any time */
1034/* during execution of a perl program */ 1046/* during execution of a perl program */
1035/* also initialises PL_top_env */ 1047/* also initialises PL_top_env */
1036static void NOINLINE 1048static void NOINLINE
1037cctx_prepare (pTHX_ coro_cctx *cctx) 1049cctx_prepare (pTHX_ coro_cctx *cctx)
1038{ 1050{
1039 dSP; 1051 dSP;
1040 LOGOP myop; 1052 UNOP myop;
1041 1053
1042 PL_top_env = &PL_start_env; 1054 PL_top_env = &PL_start_env;
1043 1055
1044 if (cctx->flags & CC_TRACE) 1056 if (cctx->flags & CC_TRACE)
1045 PL_runops = runops_trace; 1057 PL_runops = runops_trace;
1046 1058
1047 Zero (&myop, 1, LOGOP); 1059 Zero (&myop, 1, UNOP);
1048 myop.op_next = PL_op; 1060 myop.op_next = PL_op;
1049 myop.op_flags = OPf_WANT_VOID | OPf_STACKED; 1061 myop.op_flags = OPf_WANT_VOID | OPf_STACKED;
1050 1062
1051 PUSHMARK (SP); 1063 PUSHMARK (SP);
1052 EXTEND (SP, 2); 1064 EXTEND (SP, 2);
1053 PUSHs (sv_2mortal (newSViv (PTR2IV (cctx)))); 1065 PUSHs (sv_2mortal (newSViv ((IV)cctx)));
1054 PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE)); 1066 PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE));
1055 PUTBACK; 1067 PUTBACK;
1056 PL_op = (OP *)&myop; 1068 PL_op = (OP *)&myop;
1057 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 1069 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
1058 SPAGAIN; 1070 SPAGAIN;
… …
1060 1072
1061/* the tail of transfer: execute stuff we can onyl do afetr a transfer */ 1073/* the tail of transfer: execute stuff we can onyl do afetr a transfer */
1062static void 1074static void
1063transfer_tail (void) 1075transfer_tail (void)
1064{ 1076{
1077 struct coro *next = (struct coro *)transfer_next;
1078 transfer_next = 0; //D for temporary assertion in transfer
1079 assert (("FATAL ERROR: internal error 1067 in Coro module, please report", next));//D
1080
1081 free_coro_mortal (aTHX);
1065 UNLOCK; 1082 UNLOCK;
1066 1083
1067 if (expect_false (next_has_throw)) 1084 if (expect_false (next->throw))
1068 { 1085 {
1069 struct coro *coro = SvSTATE (coro_current);
1070
1071 if (coro->throw)
1072 {
1073 SV *exception = coro->throw; 1086 SV *exception = sv_2mortal (next->throw);
1087
1074 coro->throw = 0; 1088 next->throw = 0;
1075 sv_setsv (ERRSV, exception); 1089 sv_setsv (ERRSV, exception);
1076 croak (0); 1090 croak (0);
1077 }
1078 } 1091 }
1079} 1092}
1080 1093
1081/* 1094/*
1082 * this is a _very_ stripped down perl interpreter ;) 1095 * this is a _very_ stripped down perl interpreter ;)
… …
1090# endif 1103# endif
1091#endif 1104#endif
1092 { 1105 {
1093 dTHX; 1106 dTHX;
1094 1107
1108 /* entersub called ENTER, but we never 'returned', undo that here */
1109 LEAVE;
1110
1095 /* we now skip the entersub that lead to transfer () */ 1111 /* we now skip the entersub that did lead to transfer() */
1096 PL_op = PL_op->op_next; 1112 PL_op = PL_op->op_next;
1097 1113
1098 /* inject a fake subroutine call to cctx_init */ 1114 /* inject a fake subroutine call to cctx_init */
1099 cctx_prepare (aTHX_ (coro_cctx *)arg); 1115 cctx_prepare (aTHX_ (coro_cctx *)arg);
1100 1116
1101 /* cctx_run is the alternative tail of transfer () */ 1117 /* cctx_run is the alternative tail of transfer() */
1102 transfer_tail (); 1118 transfer_tail ();
1103 1119
1104 /* somebody or something will hit me for both perl_run and PL_restartop */ 1120 /* somebody or something will hit me for both perl_run and PL_restartop */
1105 PL_restartop = PL_op; 1121 PL_restartop = PL_op;
1106 perl_run (PL_curinterp); 1122 perl_run (PL_curinterp);
… …
1125 ++cctx_count; 1141 ++cctx_count;
1126 New (0, cctx, 1, coro_cctx); 1142 New (0, cctx, 1, coro_cctx);
1127 1143
1128 cctx->gen = cctx_gen; 1144 cctx->gen = cctx_gen;
1129 cctx->flags = 0; 1145 cctx->flags = 0;
1130 cctx->idle_sp = 0; /* can be accessed by transfer between cctx_run and set_stacklevel */ 1146 cctx->idle_sp = 0; /* can be accessed by transfer between cctx_run and set_stacklevel, on throw */
1131 1147
1132 return cctx; 1148 return cctx;
1133} 1149}
1134 1150
1135/* create a new cctx only suitable as source */ 1151/* create a new cctx only suitable as source */
… …
1321 else 1337 else
1322 load_perl (aTHX_ next); 1338 load_perl (aTHX_ next);
1323 1339
1324 prev__cctx = prev->cctx; 1340 prev__cctx = prev->cctx;
1325 1341
1326 if (prev__cctx->idle_sp == STACKLEVEL) asm volatile("");//D
1327
1328 /* possibly "free" the cctx */ 1342 /* possibly "free" the cctx */
1329 if (expect_true ( 1343 if (expect_true (
1330 prev__cctx->idle_sp == STACKLEVEL 1344 prev__cctx->idle_sp == STACKLEVEL
1331 && !(prev__cctx->flags & CC_TRACE) 1345 && !(prev__cctx->flags & CC_TRACE)
1332 && !force_cctx 1346 && !force_cctx
… …
1349 ++next->usecount; 1363 ++next->usecount;
1350 1364
1351 if (expect_true (!next->cctx)) 1365 if (expect_true (!next->cctx))
1352 next->cctx = cctx_get (aTHX); 1366 next->cctx = cctx_get (aTHX);
1353 1367
1354 next_has_throw = !!next->throw; 1368 assert (("FATAL ERROR: internal error 1352 in Coro, please report", !transfer_next));//D
1369 transfer_next = next;
1355 1370
1356 if (expect_false (prev__cctx != next->cctx)) 1371 if (expect_false (prev__cctx != next->cctx))
1357 { 1372 {
1358 prev__cctx->top_env = PL_top_env; 1373 prev__cctx->top_env = PL_top_env;
1359 PL_top_env = next->cctx->top_env; 1374 PL_top_env = next->cctx->top_env;
1360 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx); 1375 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
1361 } 1376 }
1362 1377
1363 free_coro_mortal (aTHX);
1364 UNLOCK;
1365
1366 transfer_tail (); 1378 transfer_tail ();
1367 } 1379 }
1368} 1380}
1369
1370struct transfer_args
1371{
1372 struct coro *prev, *next;
1373};
1374 1381
1375#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx)) 1382#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))
1376#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next) 1383#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1377 1384
1378/** high level stuff ********************************************************/ 1385/** high level stuff ********************************************************/
… …
1590 /* cannot transfer to destroyed coros, skip and look for next */ 1597 /* cannot transfer to destroyed coros, skip and look for next */
1591 if (expect_false (ta->next->flags & CF_DESTROYED)) 1598 if (expect_false (ta->next->flags & CF_DESTROYED))
1592 { 1599 {
1593 UNLOCK; 1600 UNLOCK;
1594 SvREFCNT_dec (next_sv); 1601 SvREFCNT_dec (next_sv);
1595 /* coro_nready is already taken care of by destroy */ 1602 /* coro_nready has already been taken care of by destroy */
1596 continue; 1603 continue;
1597 } 1604 }
1598 1605
1599 --coro_nready; 1606 --coro_nready;
1600 UNLOCK; 1607 UNLOCK;
… …
1897 1904
1898 PUTBACK; 1905 PUTBACK;
1899 switch (ix) 1906 switch (ix)
1900 { 1907 {
1901 case 0: 1908 case 0:
1902 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0))); 1909 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (ST (0)));
1903 ta.next = 0;
1904 break; 1910 break;
1905 1911
1906 case 1: 1912 case 1:
1907 if (items != 2) 1913 if (items != 2)
1908 croak ("Coro::State::transfer (prev, next) expects two arguments, not %d", items); 1914 croak ("Coro::State::transfer (prev, next) expects two arguments, not %d", items);
… …
2047 is_destroyed = CF_DESTROYED 2053 is_destroyed = CF_DESTROYED
2048 CODE: 2054 CODE:
2049 RETVAL = boolSV (coro->flags & ix); 2055 RETVAL = boolSV (coro->flags & ix);
2050 OUTPUT: 2056 OUTPUT:
2051 RETVAL 2057 RETVAL
2058
2059void
2060throw (Coro::State self, SV *throw = &PL_sv_undef)
2061 PROTOTYPE: $;$
2062 CODE:
2063 SvREFCNT_dec (self->throw);
2064 self->throw = SvOK (throw) ? newSVsv (throw) : 0;
2052 2065
2053void 2066void
2054api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB) 2067api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)
2055 2068
2056SV * 2069SV *
… …
2200 CODE: 2213 CODE:
2201 RETVAL = coro_nready; 2214 RETVAL = coro_nready;
2202 OUTPUT: 2215 OUTPUT:
2203 RETVAL 2216 RETVAL
2204 2217
2205void
2206throw (Coro::State self, SV *throw = &PL_sv_undef)
2207 PROTOTYPE: $;$
2208 CODE:
2209 SvREFCNT_dec (self->throw);
2210 self->throw = SvOK (throw) ? newSVsv (throw) : 0;
2211
2212# for async_pool speedup 2218# for async_pool speedup
2213void 2219void
2214_pool_1 (SV *cb) 2220_pool_1 (SV *cb)
2215 CODE: 2221 CODE:
2216{ 2222{

Diff Legend

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