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.259 by root, Mon Nov 10 00:02:29 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 */
186 187
187static GV *irsgv; /* $/ */ 188static GV *irsgv; /* $/ */
188static GV *stdoutgv; /* *STDOUT */ 189static GV *stdoutgv; /* *STDOUT */
189static SV *rv_diehook; 190static SV *rv_diehook;
190static SV *rv_warnhook; 191static SV *rv_warnhook;
1029} 1030}
1030 1031
1031/* inject a fake call to Coro::State::_cctx_init into the execution */ 1032/* 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 */ 1033/* _cctx_init should be careful, as it could be called at almost any time */
1033/* during execution of a perl program */ 1034/* during execution of a perl program */
1035/* also initialises PL_top_env */
1034static void NOINLINE 1036static void NOINLINE
1035cctx_prepare (pTHX_ coro_cctx *cctx) 1037cctx_prepare (pTHX_ coro_cctx *cctx)
1036{ 1038{
1037 dSP; 1039 dSP;
1038 LOGOP myop; 1040 LOGOP myop;
1054 PL_op = (OP *)&myop; 1056 PL_op = (OP *)&myop;
1055 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 1057 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
1056 SPAGAIN; 1058 SPAGAIN;
1057} 1059}
1058 1060
1061/* the tail of transfer: execute stuff we can onyl do afetr a transfer */
1062static void
1063transfer_tail (void)
1064{
1065 UNLOCK;
1066
1067 if (expect_false (next_has_throw))
1068 {
1069 struct coro *coro = SvSTATE (coro_current);
1070
1071 if (coro->throw)
1072 {
1073 SV *exception = coro->throw;
1074 coro->throw = 0;
1075 sv_setsv (ERRSV, exception);
1076 croak (0);
1077 }
1078 }
1079}
1080
1059/* 1081/*
1060 * this is a _very_ stripped down perl interpreter ;) 1082 * this is a _very_ stripped down perl interpreter ;)
1061 */ 1083 */
1062static void 1084static void
1063cctx_run (void *arg) 1085cctx_run (void *arg)
1068# endif 1090# endif
1069#endif 1091#endif
1070 { 1092 {
1071 dTHX; 1093 dTHX;
1072 1094
1073 /* cctx_run is the alternative tail of transfer(), so unlock here. */
1074 UNLOCK;
1075
1076 /* we now skip the entersub that lead to transfer() */ 1095 /* we now skip the entersub that lead to transfer () */
1077 PL_op = PL_op->op_next; 1096 PL_op = PL_op->op_next;
1078 1097
1079 /* inject a fake subroutine call to cctx_init */ 1098 /* inject a fake subroutine call to cctx_init */
1080 cctx_prepare (aTHX_ (coro_cctx *)arg); 1099 cctx_prepare (aTHX_ (coro_cctx *)arg);
1100
1101 /* cctx_run is the alternative tail of transfer () */
1102 transfer_tail ();
1081 1103
1082 /* somebody or something will hit me for both perl_run and PL_restartop */ 1104 /* somebody or something will hit me for both perl_run and PL_restartop */
1083 PL_restartop = PL_op; 1105 PL_restartop = PL_op;
1084 perl_run (PL_curinterp); 1106 perl_run (PL_curinterp);
1085 1107
1101 coro_cctx *cctx; 1123 coro_cctx *cctx;
1102 1124
1103 ++cctx_count; 1125 ++cctx_count;
1104 New (0, cctx, 1, coro_cctx); 1126 New (0, cctx, 1, coro_cctx);
1105 1127
1106 cctx->gen = cctx_gen; 1128 cctx->gen = cctx_gen;
1107 cctx->flags = 0; 1129 cctx->flags = 0;
1130 cctx->idle_sp = 0; /* can be accessed by transfer between cctx_run and set_stacklevel */
1108 1131
1109 return cctx; 1132 return cctx;
1110} 1133}
1111 1134
1112/* create a new cctx only suitable as source */ 1135/* create a new cctx only suitable as source */
1113static coro_cctx * 1136static coro_cctx *
1114cctx_new_empty () 1137cctx_new_empty ()
1115{ 1138{
1116 coro_cctx *cctx = cctx_new (); 1139 coro_cctx *cctx = cctx_new ();
1117 1140
1118 cctx->sptr = 0; 1141 cctx->sptr = 0;
1119 cctx->idle_sp = 0; /* should never be a valid address */
1120 coro_create (&cctx->cctx, 0, 0, 0, 0); 1142 coro_create (&cctx->cctx, 0, 0, 0, 0);
1121 1143
1122 return cctx; 1144 return cctx;
1123} 1145}
1124 1146
1269 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 1291 ((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 */ 1292 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1271 } 1293 }
1272 else if (expect_true (prev != next)) 1294 else if (expect_true (prev != next))
1273 { 1295 {
1274 static volatile int has_throw;
1275 coro_cctx *prev__cctx; 1296 coro_cctx *prev__cctx;
1276 1297
1277 if (expect_false (prev->flags & CF_NEW)) 1298 if (expect_false (prev->flags & CF_NEW))
1278 { 1299 {
1279 /* create a new empty/source context */ 1300 /* create a new empty/source context */
1300 else 1321 else
1301 load_perl (aTHX_ next); 1322 load_perl (aTHX_ next);
1302 1323
1303 prev__cctx = prev->cctx; 1324 prev__cctx = prev->cctx;
1304 1325
1326 if (prev__cctx->idle_sp == STACKLEVEL) asm volatile("");//D
1327
1305 /* possibly "free" the cctx */ 1328 /* possibly "free" the cctx */
1306 if (expect_true ( 1329 if (expect_true (
1307 prev__cctx->idle_sp == STACKLEVEL 1330 prev__cctx->idle_sp == STACKLEVEL
1308 && !(prev__cctx->flags & CC_TRACE) 1331 && !(prev__cctx->flags & CC_TRACE)
1309 && !force_cctx 1332 && !force_cctx
1326 ++next->usecount; 1349 ++next->usecount;
1327 1350
1328 if (expect_true (!next->cctx)) 1351 if (expect_true (!next->cctx))
1329 next->cctx = cctx_get (aTHX); 1352 next->cctx = cctx_get (aTHX);
1330 1353
1331 has_throw = !!next->throw; 1354 next_has_throw = !!next->throw;
1332 1355
1333 if (expect_false (prev__cctx != next->cctx)) 1356 if (expect_false (prev__cctx != next->cctx))
1334 { 1357 {
1335 prev__cctx->top_env = PL_top_env; 1358 prev__cctx->top_env = PL_top_env;
1336 PL_top_env = next->cctx->top_env; 1359 PL_top_env = next->cctx->top_env;
1338 } 1361 }
1339 1362
1340 free_coro_mortal (aTHX); 1363 free_coro_mortal (aTHX);
1341 UNLOCK; 1364 UNLOCK;
1342 1365
1343 if (expect_false (has_throw)) 1366 transfer_tail ();
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 } 1367 }
1356} 1368}
1357 1369
1358struct transfer_args 1370struct transfer_args
1359{ 1371{

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines