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.258 by root, Sun Nov 9 23:08:49 2008 UTC vs.
Revision 1.262 by root, Mon Nov 10 20:38:19 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 struct coro *transfer_next;
187
188struct transfer_args
189{
190 struct coro *prev, *next;
191};
186 192
187static GV *irsgv; /* $/ */ 193static GV *irsgv; /* $/ */
188static GV *stdoutgv; /* *STDOUT */ 194static GV *stdoutgv; /* *STDOUT */
189static SV *rv_diehook; 195static SV *rv_diehook;
190static SV *rv_warnhook; 196static SV *rv_warnhook;
… …
834 PL_rs = newSVsv (GvSV (irsgv)); 840 PL_rs = newSVsv (GvSV (irsgv));
835 PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv); 841 PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);
836 842
837 { 843 {
838 dSP; 844 dSP;
839 LOGOP myop; 845 UNOP myop;
840 846
841 Zero (&myop, 1, LOGOP); 847 Zero (&myop, 1, UNOP);
842 myop.op_next = Nullop; 848 myop.op_next = Nullop;
843 myop.op_flags = OPf_WANT_VOID; 849 myop.op_flags = OPf_WANT_VOID;
844 850
845 PUSHMARK (SP); 851 PUSHMARK (SP);
846 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv)))); 852 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv))));
… …
850 SPAGAIN; 856 SPAGAIN;
851 } 857 }
852 858
853 /* 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
854 * likely was suspended in set_stacklevel, called from entersub. 860 * likely was suspended in set_stacklevel, called from entersub.
855 * set_stacklevl doesn't do anything on return, but entersub does LEAVE, 861 * set_stacklevel doesn't do anything on return, but entersub does LEAVE,
856 * so we ENTER here for symmetry 862 * so we ENTER here for symmetry.
857 */ 863 */
858 ENTER; 864 ENTER;
859} 865}
860 866
861static void 867static void
… …
1026 1032
1027 TAINT_NOT; 1033 TAINT_NOT;
1028 return 0; 1034 return 0;
1029} 1035}
1030 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
1031/* 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 */
1032/* _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 */
1033/* during execution of a perl program */ 1046/* during execution of a perl program */
1047/* also initialises PL_top_env */
1034static void NOINLINE 1048static void NOINLINE
1035cctx_prepare (pTHX_ coro_cctx *cctx) 1049cctx_prepare (pTHX_ coro_cctx *cctx)
1036{ 1050{
1037 dSP; 1051 dSP;
1038 LOGOP myop; 1052 UNOP myop;
1039 1053
1040 PL_top_env = &PL_start_env; 1054 PL_top_env = &PL_start_env;
1041 1055
1042 if (cctx->flags & CC_TRACE) 1056 if (cctx->flags & CC_TRACE)
1043 PL_runops = runops_trace; 1057 PL_runops = runops_trace;
1044 1058
1045 Zero (&myop, 1, LOGOP); 1059 Zero (&myop, 1, UNOP);
1046 myop.op_next = PL_op; 1060 myop.op_next = PL_op;
1047 myop.op_flags = OPf_WANT_VOID | OPf_STACKED; 1061 myop.op_flags = OPf_WANT_VOID | OPf_STACKED;
1048 1062
1049 PUSHMARK (SP); 1063 PUSHMARK (SP);
1050 EXTEND (SP, 2); 1064 EXTEND (SP, 2);
1051 PUSHs (sv_2mortal (newSViv (PTR2IV (cctx)))); 1065 PUSHs (sv_2mortal (newSViv ((IV)cctx)));
1052 PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE)); 1066 PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE));
1053 PUTBACK; 1067 PUTBACK;
1054 PL_op = (OP *)&myop; 1068 PL_op = (OP *)&myop;
1055 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 1069 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
1056 SPAGAIN; 1070 SPAGAIN;
1057} 1071}
1058 1072
1073/* the tail of transfer: execute stuff we can only do after a transfer */
1074static void
1075transfer_tail (pTHX)
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);
1082 UNLOCK;
1083
1084 if (expect_false (next->throw))
1085 {
1086 SV *exception = sv_2mortal (next->throw);
1087
1088 next->throw = 0;
1089 sv_setsv (ERRSV, exception);
1090 croak (0);
1091 }
1092}
1093
1059/* 1094/*
1060 * this is a _very_ stripped down perl interpreter ;) 1095 * this is a _very_ stripped down perl interpreter ;)
1061 */ 1096 */
1062static void 1097static void
1063cctx_run (void *arg) 1098cctx_run (void *arg)
… …
1068# endif 1103# endif
1069#endif 1104#endif
1070 { 1105 {
1071 dTHX; 1106 dTHX;
1072 1107
1073 /* cctx_run is the alternative tail of transfer(), so unlock here. */ 1108 /* entersub called ENTER, but we never 'returned', undo that here */
1074 UNLOCK; 1109 LEAVE;
1075 1110
1076 /* we now skip the entersub that lead to transfer() */ 1111 /* we now skip the entersub that did lead to transfer() */
1077 PL_op = PL_op->op_next; 1112 PL_op = PL_op->op_next;
1078 1113
1079 /* inject a fake subroutine call to cctx_init */ 1114 /* inject a fake subroutine call to cctx_init */
1080 cctx_prepare (aTHX_ (coro_cctx *)arg); 1115 cctx_prepare (aTHX_ (coro_cctx *)arg);
1116
1117 /* cctx_run is the alternative tail of transfer() */
1118 transfer_tail (aTHX);
1081 1119
1082 /* 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 */
1083 PL_restartop = PL_op; 1121 PL_restartop = PL_op;
1084 perl_run (PL_curinterp); 1122 perl_run (PL_curinterp);
1085 1123
… …
1101 coro_cctx *cctx; 1139 coro_cctx *cctx;
1102 1140
1103 ++cctx_count; 1141 ++cctx_count;
1104 New (0, cctx, 1, coro_cctx); 1142 New (0, cctx, 1, coro_cctx);
1105 1143
1106 cctx->gen = cctx_gen; 1144 cctx->gen = cctx_gen;
1107 cctx->flags = 0; 1145 cctx->flags = 0;
1146 cctx->idle_sp = 0; /* can be accessed by transfer between cctx_run and set_stacklevel, on throw */
1108 1147
1109 return cctx; 1148 return cctx;
1110} 1149}
1111 1150
1112/* create a new cctx only suitable as source */ 1151/* create a new cctx only suitable as source */
1113static coro_cctx * 1152static coro_cctx *
1114cctx_new_empty () 1153cctx_new_empty ()
1115{ 1154{
1116 coro_cctx *cctx = cctx_new (); 1155 coro_cctx *cctx = cctx_new ();
1117 1156
1118 cctx->sptr = 0; 1157 cctx->sptr = 0;
1119 cctx->idle_sp = 0; /* should never be a valid address */
1120 coro_create (&cctx->cctx, 0, 0, 0, 0); 1158 coro_create (&cctx->cctx, 0, 0, 0, 0);
1121 1159
1122 return cctx; 1160 return cctx;
1123} 1161}
1124 1162
… …
1269 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 1307 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
1270 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */ 1308 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1271 } 1309 }
1272 else if (expect_true (prev != next)) 1310 else if (expect_true (prev != next))
1273 { 1311 {
1274 static volatile int has_throw;
1275 coro_cctx *prev__cctx; 1312 coro_cctx *prev__cctx;
1276 1313
1277 if (expect_false (prev->flags & CF_NEW)) 1314 if (expect_false (prev->flags & CF_NEW))
1278 { 1315 {
1279 /* create a new empty/source context */ 1316 /* create a new empty/source context */
… …
1300 else 1337 else
1301 load_perl (aTHX_ next); 1338 load_perl (aTHX_ next);
1302 1339
1303 prev__cctx = prev->cctx; 1340 prev__cctx = prev->cctx;
1304 1341
1305 /* possibly "free" the cctx */ 1342 /* possibly untie and reuse the cctx */
1306 if (expect_true ( 1343 if (expect_true (
1307 prev__cctx->idle_sp == STACKLEVEL 1344 prev__cctx->idle_sp == STACKLEVEL
1308 && !(prev__cctx->flags & CC_TRACE) 1345 && !(prev__cctx->flags & CC_TRACE)
1309 && !force_cctx 1346 && !force_cctx
1310 )) 1347 ))
… …
1326 ++next->usecount; 1363 ++next->usecount;
1327 1364
1328 if (expect_true (!next->cctx)) 1365 if (expect_true (!next->cctx))
1329 next->cctx = cctx_get (aTHX); 1366 next->cctx = cctx_get (aTHX);
1330 1367
1331 has_throw = !!next->throw; 1368 assert (("FATAL ERROR: internal error 1352 in Coro, please report", !transfer_next));//D
1369 transfer_next = next;
1332 1370
1333 if (expect_false (prev__cctx != next->cctx)) 1371 if (expect_false (prev__cctx != next->cctx))
1334 { 1372 {
1335 prev__cctx->top_env = PL_top_env; 1373 prev__cctx->top_env = PL_top_env;
1336 PL_top_env = next->cctx->top_env; 1374 PL_top_env = next->cctx->top_env;
1337 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx); 1375 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
1338 } 1376 }
1339 1377
1340 free_coro_mortal (aTHX); 1378 transfer_tail (aTHX);
1341 UNLOCK;
1342
1343 if (expect_false (has_throw))
1344 {
1345 struct coro *coro = SvSTATE (coro_current);
1346
1347 if (coro->throw)
1348 {
1349 SV *exception = coro->throw;
1350 coro->throw = 0;
1351 sv_setsv (ERRSV, exception);
1352 croak (0);
1353 }
1354 }
1355 } 1379 }
1356} 1380}
1357
1358struct transfer_args
1359{
1360 struct coro *prev, *next;
1361};
1362 1381
1363#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))
1364#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next) 1383#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1365 1384
1366/** high level stuff ********************************************************/ 1385/** high level stuff ********************************************************/
… …
1578 /* cannot transfer to destroyed coros, skip and look for next */ 1597 /* cannot transfer to destroyed coros, skip and look for next */
1579 if (expect_false (ta->next->flags & CF_DESTROYED)) 1598 if (expect_false (ta->next->flags & CF_DESTROYED))
1580 { 1599 {
1581 UNLOCK; 1600 UNLOCK;
1582 SvREFCNT_dec (next_sv); 1601 SvREFCNT_dec (next_sv);
1583 /* coro_nready is already taken care of by destroy */ 1602 /* coro_nready has already been taken care of by destroy */
1584 continue; 1603 continue;
1585 } 1604 }
1586 1605
1587 --coro_nready; 1606 --coro_nready;
1588 UNLOCK; 1607 UNLOCK;
… …
1885 1904
1886 PUTBACK; 1905 PUTBACK;
1887 switch (ix) 1906 switch (ix)
1888 { 1907 {
1889 case 0: 1908 case 0:
1890 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0))); 1909 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (ST (0)));
1891 ta.next = 0;
1892 break; 1910 break;
1893 1911
1894 case 1: 1912 case 1:
1895 if (items != 2) 1913 if (items != 2)
1896 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);
… …
2035 is_destroyed = CF_DESTROYED 2053 is_destroyed = CF_DESTROYED
2036 CODE: 2054 CODE:
2037 RETVAL = boolSV (coro->flags & ix); 2055 RETVAL = boolSV (coro->flags & ix);
2038 OUTPUT: 2056 OUTPUT:
2039 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;
2040 2065
2041void 2066void
2042api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB) 2067api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)
2043 2068
2044SV * 2069SV *
… …
2188 CODE: 2213 CODE:
2189 RETVAL = coro_nready; 2214 RETVAL = coro_nready;
2190 OUTPUT: 2215 OUTPUT:
2191 RETVAL 2216 RETVAL
2192 2217
2193void
2194throw (Coro::State self, SV *throw = &PL_sv_undef)
2195 PROTOTYPE: $;$
2196 CODE:
2197 SvREFCNT_dec (self->throw);
2198 self->throw = SvOK (throw) ? newSVsv (throw) : 0;
2199
2200# for async_pool speedup 2218# for async_pool speedup
2201void 2219void
2202_pool_1 (SV *cb) 2220_pool_1 (SV *cb)
2203 CODE: 2221 CODE:
2204{ 2222{

Diff Legend

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