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.148 by root, Fri Apr 13 12:56:55 2007 UTC vs.
Revision 1.151 by root, Wed Sep 19 21:39:15 2007 UTC

… …
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
195typedef struct coro *Coro__State; 199typedef struct coro *Coro__State;
196typedef struct coro *Coro__State_or_hashref; 200typedef struct coro *Coro__State_or_hashref;
197 201
… …
206 210
207/* for Coro.pm */ 211/* for Coro.pm */
208static SV *coro_current; 212static SV *coro_current;
209static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; 213static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
210static int coro_nready; 214static int coro_nready;
215static struct coro *first;
211 216
212/** lowlevel stuff **********************************************************/ 217/** lowlevel stuff **********************************************************/
213 218
214static AV * 219static AV *
215coro_clone_padlist (pTHX_ CV *cv) 220coro_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
382static void 386static void
383save_perl (pTHX_ Coro__State c) 387save_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 {
… …
567 Zero (&myop, 1, LOGOP); 570 Zero (&myop, 1, LOGOP);
568 myop.op_next = Nullop; 571 myop.op_next = Nullop;
569 myop.op_flags = OPf_WANT_VOID; 572 myop.op_flags = OPf_WANT_VOID;
570 573
571 PUSHMARK (SP); 574 PUSHMARK (SP);
572 XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE)); 575 XPUSHs (av_shift (GvAV (PL_defgv)));
573 PUTBACK; 576 PUTBACK;
574 PL_op = (OP *)&myop; 577 PL_op = (OP *)&myop;
575 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 578 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
576 SPAGAIN; 579 SPAGAIN;
577 } 580 }
… …
588 coro_mortal = 0; 591 coro_mortal = 0;
589 } 592 }
590} 593}
591 594
592/* inject a fake call to Coro::State::_cctx_init into the execution */ 595/* 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 */ 596/* _cctx_init should be careful, as it could be called at almost any time */
594/* during execution of a pelr program */ 597/* during execution of a perl program */
595static void NOINLINE 598static void NOINLINE
596prepare_cctx (pTHX_ coro_cctx *cctx) 599prepare_cctx (pTHX_ coro_cctx *cctx)
597{ 600{
598 dSP; 601 dSP;
599 LOGOP myop; 602 LOGOP myop;
… …
630 633
631 /* somebody or something will hit me for both perl_run and PL_restartop */ 634 /* somebody or something will hit me for both perl_run and PL_restartop */
632 PL_restartop = PL_op; 635 PL_restartop = PL_op;
633 perl_run (PL_curinterp); 636 perl_run (PL_curinterp);
634 637
638 /*
635 /* If perl-run returns we assume exit() was being called, which */ 639 * If perl-run returns we assume exit() was being called or the coro
636 /* seems to be the only valid (non-bug) reason for perl_run to return. */ 640 * fell off the end, which seems to be the only valid (non-bug)
637 /* We try to exit by jumping to the bootstrap-time "top" top_env, as */ 641 * reason for perl_run to return. We try to exit by jumping to the
638 /* we cannot restore the "main" coroutine as Coro has no such concept */ 642 * bootstrap-time "top" top_env, as we cannot restore the "main"
643 * coroutine as Coro has no such concept
644 */
639 PL_top_env = main_top_env; 645 PL_top_env = main_top_env;
640 JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */ 646 JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
641} 647}
642 648
643static coro_cctx * 649static coro_cctx *
… …
874 struct coro temp; 880 struct coro temp;
875 881
876 assert (!(coro->flags & CF_RUNNING)); 882 assert (!(coro->flags & CF_RUNNING));
877 883
878 Zero (&temp, 1, struct coro); 884 Zero (&temp, 1, struct coro);
879 temp.save = CORO_SAVE_DEF; 885 temp.save = CORO_SAVE_ALL;
880 886
881 if (coro->flags & CF_RUNNING) 887 if (coro->flags & CF_RUNNING)
882 croak ("FATAL: tried to destroy currently running coroutine"); 888 croak ("FATAL: tried to destroy currently running coroutine");
883 889
884 save_perl (aTHX_ &temp); 890 save_perl (aTHX_ &temp);
… …
892 } 898 }
893 899
894 cctx_destroy (coro->cctx); 900 cctx_destroy (coro->cctx);
895 SvREFCNT_dec (coro->args); 901 SvREFCNT_dec (coro->args);
896 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
897 return 1; 907 return 1;
898} 908}
899 909
900static int 910static int
901coro_state_free (pTHX_ SV *sv, MAGIC *mg) 911coro_state_free (pTHX_ SV *sv, MAGIC *mg)
902{ 912{
903 struct coro *coro = (struct coro *)mg->mg_ptr; 913 struct coro *coro = (struct coro *)mg->mg_ptr;
904 mg->mg_ptr = 0; 914 mg->mg_ptr = 0;
915
916 coro->hv = 0;
905 917
906 if (--coro->refcnt < 0) 918 if (--coro->refcnt < 0)
907 { 919 {
908 coro_state_destroy (aTHX_ coro); 920 coro_state_destroy (aTHX_ coro);
909 Safefree (coro); 921 Safefree (coro);
… …
1206 Newz (0, coro, 1, struct coro); 1218 Newz (0, coro, 1, struct coro);
1207 coro->args = newAV (); 1219 coro->args = newAV ();
1208 coro->save = CORO_SAVE_DEF; 1220 coro->save = CORO_SAVE_DEF;
1209 coro->flags = CF_NEW; 1221 coro->flags = CF_NEW;
1210 1222
1223 if (first) first->prev = coro;
1224 coro->next = first;
1225 first = coro;
1226
1211 hv = newHV (); 1227 coro->hv = hv = newHV ();
1212 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;
1213 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 1229 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1214 1230
1215 for (i = 1; i < items; i++) 1231 for (i = 1; i < items; i++)
1216 av_push (coro->args, newSVsv (ST (i))); 1232 av_push (coro->args, newSVsv (ST (i)));
… …
1318 CODE: 1334 CODE:
1319 RETVAL = cctx_idle; 1335 RETVAL = cctx_idle;
1320 OUTPUT: 1336 OUTPUT:
1321 RETVAL 1337 RETVAL
1322 1338
1339void
1340list ()
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
1349void
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
1387SV *
1388is_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
1323MODULE = Coro::State PACKAGE = Coro 1402MODULE = Coro::State PACKAGE = Coro
1324 1403
1325BOOT: 1404BOOT:
1326{ 1405{
1327 int i; 1406 int i;
… …
1394 CODE: 1473 CODE:
1395 RETVAL = boolSV (api_ready (self)); 1474 RETVAL = boolSV (api_ready (self));
1396 OUTPUT: 1475 OUTPUT:
1397 RETVAL 1476 RETVAL
1398 1477
1399SV *
1400is_ready (SV *self)
1401 PROTOTYPE: $
1402 CODE:
1403 RETVAL = boolSV (api_is_ready (self));
1404 OUTPUT:
1405 RETVAL
1406
1407int 1478int
1408nready (...) 1479nready (...)
1409 PROTOTYPE: 1480 PROTOTYPE:
1410 CODE: 1481 CODE:
1411 RETVAL = coro_nready; 1482 RETVAL = coro_nready;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines