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.101 by root, Mon Nov 27 00:08:18 2006 UTC vs.
Revision 1.105 by root, Mon Nov 27 02:01:33 2006 UTC

… …
3#include "EXTERN.h" 3#include "EXTERN.h"
4#include "perl.h" 4#include "perl.h"
5#include "XSUB.h" 5#include "XSUB.h"
6 6
7#include "patchlevel.h" 7#include "patchlevel.h"
8
9#if USE_VALGRIND
10# include <valgrind/valgrind.h>
11#endif
8 12
9#define PERL_VERSION_ATLEAST(a,b,c) \ 13#define PERL_VERSION_ATLEAST(a,b,c) \
10 (PERL_REVISION > (a) \ 14 (PERL_REVISION > (a) \
11 || (PERL_REVISION == (a) \ 15 || (PERL_REVISION == (a) \
12 && (PERL_VERSION > (b) \ 16 && (PERL_VERSION > (b) \
13 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c))))) 17 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
14 18
15#if !PERL_VERSION_ATLEAST (5,8,0) 19#if !PERL_VERSION_ATLEAST (5,6,0)
16# ifndef PL_ppaddr 20# ifndef PL_ppaddr
17# define PL_ppaddr ppaddr 21# define PL_ppaddr ppaddr
18# endif 22# endif
19# ifndef call_sv 23# ifndef call_sv
20# define call_sv perl_call_sv 24# define call_sv perl_call_sv
… …
108 112
109 /* cpu state */ 113 /* cpu state */
110 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 114 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
111 JMPENV *top_env; 115 JMPENV *top_env;
112 coro_context cctx; 116 coro_context cctx;
117
118#if USE_VALGRIND
119 int valgrind_id;
120#endif
113} coro_stack; 121} coro_stack;
114 122
115/* this is a structure representing a perl-level coroutine */ 123/* this is a structure representing a perl-level coroutine */
116struct coro { 124struct coro {
117 /* the c coroutine allocated to this perl coroutine, if any */ 125 /* the c coroutine allocated to this perl coroutine, if any */
… …
491 499
492/* 500/*
493 * destroy the stacks, the callchain etc... 501 * destroy the stacks, the callchain etc...
494 */ 502 */
495static void 503static void
496destroy_stacks() 504coro_destroy_stacks()
497{ 505{
498 if (!IN_DESTRUCT) 506 if (!IN_DESTRUCT)
499 { 507 {
500 /* is this ugly, I ask? */ 508 /* is this ugly, I ask? */
501 LEAVE_SCOPE (0); 509 LEAVE_SCOPE (0);
… …
543setup_coro (struct coro *coro) 551setup_coro (struct coro *coro)
544{ 552{
545 /* 553 /*
546 * emulate part of the perl startup here. 554 * emulate part of the perl startup here.
547 */ 555 */
548 dTHX;
549 dSP;
550 UNOP myop;
551 SV *sub_init = (SV *)get_cv ("Coro::State::coro_init", FALSE);
552 556
553 coro_init_stacks (); 557 coro_init_stacks ();
558
554 /*PL_curcop = 0;*/ 559 PL_curcop = 0;
555 /*PL_in_eval = PL_in_eval;*/ /* inherit */ 560 PL_in_eval = 0;
561 PL_curpm = 0;
562
563 {
564 dSP;
565 LOGOP myop;
566
567 /* I have no idea why this is needed, but it is */
568 PUSHMARK (SP);
569
556 SvREFCNT_dec (GvAV (PL_defgv)); 570 SvREFCNT_dec (GvAV (PL_defgv));
557 GvAV (PL_defgv) = coro->args; coro->args = 0; 571 GvAV (PL_defgv) = coro->args; coro->args = 0;
558 572
559 SPAGAIN;
560
561 Zero (&myop, 1, UNOP); 573 Zero (&myop, 1, LOGOP);
562 myop.op_next = Nullop; 574 myop.op_next = Nullop;
563 myop.op_flags = OPf_WANT_VOID; 575 myop.op_flags = OPf_WANT_VOID;
564 576
565 PL_op = (OP *)&myop; 577 PL_op = (OP *)&myop;
566 578
567 PUSHMARK(SP); 579 PUSHMARK (SP);
568 XPUSHs (sub_init); 580 XPUSHs ((SV *)get_cv ("Coro::State::coro_init", FALSE));
569 PUTBACK; 581 PUTBACK;
570 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 582 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
571 SPAGAIN; 583 SPAGAIN;
572 584
573 ENTER; /* necessary e.g. for dounwind */ 585 ENTER; /* necessary e.g. for dounwind */
586 }
574} 587}
575 588
576static void 589static void
577free_coro_mortal () 590free_coro_mortal ()
578{ 591{
… …
585 598
586static void NOINLINE 599static void NOINLINE
587prepare_cctx (coro_stack *cctx) 600prepare_cctx (coro_stack *cctx)
588{ 601{
589 dSP; 602 dSP;
590 UNOP myop; 603 LOGOP myop;
591 604
592 Zero (&myop, 1, UNOP); 605 Zero (&myop, 1, LOGOP);
593 myop.op_next = PL_op; 606 myop.op_next = PL_op;
594 myop.op_flags = OPf_WANT_VOID | OPf_STACKED; 607 myop.op_flags = OPf_WANT_VOID;
595 608
609 sv_setiv (get_sv ("Coro::State::cctx_stack", FALSE), PTR2IV (cctx));
610
596 PUSHMARK(SP); 611 PUSHMARK (SP);
597 EXTEND (SP, 2);
598 PUSHs (newSViv (PTR2IV (cctx)));
599 PUSHs ((SV *)get_cv ("Coro::State::cctx_init", FALSE)); 612 XPUSHs ((SV *)get_cv ("Coro::State::cctx_init", FALSE));
600 PUTBACK; 613 PUTBACK;
601 PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX); 614 PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX);
602 SPAGAIN; 615 SPAGAIN;
603} 616}
604 617
605static void 618static void
606coro_run (void *arg) 619coro_run (void *arg)
607{ 620{
621 /* coro_run is the alternative epilogue of transfer() */
622 UNLOCK;
623
608 /* 624 /*
609 * this is a _very_ stripped down perl interpreter ;) 625 * this is a _very_ stripped down perl interpreter ;)
610 */ 626 */
611 UNLOCK;
612
613 PL_top_env = &PL_start_env; 627 PL_top_env = &PL_start_env;
628 /* inject call to cctx_init */
614 prepare_cctx ((coro_stack *)arg); 629 prepare_cctx ((coro_stack *)arg);
615 630
616 /* somebody will hit me for both perl_run and PL_restartop */ 631 /* somebody will hit me for both perl_run and PL_restartop */
617 perl_run (PERL_GET_CONTEXT); 632 perl_run (PL_curinterp);
618 633
619 fputs ("FATAL: C coroutine fell over the edge of the world, aborting.\n", stderr); 634 fputs ("FATAL: C coroutine fell over the edge of the world, aborting. Did you call exit in a coroutine?\n", stderr);
620 abort (); 635 abort ();
621} 636}
622 637
623static coro_stack * 638static coro_stack *
624stack_new () 639stack_new ()
… …
654 _exit (EXIT_FAILURE); 669 _exit (EXIT_FAILURE);
655 } 670 }
656 671
657#endif 672#endif
658 673
674#if USE_VALGRIND
675 stack->valgrind_id = VALGRIND_STACK_REGISTER (
676 STACKGUARD * PAGESIZE + (char *)stack->sptr,
677 stack->ssize + (char *)stack->sptr
678 );
679#endif
680
659 coro_create (&stack->cctx, coro_run, (void *)stack, stack->sptr, stack->ssize); 681 coro_create (&stack->cctx, coro_run, (void *)stack, stack->sptr, stack->ssize);
660 682
661 return stack; 683 return stack;
662} 684}
663 685
664static void 686static void
665stack_free (coro_stack *stack) 687stack_free (coro_stack *stack)
666{ 688{
667 if (!stack) 689 if (!stack)
668 return; 690 return;
691
692#if USE_VALGRIND
693 VALGRIND_STACK_DEREGISTER (stack->valgrind_id);
694#endif
669 695
670#if HAVE_MMAP 696#if HAVE_MMAP
671 munmap (stack->sptr, stack->ssize); 697 munmap (stack->sptr, stack->ssize);
672#else 698#else
673 Safefree (stack->sptr); 699 Safefree (stack->sptr);
… …
675 701
676 Safefree (stack); 702 Safefree (stack);
677} 703}
678 704
679static coro_stack *stack_first; 705static coro_stack *stack_first;
706static int cctx_count, cctx_idle;
680 707
681static coro_stack * 708static coro_stack *
682stack_get () 709stack_get ()
683{ 710{
684 coro_stack *stack; 711 coro_stack *stack;
685 712
686 if (stack_first) 713 if (stack_first)
687 { 714 {
715 --cctx_idle;
688 stack = stack_first; 716 stack = stack_first;
689 stack_first = stack->next; 717 stack_first = stack->next;
690 } 718 }
691 else 719 else
692 { 720 {
721 ++cctx_count;
693 stack = stack_new (); 722 stack = stack_new ();
694 PL_op = PL_op->op_next; 723 PL_op = PL_op->op_next;
695 } 724 }
696 725
697 return stack; 726 return stack;
698} 727}
699 728
700static void 729static void
701stack_put (coro_stack *stack) 730stack_put (coro_stack *stack)
702{ 731{
732 ++cctx_idle;
703 stack->next = stack_first; 733 stack->next = stack_first;
704 stack_first = stack; 734 stack_first = stack;
705} 735}
706 736
707/* never call directly, always through the coro_state_transfer global variable */ 737/* never call directly, always through the coro_state_transfer global variable */
… …
784 struct coro temp; 814 struct coro temp;
785 815
786 SAVE ((&temp), TRANSFER_SAVE_ALL); 816 SAVE ((&temp), TRANSFER_SAVE_ALL);
787 LOAD (coro); 817 LOAD (coro);
788 818
789 destroy_stacks (); 819 coro_destroy_stacks ();
790 820
791 LOAD ((&temp)); /* this will get rid of defsv etc.. */ 821 LOAD ((&temp)); /* this will get rid of defsv etc.. */
792 822
793 coro->mainstack = 0; 823 coro->mainstack = 0;
794 } 824 }
… …
823 0, 0, 0, 0, 853 0, 0, 0, 0,
824 coro_state_clear, 854 coro_state_clear,
825 0, 855 0,
826#ifdef MGf_DUP 856#ifdef MGf_DUP
827 coro_state_dup, 857 coro_state_dup,
858#else
859# define MGf_DUP 0
828#endif 860#endif
829}; 861};
830 862
831static struct coro * 863static struct coro *
832SvSTATE (SV *coro) 864SvSTATE (SV *coro)

Diff Legend

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