… | |
… | |
129 | }; |
129 | }; |
130 | |
130 | |
131 | static size_t coro_stacksize = CORO_STACKSIZE; |
131 | static size_t coro_stacksize = CORO_STACKSIZE; |
132 | static struct CoroAPI coroapi; |
132 | static struct CoroAPI coroapi; |
133 | static AV *main_mainstack; /* used to differentiate between $main and others */ |
133 | static AV *main_mainstack; /* used to differentiate between $main and others */ |
|
|
134 | static JMPENV *main_top_env; |
134 | static HV *coro_state_stash, *coro_stash; |
135 | static HV *coro_state_stash, *coro_stash; |
135 | static SV *coro_mortal; /* will be freed after next transfer */ |
136 | static SV *coro_mortal; /* will be freed after next transfer */ |
136 | |
137 | |
137 | static struct coro_cctx *cctx_first; |
138 | static struct coro_cctx *cctx_first; |
138 | static int cctx_count, cctx_idle; |
139 | static int cctx_count, cctx_idle; |
… | |
… | |
177 | |
178 | |
178 | /* optionally saved, might be zero */ |
179 | /* optionally saved, might be zero */ |
179 | AV *defav; /* @_ */ |
180 | AV *defav; /* @_ */ |
180 | SV *defsv; /* $_ */ |
181 | SV *defsv; /* $_ */ |
181 | SV *errsv; /* $@ */ |
182 | SV *errsv; /* $@ */ |
|
|
183 | GV *deffh; /* default filehandle */ |
182 | SV *irssv; /* $/ */ |
184 | SV *irssv; /* $/ */ |
183 | SV *irssv_sv; /* real $/ cache */ |
185 | SV *irssv_sv; /* real $/ cache */ |
184 | |
186 | |
185 | #define VAR(name,type) type name; |
187 | #define VAR(name,type) type name; |
186 | # include "state.h" |
188 | # include "state.h" |
… | |
… | |
341 | #undef VAR |
343 | #undef VAR |
342 | |
344 | |
343 | if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav); |
345 | if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav); |
344 | if (c->defsv) REPLACE_SV (DEFSV , c->defsv); |
346 | if (c->defsv) REPLACE_SV (DEFSV , c->defsv); |
345 | if (c->errsv) REPLACE_SV (ERRSV , c->errsv); |
347 | if (c->errsv) REPLACE_SV (ERRSV , c->errsv); |
|
|
348 | if (c->deffh) REPLACE_SV (PL_defoutgv , c->deffh); |
|
|
349 | |
346 | if (c->irssv) |
350 | if (c->irssv) |
347 | { |
351 | { |
348 | if (c->irssv == PL_rs || sv_eq (PL_rs, c->irssv)) |
352 | if (c->irssv == PL_rs || sv_eq (PL_rs, c->irssv)) |
|
|
353 | { |
349 | SvREFCNT_dec (c->irssv); |
354 | SvREFCNT_dec (c->irssv); |
|
|
355 | c->irssv = 0; |
|
|
356 | } |
350 | else |
357 | else |
351 | { |
358 | { |
352 | REPLACE_SV (PL_rs, c->irssv); |
359 | REPLACE_SV (PL_rs, c->irssv); |
353 | if (!c->irssv_sv) c->irssv_sv = get_sv ("/", 0); |
360 | if (!c->irssv_sv) c->irssv_sv = get_sv ("/", 0); |
354 | sv_setsv (c->irssv_sv, PL_rs); |
361 | sv_setsv (c->irssv_sv, PL_rs); |
… | |
… | |
425 | } |
432 | } |
426 | |
433 | |
427 | c->defav = c->save & CORO_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0; |
434 | c->defav = c->save & CORO_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0; |
428 | c->defsv = c->save & CORO_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0; |
435 | c->defsv = c->save & CORO_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0; |
429 | c->errsv = c->save & CORO_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0; |
436 | c->errsv = c->save & CORO_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0; |
|
|
437 | c->deffh = c->save & CORO_SAVE_DEFFH ? (GV *)SvREFCNT_inc (PL_defoutgv) : 0; |
430 | c->irssv = c->save & CORO_SAVE_IRSSV ? SvREFCNT_inc (PL_rs) : 0; |
438 | c->irssv = c->save & CORO_SAVE_IRSSV ? SvREFCNT_inc (PL_rs) : 0; |
431 | |
439 | |
432 | #define VAR(name,type)c->name = PL_ ## name; |
440 | #define VAR(name,type)c->name = PL_ ## name; |
433 | # include "state.h" |
441 | # include "state.h" |
434 | #undef VAR |
442 | #undef VAR |
… | |
… | |
559 | Zero (&myop, 1, LOGOP); |
567 | Zero (&myop, 1, LOGOP); |
560 | myop.op_next = Nullop; |
568 | myop.op_next = Nullop; |
561 | myop.op_flags = OPf_WANT_VOID; |
569 | myop.op_flags = OPf_WANT_VOID; |
562 | |
570 | |
563 | PUSHMARK (SP); |
571 | PUSHMARK (SP); |
564 | XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE)); |
572 | XPUSHs (av_shift (GvAV (PL_defgv))); |
565 | PUTBACK; |
573 | PUTBACK; |
566 | PL_op = (OP *)&myop; |
574 | PL_op = (OP *)&myop; |
567 | PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); |
575 | PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); |
568 | SPAGAIN; |
576 | SPAGAIN; |
569 | } |
577 | } |
… | |
… | |
580 | coro_mortal = 0; |
588 | coro_mortal = 0; |
581 | } |
589 | } |
582 | } |
590 | } |
583 | |
591 | |
584 | /* inject a fake call to Coro::State::_cctx_init into the execution */ |
592 | /* inject a fake call to Coro::State::_cctx_init into the execution */ |
|
|
593 | /* _cctx_init shoukld be careful, as it could be called at almost any time */ |
|
|
594 | /* during execution of a pelr program */ |
585 | static void NOINLINE |
595 | static void NOINLINE |
586 | prepare_cctx (pTHX_ coro_cctx *cctx) |
596 | prepare_cctx (pTHX_ coro_cctx *cctx) |
587 | { |
597 | { |
588 | dSP; |
598 | dSP; |
589 | LOGOP myop; |
599 | LOGOP myop; |
… | |
… | |
600 | PL_op = (OP *)&myop; |
610 | PL_op = (OP *)&myop; |
601 | PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); |
611 | PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); |
602 | SPAGAIN; |
612 | SPAGAIN; |
603 | } |
613 | } |
604 | |
614 | |
|
|
615 | /* |
|
|
616 | * this is a _very_ stripped down perl interpreter ;) |
|
|
617 | */ |
605 | static void |
618 | static void |
606 | coro_run (void *arg) |
619 | coro_run (void *arg) |
607 | { |
620 | { |
608 | dTHX; |
621 | dTHX; |
609 | |
622 | |
610 | /* coro_run is the alternative tail of transfer(), so unlock here. */ |
623 | /* coro_run is the alternative tail of transfer(), so unlock here. */ |
611 | UNLOCK; |
624 | UNLOCK; |
612 | |
625 | |
613 | /* |
|
|
614 | * this is a _very_ stripped down perl interpreter ;) |
|
|
615 | */ |
|
|
616 | PL_top_env = &PL_start_env; |
626 | PL_top_env = &PL_start_env; |
617 | |
627 | |
618 | /* inject call to cctx_init */ |
628 | /* inject a fake subroutine call to cctx_init */ |
619 | prepare_cctx (aTHX_ (coro_cctx *)arg); |
629 | prepare_cctx (aTHX_ (coro_cctx *)arg); |
620 | |
630 | |
621 | /* somebody will hit me for both perl_run and PL_restartop */ |
631 | /* somebody or something will hit me for both perl_run and PL_restartop */ |
622 | PL_restartop = PL_op; |
632 | PL_restartop = PL_op; |
623 | perl_run (PL_curinterp); |
633 | perl_run (PL_curinterp); |
624 | |
634 | |
625 | fputs ("FATAL: C coroutine fell over the edge of the world, aborting. Did you call exit in a coroutine?\n", stderr); |
635 | /* |
626 | abort (); |
636 | * If perl-run returns we assume exit() was being called or the coro |
|
|
637 | * fell off the end, which seems to be the only valid (non-bug) |
|
|
638 | * reason for perl_run to return. We try to exit by jumping to the |
|
|
639 | * bootstrap-time "top" top_env, as we cannot restore the "main" |
|
|
640 | * coroutine as Coro has no such concept |
|
|
641 | */ |
|
|
642 | PL_top_env = main_top_env; |
|
|
643 | JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */ |
627 | } |
644 | } |
628 | |
645 | |
629 | static coro_cctx * |
646 | static coro_cctx * |
630 | cctx_new () |
647 | cctx_new () |
631 | { |
648 | { |
… | |
… | |
860 | struct coro temp; |
877 | struct coro temp; |
861 | |
878 | |
862 | assert (!(coro->flags & CF_RUNNING)); |
879 | assert (!(coro->flags & CF_RUNNING)); |
863 | |
880 | |
864 | Zero (&temp, 1, struct coro); |
881 | Zero (&temp, 1, struct coro); |
865 | temp.save = CORO_SAVE_ALL; |
882 | temp.save = CORO_SAVE_DEF; |
866 | |
883 | |
867 | if (coro->flags & CF_RUNNING) |
884 | if (coro->flags & CF_RUNNING) |
868 | croak ("FATAL: tried to destroy currently running coroutine"); |
885 | croak ("FATAL: tried to destroy currently running coroutine"); |
869 | |
886 | |
870 | save_perl (aTHX_ &temp); |
887 | save_perl (aTHX_ &temp); |
… | |
… | |
1163 | |
1180 | |
1164 | newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (CORO_SAVE_DEFAV)); |
1181 | newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (CORO_SAVE_DEFAV)); |
1165 | newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (CORO_SAVE_DEFSV)); |
1182 | newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (CORO_SAVE_DEFSV)); |
1166 | newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (CORO_SAVE_ERRSV)); |
1183 | newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (CORO_SAVE_ERRSV)); |
1167 | newCONSTSUB (coro_state_stash, "SAVE_IRSSV", newSViv (CORO_SAVE_IRSSV)); |
1184 | newCONSTSUB (coro_state_stash, "SAVE_IRSSV", newSViv (CORO_SAVE_IRSSV)); |
|
|
1185 | newCONSTSUB (coro_state_stash, "SAVE_DEFFH", newSViv (CORO_SAVE_DEFFH)); |
|
|
1186 | newCONSTSUB (coro_state_stash, "SAVE_DEF", newSViv (CORO_SAVE_DEF)); |
1168 | newCONSTSUB (coro_state_stash, "SAVE_ALL", newSViv (CORO_SAVE_ALL)); |
1187 | newCONSTSUB (coro_state_stash, "SAVE_ALL", newSViv (CORO_SAVE_ALL)); |
1169 | |
1188 | |
1170 | main_mainstack = PL_mainstack; |
1189 | main_mainstack = PL_mainstack; |
|
|
1190 | main_top_env = PL_top_env; |
|
|
1191 | |
|
|
1192 | while (main_top_env->je_prev) |
|
|
1193 | main_top_env = main_top_env->je_prev; |
1171 | |
1194 | |
1172 | coroapi.ver = CORO_API_VERSION; |
1195 | coroapi.ver = CORO_API_VERSION; |
1173 | coroapi.transfer = api_transfer; |
1196 | coroapi.transfer = api_transfer; |
1174 | |
1197 | |
1175 | assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL)); |
1198 | assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL)); |
… | |
… | |
1183 | HV *hv; |
1206 | HV *hv; |
1184 | int i; |
1207 | int i; |
1185 | |
1208 | |
1186 | Newz (0, coro, 1, struct coro); |
1209 | Newz (0, coro, 1, struct coro); |
1187 | coro->args = newAV (); |
1210 | coro->args = newAV (); |
1188 | coro->save = CORO_SAVE_ALL; |
1211 | coro->save = CORO_SAVE_DEF; |
1189 | coro->flags = CF_NEW; |
1212 | coro->flags = CF_NEW; |
1190 | |
1213 | |
1191 | hv = newHV (); |
1214 | hv = newHV (); |
1192 | sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; |
1215 | sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; |
1193 | RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); |
1216 | RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); |
… | |
… | |
1200 | |
1223 | |
1201 | int |
1224 | int |
1202 | save (SV *coro, int new_save = -1) |
1225 | save (SV *coro, int new_save = -1) |
1203 | CODE: |
1226 | CODE: |
1204 | RETVAL = api_save (coro, new_save); |
1227 | RETVAL = api_save (coro, new_save); |
|
|
1228 | OUTPUT: |
|
|
1229 | RETVAL |
|
|
1230 | |
|
|
1231 | int |
|
|
1232 | save_also (SV *coro_sv, int save_also) |
|
|
1233 | CODE: |
|
|
1234 | { |
|
|
1235 | struct coro *coro = SvSTATE (coro_sv); |
|
|
1236 | RETVAL = coro->save; |
|
|
1237 | coro->save |= save_also; |
|
|
1238 | } |
1205 | OUTPUT: |
1239 | OUTPUT: |
1206 | RETVAL |
1240 | RETVAL |
1207 | |
1241 | |
1208 | void |
1242 | void |
1209 | _set_stacklevel (...) |
1243 | _set_stacklevel (...) |