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.90 by root, Sat Nov 25 00:56:35 2006 UTC vs.
Revision 1.96 by root, Sun Nov 26 18:25:11 2006 UTC

27# ifndef IS_PADCONST 27# ifndef IS_PADCONST
28# define IS_PADCONST(v) 0 28# define IS_PADCONST(v) 0
29# endif 29# endif
30#endif 30#endif
31 31
32#include <stdio.h>
32#include <errno.h> 33#include <errno.h>
33 34
34#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64 35#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
35# undef STACKGUARD 36# undef STACKGUARD
36#endif 37#endif
57# else 58# else
58# define BOOT_PAGESIZE 59# define BOOT_PAGESIZE
59# endif 60# endif
60#endif 61#endif
61 62
62#define SUB_INIT "Coro::State::initialize"
63
64/* The next macro should declare a variable stacklevel that contains and approximation 63/* The next macro should declare a variable stacklevel that contains and approximation
65 * to the current C stack pointer. Its property is that it changes with each call 64 * to the current C stack pointer. Its property is that it changes with each call
66 * and should be unique. */ 65 * and should be unique. */
66#define dSTACKLEVEL int stacklevel
67#define dSTACKLEVEL void *stacklevel = &stacklevel 67#define STACKLEVEL ((void *)&stacklevel)
68 68
69#define IN_DESTRUCT (PL_main_cv == Nullcv) 69#define IN_DESTRUCT (PL_main_cv == Nullcv)
70 70
71#define labs(l) ((l) >= 0 ? (l) : -(l))
72
73#include "CoroAPI.h" 71#include "CoroAPI.h"
72
73#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */
74 74
75#ifdef USE_ITHREADS 75#ifdef USE_ITHREADS
76static perl_mutex coro_mutex; 76static perl_mutex coro_mutex;
77# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0) 77# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)
78# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0) 78# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)
84static struct CoroAPI coroapi; 84static struct CoroAPI coroapi;
85static AV *main_mainstack; /* used to differentiate between $main and others */ 85static AV *main_mainstack; /* used to differentiate between $main and others */
86static HV *coro_state_stash, *coro_stash; 86static HV *coro_state_stash, *coro_stash;
87static SV *coro_mortal; /* will be freed after next transfer */ 87static SV *coro_mortal; /* will be freed after next transfer */
88 88
89/* this is actually not just the c stack but also c registers etc... */ 89/* this is a structure representing a c-level coroutine */
90typedef struct coro_stack { 90typedef struct coro_stack {
91 struct coro_stack *next; 91 struct coro_stack *next;
92 92
93 void *idle_sp; 93 /* the stack */
94 void *sptr; 94 void *sptr;
95 long ssize; /* positive == mmap, otherwise malloc */ 95 long ssize; /* positive == mmap, otherwise malloc */
96 96
97 /* cpu state */ 97 /* cpu state */
98 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
99 JMPENV *top_env;
98 coro_context cctx; 100 coro_context cctx;
99} coro_stack; 101} coro_stack;
100 102
101static coro_stack *main_stack; 103/* this is a structure representing a perl-level coroutine */
102
103struct coro { 104struct coro {
105 /* the c coroutine allocated to this perl coroutine, if any */
106 coro_stack *stack;
107
108 /* data associated with this coroutine (initial args) */
109 AV *args;
110 int refcnt;
111
104 /* optionally saved, might be zero */ 112 /* optionally saved, might be zero */
105 AV *defav; 113 AV *defav;
106 SV *defsv; 114 SV *defsv;
107 SV *errsv; 115 SV *errsv;
108 116
109 /* saved global state not related to stacks */ 117 /* saved global state not related to stacks */
110 U8 dowarn; 118 U8 dowarn;
111 I32 in_eval; 119 I32 in_eval;
112
113 /* the c stack, if any */
114 coro_stack *stack;
115 120
116 /* the stacks and related info (callchain etc..) */ 121 /* the stacks and related info (callchain etc..) */
117 PERL_SI *curstackinfo; 122 PERL_SI *curstackinfo;
118 AV *curstack; 123 AV *curstack;
119 AV *mainstack; 124 AV *mainstack;
140 OP **retstack; 145 OP **retstack;
141 I32 retstack_ix; 146 I32 retstack_ix;
142 I32 retstack_max; 147 I32 retstack_max;
143 PMOP *curpm; 148 PMOP *curpm;
144 COP *curcop; 149 COP *curcop;
145 JMPENV *top_env;
146 150
147 /* coro process data */ 151 /* coro process data */
148 int prio; 152 int prio;
149
150 /* data associated with this coroutine (initial args) */
151 AV *args;
152 int refcnt;
153}; 153};
154 154
155typedef struct coro *Coro__State; 155typedef struct coro *Coro__State;
156typedef struct coro *Coro__State_or_hashref; 156typedef struct coro *Coro__State_or_hashref;
157 157
229 if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0) 229 if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0)
230 CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj); 230 CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj);
231 else 231 else
232 { 232 {
233#if 0 233#if 0
234 /* this should work - but it doesn't :( */ 234 /* this is probably cleaner, but also slower? */
235 CV *cp = Perl_cv_clone (aTHX_ cv); 235 CV *cp = Perl_cv_clone (aTHX_ cv);
236 CvPADLIST (cv) = CvPADLIST (cp); 236 CvPADLIST (cv) = CvPADLIST (cp);
237 CvPADLIST (cp) = 0; 237 CvPADLIST (cp) = 0;
238 SvREFCNT_dec (cp); 238 SvREFCNT_dec (cp);
239#else 239#else
300 PL_retstack_ix = c->retstack_ix; 300 PL_retstack_ix = c->retstack_ix;
301 PL_retstack_max = c->retstack_max; 301 PL_retstack_max = c->retstack_max;
302#endif 302#endif
303 PL_curpm = c->curpm; 303 PL_curpm = c->curpm;
304 PL_curcop = c->curcop; 304 PL_curcop = c->curcop;
305 PL_top_env = c->top_env;
306 305
307 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav); 306 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
308 if (c->defsv) REPLACE_SV (DEFSV , c->defsv); 307 if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
309 if (c->errsv) REPLACE_SV (ERRSV , c->errsv); 308 if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
310 309
428 c->retstack_ix = PL_retstack_ix; 427 c->retstack_ix = PL_retstack_ix;
429 c->retstack_max = PL_retstack_max; 428 c->retstack_max = PL_retstack_max;
430#endif 429#endif
431 c->curpm = PL_curpm; 430 c->curpm = PL_curpm;
432 c->curcop = PL_curcop; 431 c->curcop = PL_curcop;
433 c->top_env = PL_top_env;
434} 432}
435 433
436/* 434/*
437 * allocate various perl stacks. This is an exact copy 435 * allocate various perl stacks. This is an exact copy
438 * of perl.c:init_stacks, except that it uses less memory 436 * of perl.c:init_stacks, except that it uses less memory
540 * emulate part of the perl startup here. 538 * emulate part of the perl startup here.
541 */ 539 */
542 dTHX; 540 dTHX;
543 dSP; 541 dSP;
544 UNOP myop; 542 UNOP myop;
545 SV *sub_init = (SV *)get_cv (SUB_INIT, FALSE); 543 SV *sub_init = (SV *)get_cv ("Coro::State::coro_init", FALSE);
546 544
547 coro_init_stacks (aTHX); 545 coro_init_stacks (aTHX);
548 /*PL_curcop = 0;*/ 546 /*PL_curcop = 0;*/
549 /*PL_in_eval = PL_in_eval;*/ /* inherit */ 547 /*PL_in_eval = PL_in_eval;*/ /* inherit */
550 SvREFCNT_dec (GvAV (PL_defgv)); 548 SvREFCNT_dec (GvAV (PL_defgv));
566 564
567 ENTER; /* necessary e.g. for dounwind */ 565 ENTER; /* necessary e.g. for dounwind */
568} 566}
569 567
570static void 568static void
571transfer_tail () 569free_coro_mortal ()
572{ 570{
573 if (coro_mortal) 571 if (coro_mortal)
574 { 572 {
575 SvREFCNT_dec (coro_mortal); 573 SvREFCNT_dec (coro_mortal);
576 coro_mortal = 0; 574 coro_mortal = 0;
577 } 575 }
578
579 UNLOCK;
580} 576}
581 577
582static void 578static void
583coro_run (void *arg) 579coro_run (void *arg)
584{ 580{
585 /* 581 /*
586 * this is a _very_ stripped down perl interpreter ;) 582 * this is a _very_ stripped down perl interpreter ;)
587 */ 583 */
588 dTHX; 584 dTHX;
585 int ret;
589 586
590 transfer_tail (); 587 UNLOCK;
591 588
592 PL_top_env = &PL_start_env; 589 PL_top_env = &PL_start_env;
593 PL_restartop = PL_op->op_next; 590
591 sv_setiv (get_sv ("Coro::State::cctx_stack", FALSE), PTR2IV ((coro_stack *)arg));
592 sv_setiv (get_sv ("Coro::State::cctx_restartop", FALSE), PTR2IV (PL_op));
593
594 /* continue at cctx_init, without entersub */
595 PL_restartop = CvSTART (get_cv ("Coro::State::cctx_init", FALSE));
596
594 /* somebody will hit me for both perl_run and PL_restart_top */ 597 /* somebody will hit me for both perl_run and PL_restartop */
595 perl_run (aTHX_ PERL_GET_CONTEXT); 598 ret = perl_run (aTHX_ PERL_GET_CONTEXT);
599 printf ("ret %d\n", ret);//D
596 600
601 fputs ("FATAL: C coroutine fell over the edge of the world, aborting.\n", stderr);
597 abort (); 602 abort ();
598} 603}
599 604
600static coro_stack * 605static coro_stack *
601stack_new () 606stack_new ()
604 609
605 New (0, stack, 1, coro_stack); 610 New (0, stack, 1, coro_stack);
606 611
607#if HAVE_MMAP 612#if HAVE_MMAP
608 613
609 stack->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; /* mmap should do allocate-on-write for us */ 614 stack->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE;
615 /* mmap suppsedly does allocate-on-write for us */
610 stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 616 stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
611 617
612 if (stack->sptr == (void *)-1) 618 if (stack->sptr == (void *)-1)
613 { 619 {
614 fprintf (stderr, "FATAL: unable to mmap stack for coroutine\n"); 620 perror ("FATAL: unable to mmap stack for coroutine");
615 _exit (EXIT_FAILURE); 621 _exit (EXIT_FAILURE);
616 } 622 }
617 623
624# if STACKGUARD
618 mprotect (stack->sptr, STACKGUARD * PAGESIZE, PROT_NONE); 625 mprotect (stack->sptr, STACKGUARD * PAGESIZE, PROT_NONE);
626# endif
619 627
620#else 628#else
621 629
622 stack->ssize = STACKSIZE * (long)sizeof (long); 630 stack->ssize = STACKSIZE * (long)sizeof (long);
623 New (0, stack->sptr, STACKSIZE, long); 631 New (0, stack->sptr, STACKSIZE, long);
624 632
625 if (!stack->sptr) 633 if (!stack->sptr)
626 { 634 {
627 fprintf (stderr, "FATAL: unable to malloc stack for coroutine\n"); 635 perror (stderr, "FATAL: unable to malloc stack for coroutine");
628 _exit (EXIT_FAILURE); 636 _exit (EXIT_FAILURE);
629 } 637 }
630 638
631#endif 639#endif
632 640
633 coro_create (&stack->cctx, coro_run, 0, stack->sptr, stack->ssize); 641 coro_create (&stack->cctx, coro_run, (void *)stack, stack->sptr, stack->ssize);
634 642
635 return stack; 643 return stack;
636} 644}
637 645
638static void 646static void
639stack_free (coro_stack *stack) 647stack_free (coro_stack *stack)
640{ 648{
641 if (!stack || stack == main_stack) 649 if (!stack)
642 return; 650 return;
643 651
644#if HAVE_MMAP 652#if HAVE_MMAP
645 munmap (stack->sptr, stack->ssize); 653 munmap (stack->sptr, stack->ssize);
646#else 654#else
650 Safefree (stack); 658 Safefree (stack);
651} 659}
652 660
653static coro_stack *stack_first; 661static coro_stack *stack_first;
654 662
655static void 663static coro_stack *
656stack_get (struct coro *coro) 664stack_get ()
657{ 665{
666 coro_stack *stack;
667
658 if (stack_first) 668 if (stack_first)
659 { 669 {
660 coro->stack = stack_first; 670 stack = stack_first;
661 stack_first = stack_first->next; 671 stack_first = stack->next;
662 } 672 }
663 else 673 else
674 {
664 coro->stack = stack_new (); 675 stack = stack_new ();
676 PL_op = PL_op->op_next;
677 }
678
679 return stack;
665} 680}
666 681
667static void 682static void
668stack_put (coro_stack *stack) 683stack_put (coro_stack *stack)
669{ 684{
676transfer_impl (pTHX_ struct coro *prev, struct coro *next, int flags) 691transfer_impl (pTHX_ struct coro *prev, struct coro *next, int flags)
677{ 692{
678 dSTACKLEVEL; 693 dSTACKLEVEL;
679 694
680 /* sometimes transfer is only called to set idle_sp */ 695 /* sometimes transfer is only called to set idle_sp */
681 if (!prev->stack->idle_sp) 696 if (flags == TRANSFER_SET_STACKLEVEL)
682 prev->stack->idle_sp = stacklevel; 697 ((coro_stack *)prev)->idle_sp = STACKLEVEL;
683
684 LOCK;
685
686 if (prev != next) 698 else if (prev != next)
687 { 699 {
688 coro_stack *prev_stack = prev->stack; 700 coro_stack *prev__stack;
689 701
690 /* possibly "free" the stack */ 702 LOCK;
691 if (prev_stack->idle_sp == stacklevel)
692 {
693 stack_put (prev_stack);
694 prev->stack = 0;
695 }
696 703
697 if (next->mainstack) 704 if (next->mainstack)
698 { 705 {
699 /* coroutine already started */ 706 /* coroutine already started */
700 SAVE (prev, flags); 707 SAVE (prev, flags);
705 /* need to start coroutine */ 712 /* need to start coroutine */
706 /* first get rid of the old state */ 713 /* first get rid of the old state */
707 SAVE (prev, -1); 714 SAVE (prev, -1);
708 /* setup coroutine call */ 715 /* setup coroutine call */
709 setup_coro (next); 716 setup_coro (next);
710 /* need to change stack from main_stack to real one */ 717 /* need a stack */
711 next->stack = 0; 718 next->stack = 0;
712 } 719 }
713 720
721 if (!prev->stack)
722 /* create a new empty context */
723 Newz (0, prev->stack, 1, coro_stack);
724
725 prev__stack = prev->stack;
726
727 /* possibly "free" the stack */
728 if (prev__stack->idle_sp == STACKLEVEL)
729 {
730 stack_put (prev__stack);
731 prev->stack = 0;
732 }
733
714 if (!next->stack) 734 if (!next->stack)
715 stack_get (next); 735 next->stack = stack_get ();
716 736
717 if (prev_stack != next->stack) 737 if (prev__stack != next->stack)
738 {
739 prev__stack->top_env = PL_top_env;
740 PL_top_env = next->stack->top_env;
718 coro_transfer (&prev_stack->cctx, &next->stack->cctx); 741 coro_transfer (&prev__stack->cctx, &next->stack->cctx);
742 }
743
744 free_coro_mortal ();
745
746 UNLOCK;
719 } 747 }
720
721 transfer_tail ();
722} 748}
723 749
724/* use this function pointer to call the above function */ 750/* use this function pointer to call the above function */
725/* this is done to increase chances of the compiler not inlining the call */ 751/* this is done to increase chances of the compiler not inlining the call */
752/* not static to make it even harder for the compiler (and theoretically impossible in most cases */
726void (*coro_state_transfer)(pTHX_ struct coro *prev, struct coro *next, int flags) = transfer_impl; 753void (*coro_state_transfer)(pTHX_ struct coro *prev, struct coro *next, int flags) = transfer_impl;
754
755struct transfer_args
756{
757 struct coro *prev, *next;
758 int flags;
759};
760
761#define TRANSFER(ta) coro_state_transfer ((ta).prev, (ta).next, (ta).flags)
727 762
728static void 763static void
729coro_state_destroy (struct coro *coro) 764coro_state_destroy (struct coro *coro)
730{ 765{
731 if (coro->refcnt--) 766 if (coro->refcnt--)
794 assert (mg->mg_type == PERL_MAGIC_ext); 829 assert (mg->mg_type == PERL_MAGIC_ext);
795 return (struct coro *)mg->mg_ptr; 830 return (struct coro *)mg->mg_ptr;
796} 831}
797 832
798static void 833static void
834prepare_transfer (pTHX_ struct transfer_args *ta, SV *prev, SV *next, int flags)
835{
836 ta->prev = SvSTATE (prev);
837 ta->next = SvSTATE (next);
838 ta->flags = flags;
839}
840
841static void
799api_transfer (pTHX_ SV *prev, SV *next, int flags) 842api_transfer (SV *prev, SV *next, int flags)
800{ 843{
801 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); 844 dTHX;
845 struct transfer_args ta;
846
847 prepare_transfer (aTHX_ &ta, prev, next, flags);
848 TRANSFER (ta);
802} 849}
803 850
804/** Coro ********************************************************************/ 851/** Coro ********************************************************************/
805 852
806#define PRIO_MAX 3 853#define PRIO_MAX 3
860 coro_enq (aTHX_ SvREFCNT_inc (coro)); 907 coro_enq (aTHX_ SvREFCNT_inc (coro));
861 UNLOCK; 908 UNLOCK;
862} 909}
863 910
864static void 911static void
865api_schedule (void) 912prepare_schedule (aTHX_ struct transfer_args *ta)
866{ 913{
867 dTHX;
868
869 SV *prev, *next; 914 SV *current, *prev, *next;
915
916 LOCK;
917
870 SV *current = GvSV (coro_current); 918 current = GvSV (coro_current);
871 919
872 for (;;) 920 for (;;)
873 { 921 {
874 LOCK; 922 LOCK;
875 923
897 945
898 prev = SvRV (current); 946 prev = SvRV (current);
899 SvRV (current) = next; 947 SvRV (current) = next;
900 948
901 /* free this only after the transfer */ 949 /* free this only after the transfer */
950 free_coro_mortal ();
902 coro_mortal = prev; 951 coro_mortal = prev;
903 952
953 ta->prev = SvSTATE (prev);
954 ta->next = SvSTATE (next);
955 ta->flags = TRANSFER_SAVE_ALL;
956
904 UNLOCK; 957 UNLOCK;
905
906 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), TRANSFER_SAVE_ALL);
907} 958}
908 959
909static int coro_cede_self; 960static void
961prepare_cede (aTHX_ struct transfer_args *ta)
962{
963 LOCK;
964 coro_enq (aTHX_ SvREFCNT_inc (SvRV (GvSV (coro_current))));
965 UNLOCK;
966
967 prepare_schedule (ta);
968}
969
970static void
971api_schedule (void)
972{
973 dTHX;
974 struct transfer_args ta;
975
976 prepare_schedule (&ta);
977 TRANSFER (ta);
978}
910 979
911static void 980static void
912api_cede (void) 981api_cede (void)
913{ 982{
914 dTHX; 983 dTHX;
915 SV *current = SvREFCNT_inc (SvRV (GvSV (coro_current))); 984 struct transfer_args ta;
916 985
917 LOCK; 986 prepare_cede (&ta);
918 987 TRANSFER (ta);
919 if (coro_cede_self)
920 {
921 AV *runqueue = coro_ready [PRIO_MAX - PRIO_MIN];
922 av_unshift (runqueue, 1);
923 av_store (runqueue, 0, current);
924 coro_nready++;
925 coro_cede_self = 0;
926 }
927 else
928 coro_enq (aTHX_ current);
929
930 UNLOCK;
931
932 api_schedule ();
933} 988}
934 989
935MODULE = Coro::State PACKAGE = Coro::State 990MODULE = Coro::State PACKAGE = Coro::State
936 991
937PROTOTYPES: DISABLE 992PROTOTYPES: DISABLE
952 main_mainstack = PL_mainstack; 1007 main_mainstack = PL_mainstack;
953 1008
954 coroapi.ver = CORO_API_VERSION; 1009 coroapi.ver = CORO_API_VERSION;
955 coroapi.transfer = api_transfer; 1010 coroapi.transfer = api_transfer;
956 1011
957 Newz (0, main_stack, 1, coro_stack);
958 main_stack->idle_sp = (void *)-1;
959
960 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL)); 1012 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
961} 1013}
962 1014
963SV * 1015SV *
964new (char *klass, ...) 1016new (char *klass, ...)
973 1025
974 hv = newHV (); 1026 hv = newHV ();
975 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; 1027 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
976 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 1028 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
977 1029
978 av_push (coro->args, newSVsv (RETVAL));
979 for (i = 1; i < items; i++) 1030 for (i = 1; i < items; i++)
980 av_push (coro->args, newSVsv (ST (i))); 1031 av_push (coro->args, newSVsv (ST (i)));
981 1032
982 coro->stack = main_stack;
983 /*coro->mainstack = 0; *//*actual work is done inside transfer */ 1033 /*coro->mainstack = 0; *//*actual work is done inside transfer */
984 /*coro->stack = 0;*/ 1034 /*coro->stack = 0;*/
985} 1035}
986 OUTPUT: 1036 OUTPUT:
987 RETVAL 1037 RETVAL
988 1038
989void 1039void
990transfer (prev, next, flags) 1040_set_stacklevel (...)
991 SV *prev 1041 ALIAS:
992 SV *next 1042 Coro::State::transfer = 1
993 int flags 1043 Coro::schedule = 2
1044 Coro::cede = 3
1045 Coro::Cont::yield = 4
994 CODE: 1046 CODE:
995 PUTBACK;
996 coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags);
997 SPAGAIN;
998
999int
1000prio (Coro::State coro, int newprio = 0)
1001 ALIAS:
1002 nice = 1
1003 CODE:
1004{ 1047{
1005 RETVAL = coro->prio; 1048 struct transfer_args ta;
1006 1049
1007 if (items > 1) 1050 switch (ix)
1008 { 1051 {
1052 case 0:
1053 ta.prev = (struct coro *)INT2PTR (coro_stack *, SvIV (ST (0)));
1054 ta.next = 0;
1055 ta.flags = TRANSFER_SET_STACKLEVEL;
1056 break;
1057
1058 case 1:
1009 if (ix) 1059 if (items != 3)
1010 newprio += coro->prio; 1060 croak ("Coro::State::transfer(prev,next,flags) expects three arguments, not %d", items);
1011 1061
1012 if (newprio < PRIO_MIN) newprio = PRIO_MIN; 1062 prepare_transfer (&ta, ST (0), ST (1), SvIV (ST (2)));
1013 if (newprio > PRIO_MAX) newprio = PRIO_MAX; 1063 break;
1014 1064
1015 coro->prio = newprio; 1065 case 2:
1066 prepare_schedule (&ta);
1067 break;
1068
1069 case 3:
1070 prepare_cede (&ta);
1071 break;
1072
1073 case 4:
1074 {
1075 SV *yieldstack;
1076 SV *sv;
1077 AV *defav = GvAV (PL_defgv);
1078
1079 yieldstack = *hv_fetch (
1080 (HV *)SvRV (GvSV (coro_current)),
1081 "yieldstack", sizeof ("yieldstack") - 1,
1082 0
1083 );
1084
1085 /* set up @_ -- ugly */
1086 av_clear (defav);
1087 av_fill (defav, items - 1);
1088 while (items--)
1089 av_store (defav, items, SvREFCNT_inc (ST(items)));
1090
1091 sv = av_pop ((AV *)SvRV (yieldstack));
1092 ta.prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0));
1093 ta.next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0));
1094 ta.flags = 0;
1095 SvREFCNT_dec (sv);
1096 }
1097 break;
1098
1016 } 1099 }
1017}
1018 1100
1019void 1101 TRANSFER (ta);
1020_clear_idle_sp (Coro::State self) 1102}
1021 CODE:
1022 self->stack->idle_sp = 0;
1023 1103
1024void 1104void
1025_clone_state_from (SV *dst, SV *src) 1105_clone_state_from (SV *dst, SV *src)
1026 CODE: 1106 CODE:
1027{ 1107{
1030 sv_unmagic (SvRV (dst), PERL_MAGIC_ext); 1110 sv_unmagic (SvRV (dst), PERL_MAGIC_ext);
1031 1111
1032 ++coro_src->refcnt; 1112 ++coro_src->refcnt;
1033 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP; 1113 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP;
1034} 1114}
1115
1116void
1117_nonlocal_goto (IV nextop)
1118 CODE:
1119 /* uuh, somebody will kill me again for this */
1120 PL_op->op_next = INT2PTR (OP *, nextop);
1035 1121
1036void 1122void
1037_exit (code) 1123_exit (code)
1038 int code 1124 int code
1039 PROTOTYPE: $ 1125 PROTOTYPE: $
1040 CODE: 1126 CODE:
1041 _exit (code); 1127 _exit (code);
1042 1128
1043MODULE = Coro::State PACKAGE = Coro::Cont
1044
1045void
1046yield (...)
1047 PROTOTYPE: @
1048 CODE:
1049{
1050 SV *yieldstack;
1051 SV *sv;
1052 AV *defav = GvAV (PL_defgv);
1053 struct coro *prev, *next;
1054
1055 yieldstack = *hv_fetch (
1056 (HV *)SvRV (GvSV (coro_current)),
1057 "yieldstack", sizeof ("yieldstack") - 1,
1058 0
1059 );
1060
1061 /* set up @_ -- ugly */
1062 av_clear (defav);
1063 av_fill (defav, items - 1);
1064 while (items--)
1065 av_store (defav, items, SvREFCNT_inc (ST(items)));
1066
1067 sv = av_pop ((AV *)SvRV (yieldstack));
1068 prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0));
1069 next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0));
1070 SvREFCNT_dec (sv);
1071
1072 coro_state_transfer (aTHX_ prev, next, 0);
1073}
1074
1075MODULE = Coro::State PACKAGE = Coro 1129MODULE = Coro::State PACKAGE = Coro
1076 1130
1077BOOT: 1131BOOT:
1078{ 1132{
1079 int i; 1133 int i;
1104 1158
1105 GCoroAPI = &coroapi; 1159 GCoroAPI = &coroapi;
1106 sv_setiv (sv, (IV)&coroapi); 1160 sv_setiv (sv, (IV)&coroapi);
1107 SvREADONLY_on (sv); 1161 SvREADONLY_on (sv);
1108 } 1162 }
1163}
1164
1165int
1166prio (Coro::State coro, int newprio = 0)
1167 ALIAS:
1168 nice = 1
1169 CODE:
1170{
1171 RETVAL = coro->prio;
1172
1173 if (items > 1)
1174 {
1175 if (ix)
1176 newprio += coro->prio;
1177
1178 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1179 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1180
1181 coro->prio = newprio;
1182 }
1109} 1183}
1110 1184
1111void 1185void
1112ready (SV *self) 1186ready (SV *self)
1113 PROTOTYPE: $ 1187 PROTOTYPE: $
1120 CODE: 1194 CODE:
1121 RETVAL = coro_nready; 1195 RETVAL = coro_nready;
1122 OUTPUT: 1196 OUTPUT:
1123 RETVAL 1197 RETVAL
1124 1198
1125void
1126schedule (...)
1127 PROTOTYPE:
1128 CODE:
1129 api_schedule ();
1130
1131void
1132_set_cede_self ()
1133 CODE:
1134 coro_cede_self = 1;
1135
1136void
1137cede (...)
1138 PROTOTYPE:
1139 CODE:
1140 api_cede ();
1141
1142MODULE = Coro::State PACKAGE = Coro::AIO 1199MODULE = Coro::State PACKAGE = Coro::AIO
1143 1200
1144SV * 1201SV *
1145_get_state () 1202_get_state ()
1146 CODE: 1203 CODE:

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines