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.79 by root, Thu Nov 2 12:29:08 2006 UTC vs.
Revision 1.86 by root, Fri Nov 24 11:36:57 2006 UTC

100 void *sptr; 100 void *sptr;
101 long ssize; /* positive == mmap, otherwise malloc */ 101 long ssize; /* positive == mmap, otherwise malloc */
102} coro_stack; 102} coro_stack;
103 103
104struct coro { 104struct coro {
105 /* the top-level JMPENV for each coroutine, needed to catch dies. */
106 JMPENV start_env;
107
108 /* the optional C context */ 105 /* the optional C context */
109 coro_stack *stack; 106 coro_stack *stack;
110 void *cursp; 107 void *cursp;
111 int gencnt; 108 int gencnt;
112 109
629 } 626 }
630 else 627 else
631 { 628 {
632 UNOP myop; 629 UNOP myop;
633 630
634 PL_op = (OP *)&myop;
635
636 Zero(&myop, 1, UNOP); 631 Zero(&myop, 1, UNOP);
637 myop.op_next = Nullop; 632 myop.op_next = Nullop;
638 myop.op_flags = OPf_WANT_VOID; 633 myop.op_flags = OPf_WANT_VOID;
634
635 PL_op = (OP *)&myop;
639 636
640 PUSHMARK(SP); 637 PUSHMARK(SP);
641 XPUSHs (sub_init); 638 XPUSHs (sub_init);
642 /* 639 /*
643 * the next line is slightly wrong, as PL_op->op_next 640 * the next line is slightly wrong, as PL_op->op_next
661 * this is a _very_ stripped down perl interpreter ;) 658 * this is a _very_ stripped down perl interpreter ;)
662 */ 659 */
663 dTHX; 660 dTHX;
664 Coro__State ctx = (Coro__State)arg; 661 Coro__State ctx = (Coro__State)arg;
665 662
666 PL_top_env = &ctx->start_env; 663 PL_top_env = &PL_start_env;
667 664
668 ctx->cursp = 0; 665 ctx->cursp = 0;
669 PL_op = PL_op->op_next; 666 PL_op = PL_op->op_next;
670 CALLRUNOPS(aTHX); 667 CALLRUNOPS(aTHX);
671 668
672 abort (); 669 abort ();
673} 670}
674 671
672/* never call directly, always through the coro_state_transfer global variable */
675static void 673static void
676transfer (pTHX_ struct coro *prev, struct coro *next, int flags) 674transfer_impl (pTHX_ struct coro *prev, struct coro *next, int flags)
677{ 675{
678 dSTACKLEVEL; 676 dSTACKLEVEL;
679 677
680 if (prev != next) 678 if (prev != next)
681 { 679 {
680 /* has this coro been created yet? */
682 if (next->mainstack) 681 if (next->mainstack)
683 { 682 {
684 LOCK; 683 LOCK;
685 SAVE (prev, flags); 684 SAVE (prev, flags);
686 LOAD (next); 685 LOAD (next);
725 { 724 {
726 LOCK; 725 LOCK;
727 SAVE (prev, -1); /* first get rid of the old state */ 726 SAVE (prev, -1); /* first get rid of the old state */
728 UNLOCK; 727 UNLOCK;
729 728
729 /* create the coroutine for the first time */
730 if (flags & TRANSFER_SAVE_CCTXT) 730 if (flags & TRANSFER_SAVE_CCTXT)
731 { 731 {
732 if (!prev->stack) 732 if (!prev->stack)
733 allocate_stack (prev, 0); 733 allocate_stack (prev, 0);
734 734
735 /* the new coroutine starts with start_env again */
736 PL_top_env = &PL_start_env;
737
735 if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK) 738 if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK)
736 { 739 {
737 PL_top_env = &next->start_env;
738
739 setup_coro (next); 740 setup_coro (next);
740 next->cursp = stacklevel; 741 next->cursp = stacklevel;
741 742
742 prev->stack->refcnt++; 743 prev->stack->refcnt++;
743 prev->stack->usecnt++; 744 prev->stack->usecnt++;
771 coro_mortal = 0; 772 coro_mortal = 0;
772 } 773 }
773 UNLOCK; 774 UNLOCK;
774} 775}
775 776
777/* use this function pointer to call the above function */
778/* this is done to increase chances of the compiler not inlining the call */
779void (*coro_state_transfer)(pTHX_ struct coro *prev, struct coro *next, int flags) = transfer_impl;
780
776#define SV_CORO(sv,func) \ 781#define SV_CORO(sv,func) \
777 do { \ 782 do { \
778 if (SvROK (sv)) \ 783 if (SvROK (sv)) \
779 sv = SvRV (sv); \ 784 sv = SvRV (sv); \
780 \ 785 \
792 if (!SvOBJECT (sv) || SvSTASH (sv) != coro_state_stash) \ 797 if (!SvOBJECT (sv) || SvSTASH (sv) != coro_state_stash) \
793 croak ("%s() -- %s is not (and contains not) a Coro::State object", func, # sv); \ 798 croak ("%s() -- %s is not (and contains not) a Coro::State object", func, # sv); \
794 \ 799 \
795 } while(0) 800 } while(0)
796 801
797#define SvSTATE(sv) INT2PTR (struct coro *, SvIV (sv)) 802#define SvSTATE(sv) INT2PTR (struct coro *, SvIVX (sv))
798 803
799static void 804static void
800api_transfer(pTHX_ SV *prev, SV *next, int flags) 805api_transfer (pTHX_ SV *prev, SV *next, int flags)
801{ 806{
802 SV_CORO (prev, "Coro::transfer"); 807 SV_CORO (prev, "Coro::transfer");
803 SV_CORO (next, "Coro::transfer"); 808 SV_CORO (next, "Coro::transfer");
804 809
805 transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); 810 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags);
806} 811}
807 812
808/** Coro ********************************************************************/ 813/** Coro ********************************************************************/
809 814
810#define PRIO_MAX 3 815#define PRIO_MAX 3
814#define PRIO_IDLE -3 819#define PRIO_IDLE -3
815#define PRIO_MIN -4 820#define PRIO_MIN -4
816 821
817/* for Coro.pm */ 822/* for Coro.pm */
818static GV *coro_current, *coro_idle; 823static GV *coro_current, *coro_idle;
819static AV *coro_ready[PRIO_MAX-PRIO_MIN+1]; 824static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
820static int coro_nready; 825static int coro_nready;
821 826
822static void 827static void
823coro_enq (pTHX_ SV *sv) 828coro_enq (pTHX_ SV *sv)
824{ 829{
847 min_prio -= PRIO_MIN; 852 min_prio -= PRIO_MIN;
848 if (min_prio < 0) 853 if (min_prio < 0)
849 min_prio = 0; 854 min_prio = 0;
850 855
851 for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; ) 856 for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
852 if (av_len (coro_ready[prio]) >= 0) 857 if (AvFILLp (coro_ready [prio]) >= 0)
853 { 858 {
854 coro_nready--; 859 coro_nready--;
855 return av_shift (coro_ready[prio]); 860 return av_shift (coro_ready [prio]);
856 } 861 }
857 862
858 return 0; 863 return 0;
859} 864}
860 865
894 899
895 SV_CORO (next, "Coro::schedule"); 900 SV_CORO (next, "Coro::schedule");
896 901
897 UNLOCK; 902 UNLOCK;
898 903
899 transfer (aTHX_ SvSTATE (prev), SvSTATE (next), 904 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next),
900 TRANSFER_SAVE_ALL | TRANSFER_LAZY_STACK); 905 TRANSFER_SAVE_ALL | TRANSFER_LAZY_STACK);
901} 906}
902 907
903static void 908static void
904api_cede (void) 909api_cede (void)
905{ 910{
937 coroapi.ver = CORO_API_VERSION; 942 coroapi.ver = CORO_API_VERSION;
938 coroapi.transfer = api_transfer; 943 coroapi.transfer = api_transfer;
939} 944}
940 945
941Coro::State 946Coro::State
942_newprocess(args) 947new (char *klass, ...)
943 SV * args
944 PROTOTYPE: $ 948 PROTOTYPE: $@
945 CODE: 949 CODE:
950{
946 Coro__State coro; 951 Coro__State coro;
952 int i;
947 953
948 if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV) 954 if (!SvOK (ST (1)))
949 croak ("Coro::State::_newprocess expects an arrayref"); 955 croak ("Coro::State::new needs something callable as first argument");
950 956
951 Newz (0, coro, 1, struct coro); 957 Newz (0, coro, 1, struct coro);
958 coro->args = newAV ();
952 959
953 coro->args = (AV *)SvREFCNT_inc (SvRV (args)); 960 for (i = 1; i < items; i++)
961 av_push (coro->args, newSVsv (ST (i)));
962
963 RETVAL = coro;
964
954 /*coro->mainstack = 0; *//*actual work is done inside transfer */ 965 /*coro->mainstack = 0; *//*actual work is done inside transfer */
955 /*coro->stack = 0;*/ 966 /*coro->stack = 0;*/
956 967}
957 /* same as JMPENV_BOOTSTRAP */
958 /* we might be able to recycle start_env, but safe is safe */
959 /*Zero(&coro->start_env, 1, JMPENV);*/
960 coro->start_env.je_ret = -1;
961 coro->start_env.je_mustcatch = TRUE;
962
963 RETVAL = coro;
964 OUTPUT: 968 OUTPUT:
965 RETVAL 969 RETVAL
966 970
967void 971void
968transfer(prev, next, flags) 972transfer(prev, next, flags)
972 PROTOTYPE: @ 976 PROTOTYPE: @
973 CODE: 977 CODE:
974 PUTBACK; 978 PUTBACK;
975 SV_CORO (next, "Coro::transfer"); 979 SV_CORO (next, "Coro::transfer");
976 SV_CORO (prev, "Coro::transfer"); 980 SV_CORO (prev, "Coro::transfer");
977 transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); 981 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags);
978 SPAGAIN; 982 SPAGAIN;
979 983
980void 984void
981DESTROY(coro) 985DESTROY(coro)
982 Coro::State coro 986 Coro::State coro
1009 PROTOTYPE: $ 1013 PROTOTYPE: $
1010 CODE: 1014 CODE:
1011 _exit (code); 1015 _exit (code);
1012 1016
1013MODULE = Coro::State PACKAGE = Coro::Cont 1017MODULE = Coro::State PACKAGE = Coro::Cont
1014
1015# this is slightly dirty (should expose a c-level api)
1016 1018
1017void 1019void
1018yield(...) 1020yield(...)
1019 PROTOTYPE: @ 1021 PROTOTYPE: @
1020 CODE: 1022 CODE:
1034 av_fill (defav, items - 1); 1036 av_fill (defav, items - 1);
1035 while (items--) 1037 while (items--)
1036 av_store (defav, items, SvREFCNT_inc (ST(items))); 1038 av_store (defav, items, SvREFCNT_inc (ST(items)));
1037 1039
1038 sv = av_pop ((AV *)SvRV (yieldstack)); 1040 sv = av_pop ((AV *)SvRV (yieldstack));
1039 prev = INT2PTR (struct coro *, SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0)))); 1041 prev = SvSTATE ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0)));
1040 next = INT2PTR (struct coro *, SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0)))); 1042 next = SvSTATE ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0)));
1041 SvREFCNT_dec (sv); 1043 SvREFCNT_dec (sv);
1042 1044
1043 transfer (aTHX_ prev, next, 0); 1045 coro_state_transfer (aTHX_ prev, next, 0);
1044 1046
1045MODULE = Coro::State PACKAGE = Coro 1047MODULE = Coro::State PACKAGE = Coro
1046
1047# this is slightly dirty (should expose a c-level api)
1048 1048
1049BOOT: 1049BOOT:
1050{ 1050{
1051 int i; 1051 int i;
1052 HV *stash = gv_stashpv ("Coro", TRUE); 1052 HV *stash = gv_stashpv ("Coro", TRUE);
1072 coroapi.ready = api_ready; 1072 coroapi.ready = api_ready;
1073 coroapi.nready = &coro_nready; 1073 coroapi.nready = &coro_nready;
1074 coroapi.current = coro_current; 1074 coroapi.current = coro_current;
1075 1075
1076 GCoroAPI = &coroapi; 1076 GCoroAPI = &coroapi;
1077 sv_setiv(sv, (IV)&coroapi); 1077 sv_setiv (sv, (IV)&coroapi);
1078 SvREADONLY_on(sv); 1078 SvREADONLY_on (sv);
1079 } 1079 }
1080} 1080}
1081 1081
1082#if !PERL_MICRO 1082#if !PERL_MICRO
1083 1083

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines