… | |
… | |
181 | static struct CoroAPI coroapi; |
181 | static struct CoroAPI coroapi; |
182 | static AV *main_mainstack; /* used to differentiate between $main and others */ |
182 | static AV *main_mainstack; /* used to differentiate between $main and others */ |
183 | static JMPENV *main_top_env; |
183 | static JMPENV *main_top_env; |
184 | static HV *coro_state_stash, *coro_stash; |
184 | static HV *coro_state_stash, *coro_stash; |
185 | static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */ |
185 | static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */ |
|
|
186 | static volatile char next_has_throw; /* speedup flag for next->throw check */ |
186 | |
187 | |
187 | static GV *irsgv; /* $/ */ |
188 | static GV *irsgv; /* $/ */ |
188 | static GV *stdoutgv; /* *STDOUT */ |
189 | static GV *stdoutgv; /* *STDOUT */ |
189 | static SV *rv_diehook; |
190 | static SV *rv_diehook; |
190 | static SV *rv_warnhook; |
191 | static 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 */ |
1034 | static void NOINLINE |
1036 | static void NOINLINE |
1035 | cctx_prepare (pTHX_ coro_cctx *cctx) |
1037 | cctx_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 */ |
|
|
1062 | static void |
|
|
1063 | transfer_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 | */ |
1062 | static void |
1084 | static void |
1063 | cctx_run (void *arg) |
1085 | cctx_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 */ |
1113 | static coro_cctx * |
1136 | static coro_cctx * |
1114 | cctx_new_empty () |
1137 | cctx_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 | |
1358 | struct transfer_args |
1370 | struct transfer_args |
1359 | { |
1371 | { |