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.12 by root, Sun Jul 22 03:24:10 2001 UTC vs.
Revision 1.13 by root, Mon Jul 23 22:09:39 2001 UTC

1#include "EXTERN.h" 1#include "EXTERN.h"
2#include "perl.h" 2#include "perl.h"
3#include "XSUB.h" 3#include "XSUB.h"
4 4
5#if 1 5#include "libcoro/coro.c"
6# define CHK(x) (void *)0 6
7#else 7#ifdef HAVE_MMAP
8# define CHK(x) if (!(x)) croak("FATAL, CHK: " #x) 8# include <unistd.h>
9# include <sys/mman.h>
9#endif 10#endif
10 11
11#define MAY_FLUSH /* increases codesize */ 12#define MAY_FLUSH /* increases codesize */
12 13
13#define SUB_INIT "Coro::State::initialize" 14#define SUB_INIT "Coro::State::initialize"
14 15
15#define TRANSFER_SAVE_DEFAV 0x00000001 16#define TRANSFER_SAVE_DEFAV 0x00000001
16#define TRANSFER_SAVE_DEFSV 0x00000002 17#define TRANSFER_SAVE_DEFSV 0x00000002
17#define TRANSFER_SAVE_ERRSV 0x00000004 18#define TRANSFER_SAVE_ERRSV 0x00000004
19#define TRANSFER_SAVE_CCTXT 0x00000008
18 20
19#define TRANSFER_SAVE_ALL -1 21#define TRANSFER_SAVE_ALL -1
20 22
21struct coro { 23struct coro {
24 /* the optional C context */
25 coro_context cctx;
26 void *sptr;
27 long ssize;
28
22 /* optionally saved, might be zero */ 29 /* optionally saved, might be zero */
23 AV *defav; 30 AV *defav;
24 SV *defsv; 31 SV *defsv;
25 SV *errsv; 32 SV *errsv;
26 33
… …
51 I32 savestack_max; 58 I32 savestack_max;
52 OP **retstack; 59 OP **retstack;
53 I32 retstack_ix; 60 I32 retstack_ix;
54 I32 retstack_max; 61 I32 retstack_max;
55 COP *curcop; 62 COP *curcop;
63 JMPENV start_env;
64 JMPENV *top_env;
56 65
57 /* data associated with this coroutine (initial args) */ 66 /* data associated with this coroutine (initial args) */
58 AV *args; 67 AV *args;
59}; 68};
60 69
61typedef struct coro *Coro__State; 70typedef struct coro *Coro__State;
62typedef struct coro *Coro__State_or_hashref; 71typedef struct coro *Coro__State_or_hashref;
63 72
64static AV *main_mainstack; /* used to differentiate between $main and others */ 73static AV *main_mainstack; /* used to differentiate between $main and others */
65 74static HV *coro_state_stash;
66static HV *padlist_cache; 75static HV *padlist_cache;
67 76
68/* mostly copied from op.c:cv_clone2 */ 77/* mostly copied from op.c:cv_clone2 */
69STATIC AV * 78STATIC AV *
70clone_padlist (AV *protopadlist) 79clone_padlist (AV *protopadlist)
… …
233#endif 242#endif
234 243
235#define SB do { 244#define SB do {
236#define SE } while (0) 245#define SE } while (0)
237 246
238#define LOAD(state) SB load_state(aTHX_ state); SPAGAIN; SE 247#define LOAD(state) SB load_state(aTHX_ (state)); SPAGAIN; SE
239#define SAVE(state,flags) SB PUTBACK; save_state(aTHX_ state,flags); SE 248#define SAVE(state,flags) SB PUTBACK; save_state(aTHX_ (state),(flags)); SE
240 249
241#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); SE 250#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); SE
242 251
243static void 252static void
244load_state(pTHX_ Coro__State c) 253load_state(pTHX_ Coro__State c)
… …
268 PL_savestack_max = c->savestack_max; 277 PL_savestack_max = c->savestack_max;
269 PL_retstack = c->retstack; 278 PL_retstack = c->retstack;
270 PL_retstack_ix = c->retstack_ix; 279 PL_retstack_ix = c->retstack_ix;
271 PL_retstack_max = c->retstack_max; 280 PL_retstack_max = c->retstack_max;
272 PL_curcop = c->curcop; 281 PL_curcop = c->curcop;
282 PL_start_env = c->start_env;
283 PL_top_env = c->top_env;
273 284
274 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav); 285 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
275 if (c->defsv) REPLACE_SV (DEFSV , c->defsv); 286 if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
276 if (c->errsv) REPLACE_SV (ERRSV , c->errsv); 287 if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
277 288
… …
401 c->savestack_max = PL_savestack_max; 412 c->savestack_max = PL_savestack_max;
402 c->retstack = PL_retstack; 413 c->retstack = PL_retstack;
403 c->retstack_ix = PL_retstack_ix; 414 c->retstack_ix = PL_retstack_ix;
404 c->retstack_max = PL_retstack_max; 415 c->retstack_max = PL_retstack_max;
405 c->curcop = PL_curcop; 416 c->curcop = PL_curcop;
417 c->start_env = PL_start_env;
418 c->top_env = PL_top_env;
419}
420
421/*
422 * allocate various perl stacks. This is an exact copy
423 * of perl.c:init_stacks, except that it uses less memory
424 * on the assumption that coroutines do not usually need
425 * a lot of stackspace.
426 */
427STATIC void
428coro_init_stacks (pTHX)
429{
430 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1);
431 PL_curstackinfo->si_type = PERLSI_MAIN;
432 PL_curstack = PL_curstackinfo->si_stack;
433 PL_mainstack = PL_curstack; /* remember in case we switch stacks */
434
435 PL_stack_base = AvARRAY(PL_curstack);
436 PL_stack_sp = PL_stack_base;
437 PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
438
439 New(50,PL_tmps_stack,64,SV*);
440 PL_tmps_floor = -1;
441 PL_tmps_ix = -1;
442 PL_tmps_max = 64;
443
444 New(54,PL_markstack,12,I32);
445 PL_markstack_ptr = PL_markstack;
446 PL_markstack_max = PL_markstack + 12;
447
448 SET_MARK_OFFSET;
449
450 New(54,PL_scopestack,12,I32);
451 PL_scopestack_ix = 0;
452 PL_scopestack_max = 12;
453
454 New(54,PL_savestack,64,ANY);
455 PL_savestack_ix = 0;
456 PL_savestack_max = 64;
457
458 New(54,PL_retstack,8,OP*);
459 PL_retstack_ix = 0;
460 PL_retstack_max = 8;
406} 461}
407 462
408/* 463/*
409 * destroy the stacks, the callchain etc... 464 * destroy the stacks, the callchain etc...
410 * still there is a memleak of 128 bytes... 465 * still there is a memleak of 128 bytes...
… …
446 Safefree(PL_scopestack); 501 Safefree(PL_scopestack);
447 Safefree(PL_savestack); 502 Safefree(PL_savestack);
448 Safefree(PL_retstack); 503 Safefree(PL_retstack);
449} 504}
450 505
506static void
507allocate_stack (Coro__State ctx)
508{
509#ifdef HAVE_MMAP
510 ctx->ssize = 128 * 1024 * sizeof (long); /* mmap should do allocate-on-use */
511 ctx->sptr = mmap (0, ctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANON, 0, 0);
512 if (ctx->sptr == (void *)-1)
513#endif
514 {
515 /*FIXME*//*D*//* reasonable stack size! */
516 ctx->ssize = 4096 * sizeof (long);
517 New (0, ctx->sptr, 4096, long);
518 }
519}
520
521static void
522deallocate_stack (Coro__State ctx)
523{
524#ifdef HAVE_MMAP
525 munmap (ctx->sptr, ctx->ssize);
526#else
527 Safefree (ctx->sptr);
528#endif
529}
530
531/* might go away together with optional SAVE_CCTXT */
532static void
533setup_coro (void *arg)
534{
535 /*
536 * emulate part of the perl startup here.
537 */
538 dSP;
539 Coro__State ctx = (Coro__State)arg;
540 SV *sub_init = (SV*)get_cv(SUB_INIT, FALSE);
541
542 coro_init_stacks (aTHX);
543 JMPENV_BOOTSTRAP;
544 SPAGAIN;
545
546 /*PL_curcop = 0;*/
547 SvREFCNT_dec (GvAV (PL_defgv));
548 GvAV (PL_defgv) = ctx->args;
549
550 if (ctx->sptr)
551 {
552 PUSHMARK(SP);
553 PUTBACK;
554 (void) call_sv (sub_init, G_VOID|G_NOARGS);
555 croak ("FATAL: CCTXT coroutine returned!");
556 }
557 else
558 {
559 UNOP myop;
560
561 PL_op = (OP *)&myop;
562
563 Zero(&myop, 1, UNOP);
564 myop.op_next = Nullop;
565 myop.op_flags = OPf_WANT_VOID;
566
567 PUSHMARK(SP);
568 XPUSHs (sub_init);
569 /*
570 * the next line is slightly wrong, as PL_op->op_next
571 * is actually being executed so we skip the first op.
572 * that doesn't matter, though, since it is only
573 * pp_nextstate and we never return...
574 * ah yes, and I don't care anyways ;)
575 */
576 PUTBACK;
577 PL_op = pp_entersub();
578 SPAGAIN;
579
580 ENTER; /* necessary e.g. for dounwind */
581 }
582}
583
451STATIC void 584STATIC void
452transfer(pTHX_ struct coro *prev, struct coro *next, int flags) 585transfer(pTHX_ struct coro *prev, struct coro *next, int flags)
453{ 586{
454 dSP; 587 dSP;
455 588
456 if (prev != next) 589 if (prev != next)
457 { 590 {
458 /* 591 /*
459 * this could be done in newprocess which would lead to 592 * this could be done in newprocess which would lead to
460 * extremely elegant and fast (just SAVE/LOAD) 593 * extremely elegant and fast (basically just SAVE/LOAD)
461 * code here, but lazy allocation of stacks has also 594 * code here, but lazy allocation of stacks has also
462 * some virtues and the overhead of the if() is nil. 595 * some virtues and the overhead of the if() is nil.
463 */ 596 */
464 if (next->mainstack) 597 if (next->mainstack)
465 { 598 {
466 SAVE (prev, flags); 599 SAVE (prev, flags);
467 LOAD (next); 600 LOAD (next);
601
468 /* mark this state as in-use */ 602 /* mark this state as in-use */
469 next->mainstack = 0; 603 next->mainstack = 0;
470 next->tmps_ix = -2; 604 next->tmps_ix = -2;
605
606 if (flags & TRANSFER_SAVE_CCTXT)
607 {
608 if (!next->ssize)
609 croak ("destination coroutine has no CCTXT (%p, %d)", next->sptr, next->ssize);
610
611 if (!prev->ssize)
612 prev->ssize = 1; /* mark cctx as valid ;) */
613
614 coro_transfer (&(prev->cctx), &(next->cctx));
615 }
616
471 } 617 }
472 else if (next->tmps_ix == -2) 618 else if (next->tmps_ix == -2)
473 {
474 croak ("tried to transfer to running coroutine"); 619 croak ("tried to transfer to running coroutine");
475 }
476 else 620 else
477 { 621 {
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 */ 622 SAVE (prev, -1); /* first get rid of the old state */
484 623
485 init_stacks (); /* from perl.c */ 624 if (flags & TRANSFER_SAVE_CCTXT)
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 */ 625 {
506 PUTBACK; 626 if (!next->ssize)
507 PL_op = pp_entersub(aTHX); 627 {
508 SPAGAIN; 628 allocate_stack (next);
629 coro_create (&(next->cctx),
630 setup_coro, (void *)next,
631 next->sptr, next->ssize);
632 }
509 633
510 ENTER; /* necessary e.g. for dounwind */ 634 if (!prev->ssize)
635 prev->ssize = 1; /* mark cctx as valid ;) */
636
637 coro_transfer (&(prev->cctx), &(next->cctx));
638 }
639 else
640 setup_coro (next);
511 } 641 }
512 } 642 }
513} 643}
514 644
515MODULE = Coro::State PACKAGE = Coro::State 645MODULE = Coro::State PACKAGE = Coro::State
516 646
517PROTOTYPES: ENABLE 647PROTOTYPES: ENABLE
518 648
519BOOT: 649BOOT:
520{ /* {} necessary for stoopid perl-5.6.x */ 650{ /* {} necessary for stoopid perl-5.6.x */
521 HV * stash = gv_stashpvn("Coro::State", 10, TRUE); 651 coro_state_stash = gv_stashpvn ("Coro::State", 10, TRUE);
522 652
523 newCONSTSUB (stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV)); 653 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV));
524 newCONSTSUB (stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV)); 654 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV));
525 newCONSTSUB (stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV)); 655 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV));
656 newCONSTSUB (coro_state_stash, "SAVE_CCTXT", newSViv (TRANSFER_SAVE_CCTXT));
526 657
527 if (!padlist_cache) 658 if (!padlist_cache)
528 padlist_cache = newHV (); 659 padlist_cache = newHV ();
529 660
530 main_mainstack = PL_mainstack; 661 main_mainstack = PL_mainstack;
… …
540 if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV) 671 if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV)
541 croak ("Coro::State::_newprocess expects an arrayref"); 672 croak ("Coro::State::_newprocess expects an arrayref");
542 673
543 New (0, coro, 1, struct coro); 674 New (0, coro, 1, struct coro);
544 675
676 coro->args = (AV *)SvREFCNT_inc (SvRV (args));
545 coro->mainstack = 0; /* actual work is done inside transfer */ 677 coro->mainstack = 0; /* actual work is done inside transfer */
546 coro->args = (AV *)SvREFCNT_inc (SvRV (args)); 678 coro->sptr = 0;
679 coro->ssize = 0;
547 680
548 RETVAL = coro; 681 RETVAL = coro;
549 OUTPUT: 682 OUTPUT:
550 RETVAL 683 RETVAL
551 684
… …
554 Coro::State_or_hashref prev 687 Coro::State_or_hashref prev
555 Coro::State_or_hashref next 688 Coro::State_or_hashref next
556 int flags 689 int flags
557 PROTOTYPE: @ 690 PROTOTYPE: @
558 CODE: 691 CODE:
559
560 transfer (aTHX_ prev, next, flags); 692 transfer (aTHX_ prev, next, flags);
561 693
562void 694void
563DESTROY(coro) 695DESTROY(coro)
564 Coro::State coro 696 Coro::State coro
… …
569 struct coro temp; 701 struct coro temp;
570 702
571 SAVE(aTHX_ (&temp), TRANSFER_SAVE_ALL); 703 SAVE(aTHX_ (&temp), TRANSFER_SAVE_ALL);
572 LOAD(aTHX_ coro); 704 LOAD(aTHX_ coro);
573 705
574 destroy_stacks (); 706 destroy_stacks (aTHX);
575 707
576 LOAD((&temp)); /* this will get rid of defsv etc.. */ 708 LOAD((&temp)); /* this will get rid of defsv etc.. */
709
710 coro->mainstack = 0;
577 } 711 }
578 712
713 if (coro->sptr)
714 {
715 deallocate_stack (coro);
716 coro->sptr = 0;
717 }
718
579 Safefree (coro); 719 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
608 720
609void 721void
610flush() 722flush()
611 CODE: 723 CODE:
612#ifdef MAY_FLUSH 724#ifdef MAY_FLUSH
613 flush_padlist_cache (); 725 flush_padlist_cache ();
614#endif 726#endif
615 727
616MODULE = Coro::State PACKAGE = Coro::Cont 728MODULE = Coro::State PACKAGE = Coro::Cont
617 729
618# this is dirty (do you hear me?) and should be in it's own .xs 730# this is slightly dirty
619 731
620void 732void
621result(...) 733yield(...)
622 PROTOTYPE: @ 734 PROTOTYPE: @
623 CODE: 735 CODE:
624 static SV *returnstk; 736 static SV *returnstk;
625 SV *sv; 737 SV *sv;
626 AV *defav = GvAV (PL_defgv); 738 AV *defav = GvAV (PL_defgv);
… …
638 mg_get (returnstk); /* isn't documentation wrong for mg_get? */ 750 mg_get (returnstk); /* isn't documentation wrong for mg_get? */
639 sv = av_pop ((AV *)SvRV (returnstk)); 751 sv = av_pop ((AV *)SvRV (returnstk));
640 prev = (struct coro *)SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0))); 752 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))); 753 next = (struct coro *)SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0)));
642 SvREFCNT_dec (sv); 754 SvREFCNT_dec (sv);
755
643 transfer(prev, next, 0); 756 transfer(aTHX_ prev, next, 0);
644 757

Diff Legend

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