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.125 by root, Mon Dec 11 20:54:45 2006 UTC vs.
Revision 1.131 by root, Fri Dec 29 11:37:49 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/* 5.8.7 */
44#ifndef SvRV_set
45# define SvRV_set(s,v) SvRV(s) = (v)
46#endif
47
48#include <stdio.h> 9#include <stdio.h>
49#include <errno.h> 10#include <errno.h>
50#include <assert.h> 11#include <assert.h>
51
52#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
53# undef STACKGUARD
54#endif
55
56#ifndef STACKGUARD
57# define STACKGUARD 0
58#endif
59 12
60#ifdef HAVE_MMAP 13#ifdef HAVE_MMAP
61# include <unistd.h> 14# include <unistd.h>
62# include <sys/mman.h> 15# include <sys/mman.h>
63# ifndef MAP_ANONYMOUS 16# ifndef MAP_ANONYMOUS
… …
78#else 31#else
79# define PAGESIZE 0 32# define PAGESIZE 0
80# define BOOT_PAGESIZE (void)0 33# define BOOT_PAGESIZE (void)0
81#endif 34#endif
82 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
83/* 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
84 * 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
85 * and should be unique. */ 90 * and should be unique. */
86#define dSTACKLEVEL int stacklevel 91#define dSTACKLEVEL int stacklevel
87#define STACKLEVEL ((void *)&stacklevel) 92#define STACKLEVEL ((void *)&stacklevel)
88 93
89#define IN_DESTRUCT (PL_main_cv == Nullcv) 94#define IN_DESTRUCT (PL_main_cv == Nullcv)
90 95
91#if __GNUC__ >= 3 96#if __GNUC__ >= 3
92# define attribute(x) __attribute__(x) 97# define attribute(x) __attribute__(x)
98# define BARRIER __asm__ __volatile__ ("" : : : "memory")
93#else 99#else
94# define attribute(x) 100# define attribute(x)
101# define BARRIER
95#endif 102#endif
96 103
97#define NOINLINE attribute ((noinline)) 104#define NOINLINE attribute ((noinline))
98 105
99#include "CoroAPI.h" 106#include "CoroAPI.h"
… …
259 266
260 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0) 267 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
261 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--]; 268 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
262 else 269 else
263 { 270 {
264#if 0 271#if PREFER_PERL_FUNCTIONS
265 /* this is probably cleaner, but also slower? */ 272 /* this is probably cleaner, but also slower? */
266 CV *cp = Perl_cv_clone (cv); 273 CV *cp = Perl_cv_clone (cv);
267 CvPADLIST (cv) = CvPADLIST (cp); 274 CvPADLIST (cv) = CvPADLIST (cp);
268 CvPADLIST (cp) = 0; 275 CvPADLIST (cp) = 0;
269 SvREFCNT_dec (cp); 276 SvREFCNT_dec (cp);
… …
350 /* 357 /*
351 * the worst thing you can imagine happens first - we have to save 358 * the worst thing you can imagine happens first - we have to save
352 * (and reinitialize) all cv's in the whole callchain :( 359 * (and reinitialize) all cv's in the whole callchain :(
353 */ 360 */
354 361
362 EXTEND (SP, 3 + 1);
355 PUSHs (Nullsv); 363 PUSHs (Nullsv);
356 /* this loop was inspired by pp_caller */ 364 /* this loop was inspired by pp_caller */
357 for (;;) 365 for (;;)
358 { 366 {
359 while (cxix >= 0) 367 while (cxix >= 0)
… …
365 CV *cv = cx->blk_sub.cv; 373 CV *cv = cx->blk_sub.cv;
366 374
367 if (CvDEPTH (cv)) 375 if (CvDEPTH (cv))
368 { 376 {
369 EXTEND (SP, 3); 377 EXTEND (SP, 3);
370
371 PUSHs ((SV *)CvPADLIST (cv)); 378 PUSHs ((SV *)CvPADLIST (cv));
372 PUSHs (INT2PTR (SV *, CvDEPTH (cv))); 379 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
373 PUSHs ((SV *)cv); 380 PUSHs ((SV *)cv);
374 381
375 CvDEPTH (cv) = 0; 382 CvDEPTH (cv) = 0;
376 get_padlist (cv); 383 get_padlist (cv);
377 } 384 }
378 } 385 }
379#ifdef CXt_FORMAT
380 else if (CxTYPE (cx) == CXt_FORMAT)
381 {
382 /* I never used formats, so how should I know how these are implemented? */
383 /* my bold guess is as a simple, plain sub... */
384 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
385 }
386#endif
387 } 386 }
388 387
389 if (top_si->si_type == PERLSI_MAIN) 388 if (top_si->si_type == PERLSI_MAIN)
390 break; 389 break;
391 390
… …
411 * allocate various perl stacks. This is an exact copy 410 * allocate various perl stacks. This is an exact copy
412 * of perl.c:init_stacks, except that it uses less memory 411 * of perl.c:init_stacks, except that it uses less memory
413 * on the (sometimes correct) assumption that coroutines do 412 * on the (sometimes correct) assumption that coroutines do
414 * not usually need a lot of stackspace. 413 * not usually need a lot of stackspace.
415 */ 414 */
415#if PREFER_PERL_FUNCTIONS
416# define coro_init_stacks init_stacks
417#else
416static void 418static void
417coro_init_stacks () 419coro_init_stacks ()
418{ 420{
419 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT)); 421 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));
420 PL_curstackinfo->si_type = PERLSI_MAIN; 422 PL_curstackinfo->si_type = PERLSI_MAIN;
… …
450 New(54,PL_retstack,16,OP*); 452 New(54,PL_retstack,16,OP*);
451 PL_retstack_ix = 0; 453 PL_retstack_ix = 0;
452 PL_retstack_max = 16; 454 PL_retstack_max = 16;
453#endif 455#endif
454} 456}
457#endif
455 458
456/* 459/*
457 * destroy the stacks, the callchain etc... 460 * destroy the stacks, the callchain etc...
458 */ 461 */
459static void 462static void
460coro_destroy_stacks () 463coro_destroy_stacks ()
461{ 464{
462 if (!IN_DESTRUCT) 465 if (!IN_DESTRUCT)
463 { 466 {
464 /* is this ugly, I ask? */ 467 /* restore all saved variables and stuff */
465 LEAVE_SCOPE (0); 468 LEAVE_SCOPE (0);
469 assert (PL_tmps_floor == -1);
466 470
467 /* sure it is, but more important: is it correct?? :/ */ 471 /* free all temporaries */
468 FREETMPS; 472 FREETMPS;
473 assert (PL_tmps_ix == -1);
469 474
470 /*POPSTACK_TO (PL_mainstack);*//*D*//*use*/ 475 POPSTACK_TO (PL_mainstack);
471 } 476 }
472 477
473 while (PL_curstackinfo->si_next) 478 while (PL_curstackinfo->si_next)
474 PL_curstackinfo = PL_curstackinfo->si_next; 479 PL_curstackinfo = PL_curstackinfo->si_next;
475 480
476 while (PL_curstackinfo) 481 while (PL_curstackinfo)
477 { 482 {
478 PERL_SI *p = PL_curstackinfo->si_prev; 483 PERL_SI *p = PL_curstackinfo->si_prev;
479 484
480 { /*D*//*remove*/
481 dSP;
482 SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
483 PUTBACK; /* possibly superfluous */
484 }
485
486 if (!IN_DESTRUCT) 485 if (!IN_DESTRUCT)
487 {
488 dounwind (-1);/*D*//*remove*/
489 SvREFCNT_dec (PL_curstackinfo->si_stack); 486 SvREFCNT_dec (PL_curstackinfo->si_stack);
490 }
491 487
492 Safefree (PL_curstackinfo->si_cxstack); 488 Safefree (PL_curstackinfo->si_cxstack);
493 Safefree (PL_curstackinfo); 489 Safefree (PL_curstackinfo);
494 PL_curstackinfo = p; 490 PL_curstackinfo = p;
495 } 491 }
… …
963 coro = SvSTATE (coro_sv); 959 coro = SvSTATE (coro_sv);
964 960
965 if (coro->flags & CF_READY) 961 if (coro->flags & CF_READY)
966 return 0; 962 return 0;
967 963
968#if 0 /* this is actually harmless */
969 if (coro->flags & CF_RUNNING)
970 croak ("Coro::ready called on currently running coroutine");
971#endif
972
973 coro->flags |= CF_READY; 964 coro->flags |= CF_READY;
974 965
975 LOCK; 966 LOCK;
976 coro_enq (SvREFCNT_inc (coro_sv)); 967 coro_enq (SvREFCNT_inc (coro_sv));
977 UNLOCK; 968 UNLOCK;
… …
980} 971}
981 972
982static int 973static int
983api_is_ready (SV *coro_sv) 974api_is_ready (SV *coro_sv)
984{ 975{
985 return !!SvSTATE (coro_sv)->flags & CF_READY; 976 return !!(SvSTATE (coro_sv)->flags & CF_READY);
986} 977}
987 978
988static void 979static void
989prepare_schedule (struct transfer_args *ta) 980prepare_schedule (struct transfer_args *ta)
990{ 981{
… …
1035 1026
1036static void 1027static void
1037prepare_cede (struct transfer_args *ta) 1028prepare_cede (struct transfer_args *ta)
1038{ 1029{
1039 api_ready (coro_current); 1030 api_ready (coro_current);
1040
1041 prepare_schedule (ta); 1031 prepare_schedule (ta);
1032}
1033
1034static int
1035prepare_cede_notself (struct transfer_args *ta)
1036{
1037 if (coro_nready)
1038 {
1039 SV *prev = SvRV (coro_current);
1040 prepare_schedule (ta);
1041 api_ready (prev);
1042 return 1;
1043 }
1044 else
1045 return 0;
1042} 1046}
1043 1047
1044static void 1048static void
1045api_schedule (void) 1049api_schedule (void)
1046{ 1050{
… …
1048 1052
1049 prepare_schedule (&ta); 1053 prepare_schedule (&ta);
1050 TRANSFER (ta); 1054 TRANSFER (ta);
1051} 1055}
1052 1056
1053static void 1057static int
1054api_cede (void) 1058api_cede (void)
1055{ 1059{
1056 struct transfer_args ta; 1060 struct transfer_args ta;
1057 1061
1058 prepare_cede (&ta); 1062 prepare_cede (&ta);
1063
1064 if (ta.prev != ta.next)
1065 {
1059 TRANSFER (ta); 1066 TRANSFER (ta);
1067 return 1;
1068 }
1069 else
1070 return 0;
1071}
1072
1073static int
1074api_cede_notself (void)
1075{
1076 struct transfer_args ta;
1077
1078 if (prepare_cede_notself (&ta))
1079 {
1080 TRANSFER (ta);
1081 return 1;
1082 }
1083 else
1084 return 0;
1060} 1085}
1061 1086
1062MODULE = Coro::State PACKAGE = Coro::State 1087MODULE = Coro::State PACKAGE = Coro::State
1063 1088
1064PROTOTYPES: DISABLE 1089PROTOTYPES: DISABLE
… …
1120_set_stacklevel (...) 1145_set_stacklevel (...)
1121 ALIAS: 1146 ALIAS:
1122 Coro::State::transfer = 1 1147 Coro::State::transfer = 1
1123 Coro::schedule = 2 1148 Coro::schedule = 2
1124 Coro::cede = 3 1149 Coro::cede = 3
1150 Coro::cede_notself = 4
1125 CODE: 1151 CODE:
1126{ 1152{
1127 struct transfer_args ta; 1153 struct transfer_args ta;
1128 1154
1129 switch (ix) 1155 switch (ix)
… …
1145 break; 1171 break;
1146 1172
1147 case 3: 1173 case 3:
1148 prepare_cede (&ta); 1174 prepare_cede (&ta);
1149 break; 1175 break;
1176
1177 case 4:
1178 if (!prepare_cede_notself (&ta))
1179 XSRETURN_EMPTY;
1180
1181 break;
1150 } 1182 }
1151 1183
1184 BARRIER;
1152 TRANSFER (ta); 1185 TRANSFER (ta);
1153} 1186}
1154 1187
1155void 1188void
1156_clone_state_from (SV *dst, SV *src) 1189_clone_state_from (SV *dst, SV *src)
… …
1207 coro_ready[i] = newAV (); 1240 coro_ready[i] = newAV ();
1208 1241
1209 { 1242 {
1210 SV *sv = perl_get_sv("Coro::API", 1); 1243 SV *sv = perl_get_sv("Coro::API", 1);
1211 1244
1212 coroapi.schedule = api_schedule; 1245 coroapi.schedule = api_schedule;
1213 coroapi.save = api_save; 1246 coroapi.save = api_save;
1214 coroapi.cede = api_cede; 1247 coroapi.cede = api_cede;
1248 coroapi.cede_notself = api_cede_notself;
1215 coroapi.ready = api_ready; 1249 coroapi.ready = api_ready;
1216 coroapi.is_ready = api_is_ready; 1250 coroapi.is_ready = api_is_ready;
1217 coroapi.nready = &coro_nready; 1251 coroapi.nready = &coro_nready;
1218 coroapi.current = coro_current; 1252 coroapi.current = coro_current;
1219 1253
1220 GCoroAPI = &coroapi; 1254 GCoroAPI = &coroapi;
1221 sv_setiv (sv, (IV)&coroapi); 1255 sv_setiv (sv, (IV)&coroapi);
1222 SvREADONLY_on (sv); 1256 SvREADONLY_on (sv);
1223 } 1257 }
… …
1239 RETVAL = coro->prio; 1273 RETVAL = coro->prio;
1240 1274
1241 if (items > 1) 1275 if (items > 1)
1242 { 1276 {
1243 if (ix) 1277 if (ix)
1244 newprio += coro->prio; 1278 newprio = coro->prio - newprio;
1245 1279
1246 if (newprio < PRIO_MIN) newprio = PRIO_MIN; 1280 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1247 if (newprio > PRIO_MAX) newprio = PRIO_MAX; 1281 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1248 1282
1249 coro->prio = newprio; 1283 coro->prio = newprio;
1250 } 1284 }
1251} 1285}
1286 OUTPUT:
1287 RETVAL
1252 1288
1253SV * 1289SV *
1254ready (SV *self) 1290ready (SV *self)
1255 PROTOTYPE: $ 1291 PROTOTYPE: $
1256 CODE: 1292 CODE:

Diff Legend

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