… | |
… | |
29 | # endif |
29 | # endif |
30 | #endif |
30 | #endif |
31 | |
31 | |
32 | #include <errno.h> |
32 | #include <errno.h> |
33 | |
33 | |
|
|
34 | #if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64 |
|
|
35 | # undef STACKGUARD |
|
|
36 | #endif |
|
|
37 | |
|
|
38 | #ifndef STACKGUARD |
|
|
39 | # define STACKGUARD 0 |
|
|
40 | #endif |
|
|
41 | |
34 | #ifdef HAVE_MMAP |
42 | #ifdef HAVE_MMAP |
35 | # include <unistd.h> |
43 | # include <unistd.h> |
36 | # include <sys/mman.h> |
44 | # include <sys/mman.h> |
37 | # ifndef MAP_ANONYMOUS |
45 | # ifndef MAP_ANONYMOUS |
38 | # ifdef MAP_ANON |
46 | # ifdef MAP_ANON |
39 | # define MAP_ANONYMOUS MAP_ANON |
47 | # define MAP_ANONYMOUS MAP_ANON |
40 | # else |
48 | # else |
41 | # undef HAVE_MMAP |
49 | # undef HAVE_MMAP |
42 | # endif |
50 | # endif |
43 | # endif |
51 | # endif |
|
|
52 | # include <limits.h> |
|
|
53 | # ifndef PAGESIZE |
|
|
54 | # define PAGESIZE pagesize |
|
|
55 | # define BOOT_PAGESIZE pagesize = sysconf (_SC_PAGESIZE) |
|
|
56 | static long pagesize; |
|
|
57 | # else |
|
|
58 | # define BOOT_PAGESIZE |
|
|
59 | # endif |
44 | #endif |
60 | #endif |
45 | |
61 | |
46 | #define SUB_INIT "Coro::State::initialize" |
62 | #define SUB_INIT "Coro::State::initialize" |
47 | #define UCORO_STATE "_coro_state" |
63 | #define UCORO_STATE "_coro_state" |
48 | |
64 | |
… | |
… | |
84 | void *sptr; |
100 | void *sptr; |
85 | long ssize; /* positive == mmap, otherwise malloc */ |
101 | long ssize; /* positive == mmap, otherwise malloc */ |
86 | } coro_stack; |
102 | } coro_stack; |
87 | |
103 | |
88 | struct coro { |
104 | struct coro { |
89 | /* the top-level JMPENV for each coroutine, needed to catch dies. */ |
|
|
90 | JMPENV start_env; |
|
|
91 | |
|
|
92 | /* the optional C context */ |
105 | /* the optional C context */ |
93 | coro_stack *stack; |
106 | coro_stack *stack; |
94 | void *cursp; |
107 | void *cursp; |
95 | int gencnt; |
108 | int gencnt; |
96 | |
109 | |
… | |
… | |
147 | AV *padlist = CvPADLIST (cv); |
160 | AV *padlist = CvPADLIST (cv); |
148 | AV *newpadlist, *newpad; |
161 | AV *newpadlist, *newpad; |
149 | |
162 | |
150 | newpadlist = newAV (); |
163 | newpadlist = newAV (); |
151 | AvREAL_off (newpadlist); |
164 | AvREAL_off (newpadlist); |
|
|
165 | #if PERL_VERSION < 9 |
152 | Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); |
166 | Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); |
|
|
167 | #else |
|
|
168 | Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1); |
|
|
169 | #endif |
153 | newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; |
170 | newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; |
154 | --AvFILLp (padlist); |
171 | --AvFILLp (padlist); |
155 | |
172 | |
156 | av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE))); |
173 | av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE))); |
157 | av_store (newpadlist, 1, (SV *)newpad); |
174 | av_store (newpadlist, 1, (SV *)newpad); |
… | |
… | |
527 | stack->gencnt = ctx->gencnt = 0; |
544 | stack->gencnt = ctx->gencnt = 0; |
528 | |
545 | |
529 | if (alloc) |
546 | if (alloc) |
530 | { |
547 | { |
531 | #if HAVE_MMAP |
548 | #if HAVE_MMAP |
532 | stack->ssize = STACKSIZE * sizeof (long); /* mmap should do allocate-on-write for us */ |
549 | stack->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; /* mmap should do allocate-on-write for us */ |
533 | stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); |
550 | stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); |
534 | if (stack->sptr == (void *)-1) |
551 | if (stack->sptr != (void *)-1) |
|
|
552 | { |
|
|
553 | # if STACKGUARD |
|
|
554 | mprotect (stack->sptr, STACKGUARD * PAGESIZE, PROT_NONE); |
|
|
555 | # endif |
|
|
556 | } |
|
|
557 | else |
535 | #endif |
558 | #endif |
536 | { |
559 | { |
537 | stack->ssize = - (STACKSIZE * (long)sizeof (long)); |
560 | stack->ssize = - (STACKSIZE * (long)sizeof (long)); |
538 | New (0, stack->sptr, STACKSIZE, long); |
561 | New (0, stack->sptr, STACKSIZE, long); |
539 | } |
562 | } |
… | |
… | |
603 | } |
626 | } |
604 | else |
627 | else |
605 | { |
628 | { |
606 | UNOP myop; |
629 | UNOP myop; |
607 | |
630 | |
608 | PL_op = (OP *)&myop; |
|
|
609 | |
|
|
610 | Zero(&myop, 1, UNOP); |
631 | Zero(&myop, 1, UNOP); |
611 | myop.op_next = Nullop; |
632 | myop.op_next = Nullop; |
612 | myop.op_flags = OPf_WANT_VOID; |
633 | myop.op_flags = OPf_WANT_VOID; |
|
|
634 | |
|
|
635 | PL_op = (OP *)&myop; |
613 | |
636 | |
614 | PUSHMARK(SP); |
637 | PUSHMARK(SP); |
615 | XPUSHs (sub_init); |
638 | XPUSHs (sub_init); |
616 | /* |
639 | /* |
617 | * the next line is slightly wrong, as PL_op->op_next |
640 | * the next line is slightly wrong, as PL_op->op_next |
… | |
… | |
635 | * this is a _very_ stripped down perl interpreter ;) |
658 | * this is a _very_ stripped down perl interpreter ;) |
636 | */ |
659 | */ |
637 | dTHX; |
660 | dTHX; |
638 | Coro__State ctx = (Coro__State)arg; |
661 | Coro__State ctx = (Coro__State)arg; |
639 | |
662 | |
640 | PL_top_env = &ctx->start_env; |
663 | PL_top_env = &PL_start_env; |
641 | |
664 | |
642 | ctx->cursp = 0; |
665 | ctx->cursp = 0; |
643 | PL_op = PL_op->op_next; |
666 | PL_op = PL_op->op_next; |
644 | CALLRUNOPS(aTHX); |
667 | CALLRUNOPS(aTHX); |
645 | |
668 | |
… | |
… | |
651 | { |
674 | { |
652 | dSTACKLEVEL; |
675 | dSTACKLEVEL; |
653 | |
676 | |
654 | if (prev != next) |
677 | if (prev != next) |
655 | { |
678 | { |
|
|
679 | /* has this coro been created yet? */ |
656 | if (next->mainstack) |
680 | if (next->mainstack) |
657 | { |
681 | { |
658 | LOCK; |
682 | LOCK; |
659 | SAVE (prev, flags); |
683 | SAVE (prev, flags); |
660 | LOAD (next); |
684 | LOAD (next); |
… | |
… | |
699 | { |
723 | { |
700 | LOCK; |
724 | LOCK; |
701 | SAVE (prev, -1); /* first get rid of the old state */ |
725 | SAVE (prev, -1); /* first get rid of the old state */ |
702 | UNLOCK; |
726 | UNLOCK; |
703 | |
727 | |
|
|
728 | /* create the coroutine for the first time */ |
704 | if (flags & TRANSFER_SAVE_CCTXT) |
729 | if (flags & TRANSFER_SAVE_CCTXT) |
705 | { |
730 | { |
706 | if (!prev->stack) |
731 | if (!prev->stack) |
707 | allocate_stack (prev, 0); |
732 | allocate_stack (prev, 0); |
708 | |
733 | |
|
|
734 | /* the new coroutine starts with start_env again */ |
|
|
735 | PL_top_env = &PL_start_env; |
|
|
736 | |
709 | if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK) |
737 | if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK) |
710 | { |
738 | { |
711 | PL_top_env = &next->start_env; |
|
|
712 | |
|
|
713 | setup_coro (next); |
739 | setup_coro (next); |
714 | next->cursp = stacklevel; |
740 | next->cursp = stacklevel; |
715 | |
741 | |
716 | prev->stack->refcnt++; |
742 | prev->stack->refcnt++; |
717 | prev->stack->usecnt++; |
743 | prev->stack->usecnt++; |
… | |
… | |
893 | BOOT: |
919 | BOOT: |
894 | { /* {} necessary for stoopid perl-5.6.x */ |
920 | { /* {} necessary for stoopid perl-5.6.x */ |
895 | #ifdef USE_ITHREADS |
921 | #ifdef USE_ITHREADS |
896 | MUTEX_INIT (&coro_mutex); |
922 | MUTEX_INIT (&coro_mutex); |
897 | #endif |
923 | #endif |
|
|
924 | BOOT_PAGESIZE; |
898 | |
925 | |
899 | ucoro_state_sv = newSVpv (UCORO_STATE, sizeof(UCORO_STATE) - 1); |
926 | ucoro_state_sv = newSVpv (UCORO_STATE, sizeof(UCORO_STATE) - 1); |
900 | PERL_HASH(ucoro_state_hash, UCORO_STATE, sizeof(UCORO_STATE) - 1); |
927 | PERL_HASH(ucoro_state_hash, UCORO_STATE, sizeof(UCORO_STATE) - 1); |
901 | coro_state_stash = gv_stashpv ("Coro::State", TRUE); |
928 | coro_state_stash = gv_stashpv ("Coro::State", TRUE); |
902 | |
929 | |
… | |
… | |
924 | Newz (0, coro, 1, struct coro); |
951 | Newz (0, coro, 1, struct coro); |
925 | |
952 | |
926 | coro->args = (AV *)SvREFCNT_inc (SvRV (args)); |
953 | coro->args = (AV *)SvREFCNT_inc (SvRV (args)); |
927 | /*coro->mainstack = 0; *//*actual work is done inside transfer */ |
954 | /*coro->mainstack = 0; *//*actual work is done inside transfer */ |
928 | /*coro->stack = 0;*/ |
955 | /*coro->stack = 0;*/ |
929 | |
|
|
930 | /* same as JMPENV_BOOTSTRAP */ |
|
|
931 | /* we might be able to recycle start_env, but safe is safe */ |
|
|
932 | /*Zero(&coro->start_env, 1, JMPENV);*/ |
|
|
933 | coro->start_env.je_ret = -1; |
|
|
934 | coro->start_env.je_mustcatch = TRUE; |
|
|
935 | |
956 | |
936 | RETVAL = coro; |
957 | RETVAL = coro; |
937 | OUTPUT: |
958 | OUTPUT: |
938 | RETVAL |
959 | RETVAL |
939 | |
960 | |
… | |
… | |
983 | CODE: |
1004 | CODE: |
984 | _exit (code); |
1005 | _exit (code); |
985 | |
1006 | |
986 | MODULE = Coro::State PACKAGE = Coro::Cont |
1007 | MODULE = Coro::State PACKAGE = Coro::Cont |
987 | |
1008 | |
988 | # this is slightly dirty (should expose a c-level api) |
|
|
989 | |
|
|
990 | void |
1009 | void |
991 | yield(...) |
1010 | yield(...) |
992 | PROTOTYPE: @ |
1011 | PROTOTYPE: @ |
993 | CODE: |
1012 | CODE: |
994 | SV *yieldstack; |
1013 | SV *yieldstack; |
… | |
… | |
1015 | |
1034 | |
1016 | transfer (aTHX_ prev, next, 0); |
1035 | transfer (aTHX_ prev, next, 0); |
1017 | |
1036 | |
1018 | MODULE = Coro::State PACKAGE = Coro |
1037 | MODULE = Coro::State PACKAGE = Coro |
1019 | |
1038 | |
1020 | # this is slightly dirty (should expose a c-level api) |
|
|
1021 | |
|
|
1022 | BOOT: |
1039 | BOOT: |
1023 | { |
1040 | { |
1024 | int i; |
1041 | int i; |
1025 | HV *stash = gv_stashpv ("Coro", TRUE); |
1042 | HV *stash = gv_stashpv ("Coro", TRUE); |
1026 | |
1043 | |
… | |
… | |
1045 | coroapi.ready = api_ready; |
1062 | coroapi.ready = api_ready; |
1046 | coroapi.nready = &coro_nready; |
1063 | coroapi.nready = &coro_nready; |
1047 | coroapi.current = coro_current; |
1064 | coroapi.current = coro_current; |
1048 | |
1065 | |
1049 | GCoroAPI = &coroapi; |
1066 | GCoroAPI = &coroapi; |
1050 | sv_setiv(sv, (IV)&coroapi); |
1067 | sv_setiv (sv, (IV)&coroapi); |
1051 | SvREADONLY_on(sv); |
1068 | SvREADONLY_on (sv); |
1052 | } |
1069 | } |
1053 | } |
1070 | } |
1054 | |
1071 | |
1055 | #if !PERL_MICRO |
1072 | #if !PERL_MICRO |
1056 | |
1073 | |