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.123 by root, Mon Dec 4 21:56:00 2006 UTC vs.
Revision 1.132 by root, Fri Dec 29 13:03:05 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 USE_VALGRIND
10# include <valgrind/valgrind.h>
11#endif
12
13/* the maximum number of idle cctx that will be pooled */
14#define MAX_IDLE_CCTX 8
15
16#define PERL_VERSION_ATLEAST(a,b,c) \
17 (PERL_REVISION > (a) \
18 || (PERL_REVISION == (a) \
19 && (PERL_VERSION > (b) \
20 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
21
22#if !PERL_VERSION_ATLEAST (5,6,0)
23# ifndef PL_ppaddr
24# define PL_ppaddr ppaddr
25# endif
26# ifndef call_sv
27# define call_sv perl_call_sv
28# endif
29# ifndef get_sv
30# define get_sv perl_get_sv
31# endif
32# ifndef get_cv
33# define get_cv perl_get_cv
34# endif
35# ifndef IS_PADGV
36# define IS_PADGV(v) 0
37# endif
38# ifndef IS_PADCONST
39# define IS_PADCONST(v) 0
40# endif
41#endif
42
43#include <stdio.h> 9#include <stdio.h>
44#include <errno.h> 10#include <errno.h>
45 11#include <assert.h>
46#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
47# undef STACKGUARD
48#endif
49
50#ifndef STACKGUARD
51# define STACKGUARD 0
52#endif
53 12
54#ifdef HAVE_MMAP 13#ifdef HAVE_MMAP
55# include <unistd.h> 14# include <unistd.h>
56# include <sys/mman.h> 15# include <sys/mman.h>
57# ifndef MAP_ANONYMOUS 16# ifndef MAP_ANONYMOUS
… …
72#else 31#else
73# define PAGESIZE 0 32# define PAGESIZE 0
74# define BOOT_PAGESIZE (void)0 33# define BOOT_PAGESIZE (void)0
75#endif 34#endif
76 35
36#if USE_VALGRIND
37# include <valgrind/valgrind.h>
38#endif
39
40/* the maximum number of idle cctx that will be pooled */
41#define MAX_IDLE_CCTX 8
42
43#define PERL_VERSION_ATLEAST(a,b,c) \
44 (PERL_REVISION > (a) \
45 || (PERL_REVISION == (a) \
46 && (PERL_VERSION > (b) \
47 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
48
49#if !PERL_VERSION_ATLEAST (5,6,0)
50# ifndef PL_ppaddr
51# define PL_ppaddr ppaddr
52# endif
53# ifndef call_sv
54# define call_sv perl_call_sv
55# endif
56# ifndef get_sv
57# define get_sv perl_get_sv
58# endif
59# ifndef get_cv
60# define get_cv perl_get_cv
61# endif
62# ifndef IS_PADGV
63# define IS_PADGV(v) 0
64# endif
65# ifndef IS_PADCONST
66# define IS_PADCONST(v) 0
67# endif
68#endif
69
70/* 5.8.7 */
71#ifndef SvRV_set
72# define SvRV_set(s,v) SvRV(s) = (v)
73#endif
74
75#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
76# undef STACKGUARD
77#endif
78
79#ifndef STACKGUARD
80# define STACKGUARD 0
81#endif
82
83/* prefer perl internal functions over our own? */
84#ifndef PREFER_PERL_FUNCTIONS
85# define PREFER_PERL_FUNCTIONS 0
86#endif
87
77/* The next macro should declare a variable stacklevel that contains and approximation 88/* The next macro should declare a variable stacklevel that contains and approximation
78 * to the current C stack pointer. Its property is that it changes with each call 89 * to the current C stack pointer. Its property is that it changes with each call
79 * and should be unique. */ 90 * and should be unique. */
80#define dSTACKLEVEL int stacklevel 91#define dSTACKLEVEL int stacklevel
81#define STACKLEVEL ((void *)&stacklevel) 92#define STACKLEVEL ((void *)&stacklevel)
82 93
83#define IN_DESTRUCT (PL_main_cv == Nullcv) 94#define IN_DESTRUCT (PL_main_cv == Nullcv)
84 95
85#if __GNUC__ >= 3 96#if __GNUC__ >= 3
86# define attribute(x) __attribute__(x) 97# define attribute(x) __attribute__(x)
98# define BARRIER __asm__ __volatile__ ("" : : : "memory")
87#else 99#else
88# define attribute(x) 100# define attribute(x)
101# define BARRIER
89#endif 102#endif
90 103
91#define NOINLINE attribute ((noinline)) 104#define NOINLINE attribute ((noinline))
92 105
93#include "CoroAPI.h" 106#include "CoroAPI.h"
… …
124 /* the stack */ 137 /* the stack */
125 void *sptr; 138 void *sptr;
126 long ssize; /* positive == mmap, otherwise malloc */ 139 long ssize; /* positive == mmap, otherwise malloc */
127 140
128 /* cpu state */ 141 /* cpu state */
129 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 142 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
143 JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */
130 JMPENV *top_env; 144 JMPENV *top_env;
131 coro_context cctx; 145 coro_context cctx;
132 146
133 int inuse; 147 int inuse;
134 148
… …
253 267
254 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0) 268 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
255 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--]; 269 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
256 else 270 else
257 { 271 {
258#if 0 272#if PREFER_PERL_FUNCTIONS
259 /* this is probably cleaner, but also slower? */ 273 /* this is probably cleaner, but also slower? */
260 CV *cp = Perl_cv_clone (cv); 274 CV *cp = Perl_cv_clone (cv);
261 CvPADLIST (cv) = CvPADLIST (cp); 275 CvPADLIST (cv) = CvPADLIST (cp);
262 CvPADLIST (cp) = 0; 276 CvPADLIST (cp) = 0;
263 SvREFCNT_dec (cp); 277 SvREFCNT_dec (cp);
… …
344 /* 358 /*
345 * the worst thing you can imagine happens first - we have to save 359 * the worst thing you can imagine happens first - we have to save
346 * (and reinitialize) all cv's in the whole callchain :( 360 * (and reinitialize) all cv's in the whole callchain :(
347 */ 361 */
348 362
363 EXTEND (SP, 3 + 1);
349 PUSHs (Nullsv); 364 PUSHs (Nullsv);
350 /* this loop was inspired by pp_caller */ 365 /* this loop was inspired by pp_caller */
351 for (;;) 366 for (;;)
352 { 367 {
353 while (cxix >= 0) 368 while (cxix >= 0)
… …
359 CV *cv = cx->blk_sub.cv; 374 CV *cv = cx->blk_sub.cv;
360 375
361 if (CvDEPTH (cv)) 376 if (CvDEPTH (cv))
362 { 377 {
363 EXTEND (SP, 3); 378 EXTEND (SP, 3);
364
365 PUSHs ((SV *)CvPADLIST (cv)); 379 PUSHs ((SV *)CvPADLIST (cv));
366 PUSHs (INT2PTR (SV *, CvDEPTH (cv))); 380 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
367 PUSHs ((SV *)cv); 381 PUSHs ((SV *)cv);
368 382
369 CvDEPTH (cv) = 0; 383 CvDEPTH (cv) = 0;
370 get_padlist (cv); 384 get_padlist (cv);
371 } 385 }
372 } 386 }
373#ifdef CXt_FORMAT
374 else if (CxTYPE (cx) == CXt_FORMAT)
375 {
376 /* I never used formats, so how should I know how these are implemented? */
377 /* my bold guess is as a simple, plain sub... */
378 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
379 }
380#endif
381 } 387 }
382 388
383 if (top_si->si_type == PERLSI_MAIN) 389 if (top_si->si_type == PERLSI_MAIN)
384 break; 390 break;
385 391
… …
405 * allocate various perl stacks. This is an exact copy 411 * allocate various perl stacks. This is an exact copy
406 * of perl.c:init_stacks, except that it uses less memory 412 * of perl.c:init_stacks, except that it uses less memory
407 * on the (sometimes correct) assumption that coroutines do 413 * on the (sometimes correct) assumption that coroutines do
408 * not usually need a lot of stackspace. 414 * not usually need a lot of stackspace.
409 */ 415 */
416#if PREFER_PERL_FUNCTIONS
417# define coro_init_stacks init_stacks
418#else
410static void 419static void
411coro_init_stacks () 420coro_init_stacks ()
412{ 421{
413 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT)); 422 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));
414 PL_curstackinfo->si_type = PERLSI_MAIN; 423 PL_curstackinfo->si_type = PERLSI_MAIN;
… …
444 New(54,PL_retstack,16,OP*); 453 New(54,PL_retstack,16,OP*);
445 PL_retstack_ix = 0; 454 PL_retstack_ix = 0;
446 PL_retstack_max = 16; 455 PL_retstack_max = 16;
447#endif 456#endif
448} 457}
458#endif
449 459
450/* 460/*
451 * destroy the stacks, the callchain etc... 461 * destroy the stacks, the callchain etc...
452 */ 462 */
453static void 463static void
454coro_destroy_stacks () 464coro_destroy_stacks ()
455{ 465{
456 if (!IN_DESTRUCT) 466 if (!IN_DESTRUCT)
457 { 467 {
458 /* is this ugly, I ask? */ 468 /* restore all saved variables and stuff */
459 LEAVE_SCOPE (0); 469 LEAVE_SCOPE (0);
470 assert (PL_tmps_floor == -1);
460 471
461 /* sure it is, but more important: is it correct?? :/ */ 472 /* free all temporaries */
462 FREETMPS; 473 FREETMPS;
474 assert (PL_tmps_ix == -1);
463 475
464 /*POPSTACK_TO (PL_mainstack);*//*D*//*use*/ 476 POPSTACK_TO (PL_mainstack);
465 } 477 }
466 478
467 while (PL_curstackinfo->si_next) 479 while (PL_curstackinfo->si_next)
468 PL_curstackinfo = PL_curstackinfo->si_next; 480 PL_curstackinfo = PL_curstackinfo->si_next;
469 481
470 while (PL_curstackinfo) 482 while (PL_curstackinfo)
471 { 483 {
472 PERL_SI *p = PL_curstackinfo->si_prev; 484 PERL_SI *p = PL_curstackinfo->si_prev;
473 485
474 { /*D*//*remove*/
475 dSP;
476 SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
477 PUTBACK; /* possibly superfluous */
478 }
479
480 if (!IN_DESTRUCT) 486 if (!IN_DESTRUCT)
481 {
482 dounwind (-1);/*D*//*remove*/
483 SvREFCNT_dec (PL_curstackinfo->si_stack); 487 SvREFCNT_dec (PL_curstackinfo->si_stack);
484 }
485 488
486 Safefree (PL_curstackinfo->si_cxstack); 489 Safefree (PL_curstackinfo->si_cxstack);
487 Safefree (PL_curstackinfo); 490 Safefree (PL_curstackinfo);
488 PL_curstackinfo = p; 491 PL_curstackinfo = p;
489 } 492 }
… …
593{ 596{
594 coro_cctx *cctx; 597 coro_cctx *cctx;
595 598
596 ++cctx_count; 599 ++cctx_count;
597 600
598 New (0, cctx, 1, coro_cctx); 601 Newz (0, cctx, 1, coro_cctx);
599 602
600#if HAVE_MMAP 603#if HAVE_MMAP
601 604
602 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; 605 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE;
603 /* mmap supposedly does allocate-on-write for us */ 606 /* mmap supposedly does allocate-on-write for us */
… …
704{ 707{
705 dSTACKLEVEL; 708 dSTACKLEVEL;
706 709
707 /* sometimes transfer is only called to set idle_sp */ 710 /* sometimes transfer is only called to set idle_sp */
708 if (!next) 711 if (!next)
712 {
709 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 713 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
714 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
715 }
710 else if (prev != next) 716 else if (prev != next)
711 { 717 {
712 coro_cctx *prev__cctx; 718 coro_cctx *prev__cctx;
713 719
714 if (prev->flags & CF_NEW) 720 if (prev->flags & CF_NEW)
… …
739 /* first get rid of the old state */ 745 /* first get rid of the old state */
740 save_perl (prev); 746 save_perl (prev);
741 /* setup coroutine call */ 747 /* setup coroutine call */
742 setup_coro (next); 748 setup_coro (next);
743 /* need a new stack */ 749 /* need a new stack */
744 assert (!next->stack); 750 assert (!next->cctx);
745 } 751 }
746 else 752 else
747 { 753 {
748 /* coroutine already started */ 754 /* coroutine already started */
749 save_perl (prev); 755 save_perl (prev);
… …
754 760
755 /* possibly "free" the cctx */ 761 /* possibly "free" the cctx */
756 if (prev__cctx->idle_sp == STACKLEVEL) 762 if (prev__cctx->idle_sp == STACKLEVEL)
757 { 763 {
758 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ 764 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
759 assert (PL_top_env == prev__cctx->top_env); 765 assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te));
760 766
761 prev->cctx = 0; 767 prev->cctx = 0;
762 768
763 cctx_put (prev__cctx); 769 cctx_put (prev__cctx);
764 prev__cctx->inuse = 0; 770 prev__cctx->inuse = 0;
… …
954 coro = SvSTATE (coro_sv); 960 coro = SvSTATE (coro_sv);
955 961
956 if (coro->flags & CF_READY) 962 if (coro->flags & CF_READY)
957 return 0; 963 return 0;
958 964
959#if 0 /* this is actually harmless */
960 if (coro->flags & CF_RUNNING)
961 croak ("Coro::ready called on currently running coroutine");
962#endif
963
964 coro->flags |= CF_READY; 965 coro->flags |= CF_READY;
965 966
966 LOCK; 967 LOCK;
967 coro_enq (SvREFCNT_inc (coro_sv)); 968 coro_enq (SvREFCNT_inc (coro_sv));
968 UNLOCK; 969 UNLOCK;
… …
971} 972}
972 973
973static int 974static int
974api_is_ready (SV *coro_sv) 975api_is_ready (SV *coro_sv)
975{ 976{
976 return !!SvSTATE (coro_sv)->flags & CF_READY; 977 return !!(SvSTATE (coro_sv)->flags & CF_READY);
977} 978}
978 979
979static void 980static void
980prepare_schedule (struct transfer_args *ta) 981prepare_schedule (struct transfer_args *ta)
981{ 982{
… …
1026 1027
1027static void 1028static void
1028prepare_cede (struct transfer_args *ta) 1029prepare_cede (struct transfer_args *ta)
1029{ 1030{
1030 api_ready (coro_current); 1031 api_ready (coro_current);
1031
1032 prepare_schedule (ta); 1032 prepare_schedule (ta);
1033}
1034
1035static int
1036prepare_cede_notself (struct transfer_args *ta)
1037{
1038 if (coro_nready)
1039 {
1040 SV *prev = SvRV (coro_current);
1041 prepare_schedule (ta);
1042 api_ready (prev);
1043 return 1;
1044 }
1045 else
1046 return 0;
1033} 1047}
1034 1048
1035static void 1049static void
1036api_schedule (void) 1050api_schedule (void)
1037{ 1051{
… …
1039 1053
1040 prepare_schedule (&ta); 1054 prepare_schedule (&ta);
1041 TRANSFER (ta); 1055 TRANSFER (ta);
1042} 1056}
1043 1057
1044static void 1058static int
1045api_cede (void) 1059api_cede (void)
1046{ 1060{
1047 struct transfer_args ta; 1061 struct transfer_args ta;
1048 1062
1049 prepare_cede (&ta); 1063 prepare_cede (&ta);
1064
1065 if (ta.prev != ta.next)
1066 {
1050 TRANSFER (ta); 1067 TRANSFER (ta);
1068 return 1;
1069 }
1070 else
1071 return 0;
1072}
1073
1074static int
1075api_cede_notself (void)
1076{
1077 struct transfer_args ta;
1078
1079 if (prepare_cede_notself (&ta))
1080 {
1081 TRANSFER (ta);
1082 return 1;
1083 }
1084 else
1085 return 0;
1051} 1086}
1052 1087
1053MODULE = Coro::State PACKAGE = Coro::State 1088MODULE = Coro::State PACKAGE = Coro::State
1054 1089
1055PROTOTYPES: DISABLE 1090PROTOTYPES: DISABLE
… …
1111_set_stacklevel (...) 1146_set_stacklevel (...)
1112 ALIAS: 1147 ALIAS:
1113 Coro::State::transfer = 1 1148 Coro::State::transfer = 1
1114 Coro::schedule = 2 1149 Coro::schedule = 2
1115 Coro::cede = 3 1150 Coro::cede = 3
1151 Coro::cede_notself = 4
1116 CODE: 1152 CODE:
1117{ 1153{
1118 struct transfer_args ta; 1154 struct transfer_args ta;
1119 1155
1120 switch (ix) 1156 switch (ix)
… …
1136 break; 1172 break;
1137 1173
1138 case 3: 1174 case 3:
1139 prepare_cede (&ta); 1175 prepare_cede (&ta);
1140 break; 1176 break;
1177
1178 case 4:
1179 if (!prepare_cede_notself (&ta))
1180 XSRETURN_EMPTY;
1181
1182 break;
1141 } 1183 }
1142 1184
1185 BARRIER;
1143 TRANSFER (ta); 1186 TRANSFER (ta);
1144} 1187}
1145 1188
1146void 1189void
1147_clone_state_from (SV *dst, SV *src) 1190_clone_state_from (SV *dst, SV *src)
… …
1198 coro_ready[i] = newAV (); 1241 coro_ready[i] = newAV ();
1199 1242
1200 { 1243 {
1201 SV *sv = perl_get_sv("Coro::API", 1); 1244 SV *sv = perl_get_sv("Coro::API", 1);
1202 1245
1203 coroapi.schedule = api_schedule; 1246 coroapi.schedule = api_schedule;
1204 coroapi.save = api_save; 1247 coroapi.save = api_save;
1205 coroapi.cede = api_cede; 1248 coroapi.cede = api_cede;
1249 coroapi.cede_notself = api_cede_notself;
1206 coroapi.ready = api_ready; 1250 coroapi.ready = api_ready;
1207 coroapi.is_ready = api_is_ready; 1251 coroapi.is_ready = api_is_ready;
1208 coroapi.nready = &coro_nready; 1252 coroapi.nready = &coro_nready;
1209 coroapi.current = coro_current; 1253 coroapi.current = coro_current;
1210 1254
1211 GCoroAPI = &coroapi; 1255 GCoroAPI = &coroapi;
1212 sv_setiv (sv, (IV)&coroapi); 1256 sv_setiv (sv, (IV)&coroapi);
1213 SvREADONLY_on (sv); 1257 SvREADONLY_on (sv);
1214 } 1258 }
… …
1230 RETVAL = coro->prio; 1274 RETVAL = coro->prio;
1231 1275
1232 if (items > 1) 1276 if (items > 1)
1233 { 1277 {
1234 if (ix) 1278 if (ix)
1235 newprio += coro->prio; 1279 newprio = coro->prio - newprio;
1236 1280
1237 if (newprio < PRIO_MIN) newprio = PRIO_MIN; 1281 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1238 if (newprio > PRIO_MAX) newprio = PRIO_MAX; 1282 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1239 1283
1240 coro->prio = newprio; 1284 coro->prio = newprio;
1241 } 1285 }
1242} 1286}
1287 OUTPUT:
1288 RETVAL
1243 1289
1244SV * 1290SV *
1245ready (SV *self) 1291ready (SV *self)
1246 PROTOTYPE: $ 1292 PROTOTYPE: $
1247 CODE: 1293 CODE:

Diff Legend

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