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.98 by root, Sun Nov 26 21:25:53 2006 UTC vs.
Revision 1.104 by root, Mon Nov 27 01:51:02 2006 UTC

… …
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 8
9#if PERL_VERSION < 6 9#if USE_VALGRIND
10# include <valgrind/valgrind.h>
11#endif
12
13#define PERL_VERSION_ATLEAST(a,b,c) \
14 (PERL_REVISION > (a) \
15 || (PERL_REVISION == (a) \
16 && (PERL_VERSION > (b) \
17 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
18
19#if !PERL_VERSION_ATLEAST (5,6,0)
10# ifndef PL_ppaddr 20# ifndef PL_ppaddr
11# define PL_ppaddr ppaddr 21# define PL_ppaddr ppaddr
12# endif 22# endif
13# ifndef call_sv 23# ifndef call_sv
14# define call_sv perl_call_sv 24# define call_sv perl_call_sv
… …
64#define dSTACKLEVEL int stacklevel 74#define dSTACKLEVEL int stacklevel
65#define STACKLEVEL ((void *)&stacklevel) 75#define STACKLEVEL ((void *)&stacklevel)
66 76
67#define IN_DESTRUCT (PL_main_cv == Nullcv) 77#define IN_DESTRUCT (PL_main_cv == Nullcv)
68 78
79#if __GNUC__ >= 3
80# define attribute(x) __attribute__(x)
81#else
82# define attribute(x)
83#endif
84
85#define NOINLINE attribute ((noinline))
86
69#include "CoroAPI.h" 87#include "CoroAPI.h"
70 88
71#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */ 89#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */
72 90
73#ifdef USE_ITHREADS 91#ifdef USE_ITHREADS
… …
94 112
95 /* cpu state */ 113 /* cpu state */
96 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 114 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
97 JMPENV *top_env; 115 JMPENV *top_env;
98 coro_context cctx; 116 coro_context cctx;
117
118#if USE_VALGRIND
119 int valgrind_id;
120#endif
99} coro_stack; 121} coro_stack;
100 122
101/* this is a structure representing a perl-level coroutine */ 123/* this is a structure representing a perl-level coroutine */
102struct coro { 124struct coro {
103 /* the c coroutine allocated to this perl coroutine, if any */ 125 /* the c coroutine allocated to this perl coroutine, if any */
… …
159 AV *padlist = CvPADLIST (cv); 181 AV *padlist = CvPADLIST (cv);
160 AV *newpadlist, *newpad; 182 AV *newpadlist, *newpad;
161 183
162 newpadlist = newAV (); 184 newpadlist = newAV ();
163 AvREAL_off (newpadlist); 185 AvREAL_off (newpadlist);
164#if PERL_VERSION < 9 186#if PERL_VERSION_ATLEAST (5,9,0)
187 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
188#else
165 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); 189 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
166#else
167 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
168#endif 190#endif
169 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; 191 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
170 --AvFILLp (padlist); 192 --AvFILLp (padlist);
171 193
172 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE))); 194 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE)));
… …
291 PL_scopestack_ix = c->scopestack_ix; 313 PL_scopestack_ix = c->scopestack_ix;
292 PL_scopestack_max = c->scopestack_max; 314 PL_scopestack_max = c->scopestack_max;
293 PL_savestack = c->savestack; 315 PL_savestack = c->savestack;
294 PL_savestack_ix = c->savestack_ix; 316 PL_savestack_ix = c->savestack_ix;
295 PL_savestack_max = c->savestack_max; 317 PL_savestack_max = c->savestack_max;
296#if PERL_VERSION < 9 318#if !PERL_VERSION_ATLEAST (5,9,0)
297 PL_retstack = c->retstack; 319 PL_retstack = c->retstack;
298 PL_retstack_ix = c->retstack_ix; 320 PL_retstack_ix = c->retstack_ix;
299 PL_retstack_max = c->retstack_max; 321 PL_retstack_max = c->retstack_max;
300#endif 322#endif
301 PL_curpm = c->curpm; 323 PL_curpm = c->curpm;
… …
418 c->scopestack_ix = PL_scopestack_ix; 440 c->scopestack_ix = PL_scopestack_ix;
419 c->scopestack_max = PL_scopestack_max; 441 c->scopestack_max = PL_scopestack_max;
420 c->savestack = PL_savestack; 442 c->savestack = PL_savestack;
421 c->savestack_ix = PL_savestack_ix; 443 c->savestack_ix = PL_savestack_ix;
422 c->savestack_max = PL_savestack_max; 444 c->savestack_max = PL_savestack_max;
423#if PERL_VERSION < 9 445#if !PERL_VERSION_ATLEAST (5,9,0)
424 c->retstack = PL_retstack; 446 c->retstack = PL_retstack;
425 c->retstack_ix = PL_retstack_ix; 447 c->retstack_ix = PL_retstack_ix;
426 c->retstack_max = PL_retstack_max; 448 c->retstack_max = PL_retstack_max;
427#endif 449#endif
428 c->curpm = PL_curpm; 450 c->curpm = PL_curpm;
… …
436 * not usually need a lot of stackspace. 458 * not usually need a lot of stackspace.
437 */ 459 */
438static void 460static void
439coro_init_stacks () 461coro_init_stacks ()
440{ 462{
441 LOCK;
442
443 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1); 463 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1);
444 PL_curstackinfo->si_type = PERLSI_MAIN; 464 PL_curstackinfo->si_type = PERLSI_MAIN;
445 PL_curstack = PL_curstackinfo->si_stack; 465 PL_curstack = PL_curstackinfo->si_stack;
446 PL_mainstack = PL_curstack; /* remember in case we switch stacks */ 466 PL_mainstack = PL_curstack; /* remember in case we switch stacks */
447 467
… …
468 488
469 New(54,PL_savestack,96,ANY); 489 New(54,PL_savestack,96,ANY);
470 PL_savestack_ix = 0; 490 PL_savestack_ix = 0;
471 PL_savestack_max = 96; 491 PL_savestack_max = 96;
472 492
473#if PERL_VERSION < 9 493#if !PERL_VERSION_ATLEAST (5,9,0)
474 New(54,PL_retstack,8,OP*); 494 New(54,PL_retstack,8,OP*);
475 PL_retstack_ix = 0; 495 PL_retstack_ix = 0;
476 PL_retstack_max = 8; 496 PL_retstack_max = 8;
477#endif 497#endif
478
479 UNLOCK;
480} 498}
481 499
482/* 500/*
483 * destroy the stacks, the callchain etc... 501 * destroy the stacks, the callchain etc...
484 */ 502 */
485static void 503static void
486destroy_stacks() 504coro_destroy_stacks()
487{ 505{
488 if (!IN_DESTRUCT) 506 if (!IN_DESTRUCT)
489 { 507 {
490 /* is this ugly, I ask? */ 508 /* is this ugly, I ask? */
491 LEAVE_SCOPE (0); 509 LEAVE_SCOPE (0);
… …
522 540
523 Safefree (PL_tmps_stack); 541 Safefree (PL_tmps_stack);
524 Safefree (PL_markstack); 542 Safefree (PL_markstack);
525 Safefree (PL_scopestack); 543 Safefree (PL_scopestack);
526 Safefree (PL_savestack); 544 Safefree (PL_savestack);
527#if PERL_VERSION < 9 545#if !PERL_VERSION_ATLEAST (5,9,0)
528 Safefree (PL_retstack); 546 Safefree (PL_retstack);
529#endif 547#endif
530} 548}
531 549
532static void 550static void
533setup_coro (struct coro *coro) 551setup_coro (struct coro *coro)
534{ 552{
535 /* 553 /*
536 * emulate part of the perl startup here. 554 * emulate part of the perl startup here.
537 */ 555 */
538 dTHX;
539 dSP;
540 UNOP myop;
541 SV *sub_init = (SV *)get_cv ("Coro::State::coro_init", FALSE);
542 556
543 coro_init_stacks (); 557 coro_init_stacks ();
558
544 /*PL_curcop = 0;*/ 559 PL_curcop = 0;
545 /*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
546 SvREFCNT_dec (GvAV (PL_defgv)); 570 SvREFCNT_dec (GvAV (PL_defgv));
547 GvAV (PL_defgv) = coro->args; coro->args = 0; 571 GvAV (PL_defgv) = coro->args; coro->args = 0;
548 572
549 SPAGAIN;
550
551 Zero (&myop, 1, UNOP); 573 Zero (&myop, 1, LOGOP);
552 myop.op_next = Nullop; 574 myop.op_next = Nullop;
553 myop.op_flags = OPf_WANT_VOID; 575 myop.op_flags = OPf_WANT_VOID;
554 576
555 PL_op = (OP *)&myop; 577 PL_op = (OP *)&myop;
556 578
557 PUSHMARK(SP); 579 PUSHMARK (SP);
558 XPUSHs (sub_init); 580 XPUSHs ((SV *)get_cv ("Coro::State::coro_init", FALSE));
559 PUTBACK; 581 PUTBACK;
560 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 582 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
561 SPAGAIN; 583 SPAGAIN;
562 584
563 ENTER; /* necessary e.g. for dounwind */ 585 ENTER; /* necessary e.g. for dounwind */
586 }
564} 587}
565 588
566static void 589static void
567free_coro_mortal () 590free_coro_mortal ()
568{ 591{
… …
571 SvREFCNT_dec (coro_mortal); 594 SvREFCNT_dec (coro_mortal);
572 coro_mortal = 0; 595 coro_mortal = 0;
573 } 596 }
574} 597}
575 598
599static void NOINLINE
600prepare_cctx (coro_stack *cctx)
601{
602 dSP;
603 LOGOP myop;
604
605 Zero (&myop, 1, LOGOP);
606 myop.op_next = PL_op;
607 myop.op_flags = OPf_WANT_VOID;
608
609 sv_setiv (get_sv ("Coro::State::cctx_stack", FALSE), PTR2IV (cctx));
610
611 PUSHMARK (SP);
612 XPUSHs ((SV *)get_cv ("Coro::State::cctx_init", FALSE));
613 PUTBACK;
614 PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX);
615 SPAGAIN;
616}
617
576static void 618static void
577coro_run (void *arg) 619coro_run (void *arg)
578{ 620{
621 /* coro_run is the alternative epilogue of transfer() */
622 UNLOCK;
623
579 /* 624 /*
580 * this is a _very_ stripped down perl interpreter ;) 625 * this is a _very_ stripped down perl interpreter ;)
581 */ 626 */
582 dTHX;
583 int ret;
584
585 UNLOCK;
586
587 PL_top_env = &PL_start_env; 627 PL_top_env = &PL_start_env;
588 628 /* inject call to cctx_init */
589 sv_setiv (get_sv ("Coro::State::cctx_stack", FALSE), PTR2IV ((coro_stack *)arg)); 629 prepare_cctx ((coro_stack *)arg);
590 sv_setiv (get_sv ("Coro::State::cctx_restartop", FALSE), PTR2IV (PL_op));
591
592 /* continue at cctx_init, without entersub */
593 PL_restartop = CvSTART (get_cv ("Coro::State::cctx_init", FALSE));
594 630
595 /* somebody will hit me for both perl_run and PL_restartop */ 631 /* somebody will hit me for both perl_run and PL_restartop */
596 ret = perl_run (PERL_GET_CONTEXT); 632 perl_run (PL_curinterp);
597 printf ("ret %d\n", ret);//D
598 633
599 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.\n", stderr);
600 abort (); 635 abort ();
601} 636}
602 637
… …
634 _exit (EXIT_FAILURE); 669 _exit (EXIT_FAILURE);
635 } 670 }
636 671
637#endif 672#endif
638 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
639 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);
640 682
641 return stack; 683 return stack;
642} 684}
643 685
644static void 686static void
645stack_free (coro_stack *stack) 687stack_free (coro_stack *stack)
646{ 688{
647 if (!stack) 689 if (!stack)
648 return; 690 return;
691
692#if USE_VALGRIND
693 VALGRIND_STACK_DEREGISTER (stack->valgrind_id);
694#endif
649 695
650#if HAVE_MMAP 696#if HAVE_MMAP
651 munmap (stack->sptr, stack->ssize); 697 munmap (stack->sptr, stack->ssize);
652#else 698#else
653 Safefree (stack->sptr); 699 Safefree (stack->sptr);
… …
655 701
656 Safefree (stack); 702 Safefree (stack);
657} 703}
658 704
659static coro_stack *stack_first; 705static coro_stack *stack_first;
706static int cctx_count, cctx_idle;
660 707
661static coro_stack * 708static coro_stack *
662stack_get () 709stack_get ()
663{ 710{
664 coro_stack *stack; 711 coro_stack *stack;
665 712
666 if (stack_first) 713 if (stack_first)
667 { 714 {
715 --cctx_idle;
668 stack = stack_first; 716 stack = stack_first;
669 stack_first = stack->next; 717 stack_first = stack->next;
670 } 718 }
671 else 719 else
672 { 720 {
721 ++cctx_count;
673 stack = stack_new (); 722 stack = stack_new ();
674 PL_op = PL_op->op_next; 723 PL_op = PL_op->op_next;
675 } 724 }
676 725
677 return stack; 726 return stack;
678} 727}
679 728
680static void 729static void
681stack_put (coro_stack *stack) 730stack_put (coro_stack *stack)
682{ 731{
732 ++cctx_idle;
683 stack->next = stack_first; 733 stack->next = stack_first;
684 stack_first = stack; 734 stack_first = stack;
685} 735}
686 736
687/* never call directly, always through the coro_state_transfer global variable */ 737/* never call directly, always through the coro_state_transfer global variable */
688static void 738static void NOINLINE
689transfer_impl (struct coro *prev, struct coro *next, int flags) 739transfer (struct coro *prev, struct coro *next, int flags)
690{ 740{
691 dSTACKLEVEL; 741 dSTACKLEVEL;
692 742
693 /* sometimes transfer is only called to set idle_sp */ 743 /* sometimes transfer is only called to set idle_sp */
694 if (flags == TRANSFER_SET_STACKLEVEL) 744 if (flags == TRANSFER_SET_STACKLEVEL)
… …
743 793
744 UNLOCK; 794 UNLOCK;
745 } 795 }
746} 796}
747 797
748/* use this function pointer to call the above function */
749/* this is done to increase chances of the compiler not inlining the call */
750/* not static to make it even harder for the compiler (and theoretically impossible in most cases */
751void (*coro_state_transfer)(struct coro *prev, struct coro *next, int flags) = transfer_impl;
752
753struct transfer_args 798struct transfer_args
754{ 799{
755 struct coro *prev, *next; 800 struct coro *prev, *next;
756 int flags; 801 int flags;
757}; 802};
758 803
759#define TRANSFER(ta) coro_state_transfer ((ta).prev, (ta).next, (ta).flags) 804#define TRANSFER(ta) transfer ((ta).prev, (ta).next, (ta).flags)
760 805
761static void 806static void
762coro_state_destroy (struct coro *coro) 807coro_state_destroy (struct coro *coro)
763{ 808{
764 if (coro->refcnt--) 809 if (coro->refcnt--)
… …
769 struct coro temp; 814 struct coro temp;
770 815
771 SAVE ((&temp), TRANSFER_SAVE_ALL); 816 SAVE ((&temp), TRANSFER_SAVE_ALL);
772 LOAD (coro); 817 LOAD (coro);
773 818
774 destroy_stacks (); 819 coro_destroy_stacks ();
775 820
776 LOAD ((&temp)); /* this will get rid of defsv etc.. */ 821 LOAD ((&temp)); /* this will get rid of defsv etc.. */
777 822
778 coro->mainstack = 0; 823 coro->mainstack = 0;
779 } 824 }
… …
802 ++coro->refcnt; 847 ++coro->refcnt;
803 848
804 return 0; 849 return 0;
805} 850}
806 851
807static MGVTBL coro_state_vtbl = { 0, 0, 0, 0, coro_state_clear, 0, coro_state_dup, 0 }; 852static MGVTBL coro_state_vtbl = {
853 0, 0, 0, 0,
854 coro_state_clear,
855 0,
856#ifdef MGf_DUP
857 coro_state_dup,
858#else
859# define MGf_DUP 0
860#endif
861};
808 862
809static struct coro * 863static struct coro *
810SvSTATE (SV *coro) 864SvSTATE (SV *coro)
811{ 865{
812 HV *stash; 866 HV *stash;
… …
909static void 963static void
910prepare_schedule (struct transfer_args *ta) 964prepare_schedule (struct transfer_args *ta)
911{ 965{
912 SV *current, *prev, *next; 966 SV *current, *prev, *next;
913 967
914 LOCK;
915
916 current = GvSV (coro_current); 968 current = GvSV (coro_current);
917 969
918 for (;;) 970 for (;;)
919 { 971 {
920 LOCK; 972 LOCK;
921
922 next = coro_deq (PRIO_MIN); 973 next = coro_deq (PRIO_MIN);
974 UNLOCK;
923 975
924 if (next) 976 if (next)
925 break; 977 break;
926
927 UNLOCK;
928 978
929 { 979 {
930 dSP; 980 dSP;
931 981
932 ENTER; 982 ENTER;
… …
943 993
944 prev = SvRV (current); 994 prev = SvRV (current);
945 SvRV (current) = next; 995 SvRV (current) = next;
946 996
947 /* free this only after the transfer */ 997 /* free this only after the transfer */
998 LOCK;
948 free_coro_mortal (); 999 free_coro_mortal ();
1000 UNLOCK;
949 coro_mortal = prev; 1001 coro_mortal = prev;
950 1002
951 ta->prev = SvSTATE (prev); 1003 ta->prev = SvSTATE (prev);
952 ta->next = SvSTATE (next); 1004 ta->next = SvSTATE (next);
953 ta->flags = TRANSFER_SAVE_ALL; 1005 ta->flags = TRANSFER_SAVE_ALL;
954
955 UNLOCK;
956} 1006}
957 1007
958static void 1008static void
959prepare_cede (struct transfer_args *ta) 1009prepare_cede (struct transfer_args *ta)
960{ 1010{
… …
1110 ++coro_src->refcnt; 1160 ++coro_src->refcnt;
1111 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP; 1161 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP;
1112} 1162}
1113 1163
1114void 1164void
1115_nonlocal_goto (IV nextop)
1116 CODE:
1117 /* uuh, somebody will kill me again for this */
1118 PL_op->op_next = INT2PTR (OP *, nextop);
1119
1120void
1121_exit (code) 1165_exit (code)
1122 int code 1166 int code
1123 PROTOTYPE: $ 1167 PROTOTYPE: $
1124 CODE: 1168 CODE:
1125 _exit (code); 1169 _exit (code);

Diff Legend

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