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

Diff Legend

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