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.111 by root, Thu Nov 30 18:21:14 2006 UTC vs.
Revision 1.136 by root, Fri Jan 12 01:05:55 2007 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#define PERL_VERSION_ATLEAST(a,b,c) \
14 (PERL_REVISION > (a) \
15 || (PERL_REVISION == (a) \
16 && (PERL_VERSION > (b) \
17 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
18
19#if !PERL_VERSION_ATLEAST (5,6,0)
20# ifndef PL_ppaddr
21# define PL_ppaddr ppaddr
22# endif
23# ifndef call_sv
24# define call_sv perl_call_sv
25# endif
26# ifndef get_sv
27# define get_sv perl_get_sv
28# endif
29# ifndef get_cv
30# define get_cv perl_get_cv
31# endif
32# ifndef IS_PADGV
33# define IS_PADGV(v) 0
34# endif
35# ifndef IS_PADCONST
36# define IS_PADCONST(v) 0
37# endif
38#endif
39
40#include <stdio.h> 9#include <stdio.h>
41#include <errno.h> 10#include <errno.h>
42 11#include <assert.h>
43#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
44# undef STACKGUARD
45#endif
46
47#ifndef STACKGUARD
48# define STACKGUARD 0
49#endif
50 12
51#ifdef HAVE_MMAP 13#ifdef HAVE_MMAP
52# include <unistd.h> 14# include <unistd.h>
53# include <sys/mman.h> 15# include <sys/mman.h>
54# ifndef MAP_ANONYMOUS 16# ifndef MAP_ANONYMOUS
… …
69#else 31#else
70# define PAGESIZE 0 32# define PAGESIZE 0
71# define BOOT_PAGESIZE (void)0 33# define BOOT_PAGESIZE (void)0
72#endif 34#endif
73 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
74/* 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
75 * 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
76 * and should be unique. */ 90 * and should be unique. */
77#define dSTACKLEVEL int stacklevel 91#define dSTACKLEVEL int stacklevel
78#define STACKLEVEL ((void *)&stacklevel) 92#define STACKLEVEL ((void *)&stacklevel)
79 93
80#define IN_DESTRUCT (PL_main_cv == Nullcv) 94#define IN_DESTRUCT (PL_main_cv == Nullcv)
81 95
82#if __GNUC__ >= 3 96#if __GNUC__ >= 3
83# define attribute(x) __attribute__(x) 97# define attribute(x) __attribute__(x)
98# define BARRIER __asm__ __volatile__ ("" : : : "memory")
84#else 99#else
85# define attribute(x) 100# define attribute(x)
101# define BARRIER
86#endif 102#endif
87 103
88#define NOINLINE attribute ((noinline)) 104#define NOINLINE attribute ((noinline))
89 105
90#include "CoroAPI.h" 106#include "CoroAPI.h"
91
92#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */
93 107
94#ifdef USE_ITHREADS 108#ifdef USE_ITHREADS
95static perl_mutex coro_mutex; 109static perl_mutex coro_mutex;
96# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0) 110# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)
97# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0) 111# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)
98#else 112#else
99# define LOCK (void)0 113# define LOCK (void)0
100# define UNLOCK (void)0 114# define UNLOCK (void)0
101#endif 115#endif
102 116
117/* helper storage struct for Coro::AIO */
118struct io_state
119{
120 int errorno;
121 I32 laststype;
122 int laststatval;
123 Stat_t statcache;
124};
125
103static struct CoroAPI coroapi; 126static struct CoroAPI coroapi;
104static AV *main_mainstack; /* used to differentiate between $main and others */ 127static AV *main_mainstack; /* used to differentiate between $main and others */
105static HV *coro_state_stash, *coro_stash; 128static HV *coro_state_stash, *coro_stash;
106static SV *coro_mortal; /* will be freed after next transfer */ 129static SV *coro_mortal; /* will be freed after next transfer */
107 130
… …
115 /* the stack */ 138 /* the stack */
116 void *sptr; 139 void *sptr;
117 long ssize; /* positive == mmap, otherwise malloc */ 140 long ssize; /* positive == mmap, otherwise malloc */
118 141
119 /* cpu state */ 142 /* cpu state */
120 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 143 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
144 JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */
121 JMPENV *top_env; 145 JMPENV *top_env;
122 coro_context cctx; 146 coro_context cctx;
123 147
124 int inuse; 148 int inuse;
125 149
… …
127 int valgrind_id; 151 int valgrind_id;
128#endif 152#endif
129} coro_cctx; 153} coro_cctx;
130 154
131enum { 155enum {
132 CF_RUNNING, /* coroutine is running */ 156 CF_RUNNING = 0x0001, /* coroutine is running */
133 CF_READY, /* coroutine is ready */ 157 CF_READY = 0x0002, /* coroutine is ready */
158 CF_NEW = 0x0004, /* has never been switched to */
159 CF_DESTROYED = 0x0008, /* coroutine data has been freed */
134}; 160};
135 161
136/* this is a structure representing a perl-level coroutine */ 162/* this is a structure representing a perl-level coroutine */
137struct coro { 163struct coro {
138 /* the c coroutine allocated to this perl coroutine, if any */ 164 /* the c coroutine allocated to this perl coroutine, if any */
139 coro_cctx *cctx; 165 coro_cctx *cctx;
140 166
141 /* data associated with this coroutine (initial args) */ 167 /* data associated with this coroutine (initial args) */
142 AV *args; 168 AV *args;
143 int refcnt; 169 int refcnt;
144 int flags; 170 int save; /* CORO_SAVE flags */
171 int flags; /* CF_ flags */
145 172
146 /* optionally saved, might be zero */ 173 /* optionally saved, might be zero */
147 AV *defav; 174 AV *defav; /* @_ */
148 SV *defsv; 175 SV *defsv; /* $_ */
149 SV *errsv; 176 SV *errsv; /* $@ */
177 SV *irssv; /* $/ */
178 SV *irssv_sv; /* real $/ cache */
150 179
151#define VAR(name,type) type name; 180#define VAR(name,type) type name;
152# include "state.h" 181# include "state.h"
153#undef VAR 182#undef VAR
154 183
… …
240 269
241 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0) 270 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
242 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--]; 271 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
243 else 272 else
244 { 273 {
245#if 0 274#if PREFER_PERL_FUNCTIONS
246 /* this is probably cleaner, but also slower? */ 275 /* this is probably cleaner, but also slower? */
247 CV *cp = Perl_cv_clone (cv); 276 CV *cp = Perl_cv_clone (cv);
248 CvPADLIST (cv) = CvPADLIST (cp); 277 CvPADLIST (cv) = CvPADLIST (cp);
249 CvPADLIST (cp) = 0; 278 CvPADLIST (cp) = 0;
250 SvREFCNT_dec (cp); 279 SvREFCNT_dec (cp);
… …
277} 306}
278 307
279#define SB do { 308#define SB do {
280#define SE } while (0) 309#define SE } while (0)
281 310
282#define LOAD(state) load_state((state));
283#define SAVE(state,flags) save_state((state),(flags));
284
285#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); (val) = 0; SE 311#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE
286 312
287static void 313static void
288load_state(Coro__State c) 314load_perl (Coro__State c)
289{ 315{
290#define VAR(name,type) PL_ ## name = c->name; 316#define VAR(name,type) PL_ ## name = c->name;
291# include "state.h" 317# include "state.h"
292#undef VAR 318#undef VAR
293 319
294 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav); 320 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
295 if (c->defsv) REPLACE_SV (DEFSV , c->defsv); 321 if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
296 if (c->errsv) REPLACE_SV (ERRSV , c->errsv); 322 if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
323 if (c->irssv)
324 {
325 if (c->irssv == PL_rs || sv_eq (PL_rs, c->irssv))
326 SvREFCNT_dec (c->irssv);
327 else
328 {
329 REPLACE_SV (PL_rs, c->irssv);
330 if (!c->irssv_sv) c->irssv_sv = get_sv ("/", 0);
331 sv_setsv (c->irssv_sv, PL_rs);
332 }
333 }
297 334
298 { 335 {
299 dSP; 336 dSP;
300 CV *cv; 337 CV *cv;
301 338
… …
310 PUTBACK; 347 PUTBACK;
311 } 348 }
312} 349}
313 350
314static void 351static void
315save_state(Coro__State c, int flags) 352save_perl (Coro__State c)
316{ 353{
317 { 354 {
318 dSP; 355 dSP;
319 I32 cxix = cxstack_ix; 356 I32 cxix = cxstack_ix;
320 PERL_CONTEXT *ccstk = cxstack; 357 PERL_CONTEXT *ccstk = cxstack;
… …
323 /* 360 /*
324 * the worst thing you can imagine happens first - we have to save 361 * the worst thing you can imagine happens first - we have to save
325 * (and reinitialize) all cv's in the whole callchain :( 362 * (and reinitialize) all cv's in the whole callchain :(
326 */ 363 */
327 364
365 EXTEND (SP, 3 + 1);
328 PUSHs (Nullsv); 366 PUSHs (Nullsv);
329 /* this loop was inspired by pp_caller */ 367 /* this loop was inspired by pp_caller */
330 for (;;) 368 for (;;)
331 { 369 {
332 while (cxix >= 0) 370 while (cxix >= 0)
333 { 371 {
334 PERL_CONTEXT *cx = &ccstk[cxix--]; 372 PERL_CONTEXT *cx = &ccstk[cxix--];
335 373
336 if (CxTYPE(cx) == CXt_SUB) 374 if (CxTYPE (cx) == CXt_SUB)
337 { 375 {
338 CV *cv = cx->blk_sub.cv; 376 CV *cv = cx->blk_sub.cv;
339 377
340 if (CvDEPTH (cv)) 378 if (CvDEPTH (cv))
341 { 379 {
342 EXTEND (SP, 3); 380 EXTEND (SP, 3);
343
344 PUSHs ((SV *)CvPADLIST(cv)); 381 PUSHs ((SV *)CvPADLIST (cv));
345 PUSHs (INT2PTR (SV *, CvDEPTH (cv))); 382 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
346 PUSHs ((SV *)cv); 383 PUSHs ((SV *)cv);
347 384
348 CvDEPTH (cv) = 0; 385 CvDEPTH (cv) = 0;
349 get_padlist (cv); 386 get_padlist (cv);
350 } 387 }
351 } 388 }
352#ifdef CXt_FORMAT
353 else if (CxTYPE(cx) == CXt_FORMAT)
354 {
355 /* I never used formats, so how should I know how these are implemented? */
356 /* my bold guess is as a simple, plain sub... */
357 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
358 }
359#endif
360 } 389 }
361 390
362 if (top_si->si_type == PERLSI_MAIN) 391 if (top_si->si_type == PERLSI_MAIN)
363 break; 392 break;
364 393
… …
368 } 397 }
369 398
370 PUTBACK; 399 PUTBACK;
371 } 400 }
372 401
373 c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0; 402 c->defav = c->save & CORO_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
374 c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0; 403 c->defsv = c->save & CORO_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
375 c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0; 404 c->errsv = c->save & CORO_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
405 c->irssv = c->save & CORO_SAVE_IRSSV ? SvREFCNT_inc (PL_rs) : 0;
376 406
377#define VAR(name,type)c->name = PL_ ## name; 407#define VAR(name,type)c->name = PL_ ## name;
378# include "state.h" 408# include "state.h"
379#undef VAR 409#undef VAR
380} 410}
… …
383 * allocate various perl stacks. This is an exact copy 413 * allocate various perl stacks. This is an exact copy
384 * of perl.c:init_stacks, except that it uses less memory 414 * of perl.c:init_stacks, except that it uses less memory
385 * on the (sometimes correct) assumption that coroutines do 415 * on the (sometimes correct) assumption that coroutines do
386 * not usually need a lot of stackspace. 416 * not usually need a lot of stackspace.
387 */ 417 */
418#if PREFER_PERL_FUNCTIONS
419# define coro_init_stacks init_stacks
420#else
388static void 421static void
389coro_init_stacks () 422coro_init_stacks ()
390{ 423{
391 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1); 424 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));
392 PL_curstackinfo->si_type = PERLSI_MAIN; 425 PL_curstackinfo->si_type = PERLSI_MAIN;
393 PL_curstack = PL_curstackinfo->si_stack; 426 PL_curstack = PL_curstackinfo->si_stack;
394 PL_mainstack = PL_curstack; /* remember in case we switch stacks */ 427 PL_mainstack = PL_curstack; /* remember in case we switch stacks */
395 428
396 PL_stack_base = AvARRAY(PL_curstack); 429 PL_stack_base = AvARRAY(PL_curstack);
397 PL_stack_sp = PL_stack_base; 430 PL_stack_sp = PL_stack_base;
398 PL_stack_max = PL_stack_base + AvMAX(PL_curstack); 431 PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
399 432
400 New(50,PL_tmps_stack,96,SV*); 433 New(50,PL_tmps_stack,128,SV*);
401 PL_tmps_floor = -1; 434 PL_tmps_floor = -1;
402 PL_tmps_ix = -1; 435 PL_tmps_ix = -1;
403 PL_tmps_max = 96; 436 PL_tmps_max = 128;
404 437
405 New(54,PL_markstack,16,I32); 438 New(54,PL_markstack,32,I32);
406 PL_markstack_ptr = PL_markstack; 439 PL_markstack_ptr = PL_markstack;
407 PL_markstack_max = PL_markstack + 16; 440 PL_markstack_max = PL_markstack + 32;
408 441
409#ifdef SET_MARK_OFFSET 442#ifdef SET_MARK_OFFSET
410 SET_MARK_OFFSET; 443 SET_MARK_OFFSET;
411#endif 444#endif
412 445
413 New(54,PL_scopestack,16,I32); 446 New(54,PL_scopestack,32,I32);
414 PL_scopestack_ix = 0; 447 PL_scopestack_ix = 0;
415 PL_scopestack_max = 16; 448 PL_scopestack_max = 32;
416 449
417 New(54,PL_savestack,96,ANY); 450 New(54,PL_savestack,64,ANY);
418 PL_savestack_ix = 0; 451 PL_savestack_ix = 0;
419 PL_savestack_max = 96; 452 PL_savestack_max = 64;
420 453
421#if !PERL_VERSION_ATLEAST (5,9,0) 454#if !PERL_VERSION_ATLEAST (5,9,0)
422 New(54,PL_retstack,8,OP*); 455 New(54,PL_retstack,16,OP*);
423 PL_retstack_ix = 0; 456 PL_retstack_ix = 0;
424 PL_retstack_max = 8; 457 PL_retstack_max = 16;
425#endif 458#endif
426} 459}
460#endif
427 461
428/* 462/*
429 * destroy the stacks, the callchain etc... 463 * destroy the stacks, the callchain etc...
430 */ 464 */
431static void 465static void
432coro_destroy_stacks () 466coro_destroy_stacks ()
433{ 467{
434 if (!IN_DESTRUCT) 468 if (!IN_DESTRUCT)
435 { 469 {
436 /* is this ugly, I ask? */ 470 /* restore all saved variables and stuff */
437 LEAVE_SCOPE (0); 471 LEAVE_SCOPE (0);
472 assert (PL_tmps_floor == -1);
438 473
439 /* sure it is, but more important: is it correct?? :/ */ 474 /* free all temporaries */
440 FREETMPS; 475 FREETMPS;
476 assert (PL_tmps_ix == -1);
441 477
478 /* unwind all extra stacks */
442 /*POPSTACK_TO (PL_mainstack);*//*D*//*use*/ 479 POPSTACK_TO (PL_mainstack);
480
481 /* unwind main stack */
482 dounwind (-1);
443 } 483 }
444 484
445 while (PL_curstackinfo->si_next) 485 while (PL_curstackinfo->si_next)
446 PL_curstackinfo = PL_curstackinfo->si_next; 486 PL_curstackinfo = PL_curstackinfo->si_next;
447 487
448 while (PL_curstackinfo) 488 while (PL_curstackinfo)
449 { 489 {
450 PERL_SI *p = PL_curstackinfo->si_prev; 490 PERL_SI *p = PL_curstackinfo->si_prev;
451 491
452 { /*D*//*remove*/
453 dSP;
454 SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
455 PUTBACK; /* possibly superfluous */
456 }
457
458 if (!IN_DESTRUCT) 492 if (!IN_DESTRUCT)
459 {
460 dounwind (-1);/*D*//*remove*/
461 SvREFCNT_dec (PL_curstackinfo->si_stack); 493 SvREFCNT_dec (PL_curstackinfo->si_stack);
462 }
463 494
464 Safefree (PL_curstackinfo->si_cxstack); 495 Safefree (PL_curstackinfo->si_cxstack);
465 Safefree (PL_curstackinfo); 496 Safefree (PL_curstackinfo);
466 PL_curstackinfo = p; 497 PL_curstackinfo = p;
467 } 498 }
… …
482 * emulate part of the perl startup here. 513 * emulate part of the perl startup here.
483 */ 514 */
484 515
485 coro_init_stacks (); 516 coro_init_stacks ();
486 517
487 PL_curcop = 0; 518 PL_curcop = &PL_compiling;
488 PL_in_eval = 0; 519 PL_in_eval = EVAL_NULL;
489 PL_curpm = 0; 520 PL_curpm = 0;
521 PL_localizing = 0;
522 PL_dirty = 0;
523 PL_restartop = 0;
490 524
491 { 525 {
492 dSP; 526 dSP;
493 LOGOP myop; 527 LOGOP myop;
494 528
495 /* I have no idea why this is needed, but it is */
496 PUSHMARK (SP);
497
498 SvREFCNT_dec (GvAV (PL_defgv)); 529 SvREFCNT_dec (GvAV (PL_defgv));
499 GvAV (PL_defgv) = coro->args; coro->args = 0; 530 GvAV (PL_defgv) = coro->args; coro->args = 0;
500 531
501 Zero (&myop, 1, LOGOP); 532 Zero (&myop, 1, LOGOP);
502 myop.op_next = Nullop; 533 myop.op_next = Nullop;
503 myop.op_flags = OPf_WANT_VOID; 534 myop.op_flags = OPf_WANT_VOID;
504 535
505 PL_op = (OP *)&myop;
506
507 PUSHMARK (SP); 536 PUSHMARK (SP);
508 XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE)); 537 XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE));
509 PUTBACK; 538 PUTBACK;
539 PL_op = (OP *)&myop;
510 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 540 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
511 SPAGAIN; 541 SPAGAIN;
512
513 ENTER; /* necessary e.g. for dounwind */
514 } 542 }
543
544 ENTER; /* necessary e.g. for dounwind */
515} 545}
516 546
517static void 547static void
518free_coro_mortal () 548free_coro_mortal ()
519{ 549{
… …
522 SvREFCNT_dec (coro_mortal); 552 SvREFCNT_dec (coro_mortal);
523 coro_mortal = 0; 553 coro_mortal = 0;
524 } 554 }
525} 555}
526 556
557/* inject a fake call to Coro::State::_cctx_init into the execution */
527static void NOINLINE 558static void NOINLINE
528prepare_cctx (coro_cctx *cctx) 559prepare_cctx (coro_cctx *cctx)
529{ 560{
530 dSP; 561 dSP;
531 LOGOP myop; 562 LOGOP myop;
532 563
533 Zero (&myop, 1, LOGOP); 564 Zero (&myop, 1, LOGOP);
534 myop.op_next = PL_op; 565 myop.op_next = PL_op;
535 myop.op_flags = OPf_WANT_VOID; 566 myop.op_flags = OPf_WANT_VOID | OPf_STACKED;
536
537 sv_setiv (get_sv ("Coro::State::_cctx", FALSE), PTR2IV (cctx));
538 567
539 PUSHMARK (SP); 568 PUSHMARK (SP);
569 EXTEND (SP, 2);
570 PUSHs (sv_2mortal (newSViv (PTR2IV (cctx))));
540 XPUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE)); 571 PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE));
541 PUTBACK; 572 PUTBACK;
573 PL_op = (OP *)&myop;
542 PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX); 574 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
543 SPAGAIN; 575 SPAGAIN;
544} 576}
545 577
546static void 578static void
547coro_run (void *arg) 579coro_run (void *arg)
548{ 580{
549 /* coro_run is the alternative epilogue of transfer() */ 581 /* coro_run is the alternative tail of transfer(), so unlock here. */
550 UNLOCK; 582 UNLOCK;
551 583
552 /* 584 /*
553 * this is a _very_ stripped down perl interpreter ;) 585 * this is a _very_ stripped down perl interpreter ;)
554 */ 586 */
… …
556 588
557 /* inject call to cctx_init */ 589 /* inject call to cctx_init */
558 prepare_cctx ((coro_cctx *)arg); 590 prepare_cctx ((coro_cctx *)arg);
559 591
560 /* somebody will hit me for both perl_run and PL_restartop */ 592 /* somebody will hit me for both perl_run and PL_restartop */
593 PL_restartop = PL_op;
561 perl_run (PL_curinterp); 594 perl_run (PL_curinterp);
562 595
563 fputs ("FATAL: C coroutine fell over the edge of the world, aborting. Did you call exit in a coroutine?\n", stderr); 596 fputs ("FATAL: C coroutine fell over the edge of the world, aborting. Did you call exit in a coroutine?\n", stderr);
564 abort (); 597 abort ();
565} 598}
… …
569{ 602{
570 coro_cctx *cctx; 603 coro_cctx *cctx;
571 604
572 ++cctx_count; 605 ++cctx_count;
573 606
574 New (0, cctx, 1, coro_cctx); 607 Newz (0, cctx, 1, coro_cctx);
575 608
576#if HAVE_MMAP 609#if HAVE_MMAP
577 610
578 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; 611 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE;
579 /* mmap suppsedly does allocate-on-write for us */ 612 /* mmap supposedly does allocate-on-write for us */
580 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 613 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
581 614
582 if (cctx->sptr == (void *)-1) 615 if (cctx->sptr == (void *)-1)
583 { 616 {
584 perror ("FATAL: unable to mmap stack for coroutine"); 617 perror ("FATAL: unable to mmap stack for coroutine");
… …
613 646
614 return cctx; 647 return cctx;
615} 648}
616 649
617static void 650static void
618cctx_free (coro_cctx *cctx) 651cctx_destroy (coro_cctx *cctx)
619{ 652{
620 if (!cctx) 653 if (!cctx)
621 return; 654 return;
622 655
623 --cctx_count; 656 --cctx_count;
… …
640{ 673{
641 coro_cctx *cctx; 674 coro_cctx *cctx;
642 675
643 if (cctx_first) 676 if (cctx_first)
644 { 677 {
645 --cctx_idle;
646 cctx = cctx_first; 678 cctx = cctx_first;
647 cctx_first = cctx->next; 679 cctx_first = cctx->next;
680 --cctx_idle;
648 } 681 }
649 else 682 else
650 { 683 {
651 cctx = cctx_new (); 684 cctx = cctx_new ();
652 PL_op = PL_op->op_next; 685 PL_op = PL_op->op_next;
… …
656} 689}
657 690
658static void 691static void
659cctx_put (coro_cctx *cctx) 692cctx_put (coro_cctx *cctx)
660{ 693{
694 /* free another cctx if overlimit */
695 if (cctx_idle >= MAX_IDLE_CCTX)
696 {
697 coro_cctx *first = cctx_first;
698 cctx_first = first->next;
699 --cctx_idle;
700
701 assert (!first->inuse);
702 cctx_destroy (first);
703 }
704
661 ++cctx_idle; 705 ++cctx_idle;
662 cctx->next = cctx_first; 706 cctx->next = cctx_first;
663 cctx_first = cctx; 707 cctx_first = cctx;
664} 708}
665 709
666/* never call directly, always through the coro_state_transfer global variable */ 710/* never call directly, always through the coro_state_transfer global variable */
667static void NOINLINE 711static void NOINLINE
668transfer (struct coro *prev, struct coro *next, int flags) 712transfer (struct coro *prev, struct coro *next)
669{ 713{
670 dSTACKLEVEL; 714 dSTACKLEVEL;
671 715
672 /* sometimes transfer is only called to set idle_sp */ 716 /* sometimes transfer is only called to set idle_sp */
673 if (flags == TRANSFER_SET_STACKLEVEL) 717 if (!next)
718 {
674 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 719 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
720 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
721 }
675 else if (prev != next) 722 else if (prev != next)
676 { 723 {
677 coro_cctx *prev__cctx; 724 coro_cctx *prev__cctx;
678 725
679 if (!prev->cctx) 726 if (prev->flags & CF_NEW)
680 { 727 {
681 /* create a new empty context */ 728 /* create a new empty context */
682 Newz (0, prev->cctx, 1, coro_cctx); 729 Newz (0, prev->cctx, 1, coro_cctx);
683 prev->cctx->inuse = 1; 730 prev->cctx->inuse = 1;
731 prev->flags &= ~CF_NEW;
684 prev->flags |= CF_RUNNING; 732 prev->flags |= CF_RUNNING;
685 } 733 }
686 734
735 /*TODO: must not croak here */
687 assert ( prev->flags & CF_RUNNING); 736 if (!prev->flags & CF_RUNNING)
737 croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states");
738
688 assert (!next->flags & CF_RUNNING); 739 if (next->flags & CF_RUNNING)
740 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
741
742 if (next->flags & CF_DESTROYED)
743 croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
689 744
690 prev->flags &= ~CF_RUNNING; 745 prev->flags &= ~CF_RUNNING;
691 next->flags |= CF_RUNNING; 746 next->flags |= CF_RUNNING;
692 747
693 LOCK; 748 LOCK;
694 749
695 if (next->mainstack) 750 if (next->flags & CF_NEW)
696 { 751 {
697 /* coroutine already started */ 752 /* need to start coroutine */
698 SAVE (prev, flags); 753 next->flags &= ~CF_NEW;
699 LOAD (next); 754 /* first get rid of the old state */
755 save_perl (prev);
756 /* setup coroutine call */
757 setup_coro (next);
758 /* need a new stack */
759 assert (!next->cctx);
700 } 760 }
701 else 761 else
702 { 762 {
703 /* need to start coroutine */ 763 /* coroutine already started */
704 /* first get rid of the old state */ 764 save_perl (prev);
705 SAVE (prev, -1); 765 load_perl (next);
706 /* setup coroutine call */
707 setup_coro (next);
708 /* need a stack */
709 assert (!next->stack);
710 next->cctx = 0;
711 } 766 }
712 767
713 prev__cctx = prev->cctx; 768 prev__cctx = prev->cctx;
714 769
715 /* possibly "free" the cctx */ 770 /* possibly "free" the cctx */
716 if (prev__cctx->idle_sp == STACKLEVEL) 771 if (prev__cctx->idle_sp == STACKLEVEL)
717 { 772 {
718 assert (PL_top_env == prev__cctx->top_env);//D 773 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
774 assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te));
775
776 prev->cctx = 0;
777
719 cctx_put (prev__cctx); 778 cctx_put (prev__cctx);
720 prev->cctx = 0; 779 prev__cctx->inuse = 0;
721 } 780 }
722 781
723 if (!next->cctx) 782 if (!next->cctx)
783 {
724 next->cctx = cctx_get (); 784 next->cctx = cctx_get ();
785 assert (!next->cctx->inuse);
786 next->cctx->inuse = 1;
787 }
725 788
726 if (prev__cctx != next->cctx) 789 if (prev__cctx != next->cctx)
727 { 790 {
728 assert ( prev__cctx->inuse);
729 assert (!next->cctx->inuse);
730
731 prev__cctx->inuse = 0;
732 next->cctx->inuse = 1;
733
734 prev__cctx->top_env = PL_top_env; 791 prev__cctx->top_env = PL_top_env;
735 PL_top_env = next->cctx->top_env; 792 PL_top_env = next->cctx->top_env;
736 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx); 793 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
737 } 794 }
738 795
739 free_coro_mortal (); 796 free_coro_mortal ();
740
741 UNLOCK; 797 UNLOCK;
742 } 798 }
743} 799}
744 800
745struct transfer_args 801struct transfer_args
746{ 802{
747 struct coro *prev, *next; 803 struct coro *prev, *next;
748 int flags;
749}; 804};
750 805
751#define TRANSFER(ta) transfer ((ta).prev, (ta).next, (ta).flags) 806#define TRANSFER(ta) transfer ((ta).prev, (ta).next)
752 807
753static void 808static int
754coro_state_destroy (struct coro *coro) 809coro_state_destroy (struct coro *coro)
755{ 810{
756 if (coro->refcnt--) 811 if (coro->flags & CF_DESTROYED)
757 return; 812 return 0;
813
814 coro->flags |= CF_DESTROYED;
758 815
759 if (coro->mainstack && coro->mainstack != main_mainstack) 816 if (coro->mainstack && coro->mainstack != main_mainstack)
760 { 817 {
818 assert (!(coro->flags & CF_RUNNING));
819
761 struct coro temp; 820 struct coro temp;
821 Zero (&temp, 1, struct coro);
822 temp.save = CORO_SAVE_ALL;
762 823
763 SAVE ((&temp), TRANSFER_SAVE_ALL); 824 if (coro->flags & CF_RUNNING)
764 LOAD (coro); 825 croak ("FATAL: tried to destroy currently running coroutine");
826
827 save_perl (&temp);
828 load_perl (coro);
765 829
766 coro_destroy_stacks (); 830 coro_destroy_stacks ();
767 831
768 LOAD ((&temp)); /* this will get rid of defsv etc.. */ 832 load_perl (&temp); /* this will get rid of defsv etc.. */
769 833
770 coro->mainstack = 0; 834 coro->mainstack = 0;
771 } 835 }
772 836
773 cctx_free (coro->cctx); 837 cctx_destroy (coro->cctx);
774 SvREFCNT_dec (coro->args); 838 SvREFCNT_dec (coro->args);
775 Safefree (coro); 839
840 return 1;
776} 841}
777 842
778static int 843static int
779coro_state_clear (pTHX_ SV *sv, MAGIC *mg) 844coro_state_free (pTHX_ SV *sv, MAGIC *mg)
780{ 845{
781 struct coro *coro = (struct coro *)mg->mg_ptr; 846 struct coro *coro = (struct coro *)mg->mg_ptr;
782 mg->mg_ptr = 0; 847 mg->mg_ptr = 0;
783 848
849 if (--coro->refcnt < 0)
850 {
784 coro_state_destroy (coro); 851 coro_state_destroy (coro);
852 Safefree (coro);
853 }
785 854
786 return 0; 855 return 0;
787} 856}
788 857
789static int 858static int
… …
796 return 0; 865 return 0;
797} 866}
798 867
799static MGVTBL coro_state_vtbl = { 868static MGVTBL coro_state_vtbl = {
800 0, 0, 0, 0, 869 0, 0, 0, 0,
801 coro_state_clear, 870 coro_state_free,
802 0, 871 0,
803#ifdef MGf_DUP 872#ifdef MGf_DUP
804 coro_state_dup, 873 coro_state_dup,
805#else 874#else
806# define MGf_DUP 0 875# define MGf_DUP 0
… …
828 assert (mg->mg_type == PERL_MAGIC_ext); 897 assert (mg->mg_type == PERL_MAGIC_ext);
829 return (struct coro *)mg->mg_ptr; 898 return (struct coro *)mg->mg_ptr;
830} 899}
831 900
832static void 901static void
833prepare_transfer (struct transfer_args *ta, SV *prev, SV *next, int flags) 902prepare_transfer (struct transfer_args *ta, SV *prev_sv, SV *next_sv)
834{ 903{
835 ta->prev = SvSTATE (prev); 904 ta->prev = SvSTATE (prev_sv);
836 ta->next = SvSTATE (next); 905 ta->next = SvSTATE (next_sv);
837 ta->flags = flags;
838} 906}
839 907
840static void 908static void
841api_transfer (SV *prev, SV *next, int flags) 909api_transfer (SV *prev_sv, SV *next_sv)
842{ 910{
843 dTHX;
844 struct transfer_args ta; 911 struct transfer_args ta;
845 912
846 prepare_transfer (&ta, prev, next, flags); 913 prepare_transfer (&ta, prev_sv, next_sv);
847 TRANSFER (ta); 914 TRANSFER (ta);
915}
916
917static int
918api_save (SV *coro_sv, int new_save)
919{
920 struct coro *coro = SvSTATE (coro_sv);
921 int old_save = coro->save;
922
923 if (new_save >= 0)
924 coro->save = new_save;
925
926 return old_save;
848} 927}
849 928
850/** Coro ********************************************************************/ 929/** Coro ********************************************************************/
851 930
852#define PRIO_MAX 3 931#define PRIO_MAX 3
… …
855#define PRIO_LOW -1 934#define PRIO_LOW -1
856#define PRIO_IDLE -3 935#define PRIO_IDLE -3
857#define PRIO_MIN -4 936#define PRIO_MIN -4
858 937
859/* for Coro.pm */ 938/* for Coro.pm */
860static GV *coro_current, *coro_idle; 939static SV *coro_current;
861static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; 940static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
862static int coro_nready; 941static int coro_nready;
863 942
864static void 943static void
865coro_enq (SV *sv) 944coro_enq (SV *coro_sv)
866{ 945{
867 int prio;
868
869 if (SvTYPE (sv) != SVt_PVHV)
870 croak ("Coro::ready tried to enqueue something that is not a coroutine");
871
872 prio = SvSTATE (sv)->prio;
873
874 av_push (coro_ready [prio - PRIO_MIN], sv); 946 av_push (coro_ready [SvSTATE (coro_sv)->prio - PRIO_MIN], coro_sv);
875 coro_nready++; 947 coro_nready++;
876} 948}
877 949
878static SV * 950static SV *
879coro_deq (int min_prio) 951coro_deq (int min_prio)
… …
901 973
902 if (SvROK (coro_sv)) 974 if (SvROK (coro_sv))
903 coro_sv = SvRV (coro_sv); 975 coro_sv = SvRV (coro_sv);
904 976
905 coro = SvSTATE (coro_sv); 977 coro = SvSTATE (coro_sv);
978
906 if (coro->flags & CF_READY) 979 if (coro->flags & CF_READY)
907 return 0; 980 return 0;
908 981
909 coro->flags |= CF_READY; 982 coro->flags |= CF_READY;
910 983
… …
916} 989}
917 990
918static int 991static int
919api_is_ready (SV *coro_sv) 992api_is_ready (SV *coro_sv)
920{ 993{
921 struct coro *coro;
922
923 return !!(SvSTATE (coro_sv)->flags & CF_READY); 994 return !!(SvSTATE (coro_sv)->flags & CF_READY);
924} 995}
925 996
926static void 997static void
927prepare_schedule (struct transfer_args *ta) 998prepare_schedule (struct transfer_args *ta)
928{ 999{
929 SV *current, *prev, *next; 1000 SV *prev_sv, *next_sv;
930
931 current = GvSV (coro_current);
932 1001
933 for (;;) 1002 for (;;)
934 { 1003 {
935 LOCK; 1004 LOCK;
936 next = coro_deq (PRIO_MIN); 1005 next_sv = coro_deq (PRIO_MIN);
937 UNLOCK; 1006 UNLOCK;
938 1007
1008 /* nothing to schedule: call the idle handler */
939 if (next) 1009 if (!next_sv)
940 break;
941
942 { 1010 {
943 dSP; 1011 dSP;
944 1012
945 ENTER; 1013 ENTER;
946 SAVETMPS; 1014 SAVETMPS;
947 1015
948 PUSHMARK (SP); 1016 PUSHMARK (SP);
949 PUTBACK; 1017 PUTBACK;
950 call_sv (GvSV (coro_idle), G_DISCARD); 1018 call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD);
951 1019
952 FREETMPS; 1020 FREETMPS;
953 LEAVE; 1021 LEAVE;
1022 continue;
954 } 1023 }
955 }
956 1024
957 prev = SvRV (current); 1025 ta->next = SvSTATE (next_sv);
958 SvRV (current) = next; 1026
1027 /* cannot transfer to destroyed coros, skip and look for next */
1028 if (ta->next->flags & CF_DESTROYED)
1029 {
1030 SvREFCNT_dec (next_sv);
1031 continue;
1032 }
1033
1034 break;
1035 }
959 1036
960 /* free this only after the transfer */ 1037 /* free this only after the transfer */
1038 prev_sv = SvRV (coro_current);
1039 SvRV_set (coro_current, next_sv);
1040 ta->prev = SvSTATE (prev_sv);
1041
1042 assert (ta->next->flags & CF_READY);
1043 ta->next->flags &= ~CF_READY;
1044
961 LOCK; 1045 LOCK;
962 free_coro_mortal (); 1046 free_coro_mortal ();
1047 coro_mortal = prev_sv;
963 UNLOCK; 1048 UNLOCK;
964 coro_mortal = prev;
965
966 ta->prev = SvSTATE (prev);
967 ta->next = SvSTATE (next);
968 ta->flags = TRANSFER_SAVE_ALL;
969
970 ta->next->flags &= ~CF_READY;
971} 1049}
972 1050
973static void 1051static void
974prepare_cede (struct transfer_args *ta) 1052prepare_cede (struct transfer_args *ta)
975{ 1053{
976 api_ready (GvSV (coro_current)); 1054 api_ready (coro_current);
977
978 prepare_schedule (ta); 1055 prepare_schedule (ta);
979} 1056}
980 1057
1058static int
1059prepare_cede_notself (struct transfer_args *ta)
1060{
1061 if (coro_nready)
1062 {
1063 SV *prev = SvRV (coro_current);
1064 prepare_schedule (ta);
1065 api_ready (prev);
1066 return 1;
1067 }
1068 else
1069 return 0;
1070}
1071
981static void 1072static void
982api_schedule (void) 1073api_schedule (void)
983{ 1074{
984 dTHX;
985 struct transfer_args ta; 1075 struct transfer_args ta;
986 1076
987 prepare_schedule (&ta); 1077 prepare_schedule (&ta);
988 TRANSFER (ta); 1078 TRANSFER (ta);
989} 1079}
990 1080
991static void 1081static int
992api_cede (void) 1082api_cede (void)
993{ 1083{
994 dTHX;
995 struct transfer_args ta; 1084 struct transfer_args ta;
996 1085
997 prepare_cede (&ta); 1086 prepare_cede (&ta);
1087
1088 if (ta.prev != ta.next)
1089 {
998 TRANSFER (ta); 1090 TRANSFER (ta);
1091 return 1;
1092 }
1093 else
1094 return 0;
1095}
1096
1097static int
1098api_cede_notself (void)
1099{
1100 struct transfer_args ta;
1101
1102 if (prepare_cede_notself (&ta))
1103 {
1104 TRANSFER (ta);
1105 return 1;
1106 }
1107 else
1108 return 0;
999} 1109}
1000 1110
1001MODULE = Coro::State PACKAGE = Coro::State 1111MODULE = Coro::State PACKAGE = Coro::State
1002 1112
1003PROTOTYPES: DISABLE 1113PROTOTYPES: DISABLE
… …
1009#endif 1119#endif
1010 BOOT_PAGESIZE; 1120 BOOT_PAGESIZE;
1011 1121
1012 coro_state_stash = gv_stashpv ("Coro::State", TRUE); 1122 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1013 1123
1014 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV)); 1124 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (CORO_SAVE_DEFAV));
1015 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV)); 1125 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (CORO_SAVE_DEFSV));
1016 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV)); 1126 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (CORO_SAVE_ERRSV));
1127 newCONSTSUB (coro_state_stash, "SAVE_IRSSV", newSViv (CORO_SAVE_IRSSV));
1128 newCONSTSUB (coro_state_stash, "SAVE_ALL", newSViv (CORO_SAVE_ALL));
1017 1129
1018 main_mainstack = PL_mainstack; 1130 main_mainstack = PL_mainstack;
1019 1131
1020 coroapi.ver = CORO_API_VERSION; 1132 coroapi.ver = CORO_API_VERSION;
1021 coroapi.transfer = api_transfer; 1133 coroapi.transfer = api_transfer;
… …
1031 HV *hv; 1143 HV *hv;
1032 int i; 1144 int i;
1033 1145
1034 Newz (0, coro, 1, struct coro); 1146 Newz (0, coro, 1, struct coro);
1035 coro->args = newAV (); 1147 coro->args = newAV ();
1148 coro->save = CORO_SAVE_ALL;
1149 coro->flags = CF_NEW;
1036 1150
1037 hv = newHV (); 1151 hv = newHV ();
1038 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; 1152 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
1039 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 1153 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1040 1154
1041 for (i = 1; i < items; i++) 1155 for (i = 1; i < items; i++)
1042 av_push (coro->args, newSVsv (ST (i))); 1156 av_push (coro->args, newSVsv (ST (i)));
1043} 1157}
1044 OUTPUT: 1158 OUTPUT:
1159 RETVAL
1160
1161int
1162save (SV *coro, int new_save = -1)
1163 CODE:
1164 RETVAL = api_save (coro, new_save);
1165 OUTPUT:
1045 RETVAL 1166 RETVAL
1046 1167
1047void 1168void
1048_set_stacklevel (...) 1169_set_stacklevel (...)
1049 ALIAS: 1170 ALIAS:
1050 Coro::State::transfer = 1 1171 Coro::State::transfer = 1
1051 Coro::schedule = 2 1172 Coro::schedule = 2
1052 Coro::cede = 3 1173 Coro::cede = 3
1053 Coro::Cont::yield = 4 1174 Coro::cede_notself = 4
1054 CODE: 1175 CODE:
1055{ 1176{
1056 struct transfer_args ta; 1177 struct transfer_args ta;
1057 1178
1058 switch (ix) 1179 switch (ix)
1059 { 1180 {
1060 case 0: 1181 case 0:
1061 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0))); 1182 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0)));
1062 ta.next = 0; 1183 ta.next = 0;
1063 ta.flags = TRANSFER_SET_STACKLEVEL;
1064 break; 1184 break;
1065 1185
1066 case 1: 1186 case 1:
1067 if (items != 3) 1187 if (items != 2)
1068 croak ("Coro::State::transfer(prev,next,flags) expects three arguments, not %d", items); 1188 croak ("Coro::State::transfer (prev,next) expects two arguments, not %d", items);
1069 1189
1070 prepare_transfer (&ta, ST (0), ST (1), SvIV (ST (2))); 1190 prepare_transfer (&ta, ST (0), ST (1));
1071 break; 1191 break;
1072 1192
1073 case 2: 1193 case 2:
1074 prepare_schedule (&ta); 1194 prepare_schedule (&ta);
1075 break; 1195 break;
… …
1077 case 3: 1197 case 3:
1078 prepare_cede (&ta); 1198 prepare_cede (&ta);
1079 break; 1199 break;
1080 1200
1081 case 4: 1201 case 4:
1082 { 1202 if (!prepare_cede_notself (&ta))
1083 SV *yieldstack; 1203 XSRETURN_EMPTY;
1084 SV *sv;
1085 AV *defav = GvAV (PL_defgv);
1086 1204
1087 yieldstack = *hv_fetch (
1088 (HV *)SvRV (GvSV (coro_current)),
1089 "yieldstack", sizeof ("yieldstack") - 1,
1090 0
1091 );
1092
1093 /* set up @_ -- ugly */
1094 av_clear (defav);
1095 av_fill (defav, items - 1);
1096 while (items--)
1097 av_store (defav, items, SvREFCNT_inc (ST(items)));
1098
1099 sv = av_pop ((AV *)SvRV (yieldstack));
1100 ta.prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0));
1101 ta.next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0));
1102 ta.flags = 0;
1103 SvREFCNT_dec (sv);
1104 }
1105 break; 1205 break;
1106
1107 } 1206 }
1108 1207
1208 BARRIER;
1109 TRANSFER (ta); 1209 TRANSFER (ta);
1110}
1111 1210
1112void 1211 if (GIMME_V != G_VOID && ta.next != ta.prev)
1113_clone_state_from (SV *dst, SV *src) 1212 XSRETURN_YES;
1213}
1214
1215bool
1216_destroy (SV *coro_sv)
1114 CODE: 1217 CODE:
1115{ 1218 RETVAL = coro_state_destroy (SvSTATE (coro_sv));
1116 struct coro *coro_src = SvSTATE (src); 1219 OUTPUT:
1117 1220 RETVAL
1118 sv_unmagic (SvRV (dst), PERL_MAGIC_ext);
1119
1120 ++coro_src->refcnt;
1121 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP;
1122}
1123 1221
1124void 1222void
1125_exit (code) 1223_exit (code)
1126 int code 1224 int code
1127 PROTOTYPE: $ 1225 PROTOTYPE: $
… …
1155 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL)); 1253 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
1156 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW)); 1254 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
1157 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE)); 1255 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
1158 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN)); 1256 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
1159 1257
1160 coro_current = gv_fetchpv ("Coro::current", TRUE, SVt_PV); 1258 coro_current = get_sv ("Coro::current", FALSE);
1161 coro_idle = gv_fetchpv ("Coro::idle" , TRUE, SVt_PV); 1259 SvREADONLY_on (coro_current);
1162 1260
1163 for (i = PRIO_MAX - PRIO_MIN + 1; i--; ) 1261 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
1164 coro_ready[i] = newAV (); 1262 coro_ready[i] = newAV ();
1165 1263
1166 { 1264 {
1167 SV *sv = perl_get_sv("Coro::API", 1); 1265 SV *sv = perl_get_sv("Coro::API", 1);
1168 1266
1169 coroapi.schedule = api_schedule; 1267 coroapi.schedule = api_schedule;
1268 coroapi.save = api_save;
1170 coroapi.cede = api_cede; 1269 coroapi.cede = api_cede;
1270 coroapi.cede_notself = api_cede_notself;
1171 coroapi.ready = api_ready; 1271 coroapi.ready = api_ready;
1172 coroapi.is_ready = api_is_ready; 1272 coroapi.is_ready = api_is_ready;
1173 coroapi.nready = &coro_nready; 1273 coroapi.nready = &coro_nready;
1174 coroapi.current = coro_current; 1274 coroapi.current = coro_current;
1175 1275
1176 GCoroAPI = &coroapi; 1276 GCoroAPI = &coroapi;
1177 sv_setiv (sv, (IV)&coroapi); 1277 sv_setiv (sv, (IV)&coroapi);
1178 SvREADONLY_on (sv); 1278 SvREADONLY_on (sv);
1179 } 1279 }
1180} 1280}
1281
1282void
1283_set_current (SV *current)
1284 PROTOTYPE: $
1285 CODE:
1286 SvREFCNT_dec (SvRV (coro_current));
1287 SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1181 1288
1182int 1289int
1183prio (Coro::State coro, int newprio = 0) 1290prio (Coro::State coro, int newprio = 0)
1184 ALIAS: 1291 ALIAS:
1185 nice = 1 1292 nice = 1
… …
1188 RETVAL = coro->prio; 1295 RETVAL = coro->prio;
1189 1296
1190 if (items > 1) 1297 if (items > 1)
1191 { 1298 {
1192 if (ix) 1299 if (ix)
1193 newprio += coro->prio; 1300 newprio = coro->prio - newprio;
1194 1301
1195 if (newprio < PRIO_MIN) newprio = PRIO_MIN; 1302 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1196 if (newprio > PRIO_MAX) newprio = PRIO_MAX; 1303 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1197 1304
1198 coro->prio = newprio; 1305 coro->prio = newprio;
1199 } 1306 }
1200} 1307}
1308 OUTPUT:
1309 RETVAL
1201 1310
1202SV * 1311SV *
1203ready (SV *self) 1312ready (SV *self)
1204 PROTOTYPE: $ 1313 PROTOTYPE: $
1205 CODE: 1314 CODE:
… …
1227 1336
1228SV * 1337SV *
1229_get_state () 1338_get_state ()
1230 CODE: 1339 CODE:
1231{ 1340{
1232 struct { 1341 struct io_state *data;
1233 int errorno;
1234 int laststype;
1235 int laststatval;
1236 Stat_t statcache;
1237 } data;
1238 1342
1343 RETVAL = newSV (sizeof (struct io_state));
1344 data = (struct io_state *)SvPVX (RETVAL);
1345 SvCUR_set (RETVAL, sizeof (struct io_state));
1346 SvPOK_only (RETVAL);
1347
1239 data.errorno = errno; 1348 data->errorno = errno;
1240 data.laststype = PL_laststype; 1349 data->laststype = PL_laststype;
1241 data.laststatval = PL_laststatval; 1350 data->laststatval = PL_laststatval;
1242 data.statcache = PL_statcache; 1351 data->statcache = PL_statcache;
1243
1244 RETVAL = newSVpvn ((char *)&data, sizeof data);
1245} 1352}
1246 OUTPUT: 1353 OUTPUT:
1247 RETVAL 1354 RETVAL
1248 1355
1249void 1356void
1250_set_state (char *data_) 1357_set_state (char *data_)
1251 PROTOTYPE: $ 1358 PROTOTYPE: $
1252 CODE: 1359 CODE:
1253{ 1360{
1254 struct { 1361 struct io_state *data = (void *)data_;
1255 int errorno;
1256 int laststype;
1257 int laststatval;
1258 Stat_t statcache;
1259 } *data = (void *)data_;
1260 1362
1261 errno = data->errorno; 1363 errno = data->errorno;
1262 PL_laststype = data->laststype; 1364 PL_laststype = data->laststype;
1263 PL_laststatval = data->laststatval; 1365 PL_laststatval = data->laststatval;
1264 PL_statcache = data->statcache; 1366 PL_statcache = data->statcache;
1265} 1367}
1368

Diff Legend

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