… | |
… | |
188 | # include "state.h" |
188 | # include "state.h" |
189 | #undef VAR |
189 | #undef VAR |
190 | |
190 | |
191 | /* coro process data */ |
191 | /* coro process data */ |
192 | int prio; |
192 | int prio; |
|
|
193 | |
|
|
194 | /* linked list */ |
|
|
195 | struct coro *next, *prev; |
|
|
196 | HV *hv; /* the perl hash associated with this coro, if any */ |
193 | }; |
197 | }; |
194 | |
198 | |
195 | typedef struct coro *Coro__State; |
199 | typedef struct coro *Coro__State; |
196 | typedef struct coro *Coro__State_or_hashref; |
200 | typedef struct coro *Coro__State_or_hashref; |
197 | |
201 | |
… | |
… | |
206 | |
210 | |
207 | /* for Coro.pm */ |
211 | /* for Coro.pm */ |
208 | static SV *coro_current; |
212 | static SV *coro_current; |
209 | static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; |
213 | static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; |
210 | static int coro_nready; |
214 | static int coro_nready; |
|
|
215 | static struct coro *first; |
211 | |
216 | |
212 | /** lowlevel stuff **********************************************************/ |
217 | /** lowlevel stuff **********************************************************/ |
213 | |
218 | |
214 | static AV * |
219 | static AV * |
215 | coro_clone_padlist (pTHX_ CV *cv) |
220 | coro_clone_padlist (pTHX_ CV *cv) |
… | |
… | |
374 | CvPADLIST (cv) = (AV *)POPs; |
379 | CvPADLIST (cv) = (AV *)POPs; |
375 | } |
380 | } |
376 | |
381 | |
377 | PUTBACK; |
382 | PUTBACK; |
378 | } |
383 | } |
379 | assert (!PL_comppad || AvARRAY (PL_comppad));//D |
|
|
380 | } |
384 | } |
381 | |
385 | |
382 | static void |
386 | static void |
383 | save_perl (pTHX_ Coro__State c) |
387 | save_perl (pTHX_ Coro__State c) |
384 | { |
388 | { |
385 | assert (!PL_comppad || AvARRAY (PL_comppad));//D |
|
|
386 | { |
389 | { |
387 | dSP; |
390 | dSP; |
388 | I32 cxix = cxstack_ix; |
391 | I32 cxix = cxstack_ix; |
389 | PERL_CONTEXT *ccstk = cxstack; |
392 | PERL_CONTEXT *ccstk = cxstack; |
390 | PERL_SI *top_si = PL_curstackinfo; |
393 | PERL_SI *top_si = PL_curstackinfo; |
… | |
… | |
401 | { |
404 | { |
402 | while (cxix >= 0) |
405 | while (cxix >= 0) |
403 | { |
406 | { |
404 | PERL_CONTEXT *cx = &ccstk[cxix--]; |
407 | PERL_CONTEXT *cx = &ccstk[cxix--]; |
405 | |
408 | |
406 | if (CxTYPE (cx) == CXt_SUB) |
409 | if (CxTYPE (cx) == CXt_SUB || CxTYPE (cx) == CXt_FORMAT) |
407 | { |
410 | { |
408 | CV *cv = cx->blk_sub.cv; |
411 | CV *cv = cx->blk_sub.cv; |
409 | |
412 | |
410 | if (CvDEPTH (cv)) |
413 | if (CvDEPTH (cv)) |
411 | { |
414 | { |
… | |
… | |
877 | struct coro temp; |
880 | struct coro temp; |
878 | |
881 | |
879 | assert (!(coro->flags & CF_RUNNING)); |
882 | assert (!(coro->flags & CF_RUNNING)); |
880 | |
883 | |
881 | Zero (&temp, 1, struct coro); |
884 | Zero (&temp, 1, struct coro); |
882 | temp.save = CORO_SAVE_DEF; |
885 | temp.save = CORO_SAVE_ALL; |
883 | |
886 | |
884 | if (coro->flags & CF_RUNNING) |
887 | if (coro->flags & CF_RUNNING) |
885 | croak ("FATAL: tried to destroy currently running coroutine"); |
888 | croak ("FATAL: tried to destroy currently running coroutine"); |
886 | |
889 | |
887 | save_perl (aTHX_ &temp); |
890 | save_perl (aTHX_ &temp); |
… | |
… | |
895 | } |
898 | } |
896 | |
899 | |
897 | cctx_destroy (coro->cctx); |
900 | cctx_destroy (coro->cctx); |
898 | SvREFCNT_dec (coro->args); |
901 | SvREFCNT_dec (coro->args); |
899 | |
902 | |
|
|
903 | if (coro->next) coro->next->prev = coro->prev; |
|
|
904 | if (coro->prev) coro->prev->next = coro->next; |
|
|
905 | if (coro == first) first = coro->next; |
|
|
906 | |
900 | return 1; |
907 | return 1; |
901 | } |
908 | } |
902 | |
909 | |
903 | static int |
910 | static int |
904 | coro_state_free (pTHX_ SV *sv, MAGIC *mg) |
911 | coro_state_free (pTHX_ SV *sv, MAGIC *mg) |
905 | { |
912 | { |
906 | struct coro *coro = (struct coro *)mg->mg_ptr; |
913 | struct coro *coro = (struct coro *)mg->mg_ptr; |
907 | mg->mg_ptr = 0; |
914 | mg->mg_ptr = 0; |
|
|
915 | |
|
|
916 | coro->hv = 0; |
908 | |
917 | |
909 | if (--coro->refcnt < 0) |
918 | if (--coro->refcnt < 0) |
910 | { |
919 | { |
911 | coro_state_destroy (aTHX_ coro); |
920 | coro_state_destroy (aTHX_ coro); |
912 | Safefree (coro); |
921 | Safefree (coro); |
… | |
… | |
1209 | Newz (0, coro, 1, struct coro); |
1218 | Newz (0, coro, 1, struct coro); |
1210 | coro->args = newAV (); |
1219 | coro->args = newAV (); |
1211 | coro->save = CORO_SAVE_DEF; |
1220 | coro->save = CORO_SAVE_DEF; |
1212 | coro->flags = CF_NEW; |
1221 | coro->flags = CF_NEW; |
1213 | |
1222 | |
|
|
1223 | if (first) first->prev = coro; |
|
|
1224 | coro->next = first; |
|
|
1225 | first = coro; |
|
|
1226 | |
1214 | hv = newHV (); |
1227 | coro->hv = hv = newHV (); |
1215 | sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; |
1228 | sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; |
1216 | RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); |
1229 | RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); |
1217 | |
1230 | |
1218 | for (i = 1; i < items; i++) |
1231 | for (i = 1; i < items; i++) |
1219 | av_push (coro->args, newSVsv (ST (i))); |
1232 | av_push (coro->args, newSVsv (ST (i))); |
… | |
… | |
1321 | CODE: |
1334 | CODE: |
1322 | RETVAL = cctx_idle; |
1335 | RETVAL = cctx_idle; |
1323 | OUTPUT: |
1336 | OUTPUT: |
1324 | RETVAL |
1337 | RETVAL |
1325 | |
1338 | |
|
|
1339 | void |
|
|
1340 | list () |
|
|
1341 | PPCODE: |
|
|
1342 | { |
|
|
1343 | struct coro *coro; |
|
|
1344 | for (coro = first; coro; coro = coro->next) |
|
|
1345 | if (coro->hv) |
|
|
1346 | XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv))); |
|
|
1347 | } |
|
|
1348 | |
|
|
1349 | void |
|
|
1350 | _eval (SV *coro_sv, SV *coderef) |
|
|
1351 | CODE: |
|
|
1352 | { |
|
|
1353 | struct coro *coro = SvSTATE (coro_sv); |
|
|
1354 | if (coro->mainstack) |
|
|
1355 | { |
|
|
1356 | struct coro temp; |
|
|
1357 | Zero (&temp, 1, struct coro); |
|
|
1358 | temp.save = CORO_SAVE_ALL; |
|
|
1359 | |
|
|
1360 | if (!(coro->flags & CF_RUNNING)) |
|
|
1361 | { |
|
|
1362 | save_perl (aTHX_ &temp); |
|
|
1363 | load_perl (aTHX_ coro); |
|
|
1364 | } |
|
|
1365 | |
|
|
1366 | { |
|
|
1367 | dSP; |
|
|
1368 | ENTER; |
|
|
1369 | SAVETMPS; |
|
|
1370 | PUSHMARK (SP); |
|
|
1371 | PUTBACK; |
|
|
1372 | call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); |
|
|
1373 | SPAGAIN; |
|
|
1374 | FREETMPS; |
|
|
1375 | LEAVE; |
|
|
1376 | PUTBACK; |
|
|
1377 | } |
|
|
1378 | |
|
|
1379 | if (!(coro->flags & CF_RUNNING)) |
|
|
1380 | { |
|
|
1381 | save_perl (aTHX_ coro); |
|
|
1382 | load_perl (aTHX_ &temp); |
|
|
1383 | } |
|
|
1384 | } |
|
|
1385 | } |
|
|
1386 | |
|
|
1387 | SV * |
|
|
1388 | is_ready (SV *coro_sv) |
|
|
1389 | PROTOTYPE: $ |
|
|
1390 | ALIAS: |
|
|
1391 | is_ready = CF_READY |
|
|
1392 | is_running = CF_RUNNING |
|
|
1393 | is_new = CF_NEW |
|
|
1394 | is_destroyed = CF_DESTROYED |
|
|
1395 | CODE: |
|
|
1396 | struct coro *coro = SvSTATE (coro_sv); |
|
|
1397 | RETVAL = boolSV (coro->flags & ix); |
|
|
1398 | OUTPUT: |
|
|
1399 | RETVAL |
|
|
1400 | |
|
|
1401 | |
1326 | MODULE = Coro::State PACKAGE = Coro |
1402 | MODULE = Coro::State PACKAGE = Coro |
1327 | |
1403 | |
1328 | BOOT: |
1404 | BOOT: |
1329 | { |
1405 | { |
1330 | int i; |
1406 | int i; |
… | |
… | |
1397 | CODE: |
1473 | CODE: |
1398 | RETVAL = boolSV (api_ready (self)); |
1474 | RETVAL = boolSV (api_ready (self)); |
1399 | OUTPUT: |
1475 | OUTPUT: |
1400 | RETVAL |
1476 | RETVAL |
1401 | |
1477 | |
1402 | SV * |
|
|
1403 | is_ready (SV *self) |
|
|
1404 | PROTOTYPE: $ |
|
|
1405 | CODE: |
|
|
1406 | RETVAL = boolSV (api_is_ready (self)); |
|
|
1407 | OUTPUT: |
|
|
1408 | RETVAL |
|
|
1409 | |
|
|
1410 | int |
1478 | int |
1411 | nready (...) |
1479 | nready (...) |
1412 | PROTOTYPE: |
1480 | PROTOTYPE: |
1413 | CODE: |
1481 | CODE: |
1414 | RETVAL = coro_nready; |
1482 | RETVAL = coro_nready; |