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.7 by root, Thu Jul 19 02:45:09 2001 UTC vs.
Revision 1.12 by root, Sun Jul 22 03:24:10 2001 UTC

… …
8# define CHK(x) if (!(x)) croak("FATAL, CHK: " #x) 8# define CHK(x) if (!(x)) croak("FATAL, CHK: " #x)
9#endif 9#endif
10 10
11#define MAY_FLUSH /* increases codesize */ 11#define MAY_FLUSH /* increases codesize */
12 12
13#define SUB_INIT "Coro::State::initialize"
14
13#define SAVE_DEFAV 0x00000001 15#define TRANSFER_SAVE_DEFAV 0x00000001
14#define SAVE_DEFSV 0x00000002 16#define TRANSFER_SAVE_DEFSV 0x00000002
15#define SAVE_ERRSV 0x00000004 17#define TRANSFER_SAVE_ERRSV 0x00000004
16 18
17#define SAVE_ALL -1 19#define TRANSFER_SAVE_ALL -1
18 20
19struct coro { 21struct coro {
20 /* optionally saved, might be zero */ 22 /* optionally saved, might be zero */
21 AV *defav; 23 AV *defav;
22 SV *defsv; 24 SV *defsv;
… …
57}; 59};
58 60
59typedef struct coro *Coro__State; 61typedef struct coro *Coro__State;
60typedef struct coro *Coro__State_or_hashref; 62typedef struct coro *Coro__State_or_hashref;
61 63
64static AV *main_mainstack; /* used to differentiate between $main and others */
65
62static HV *padlist_cache; 66static HV *padlist_cache;
63 67
64/* mostly copied from op.c:cv_clone2 */ 68/* mostly copied from op.c:cv_clone2 */
65STATIC AV * 69STATIC AV *
66clone_padlist (AV *protopadlist) 70clone_padlist (AV *protopadlist)
… …
300save_state(pTHX_ Coro__State c, int flags) 304save_state(pTHX_ Coro__State c, int flags)
301{ 305{
302 { 306 {
303 dSP; 307 dSP;
304 I32 cxix = cxstack_ix; 308 I32 cxix = cxstack_ix;
309 PERL_CONTEXT *ccstk = cxstack;
305 PERL_SI *top_si = PL_curstackinfo; 310 PERL_SI *top_si = PL_curstackinfo;
306 PERL_CONTEXT *ccstk = cxstack;
307 311
308 /* 312 /*
309 * the worst thing you can imagine happens first - we have to save 313 * the worst thing you can imagine happens first - we have to save
310 * (and reinitialize) all cv's in the whole callchain :( 314 * (and reinitialize) all cv's in the whole callchain :(
311 */ 315 */
312 316
313 PUSHs (Nullsv); 317 PUSHs (Nullsv);
314 /* this loop was inspired by pp_caller */ 318 /* this loop was inspired by pp_caller */
315 for (;;) 319 for (;;)
316 { 320 {
317 do 321 do
318 { 322 {
319 PERL_CONTEXT *cx = &ccstk[cxix--]; 323 PERL_CONTEXT *cx = &ccstk[cxix--];
320 324
321 if (CxTYPE(cx) == CXt_SUB) 325 if (CxTYPE(cx) == CXt_SUB)
322 { 326 {
… …
361 } 365 }
362 366
363 PUTBACK; 367 PUTBACK;
364 } 368 }
365 369
366 c->defav = flags & SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0; 370 c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
367 c->defsv = flags & SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0; 371 c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
368 c->errsv = flags & SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0; 372 c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
373
374 /* I have not the slightest idea of why av_reify is necessary */
375 /* but if it's missing the defav contents magically get replaced sometimes */
376 if (c->defav)
377 av_reify (c->defav);
369 378
370 c->dowarn = PL_dowarn; 379 c->dowarn = PL_dowarn;
371 380
372 c->curstackinfo = PL_curstackinfo; 381 c->curstackinfo = PL_curstackinfo;
373 c->curstack = PL_curstack; 382 c->curstack = PL_curstack;
… …
437 Safefree(PL_scopestack); 446 Safefree(PL_scopestack);
438 Safefree(PL_savestack); 447 Safefree(PL_savestack);
439 Safefree(PL_retstack); 448 Safefree(PL_retstack);
440} 449}
441 450
442#define SUB_INIT "Coro::State::_newcoro" 451STATIC void
452transfer(pTHX_ struct coro *prev, struct coro *next, int flags)
453{
454 dSP;
455
456 if (prev != next)
457 {
458 /*
459 * this could be done in newprocess which would lead to
460 * extremely elegant and fast (just SAVE/LOAD)
461 * code here, but lazy allocation of stacks has also
462 * some virtues and the overhead of the if() is nil.
463 */
464 if (next->mainstack)
465 {
466 SAVE (prev, flags);
467 LOAD (next);
468 /* mark this state as in-use */
469 next->mainstack = 0;
470 next->tmps_ix = -2;
471 }
472 else if (next->tmps_ix == -2)
473 {
474 croak ("tried to transfer to running coroutine");
475 }
476 else
477 {
478 /*
479 * emulate part of the perl startup here.
480 */
481 UNOP myop;
482
483 SAVE (prev, -1); /* first get rid of the old state */
484
485 init_stacks (); /* from perl.c */
486 SPAGAIN;
487
488 PL_op = (OP *)&myop;
489 /*PL_curcop = 0;*/
490 SvREFCNT_dec (GvAV (PL_defgv));
491 GvAV (PL_defgv) = next->args;
492
493 Zero(&myop, 1, UNOP);
494 myop.op_next = Nullop;
495 myop.op_flags = OPf_WANT_VOID;
496
497 PUSHMARK(SP);
498 XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
499 /*
500 * the next line is slightly wrong, as PL_op->op_next
501 * is actually being executed so we skip the first op.
502 * that doesn't matter, though, since it is only
503 * pp_nextstate and we never return...
504 * ah yes, and I don't care anyways ;)
505 */
506 PUTBACK;
507 PL_op = pp_entersub(aTHX);
508 SPAGAIN;
509
510 ENTER; /* necessary e.g. for dounwind */
511 }
512 }
513}
443 514
444MODULE = Coro::State PACKAGE = Coro::State 515MODULE = Coro::State PACKAGE = Coro::State
445 516
446PROTOTYPES: ENABLE 517PROTOTYPES: ENABLE
447 518
448BOOT: 519BOOT:
520{ /* {} necessary for stoopid perl-5.6.x */
449 HV * stash = gv_stashpvn("Coro::State", 10, TRUE); 521 HV * stash = gv_stashpvn("Coro::State", 10, TRUE);
450 522
451 newCONSTSUB (stash, "SAVE_DEFAV", newSViv (SAVE_DEFAV)); 523 newCONSTSUB (stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV));
452 newCONSTSUB (stash, "SAVE_DEFSV", newSViv (SAVE_DEFSV)); 524 newCONSTSUB (stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV));
453 newCONSTSUB (stash, "SAVE_ERRSV", newSViv (SAVE_ERRSV)); 525 newCONSTSUB (stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV));
454 526
455 if (!padlist_cache) 527 if (!padlist_cache)
456 padlist_cache = newHV (); 528 padlist_cache = newHV ();
529
530 main_mainstack = PL_mainstack;
531}
457 532
458Coro::State 533Coro::State
459_newprocess(args) 534_newprocess(args)
460 SV * args 535 SV * args
461 PROTOTYPE: $ 536 PROTOTYPE: $
… …
473 RETVAL = coro; 548 RETVAL = coro;
474 OUTPUT: 549 OUTPUT:
475 RETVAL 550 RETVAL
476 551
477void 552void
478transfer(prev, next, flags = SAVE_DEFAV) 553transfer(prev, next, flags = TRANSFER_SAVE_ALL)
479 Coro::State_or_hashref prev 554 Coro::State_or_hashref prev
480 Coro::State_or_hashref next 555 Coro::State_or_hashref next
481 int flags 556 int flags
557 PROTOTYPE: @
482 CODE: 558 CODE:
483 559
484 if (prev != next) 560 transfer (aTHX_ prev, next, flags);
485 {
486 /*
487 * this could be done in newprocess which would lead to
488 * extremely elegant and fast (just SAVE/LOAD)
489 * code here, but lazy allocation of stacks has also
490 * some virtues and the overhead of the if() is nil.
491 */
492 if (next->mainstack)
493 {
494 SAVE (prev, flags);
495 LOAD (next);
496 /* mark this state as in-use */
497 next->mainstack = 0;
498 next->tmps_ix = -2;
499 }
500 else if (next->tmps_ix == -2)
501 {
502 croak ("tried to transfer to running coroutine");
503 }
504 else
505 {
506 /*
507 * emulate part of the perl startup here.
508 */
509 UNOP myop;
510
511 SAVE (prev, -1); /* first get rid of the old state */
512
513 init_stacks (); /* from perl.c */
514 SPAGAIN;
515
516 PL_op = (OP *)&myop;
517 /*PL_curcop = 0;*/
518 SvREFCNT_dec (GvAV (PL_defgv));
519 GvAV (PL_defgv) = next->args;
520
521 Zero(&myop, 1, UNOP);
522 myop.op_next = Nullop;
523 myop.op_flags = OPf_WANT_VOID;
524
525 PUSHMARK(SP);
526 XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
527 /*
528 * the next line is slightly wrong, as PL_op->op_next
529 * is actually being executed so we skip the first op.
530 * that doesn't matter, though, since it is only
531 * pp_nextstate and we never return...
532 * ah yes, and I don't care anyways ;)
533 */
534 PUTBACK;
535 PL_op = pp_entersub(aTHX);
536 SPAGAIN;
537
538 ENTER; /* necessary e.g. for dounwind */
539 }
540 }
541 561
542void 562void
543DESTROY(coro) 563DESTROY(coro)
544 Coro::State coro 564 Coro::State coro
545 CODE: 565 CODE:
546 566
547 if (coro->mainstack) 567 if (coro->mainstack && coro->mainstack != main_mainstack)
548 { 568 {
549 struct coro temp; 569 struct coro temp;
550 570
551 SAVE(aTHX_ (&temp), SAVE_ALL); 571 SAVE(aTHX_ (&temp), TRANSFER_SAVE_ALL);
552 LOAD(aTHX_ coro); 572 LOAD(aTHX_ coro);
553 573
554 destroy_stacks (); 574 destroy_stacks ();
555 575
556 LOAD((&temp)); /* this will get rid of defsv etc.. */ 576 LOAD((&temp)); /* this will get rid of defsv etc.. */
557 } 577 }
558 578
559 Safefree (coro); 579 Safefree (coro);
580
581 /*
582 * there is one problematic case left (remember _recurse?)
583 * consider the case when we
584 *
585 * 1. start a coroutine
586 * 2. inside it descend into some xs functions
587 * 3. xs function calls a callback
588 * 4. callback switches to $main
589 * 5. $main ends - we will end inside the xs function
590 * 6. xs function returns and perl executes - what?
591 *
592 * to avoid this case we recurse in this function
593 * and simply call my_exit(0), skipping other xs functions
594 */
595
596#if 0
597void
598_recurse()
599 CODE:
600 LEAVE;
601 PL_stack_sp = PL_stack_base + ax - 1;
602 PL_op = PL_op->op_next;
603 CALLRUNOPS(aTHX);
604 printf ("my_exit\n");
605 my_exit (0);
606
607#endif
560 608
561void 609void
562flush() 610flush()
563 CODE: 611 CODE:
564#ifdef MAY_FLUSH 612#ifdef MAY_FLUSH
565 flush_padlist_cache (); 613 flush_padlist_cache ();
566#endif 614#endif
567 615
616MODULE = Coro::State PACKAGE = Coro::Cont
568 617
618# this is dirty (do you hear me?) and should be in it's own .xs
619
620void
621result(...)
622 PROTOTYPE: @
623 CODE:
624 static SV *returnstk;
625 SV *sv;
626 AV *defav = GvAV (PL_defgv);
627 struct coro *prev, *next;
628
629 if (!returnstk)
630 returnstk = SvRV (get_sv ("Coro::Cont::return", FALSE));
631
632 /* set up @_ -- ugly */
633 av_clear (defav);
634 av_fill (defav, items - 1);
635 while (items--)
636 av_store (defav, items, SvREFCNT_inc (ST(items)));
637
638 mg_get (returnstk); /* isn't documentation wrong for mg_get? */
639 sv = av_pop ((AV *)SvRV (returnstk));
640 prev = (struct coro *)SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0)));
641 next = (struct coro *)SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0)));
642 SvREFCNT_dec (sv);
643 transfer(prev, next, 0);
644

Diff Legend

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