… | |
… | |
101 | #else |
101 | #else |
102 | # define LOCK (void)0 |
102 | # define LOCK (void)0 |
103 | # define UNLOCK (void)0 |
103 | # define UNLOCK (void)0 |
104 | #endif |
104 | #endif |
105 | |
105 | |
|
|
106 | struct io_state |
|
|
107 | { |
|
|
108 | int errorno; |
|
|
109 | I32 laststype; |
|
|
110 | int laststatval; |
|
|
111 | Stat_t statcache; |
|
|
112 | }; |
|
|
113 | |
106 | static struct CoroAPI coroapi; |
114 | static struct CoroAPI coroapi; |
107 | static AV *main_mainstack; /* used to differentiate between $main and others */ |
115 | static AV *main_mainstack; /* used to differentiate between $main and others */ |
108 | static HV *coro_state_stash, *coro_stash; |
116 | static HV *coro_state_stash, *coro_stash; |
109 | static SV *coro_mortal; /* will be freed after next transfer */ |
117 | static SV *coro_mortal; /* will be freed after next transfer */ |
110 | |
118 | |
… | |
… | |
497 | |
505 | |
498 | { |
506 | { |
499 | dSP; |
507 | dSP; |
500 | LOGOP myop; |
508 | LOGOP myop; |
501 | |
509 | |
502 | /* I have no idea why this is needed, but it is */ |
|
|
503 | PUSHMARK (SP); |
|
|
504 | |
|
|
505 | SvREFCNT_dec (GvAV (PL_defgv)); |
510 | SvREFCNT_dec (GvAV (PL_defgv)); |
506 | GvAV (PL_defgv) = coro->args; coro->args = 0; |
511 | GvAV (PL_defgv) = coro->args; coro->args = 0; |
507 | |
512 | |
508 | Zero (&myop, 1, LOGOP); |
513 | Zero (&myop, 1, LOGOP); |
509 | myop.op_next = Nullop; |
514 | myop.op_next = Nullop; |
510 | myop.op_flags = OPf_WANT_VOID; |
515 | myop.op_flags = OPf_WANT_VOID; |
511 | |
516 | |
512 | PL_op = (OP *)&myop; |
|
|
513 | |
|
|
514 | PUSHMARK (SP); |
517 | PUSHMARK (SP); |
515 | XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE)); |
518 | XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE)); |
516 | PUTBACK; |
519 | PUTBACK; |
|
|
520 | PL_op = (OP *)&myop; |
517 | PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); |
521 | PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); |
518 | SPAGAIN; |
522 | SPAGAIN; |
519 | } |
523 | } |
520 | |
524 | |
521 | ENTER; /* necessary e.g. for dounwind */ |
525 | ENTER; /* necessary e.g. for dounwind */ |
… | |
… | |
529 | SvREFCNT_dec (coro_mortal); |
533 | SvREFCNT_dec (coro_mortal); |
530 | coro_mortal = 0; |
534 | coro_mortal = 0; |
531 | } |
535 | } |
532 | } |
536 | } |
533 | |
537 | |
|
|
538 | /* inject a fake call to Coro::State::_cctx_init into the execution */ |
534 | static void NOINLINE |
539 | static void NOINLINE |
535 | prepare_cctx (coro_cctx *cctx) |
540 | prepare_cctx (coro_cctx *cctx) |
536 | { |
541 | { |
537 | dSP; |
542 | dSP; |
538 | LOGOP myop; |
543 | LOGOP myop; |
539 | |
544 | |
540 | Zero (&myop, 1, LOGOP); |
545 | Zero (&myop, 1, LOGOP); |
541 | myop.op_next = PL_op; |
546 | myop.op_next = PL_op; |
542 | myop.op_flags = OPf_WANT_VOID; |
547 | myop.op_flags = OPf_WANT_VOID | OPf_STACKED; |
543 | |
|
|
544 | sv_setiv (get_sv ("Coro::State::_cctx", FALSE), PTR2IV (cctx)); |
|
|
545 | |
548 | |
546 | PUSHMARK (SP); |
549 | PUSHMARK (SP); |
|
|
550 | EXTEND (SP, 2); |
|
|
551 | PUSHs (sv_2mortal (newSViv (PTR2IV (cctx)))); |
547 | XPUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE)); |
552 | PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE)); |
548 | PUTBACK; |
553 | PUTBACK; |
|
|
554 | PL_op = (OP *)&myop; |
549 | PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX); |
555 | PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); |
550 | SPAGAIN; |
556 | SPAGAIN; |
551 | } |
557 | } |
552 | |
558 | |
553 | static void |
559 | static void |
554 | coro_run (void *arg) |
560 | coro_run (void *arg) |
555 | { |
561 | { |
556 | /* coro_run is the alternative epilogue of transfer() */ |
562 | /* coro_run is the alternative tail of transfer(), so unlock here. */ |
557 | UNLOCK; |
563 | UNLOCK; |
558 | |
564 | |
559 | /* |
565 | /* |
560 | * this is a _very_ stripped down perl interpreter ;) |
566 | * this is a _very_ stripped down perl interpreter ;) |
561 | */ |
567 | */ |
… | |
… | |
563 | |
569 | |
564 | /* inject call to cctx_init */ |
570 | /* inject call to cctx_init */ |
565 | prepare_cctx ((coro_cctx *)arg); |
571 | prepare_cctx ((coro_cctx *)arg); |
566 | |
572 | |
567 | /* somebody will hit me for both perl_run and PL_restartop */ |
573 | /* somebody will hit me for both perl_run and PL_restartop */ |
|
|
574 | PL_restartop = PL_op; |
568 | perl_run (PL_curinterp); |
575 | perl_run (PL_curinterp); |
569 | |
576 | |
570 | fputs ("FATAL: C coroutine fell over the edge of the world, aborting. Did you call exit in a coroutine?\n", stderr); |
577 | fputs ("FATAL: C coroutine fell over the edge of the world, aborting. Did you call exit in a coroutine?\n", stderr); |
571 | abort (); |
578 | abort (); |
572 | } |
579 | } |
… | |
… | |
581 | New (0, cctx, 1, coro_cctx); |
588 | New (0, cctx, 1, coro_cctx); |
582 | |
589 | |
583 | #if HAVE_MMAP |
590 | #if HAVE_MMAP |
584 | |
591 | |
585 | cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; |
592 | cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; |
586 | /* mmap suppsedly does allocate-on-write for us */ |
593 | /* mmap supposedly does allocate-on-write for us */ |
587 | cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); |
594 | cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); |
588 | |
595 | |
589 | if (cctx->sptr == (void *)-1) |
596 | if (cctx->sptr == (void *)-1) |
590 | { |
597 | { |
591 | perror ("FATAL: unable to mmap stack for coroutine"); |
598 | perror ("FATAL: unable to mmap stack for coroutine"); |
… | |
… | |
713 | prev->flags &= ~CF_RUNNING; |
720 | prev->flags &= ~CF_RUNNING; |
714 | next->flags |= CF_RUNNING; |
721 | next->flags |= CF_RUNNING; |
715 | |
722 | |
716 | LOCK; |
723 | LOCK; |
717 | |
724 | |
718 | if (next->mainstack) |
725 | if (next->flags & CF_NEW) |
719 | { |
|
|
720 | /* coroutine already started */ |
|
|
721 | SAVE (prev, flags); |
|
|
722 | LOAD (next); |
|
|
723 | } |
|
|
724 | else |
|
|
725 | { |
726 | { |
726 | /* need to start coroutine */ |
727 | /* need to start coroutine */ |
727 | assert (next->flags & CF_NEW); |
|
|
728 | next->flags &= ~CF_NEW; |
728 | next->flags &= ~CF_NEW; |
729 | /* first get rid of the old state */ |
729 | /* first get rid of the old state */ |
730 | SAVE (prev, -1); |
730 | SAVE (prev, -1); |
731 | /* setup coroutine call */ |
731 | /* setup coroutine call */ |
732 | setup_coro (next); |
732 | setup_coro (next); |
733 | /* need a new stack */ |
733 | /* need a new stack */ |
734 | assert (!next->stack); |
734 | assert (!next->stack); |
735 | } |
735 | } |
|
|
736 | else |
|
|
737 | { |
|
|
738 | /* coroutine already started */ |
|
|
739 | SAVE (prev, flags); |
|
|
740 | LOAD (next); |
|
|
741 | } |
736 | |
742 | |
737 | prev__cctx = prev->cctx; |
743 | prev__cctx = prev->cctx; |
738 | |
744 | |
739 | /* possibly "free" the cctx */ |
745 | /* possibly "free" the cctx */ |
740 | if (prev__cctx->idle_sp == STACKLEVEL && 0) |
746 | if (prev__cctx->idle_sp == STACKLEVEL) |
741 | { |
747 | { |
742 | /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ |
748 | /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ |
743 | assert (PL_top_env == prev__cctx->top_env); |
749 | assert (PL_top_env == prev__cctx->top_env); |
744 | |
750 | |
745 | prev->cctx = 0; |
751 | prev->cctx = 0; |
… | |
… | |
1074 | _set_stacklevel (...) |
1080 | _set_stacklevel (...) |
1075 | ALIAS: |
1081 | ALIAS: |
1076 | Coro::State::transfer = 1 |
1082 | Coro::State::transfer = 1 |
1077 | Coro::schedule = 2 |
1083 | Coro::schedule = 2 |
1078 | Coro::cede = 3 |
1084 | Coro::cede = 3 |
1079 | Coro::Cont::yield = 4 |
|
|
1080 | CODE: |
1085 | CODE: |
1081 | { |
1086 | { |
1082 | struct transfer_args ta; |
1087 | struct transfer_args ta; |
1083 | |
1088 | |
1084 | switch (ix) |
1089 | switch (ix) |
… | |
… | |
1101 | break; |
1106 | break; |
1102 | |
1107 | |
1103 | case 3: |
1108 | case 3: |
1104 | prepare_cede (&ta); |
1109 | prepare_cede (&ta); |
1105 | break; |
1110 | break; |
1106 | |
|
|
1107 | case 4: |
|
|
1108 | { |
|
|
1109 | SV *yieldstack; |
|
|
1110 | SV *sv; |
|
|
1111 | AV *defav = GvAV (PL_defgv); |
|
|
1112 | |
|
|
1113 | yieldstack = *hv_fetch ( |
|
|
1114 | (HV *)SvRV (coro_current), |
|
|
1115 | "yieldstack", sizeof ("yieldstack") - 1, |
|
|
1116 | 0 |
|
|
1117 | ); |
|
|
1118 | |
|
|
1119 | /* set up @_ -- ugly */ |
|
|
1120 | av_clear (defav); |
|
|
1121 | av_fill (defav, items - 1); |
|
|
1122 | while (items--) |
|
|
1123 | av_store (defav, items, SvREFCNT_inc (ST(items))); |
|
|
1124 | |
|
|
1125 | sv = av_pop ((AV *)SvRV (yieldstack)); |
|
|
1126 | ta.prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0)); |
|
|
1127 | ta.next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0)); |
|
|
1128 | ta.flags = 0; |
|
|
1129 | SvREFCNT_dec (sv); |
|
|
1130 | } |
|
|
1131 | break; |
|
|
1132 | |
|
|
1133 | } |
1111 | } |
1134 | |
1112 | |
1135 | TRANSFER (ta); |
1113 | TRANSFER (ta); |
1136 | } |
1114 | } |
1137 | |
1115 | |
… | |
… | |
1260 | |
1238 | |
1261 | SV * |
1239 | SV * |
1262 | _get_state () |
1240 | _get_state () |
1263 | CODE: |
1241 | CODE: |
1264 | { |
1242 | { |
1265 | struct { |
1243 | RETVAL = newSV (sizeof (struct io_state)); |
1266 | int errorno; |
1244 | struct io_state *data = (struct io_state *)SvPVX (RETVAL); |
1267 | int laststype; |
1245 | SvCUR_set (RETVAL, sizeof (struct io_state)); |
1268 | int laststatval; |
1246 | SvPOK_only (RETVAL); |
1269 | Stat_t statcache; |
|
|
1270 | } data; |
|
|
1271 | |
1247 | |
1272 | data.errorno = errno; |
1248 | data->errorno = errno; |
1273 | data.laststype = PL_laststype; |
1249 | data->laststype = PL_laststype; |
1274 | data.laststatval = PL_laststatval; |
1250 | data->laststatval = PL_laststatval; |
1275 | data.statcache = PL_statcache; |
1251 | data->statcache = PL_statcache; |
1276 | |
|
|
1277 | RETVAL = newSVpvn ((char *)&data, sizeof data); |
|
|
1278 | } |
1252 | } |
1279 | OUTPUT: |
1253 | OUTPUT: |
1280 | RETVAL |
1254 | RETVAL |
1281 | |
1255 | |
1282 | void |
1256 | void |
1283 | _set_state (char *data_) |
1257 | _set_state (char *data_) |
1284 | PROTOTYPE: $ |
1258 | PROTOTYPE: $ |
1285 | CODE: |
1259 | CODE: |
1286 | { |
1260 | { |
1287 | struct { |
1261 | struct io_state *data = (void *)data_; |
1288 | int errorno; |
|
|
1289 | int laststype; |
|
|
1290 | int laststatval; |
|
|
1291 | Stat_t statcache; |
|
|
1292 | } *data = (void *)data_; |
|
|
1293 | |
1262 | |
1294 | errno = data->errorno; |
1263 | errno = data->errorno; |
1295 | PL_laststype = data->laststype; |
1264 | PL_laststype = data->laststype; |
1296 | PL_laststatval = data->laststatval; |
1265 | PL_laststatval = data->laststatval; |
1297 | PL_statcache = data->statcache; |
1266 | PL_statcache = data->statcache; |
1298 | } |
1267 | } |
|
|
1268 | |