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.130 by root, Mon Dec 25 13:25:55 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)
… …
254 264
255 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0) 265 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
256 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--]; 266 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
257 else 267 else
258 { 268 {
259#if 0 269#if PREFER_PERL_FUNCTIONS
260 /* this is probably cleaner, but also slower? */ 270 /* this is probably cleaner, but also slower? */
261 CV *cp = Perl_cv_clone (cv); 271 CV *cp = Perl_cv_clone (cv);
262 CvPADLIST (cv) = CvPADLIST (cp); 272 CvPADLIST (cv) = CvPADLIST (cp);
263 CvPADLIST (cp) = 0; 273 CvPADLIST (cp) = 0;
264 SvREFCNT_dec (cp); 274 SvREFCNT_dec (cp);
… …
345 /* 355 /*
346 * the worst thing you can imagine happens first - we have to save 356 * the worst thing you can imagine happens first - we have to save
347 * (and reinitialize) all cv's in the whole callchain :( 357 * (and reinitialize) all cv's in the whole callchain :(
348 */ 358 */
349 359
360 EXTEND (SP, 3 + 1);
350 PUSHs (Nullsv); 361 PUSHs (Nullsv);
351 /* this loop was inspired by pp_caller */ 362 /* this loop was inspired by pp_caller */
352 for (;;) 363 for (;;)
353 { 364 {
354 while (cxix >= 0) 365 while (cxix >= 0)
… …
360 CV *cv = cx->blk_sub.cv; 371 CV *cv = cx->blk_sub.cv;
361 372
362 if (CvDEPTH (cv)) 373 if (CvDEPTH (cv))
363 { 374 {
364 EXTEND (SP, 3); 375 EXTEND (SP, 3);
365
366 PUSHs ((SV *)CvPADLIST (cv)); 376 PUSHs ((SV *)CvPADLIST (cv));
367 PUSHs (INT2PTR (SV *, CvDEPTH (cv))); 377 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
368 PUSHs ((SV *)cv); 378 PUSHs ((SV *)cv);
369 379
370 CvDEPTH (cv) = 0; 380 CvDEPTH (cv) = 0;
371 get_padlist (cv); 381 get_padlist (cv);
372 } 382 }
373 } 383 }
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 } 384 }
383 385
384 if (top_si->si_type == PERLSI_MAIN) 386 if (top_si->si_type == PERLSI_MAIN)
385 break; 387 break;
386 388
… …
406 * allocate various perl stacks. This is an exact copy 408 * allocate various perl stacks. This is an exact copy
407 * of perl.c:init_stacks, except that it uses less memory 409 * of perl.c:init_stacks, except that it uses less memory
408 * on the (sometimes correct) assumption that coroutines do 410 * on the (sometimes correct) assumption that coroutines do
409 * not usually need a lot of stackspace. 411 * not usually need a lot of stackspace.
410 */ 412 */
413#if PREFER_PERL_FUNCTIONS
414# define coro_init_stacks init_stacks
415#else
411static void 416static void
412coro_init_stacks () 417coro_init_stacks ()
413{ 418{
414 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT)); 419 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));
415 PL_curstackinfo->si_type = PERLSI_MAIN; 420 PL_curstackinfo->si_type = PERLSI_MAIN;
… …
445 New(54,PL_retstack,16,OP*); 450 New(54,PL_retstack,16,OP*);
446 PL_retstack_ix = 0; 451 PL_retstack_ix = 0;
447 PL_retstack_max = 16; 452 PL_retstack_max = 16;
448#endif 453#endif
449} 454}
455#endif
450 456
451/* 457/*
452 * destroy the stacks, the callchain etc... 458 * destroy the stacks, the callchain etc...
453 */ 459 */
454static void 460static void
455coro_destroy_stacks () 461coro_destroy_stacks ()
456{ 462{
457 if (!IN_DESTRUCT) 463 if (!IN_DESTRUCT)
458 { 464 {
459 /* is this ugly, I ask? */ 465 /* restore all saved variables and stuff */
460 LEAVE_SCOPE (0); 466 LEAVE_SCOPE (0);
467 assert (PL_tmps_floor == -1);
461 468
462 /* sure it is, but more important: is it correct?? :/ */ 469 /* free all temporaries */
463 FREETMPS; 470 FREETMPS;
471 assert (PL_tmps_ix == -1);
464 472
465 /*POPSTACK_TO (PL_mainstack);*//*D*//*use*/ 473 POPSTACK_TO (PL_mainstack);
466 } 474 }
467 475
468 while (PL_curstackinfo->si_next) 476 while (PL_curstackinfo->si_next)
469 PL_curstackinfo = PL_curstackinfo->si_next; 477 PL_curstackinfo = PL_curstackinfo->si_next;
470 478
471 while (PL_curstackinfo) 479 while (PL_curstackinfo)
472 { 480 {
473 PERL_SI *p = PL_curstackinfo->si_prev; 481 PERL_SI *p = PL_curstackinfo->si_prev;
474 482
475 { /*D*//*remove*/
476 dSP;
477 SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
478 PUTBACK; /* possibly superfluous */
479 }
480
481 if (!IN_DESTRUCT) 483 if (!IN_DESTRUCT)
482 {
483 dounwind (-1);/*D*//*remove*/
484 SvREFCNT_dec (PL_curstackinfo->si_stack); 484 SvREFCNT_dec (PL_curstackinfo->si_stack);
485 }
486 485
487 Safefree (PL_curstackinfo->si_cxstack); 486 Safefree (PL_curstackinfo->si_cxstack);
488 Safefree (PL_curstackinfo); 487 Safefree (PL_curstackinfo);
489 PL_curstackinfo = p; 488 PL_curstackinfo = p;
490 } 489 }
… …
958 coro = SvSTATE (coro_sv); 957 coro = SvSTATE (coro_sv);
959 958
960 if (coro->flags & CF_READY) 959 if (coro->flags & CF_READY)
961 return 0; 960 return 0;
962 961
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; 962 coro->flags |= CF_READY;
969 963
970 LOCK; 964 LOCK;
971 coro_enq (SvREFCNT_inc (coro_sv)); 965 coro_enq (SvREFCNT_inc (coro_sv));
972 UNLOCK; 966 UNLOCK;
… …
975} 969}
976 970
977static int 971static int
978api_is_ready (SV *coro_sv) 972api_is_ready (SV *coro_sv)
979{ 973{
980 return !!SvSTATE (coro_sv)->flags & CF_READY; 974 return !!(SvSTATE (coro_sv)->flags & CF_READY);
981} 975}
982 976
983static void 977static void
984prepare_schedule (struct transfer_args *ta) 978prepare_schedule (struct transfer_args *ta)
985{ 979{
… …
1234 RETVAL = coro->prio; 1228 RETVAL = coro->prio;
1235 1229
1236 if (items > 1) 1230 if (items > 1)
1237 { 1231 {
1238 if (ix) 1232 if (ix)
1239 newprio += coro->prio; 1233 newprio = coro->prio - newprio;
1240 1234
1241 if (newprio < PRIO_MIN) newprio = PRIO_MIN; 1235 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1242 if (newprio > PRIO_MAX) newprio = PRIO_MAX; 1236 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1243 1237
1244 coro->prio = newprio; 1238 coro->prio = newprio;
1245 } 1239 }
1246} 1240}
1241 OUTPUT:
1242 RETVAL
1247 1243
1248SV * 1244SV *
1249ready (SV *self) 1245ready (SV *self)
1250 PROTOTYPE: $ 1246 PROTOTYPE: $
1251 CODE: 1247 CODE:

Diff Legend

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