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.124 by root, Tue Dec 5 12:50:04 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#include <assert.h> 11#include <assert.h>
46
47#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
48# undef STACKGUARD
49#endif
50
51#ifndef STACKGUARD
52# define STACKGUARD 0
53#endif
54 12
55#ifdef HAVE_MMAP 13#ifdef HAVE_MMAP
56# include <unistd.h> 14# include <unistd.h>
57# include <sys/mman.h> 15# include <sys/mman.h>
58# ifndef MAP_ANONYMOUS 16# ifndef MAP_ANONYMOUS
… …
73#else 31#else
74# define PAGESIZE 0 32# define PAGESIZE 0
75# define BOOT_PAGESIZE (void)0 33# define BOOT_PAGESIZE (void)0
76#endif 34#endif
77 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
78/* 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
79 * 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
80 * and should be unique. */ 90 * and should be unique. */
81#define dSTACKLEVEL int stacklevel 91#define dSTACKLEVEL int stacklevel
82#define STACKLEVEL ((void *)&stacklevel) 92#define STACKLEVEL ((void *)&stacklevel)
83 93
84#define IN_DESTRUCT (PL_main_cv == Nullcv) 94#define IN_DESTRUCT (PL_main_cv == Nullcv)
85 95
86#if __GNUC__ >= 3 96#if __GNUC__ >= 3
87# define attribute(x) __attribute__(x) 97# define attribute(x) __attribute__(x)
98# define BARRIER __asm__ __volatile__ ("" : : : "memory")
88#else 99#else
89# define attribute(x) 100# define attribute(x)
101# define BARRIER
90#endif 102#endif
91 103
92#define NOINLINE attribute ((noinline)) 104#define NOINLINE attribute ((noinline))
93 105
94#include "CoroAPI.h" 106#include "CoroAPI.h"
… …
125 /* the stack */ 137 /* the stack */
126 void *sptr; 138 void *sptr;
127 long ssize; /* positive == mmap, otherwise malloc */ 139 long ssize; /* positive == mmap, otherwise malloc */
128 140
129 /* cpu state */ 141 /* cpu state */
130 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 */
131 JMPENV *top_env; 144 JMPENV *top_env;
132 coro_context cctx; 145 coro_context cctx;
133 146
134 int inuse; 147 int inuse;
135 148
… …
254 267
255 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0) 268 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
256 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--]; 269 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
257 else 270 else
258 { 271 {
259#if 0 272#if PREFER_PERL_FUNCTIONS
260 /* this is probably cleaner, but also slower? */ 273 /* this is probably cleaner, but also slower? */
261 CV *cp = Perl_cv_clone (cv); 274 CV *cp = Perl_cv_clone (cv);
262 CvPADLIST (cv) = CvPADLIST (cp); 275 CvPADLIST (cv) = CvPADLIST (cp);
263 CvPADLIST (cp) = 0; 276 CvPADLIST (cp) = 0;
264 SvREFCNT_dec (cp); 277 SvREFCNT_dec (cp);
… …
345 /* 358 /*
346 * 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
347 * (and reinitialize) all cv's in the whole callchain :( 360 * (and reinitialize) all cv's in the whole callchain :(
348 */ 361 */
349 362
363 EXTEND (SP, 3 + 1);
350 PUSHs (Nullsv); 364 PUSHs (Nullsv);
351 /* this loop was inspired by pp_caller */ 365 /* this loop was inspired by pp_caller */
352 for (;;) 366 for (;;)
353 { 367 {
354 while (cxix >= 0) 368 while (cxix >= 0)
… …
360 CV *cv = cx->blk_sub.cv; 374 CV *cv = cx->blk_sub.cv;
361 375
362 if (CvDEPTH (cv)) 376 if (CvDEPTH (cv))
363 { 377 {
364 EXTEND (SP, 3); 378 EXTEND (SP, 3);
365
366 PUSHs ((SV *)CvPADLIST (cv)); 379 PUSHs ((SV *)CvPADLIST (cv));
367 PUSHs (INT2PTR (SV *, CvDEPTH (cv))); 380 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
368 PUSHs ((SV *)cv); 381 PUSHs ((SV *)cv);
369 382
370 CvDEPTH (cv) = 0; 383 CvDEPTH (cv) = 0;
371 get_padlist (cv); 384 get_padlist (cv);
372 } 385 }
373 } 386 }
374#ifdef CXt_FORMAT
375 else if (CxTYPE (cx) == CXt_FORMAT)
376 {
377 /* I never used formats, so how should I know how these are implemented? */
378 /* my bold guess is as a simple, plain sub... */
379 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
380 }
381#endif
382 } 387 }
383 388
384 if (top_si->si_type == PERLSI_MAIN) 389 if (top_si->si_type == PERLSI_MAIN)
385 break; 390 break;
386 391
… …
406 * allocate various perl stacks. This is an exact copy 411 * allocate various perl stacks. This is an exact copy
407 * of perl.c:init_stacks, except that it uses less memory 412 * of perl.c:init_stacks, except that it uses less memory
408 * on the (sometimes correct) assumption that coroutines do 413 * on the (sometimes correct) assumption that coroutines do
409 * not usually need a lot of stackspace. 414 * not usually need a lot of stackspace.
410 */ 415 */
416#if PREFER_PERL_FUNCTIONS
417# define coro_init_stacks init_stacks
418#else
411static void 419static void
412coro_init_stacks () 420coro_init_stacks ()
413{ 421{
414 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT)); 422 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));
415 PL_curstackinfo->si_type = PERLSI_MAIN; 423 PL_curstackinfo->si_type = PERLSI_MAIN;
… …
445 New(54,PL_retstack,16,OP*); 453 New(54,PL_retstack,16,OP*);
446 PL_retstack_ix = 0; 454 PL_retstack_ix = 0;
447 PL_retstack_max = 16; 455 PL_retstack_max = 16;
448#endif 456#endif
449} 457}
458#endif
450 459
451/* 460/*
452 * destroy the stacks, the callchain etc... 461 * destroy the stacks, the callchain etc...
453 */ 462 */
454static void 463static void
455coro_destroy_stacks () 464coro_destroy_stacks ()
456{ 465{
457 if (!IN_DESTRUCT) 466 if (!IN_DESTRUCT)
458 { 467 {
459 /* is this ugly, I ask? */ 468 /* restore all saved variables and stuff */
460 LEAVE_SCOPE (0); 469 LEAVE_SCOPE (0);
470 assert (PL_tmps_floor == -1);
461 471
462 /* sure it is, but more important: is it correct?? :/ */ 472 /* free all temporaries */
463 FREETMPS; 473 FREETMPS;
474 assert (PL_tmps_ix == -1);
464 475
465 /*POPSTACK_TO (PL_mainstack);*//*D*//*use*/ 476 POPSTACK_TO (PL_mainstack);
466 } 477 }
467 478
468 while (PL_curstackinfo->si_next) 479 while (PL_curstackinfo->si_next)
469 PL_curstackinfo = PL_curstackinfo->si_next; 480 PL_curstackinfo = PL_curstackinfo->si_next;
470 481
471 while (PL_curstackinfo) 482 while (PL_curstackinfo)
472 { 483 {
473 PERL_SI *p = PL_curstackinfo->si_prev; 484 PERL_SI *p = PL_curstackinfo->si_prev;
474 485
475 { /*D*//*remove*/
476 dSP;
477 SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
478 PUTBACK; /* possibly superfluous */
479 }
480
481 if (!IN_DESTRUCT) 486 if (!IN_DESTRUCT)
482 {
483 dounwind (-1);/*D*//*remove*/
484 SvREFCNT_dec (PL_curstackinfo->si_stack); 487 SvREFCNT_dec (PL_curstackinfo->si_stack);
485 }
486 488
487 Safefree (PL_curstackinfo->si_cxstack); 489 Safefree (PL_curstackinfo->si_cxstack);
488 Safefree (PL_curstackinfo); 490 Safefree (PL_curstackinfo);
489 PL_curstackinfo = p; 491 PL_curstackinfo = p;
490 } 492 }
… …
707 709
708 /* sometimes transfer is only called to set idle_sp */ 710 /* sometimes transfer is only called to set idle_sp */
709 if (!next) 711 if (!next)
710 { 712 {
711 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 713 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
712 assert (((coro_cctx *)prev)->top_env = PL_top_env); /* just for the side effetc when assert is enabled */ 714 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
713 } 715 }
714 else if (prev != next) 716 else if (prev != next)
715 { 717 {
716 coro_cctx *prev__cctx; 718 coro_cctx *prev__cctx;
717 719
… …
758 760
759 /* possibly "free" the cctx */ 761 /* possibly "free" the cctx */
760 if (prev__cctx->idle_sp == STACKLEVEL) 762 if (prev__cctx->idle_sp == STACKLEVEL)
761 { 763 {
762 /* 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 */
763 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));
764 766
765 prev->cctx = 0; 767 prev->cctx = 0;
766 768
767 cctx_put (prev__cctx); 769 cctx_put (prev__cctx);
768 prev__cctx->inuse = 0; 770 prev__cctx->inuse = 0;
… …
958 coro = SvSTATE (coro_sv); 960 coro = SvSTATE (coro_sv);
959 961
960 if (coro->flags & CF_READY) 962 if (coro->flags & CF_READY)
961 return 0; 963 return 0;
962 964
963#if 0 /* this is actually harmless */
964 if (coro->flags & CF_RUNNING)
965 croak ("Coro::ready called on currently running coroutine");
966#endif
967
968 coro->flags |= CF_READY; 965 coro->flags |= CF_READY;
969 966
970 LOCK; 967 LOCK;
971 coro_enq (SvREFCNT_inc (coro_sv)); 968 coro_enq (SvREFCNT_inc (coro_sv));
972 UNLOCK; 969 UNLOCK;
… …
975} 972}
976 973
977static int 974static int
978api_is_ready (SV *coro_sv) 975api_is_ready (SV *coro_sv)
979{ 976{
980 return !!SvSTATE (coro_sv)->flags & CF_READY; 977 return !!(SvSTATE (coro_sv)->flags & CF_READY);
981} 978}
982 979
983static void 980static void
984prepare_schedule (struct transfer_args *ta) 981prepare_schedule (struct transfer_args *ta)
985{ 982{
… …
1030 1027
1031static void 1028static void
1032prepare_cede (struct transfer_args *ta) 1029prepare_cede (struct transfer_args *ta)
1033{ 1030{
1034 api_ready (coro_current); 1031 api_ready (coro_current);
1035
1036 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;
1037} 1047}
1038 1048
1039static void 1049static void
1040api_schedule (void) 1050api_schedule (void)
1041{ 1051{
… …
1043 1053
1044 prepare_schedule (&ta); 1054 prepare_schedule (&ta);
1045 TRANSFER (ta); 1055 TRANSFER (ta);
1046} 1056}
1047 1057
1048static void 1058static int
1049api_cede (void) 1059api_cede (void)
1050{ 1060{
1051 struct transfer_args ta; 1061 struct transfer_args ta;
1052 1062
1053 prepare_cede (&ta); 1063 prepare_cede (&ta);
1064
1065 if (ta.prev != ta.next)
1066 {
1054 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;
1055} 1086}
1056 1087
1057MODULE = Coro::State PACKAGE = Coro::State 1088MODULE = Coro::State PACKAGE = Coro::State
1058 1089
1059PROTOTYPES: DISABLE 1090PROTOTYPES: DISABLE
… …
1115_set_stacklevel (...) 1146_set_stacklevel (...)
1116 ALIAS: 1147 ALIAS:
1117 Coro::State::transfer = 1 1148 Coro::State::transfer = 1
1118 Coro::schedule = 2 1149 Coro::schedule = 2
1119 Coro::cede = 3 1150 Coro::cede = 3
1151 Coro::cede_notself = 4
1120 CODE: 1152 CODE:
1121{ 1153{
1122 struct transfer_args ta; 1154 struct transfer_args ta;
1123 1155
1124 switch (ix) 1156 switch (ix)
… …
1140 break; 1172 break;
1141 1173
1142 case 3: 1174 case 3:
1143 prepare_cede (&ta); 1175 prepare_cede (&ta);
1144 break; 1176 break;
1177
1178 case 4:
1179 if (!prepare_cede_notself (&ta))
1180 XSRETURN_EMPTY;
1181
1182 break;
1145 } 1183 }
1146 1184
1185 BARRIER;
1147 TRANSFER (ta); 1186 TRANSFER (ta);
1148} 1187}
1149 1188
1150void 1189void
1151_clone_state_from (SV *dst, SV *src) 1190_clone_state_from (SV *dst, SV *src)
… …
1202 coro_ready[i] = newAV (); 1241 coro_ready[i] = newAV ();
1203 1242
1204 { 1243 {
1205 SV *sv = perl_get_sv("Coro::API", 1); 1244 SV *sv = perl_get_sv("Coro::API", 1);
1206 1245
1207 coroapi.schedule = api_schedule; 1246 coroapi.schedule = api_schedule;
1208 coroapi.save = api_save; 1247 coroapi.save = api_save;
1209 coroapi.cede = api_cede; 1248 coroapi.cede = api_cede;
1249 coroapi.cede_notself = api_cede_notself;
1210 coroapi.ready = api_ready; 1250 coroapi.ready = api_ready;
1211 coroapi.is_ready = api_is_ready; 1251 coroapi.is_ready = api_is_ready;
1212 coroapi.nready = &coro_nready; 1252 coroapi.nready = &coro_nready;
1213 coroapi.current = coro_current; 1253 coroapi.current = coro_current;
1214 1254
1215 GCoroAPI = &coroapi; 1255 GCoroAPI = &coroapi;
1216 sv_setiv (sv, (IV)&coroapi); 1256 sv_setiv (sv, (IV)&coroapi);
1217 SvREADONLY_on (sv); 1257 SvREADONLY_on (sv);
1218 } 1258 }
… …
1234 RETVAL = coro->prio; 1274 RETVAL = coro->prio;
1235 1275
1236 if (items > 1) 1276 if (items > 1)
1237 { 1277 {
1238 if (ix) 1278 if (ix)
1239 newprio += coro->prio; 1279 newprio = coro->prio - newprio;
1240 1280
1241 if (newprio < PRIO_MIN) newprio = PRIO_MIN; 1281 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1242 if (newprio > PRIO_MAX) newprio = PRIO_MAX; 1282 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1243 1283
1244 coro->prio = newprio; 1284 coro->prio = newprio;
1245 } 1285 }
1246} 1286}
1287 OUTPUT:
1288 RETVAL
1247 1289
1248SV * 1290SV *
1249ready (SV *self) 1291ready (SV *self)
1250 PROTOTYPE: $ 1292 PROTOTYPE: $
1251 CODE: 1293 CODE:

Diff Legend

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