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.200 by root, Sun Oct 7 15:08:23 2007 UTC vs.
Revision 1.210 by root, Wed Oct 10 03:24:40 2007 UTC

… …
10#include "patchlevel.h" 10#include "patchlevel.h"
11 11
12#include <stdio.h> 12#include <stdio.h>
13#include <errno.h> 13#include <errno.h>
14#include <assert.h> 14#include <assert.h>
15#include <inttypes.h> /* portable stdint.h */
15 16
16#ifdef HAVE_MMAP 17#ifdef HAVE_MMAP
17# include <unistd.h> 18# include <unistd.h>
18# include <sys/mman.h> 19# include <sys/mman.h>
19# ifndef MAP_ANONYMOUS 20# ifndef MAP_ANONYMOUS
… …
160/* async_pool helper stuff */ 161/* async_pool helper stuff */
161static SV *sv_pool_rss; 162static SV *sv_pool_rss;
162static SV *sv_pool_size; 163static SV *sv_pool_size;
163static AV *av_async_pool; 164static AV *av_async_pool;
164 165
165static struct coro_cctx *cctx_first; 166static struct coro_cctx *cctx_first[3]; /* index by GIMME_V type, void, scalar, array */
166static int cctx_count, cctx_idle; 167static int cctx_count, cctx_idle[3];
167 168
168enum { 169enum {
169 CC_MAPPED = 0x01, 170 CC_MAPPED = 0x01,
170 CC_NOREUSE = 0x02, /* throw this away after tracing */ 171 CC_NOREUSE = 0x02, /* throw this away after tracing */
171 CC_TRACE = 0x04, 172 CC_TRACE = 0x04,
… …
216 217
217/* this is a structure representing a perl-level coroutine */ 218/* this is a structure representing a perl-level coroutine */
218struct coro { 219struct coro {
219 /* the c coroutine allocated to this perl coroutine, if any */ 220 /* the c coroutine allocated to this perl coroutine, if any */
220 coro_cctx *cctx; 221 coro_cctx *cctx;
222 int gimme;
221 223
222 /* process data */ 224 /* process data */
223 AV *mainstack; 225 AV *mainstack;
224 perl_slots *slot; /* basically the saved sp */ 226 perl_slots *slot; /* basically the saved sp */
225 227
226 /* data associated with this coroutine (initial args) */ 228 AV *args; /* data associated with this coroutine (initial args) */
227 AV *args; 229 int refcnt; /* coroutines are refcounted, yes */
228 int refcnt;
229 int flags; /* CF_ flags */ 230 int flags; /* CF_ flags */
231 HV *hv; /* the perl hash associated with this coro, if any */
230 232
231 /* statistics */ 233 /* statistics */
232 int usecount; /* number of transfers to this coro */ 234 int usecount; /* number of transfers to this coro */
233 235
234 /* coro process data */ 236 /* coro process data */
235 int prio; 237 int prio;
236 SV *throw; 238 SV *throw; /* exception to be thrown */
237 239
238 /* async_pool */ 240 /* async_pool */
239 SV *saved_deffh; 241 SV *saved_deffh;
240 242
241 /* linked list */ 243 /* linked list */
242 struct coro *next, *prev; 244 struct coro *next, *prev;
243 HV *hv; /* the perl hash associated with this coro, if any */
244}; 245};
245 246
246typedef struct coro *Coro__State; 247typedef struct coro *Coro__State;
247typedef struct coro *Coro__State_or_hashref; 248typedef struct coro *Coro__State_or_hashref;
248 249
… …
453 454
454 #define VAR(name,type) PL_ ## name = slot->name; 455 #define VAR(name,type) PL_ ## name = slot->name;
455 # include "state.h" 456 # include "state.h"
456 #undef VAR 457 #undef VAR
457 458
459 /*hv_store (hv_sig, strpair ("__DIE__" ), SvREFCNT_inc (sv_diehook ), 0);*/
460 /*hv_store (hv_sig, strpair ("__WARN__"), SvREFCNT_inc (sv_warnhook), 0);*/
461
458 { 462 {
459 dSP; 463 dSP;
460 464
461 CV *cv; 465 CV *cv;
462 466
… …
521 525
522 PUTBACK; 526 PUTBACK;
523 } 527 }
524 528
525 /* allocate some space on the context stack for our purposes */ 529 /* allocate some space on the context stack for our purposes */
530 /* we manually unroll here, as usually 2 slots is enough */
531 if (SLOT_COUNT >= 1) CXINC;
532 if (SLOT_COUNT >= 2) CXINC;
533 if (SLOT_COUNT >= 3) CXINC;
526 { 534 {
527 /* we manually unroll here, as usually 2 slots is enough */
528 int i; 535 int i;
529 if (SLOT_COUNT >= 1) CXINC;
530 if (SLOT_COUNT >= 2) CXINC;
531 if (SLOT_COUNT >= 3) CXINC;
532 for (i = 3; i < SLOT_COUNT; ++i) 536 for (i = 3; i < SLOT_COUNT; ++i)
533 CXINC; 537 CXINC;
534
535 cxstack_ix -= SLOT_COUNT; /* undo allocation */
536 } 538 }
539 cxstack_ix -= SLOT_COUNT; /* undo allocation */
537 540
538 c->mainstack = PL_mainstack; 541 c->mainstack = PL_mainstack;
539 542
540 { 543 {
541 perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1); 544 perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);
… …
685 PL_curpm = 0; 688 PL_curpm = 0;
686 PL_curpad = 0; 689 PL_curpad = 0;
687 PL_localizing = 0; 690 PL_localizing = 0;
688 PL_dirty = 0; 691 PL_dirty = 0;
689 PL_restartop = 0; 692 PL_restartop = 0;
690 SvREFCNT_inc (PL_diehook ); hv_store (hv_sig, strpair ("__DIE__" ), SvREFCNT_inc (sv_diehook ), 0); 693 PL_diehook = 0; hv_store (hv_sig, strpair ("__DIE__" ), SvREFCNT_inc (sv_diehook ), 0);
691 SvREFCNT_inc (PL_warnhook); hv_store (hv_sig, strpair ("__WARN__"), SvREFCNT_inc (sv_warnhook), 0); 694 PL_warnhook = 0; hv_store (hv_sig, strpair ("__WARN__"), SvREFCNT_inc (sv_warnhook), 0);
692 695
693 GvSV (PL_defgv) = newSV (0); 696 GvSV (PL_defgv) = newSV (0);
694 GvAV (PL_defgv) = coro->args; coro->args = 0; 697 GvAV (PL_defgv) = coro->args; coro->args = 0;
695 GvSV (PL_errgv) = newSV (0); 698 GvSV (PL_errgv) = newSV (0);
696 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0); 699 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
… …
709 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv)))); 712 XPUSHs (sv_2mortal (av_shift (GvAV (PL_defgv))));
710 PUTBACK; 713 PUTBACK;
711 PL_op = (OP *)&myop; 714 PL_op = (OP *)&myop;
712 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 715 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
713 SPAGAIN; 716 SPAGAIN;
717
718 /*
719 * now its very tricky. the "tail" of the next transfer might end up
720 * either in a new cctx, or an existing one.
721 * in case of an existing one we have to take care of whatever
722 * entersub and transfer do to the perl stack.
723 */
724 ENTER;
725 EXTEND (SP, 4);
726 PUSHs ((SV *)0); /* items */
727 PUSHs ((SV *)0); /* ix, set_stacklevel */
728 PUSHs ((SV *)(sp - PL_stack_base + 1)); /* ax */
729 PUSHs ((SV *)0); /* again */
730 PUTBACK;
714 } 731 }
715 732
716 ENTER; /* necessary e.g. for dounwind and to balance the xsub-entersub */ 733 /* this newly created coroutine might be run on an existing cctx which most
734 * likely was suspended in set_stacklevel, called from entersub.
735 * set_stacklevl doesn't do anything on return, but entersub does LEAVE,
736 * so we ENTER here for symmetry
737 */
738 ENTER;
717} 739}
718 740
719static void 741static void
720coro_destroy (pTHX_ struct coro *coro) 742coro_destroy (pTHX_ struct coro *coro)
721{ 743{
… …
888 910
889/* inject a fake call to Coro::State::_cctx_init into the execution */ 911/* inject a fake call to Coro::State::_cctx_init into the execution */
890/* _cctx_init should be careful, as it could be called at almost any time */ 912/* _cctx_init should be careful, as it could be called at almost any time */
891/* during execution of a perl program */ 913/* during execution of a perl program */
892static void NOINLINE 914static void NOINLINE
893prepare_cctx (pTHX_ coro_cctx *cctx) 915cctx_prepare (pTHX_ coro_cctx *cctx)
894{ 916{
895 dSP; 917 dSP;
896 LOGOP myop; 918 LOGOP myop;
897 919
898 PL_top_env = &PL_start_env; 920 PL_top_env = &PL_start_env;
… …
916 938
917/* 939/*
918 * this is a _very_ stripped down perl interpreter ;) 940 * this is a _very_ stripped down perl interpreter ;)
919 */ 941 */
920static void 942static void
921coro_run (void *arg) 943cctx_run (void *arg)
922{ 944{
923 dTHX; 945 dTHX;
924 946
925 /* coro_run is the alternative tail of transfer(), so unlock here. */ 947 /* cctx_run is the alternative tail of transfer(), so unlock here. */
926 UNLOCK; 948 UNLOCK;
927 949
928 /* we now skip the entersub that lead to transfer() */ 950 /* we now skip the entersub that lead to transfer() */
929 PL_op = PL_op->op_next; 951 PL_op = PL_op->op_next;
930 952
931 /* inject a fake subroutine call to cctx_init */ 953 /* inject a fake subroutine call to cctx_init */
932 prepare_cctx (aTHX_ (coro_cctx *)arg); 954 cctx_prepare (aTHX_ (coro_cctx *)arg);
933 955
934 /* somebody or something will hit me for both perl_run and PL_restartop */ 956 /* somebody or something will hit me for both perl_run and PL_restartop */
935 PL_restartop = PL_op; 957 PL_restartop = PL_op;
936 perl_run (PL_curinterp); 958 perl_run (PL_curinterp);
937 959
… …
956 ++cctx_count; 978 ++cctx_count;
957 979
958 Newz (0, cctx, 1, coro_cctx); 980 Newz (0, cctx, 1, coro_cctx);
959 981
960#if HAVE_MMAP 982#if HAVE_MMAP
961
962 cctx->ssize = ((coro_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE; 983 cctx->ssize = ((coro_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
963 /* mmap supposedly does allocate-on-write for us */ 984 /* mmap supposedly does allocate-on-write for us */
964 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 985 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
965 986
966 if (cctx->sptr != (void *)-1) 987 if (cctx->sptr != (void *)-1)
… …
987 stack_start = cctx->sptr; 1008 stack_start = cctx->sptr;
988 stack_size = cctx->ssize; 1009 stack_size = cctx->ssize;
989 } 1010 }
990 1011
991 REGISTER_STACK (cctx, (char *)stack_start, (char *)stack_start + stack_size); 1012 REGISTER_STACK (cctx, (char *)stack_start, (char *)stack_start + stack_size);
992 coro_create (&cctx->cctx, coro_run, (void *)cctx, stack_start, stack_size); 1013 coro_create (&cctx->cctx, cctx_run, (void *)cctx, stack_start, stack_size);
993 1014
994 return cctx; 1015 return cctx;
995} 1016}
996 1017
997static void 1018static void
… …
1018 1039
1019/* wether this cctx should be destructed */ 1040/* wether this cctx should be destructed */
1020#define CCTX_EXPIRED(cctx) ((cctx)->ssize < coro_stacksize || ((cctx)->flags & CC_NOREUSE)) 1041#define CCTX_EXPIRED(cctx) ((cctx)->ssize < coro_stacksize || ((cctx)->flags & CC_NOREUSE))
1021 1042
1022static coro_cctx * 1043static coro_cctx *
1023cctx_get (pTHX) 1044cctx_get (pTHX_ int gimme)
1024{ 1045{
1025 while (expect_true (cctx_first)) 1046 while (expect_true (cctx_first[gimme]))
1026 { 1047 {
1027 coro_cctx *cctx = cctx_first; 1048 coro_cctx *cctx = cctx_first[gimme];
1028 cctx_first = cctx->next; 1049 cctx_first[gimme] = cctx->next;
1029 --cctx_idle; 1050 --cctx_idle[gimme];
1030 1051
1031 if (expect_true (!CCTX_EXPIRED (cctx))) 1052 if (expect_true (!CCTX_EXPIRED (cctx)))
1032 return cctx; 1053 return cctx;
1033 1054
1034 cctx_destroy (cctx); 1055 cctx_destroy (cctx);
1035 } 1056 }
1036 1057
1058 assert (!gimme);
1037 return cctx_new (); 1059 return cctx_new ();
1038} 1060}
1039 1061
1040static void 1062static void
1041cctx_put (coro_cctx *cctx) 1063cctx_put (coro_cctx *cctx, int gimme)
1042{ 1064{
1043 /* free another cctx if overlimit */ 1065 /* free another cctx if overlimit */
1044 if (expect_false (cctx_idle >= MAX_IDLE_CCTX)) 1066 if (expect_false (cctx_idle[gimme] >= MAX_IDLE_CCTX))
1045 { 1067 {
1046 coro_cctx *first = cctx_first; 1068 coro_cctx *first = cctx_first[gimme];
1047 cctx_first = first->next; 1069 cctx_first[gimme] = first->next;
1048 --cctx_idle; 1070 --cctx_idle[gimme];
1049 1071
1050 cctx_destroy (first); 1072 cctx_destroy (first);
1051 } 1073 }
1052 1074
1053 ++cctx_idle; 1075 ++cctx_idle[gimme];
1054 cctx->next = cctx_first; 1076 cctx->next = cctx_first[gimme];
1055 cctx_first = cctx; 1077 cctx_first[gimme] = cctx;
1056} 1078}
1057 1079
1058/** coroutine switching *****************************************************/ 1080/** coroutine switching *****************************************************/
1059 1081
1060static void 1082static void
… …
1138 prev->cctx = 0; 1160 prev->cctx = 0;
1139 1161
1140 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */ 1162 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */
1141 /* without this the next cctx_get might destroy the prev__cctx while still in use */ 1163 /* without this the next cctx_get might destroy the prev__cctx while still in use */
1142 if (expect_false (CCTX_EXPIRED (prev__cctx))) 1164 if (expect_false (CCTX_EXPIRED (prev__cctx)))
1165 if (!next->cctx)
1143 next->cctx = cctx_get (aTHX); 1166 next->cctx = cctx_get (aTHX_ next->gimme);
1144 1167
1145 cctx_put (prev__cctx); 1168 cctx_put (prev__cctx, prev->gimme);
1146 } 1169 }
1147 1170
1148 ++next->usecount; 1171 ++next->usecount;
1149 1172
1150 if (expect_true (!next->cctx)) 1173 if (expect_true (!next->cctx))
1151 next->cctx = cctx_get (aTHX); 1174 next->cctx = cctx_get (aTHX_ next->gimme);
1152 1175
1153 if (expect_false (prev__cctx != next->cctx)) 1176 if (expect_false (prev__cctx != next->cctx))
1154 { 1177 {
1155 prev__cctx->top_env = PL_top_env; 1178 prev__cctx->top_env = PL_top_env;
1156 PL_top_env = next->cctx->top_env; 1179 PL_top_env = next->cctx->top_env;
… …
1522 1545
1523 while (main_top_env->je_prev) 1546 while (main_top_env->je_prev)
1524 main_top_env = main_top_env->je_prev; 1547 main_top_env = main_top_env->je_prev;
1525 1548
1526 coroapi.ver = CORO_API_VERSION; 1549 coroapi.ver = CORO_API_VERSION;
1550 coroapi.rev = CORO_API_REVISION;
1527 coroapi.transfer = api_transfer; 1551 coroapi.transfer = api_transfer;
1528 1552
1529 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL)); 1553 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
1530} 1554}
1531 1555
… …
1598 1622
1599 break; 1623 break;
1600 } 1624 }
1601 1625
1602 BARRIER; 1626 BARRIER;
1627 PUTBACK;
1603 TRANSFER (ta); 1628 TRANSFER (ta);
1604 1629 SPAGAIN; /* might be the sp of a different coroutine now */
1605 if (expect_false (GIMME_V != G_VOID && ta.next != ta.prev)) 1630 /* be extra careful not to ever do anything after TRANSFER */
1606 XSRETURN_YES;
1607} 1631}
1608 1632
1609bool 1633bool
1610_destroy (SV *coro_sv) 1634_destroy (SV *coro_sv)
1611 CODE: 1635 CODE:
… …
1637 RETVAL 1661 RETVAL
1638 1662
1639int 1663int
1640cctx_idle () 1664cctx_idle ()
1641 CODE: 1665 CODE:
1642 RETVAL = cctx_idle; 1666 RETVAL = cctx_idle[0] + cctx_idle[1] + cctx_idle[2];
1643 OUTPUT: 1667 OUTPUT:
1644 RETVAL 1668 RETVAL
1645 1669
1646void 1670void
1647list () 1671list ()
… …
1671 1695
1672 { 1696 {
1673 dSP; 1697 dSP;
1674 ENTER; 1698 ENTER;
1675 SAVETMPS; 1699 SAVETMPS;
1700 PUTBACK;
1701 PUSHSTACK;
1676 PUSHMARK (SP); 1702 PUSHMARK (SP);
1677 PUTBACK;
1678 1703
1679 if (ix) 1704 if (ix)
1680 eval_sv (coderef, 0); 1705 eval_sv (coderef, 0);
1681 else 1706 else
1682 call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); 1707 call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
1683 1708
1684 SPAGAIN; 1709 POPSTACK;
1685 FREETMPS; 1710 FREETMPS;
1686 LEAVE; 1711 LEAVE;
1687 PUTBACK; 1712 PUTBACK;
1688 } 1713 }
1689 1714

Diff Legend

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