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.121 by root, Sat Dec 2 20:40:25 2006 UTC vs.
Revision 1.129 by root, Fri Dec 22 04:34:04 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)
… …
89#endif 100#endif
90 101
91#define NOINLINE attribute ((noinline)) 102#define NOINLINE attribute ((noinline))
92 103
93#include "CoroAPI.h" 104#include "CoroAPI.h"
94
95#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */
96 105
97#ifdef USE_ITHREADS 106#ifdef USE_ITHREADS
98static perl_mutex coro_mutex; 107static perl_mutex coro_mutex;
99# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0) 108# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)
100# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0) 109# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)
… …
151 coro_cctx *cctx; 160 coro_cctx *cctx;
152 161
153 /* data associated with this coroutine (initial args) */ 162 /* data associated with this coroutine (initial args) */
154 AV *args; 163 AV *args;
155 int refcnt; 164 int refcnt;
156 int flags; 165 int save; /* CORO_SAVE flags */
166 int flags; /* CF_ flags */
157 167
158 /* optionally saved, might be zero */ 168 /* optionally saved, might be zero */
159 AV *defav; 169 AV *defav; /* @_ */
160 SV *defsv; 170 SV *defsv; /* $_ */
161 SV *errsv; 171 SV *errsv; /* $@ */
172 SV *irssv; /* $/ */
173 SV *irssv_sv; /* real $/ cache */
162 174
163#define VAR(name,type) type name; 175#define VAR(name,type) type name;
164# include "state.h" 176# include "state.h"
165#undef VAR 177#undef VAR
166 178
… …
252 264
253 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0) 265 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
254 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--]; 266 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
255 else 267 else
256 { 268 {
257#if 0 269#if PREFER_PERL_FUNCTIONS
258 /* this is probably cleaner, but also slower? */ 270 /* this is probably cleaner, but also slower? */
259 CV *cp = Perl_cv_clone (cv); 271 CV *cp = Perl_cv_clone (cv);
260 CvPADLIST (cv) = CvPADLIST (cp); 272 CvPADLIST (cv) = CvPADLIST (cp);
261 CvPADLIST (cp) = 0; 273 CvPADLIST (cp) = 0;
262 SvREFCNT_dec (cp); 274 SvREFCNT_dec (cp);
… …
289} 301}
290 302
291#define SB do { 303#define SB do {
292#define SE } while (0) 304#define SE } while (0)
293 305
294#define LOAD(state) load_state ((state))
295#define SAVE(state,flags) save_state ((state),(flags))
296
297#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE 306#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE
298 307
299static void 308static void
300load_state (Coro__State c) 309load_perl (Coro__State c)
301{ 310{
302#define VAR(name,type) PL_ ## name = c->name; 311#define VAR(name,type) PL_ ## name = c->name;
303# include "state.h" 312# include "state.h"
304#undef VAR 313#undef VAR
305 314
306 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav); 315 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
307 if (c->defsv) REPLACE_SV (DEFSV , c->defsv); 316 if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
308 if (c->errsv) REPLACE_SV (ERRSV , c->errsv); 317 if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
318 if (c->irssv)
319 {
320 if (c->irssv == PL_rs || sv_eq (PL_rs, c->irssv))
321 SvREFCNT_dec (c->irssv);
322 else
323 {
324 REPLACE_SV (PL_rs, c->irssv);
325 if (!c->irssv_sv) c->irssv_sv = get_sv ("/", 0);
326 sv_setsv (c->irssv_sv, PL_rs);
327 }
328 }
309 329
310 { 330 {
311 dSP; 331 dSP;
312 CV *cv; 332 CV *cv;
313 333
… …
322 PUTBACK; 342 PUTBACK;
323 } 343 }
324} 344}
325 345
326static void 346static void
327save_state (Coro__State c, int flags) 347save_perl (Coro__State c)
328{ 348{
329 { 349 {
330 dSP; 350 dSP;
331 I32 cxix = cxstack_ix; 351 I32 cxix = cxstack_ix;
332 PERL_CONTEXT *ccstk = cxstack; 352 PERL_CONTEXT *ccstk = cxstack;
… …
335 /* 355 /*
336 * 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
337 * (and reinitialize) all cv's in the whole callchain :( 357 * (and reinitialize) all cv's in the whole callchain :(
338 */ 358 */
339 359
360 EXTEND (SP, 3 + 1);
340 PUSHs (Nullsv); 361 PUSHs (Nullsv);
341 /* this loop was inspired by pp_caller */ 362 /* this loop was inspired by pp_caller */
342 for (;;) 363 for (;;)
343 { 364 {
344 while (cxix >= 0) 365 while (cxix >= 0)
… …
350 CV *cv = cx->blk_sub.cv; 371 CV *cv = cx->blk_sub.cv;
351 372
352 if (CvDEPTH (cv)) 373 if (CvDEPTH (cv))
353 { 374 {
354 EXTEND (SP, 3); 375 EXTEND (SP, 3);
355
356 PUSHs ((SV *)CvPADLIST (cv)); 376 PUSHs ((SV *)CvPADLIST (cv));
357 PUSHs (INT2PTR (SV *, CvDEPTH (cv))); 377 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
358 PUSHs ((SV *)cv); 378 PUSHs ((SV *)cv);
359 379
360 CvDEPTH (cv) = 0; 380 CvDEPTH (cv) = 0;
361 get_padlist (cv); 381 get_padlist (cv);
362 } 382 }
363 } 383 }
364#ifdef CXt_FORMAT
365 else if (CxTYPE (cx) == CXt_FORMAT)
366 {
367 /* I never used formats, so how should I know how these are implemented? */
368 /* my bold guess is as a simple, plain sub... */
369 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
370 }
371#endif
372 } 384 }
373 385
374 if (top_si->si_type == PERLSI_MAIN) 386 if (top_si->si_type == PERLSI_MAIN)
375 break; 387 break;
376 388
… …
380 } 392 }
381 393
382 PUTBACK; 394 PUTBACK;
383 } 395 }
384 396
385 c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0; 397 c->defav = c->save & CORO_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
386 c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0; 398 c->defsv = c->save & CORO_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
387 c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0; 399 c->errsv = c->save & CORO_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
400 c->irssv = c->save & CORO_SAVE_IRSSV ? SvREFCNT_inc (PL_rs) : 0;
388 401
389#define VAR(name,type)c->name = PL_ ## name; 402#define VAR(name,type)c->name = PL_ ## name;
390# include "state.h" 403# include "state.h"
391#undef VAR 404#undef VAR
392} 405}
… …
395 * allocate various perl stacks. This is an exact copy 408 * allocate various perl stacks. This is an exact copy
396 * of perl.c:init_stacks, except that it uses less memory 409 * of perl.c:init_stacks, except that it uses less memory
397 * on the (sometimes correct) assumption that coroutines do 410 * on the (sometimes correct) assumption that coroutines do
398 * not usually need a lot of stackspace. 411 * not usually need a lot of stackspace.
399 */ 412 */
413#if PREFER_PERL_FUNCTIONS
414# define coro_init_stacks init_stacks
415#else
400static void 416static void
401coro_init_stacks () 417coro_init_stacks ()
402{ 418{
403 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT)); 419 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));
404 PL_curstackinfo->si_type = PERLSI_MAIN; 420 PL_curstackinfo->si_type = PERLSI_MAIN;
… …
434 New(54,PL_retstack,16,OP*); 450 New(54,PL_retstack,16,OP*);
435 PL_retstack_ix = 0; 451 PL_retstack_ix = 0;
436 PL_retstack_max = 16; 452 PL_retstack_max = 16;
437#endif 453#endif
438} 454}
455#endif
439 456
440/* 457/*
441 * destroy the stacks, the callchain etc... 458 * destroy the stacks, the callchain etc...
442 */ 459 */
443static void 460static void
444coro_destroy_stacks () 461coro_destroy_stacks ()
445{ 462{
446 if (!IN_DESTRUCT) 463 if (!IN_DESTRUCT)
447 { 464 {
448 /* is this ugly, I ask? */ 465 /* restore all saved variables and stuff */
449 LEAVE_SCOPE (0); 466 LEAVE_SCOPE (0);
467 assert (PL_tmps_floor == -1);
450 468
451 /* sure it is, but more important: is it correct?? :/ */ 469 /* free all temporaries */
452 FREETMPS; 470 FREETMPS;
471 assert (PL_tmps_ix == -1);
453 472
454 /*POPSTACK_TO (PL_mainstack);*//*D*//*use*/ 473 POPSTACK_TO (PL_mainstack);
455 } 474 }
456 475
457 while (PL_curstackinfo->si_next) 476 while (PL_curstackinfo->si_next)
458 PL_curstackinfo = PL_curstackinfo->si_next; 477 PL_curstackinfo = PL_curstackinfo->si_next;
459 478
460 while (PL_curstackinfo) 479 while (PL_curstackinfo)
461 { 480 {
462 PERL_SI *p = PL_curstackinfo->si_prev; 481 PERL_SI *p = PL_curstackinfo->si_prev;
463 482
464 { /*D*//*remove*/
465 dSP;
466 SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
467 PUTBACK; /* possibly superfluous */
468 }
469
470 if (!IN_DESTRUCT) 483 if (!IN_DESTRUCT)
471 {
472 dounwind (-1);/*D*//*remove*/
473 SvREFCNT_dec (PL_curstackinfo->si_stack); 484 SvREFCNT_dec (PL_curstackinfo->si_stack);
474 }
475 485
476 Safefree (PL_curstackinfo->si_cxstack); 486 Safefree (PL_curstackinfo->si_cxstack);
477 Safefree (PL_curstackinfo); 487 Safefree (PL_curstackinfo);
478 PL_curstackinfo = p; 488 PL_curstackinfo = p;
479 } 489 }
… …
583{ 593{
584 coro_cctx *cctx; 594 coro_cctx *cctx;
585 595
586 ++cctx_count; 596 ++cctx_count;
587 597
588 New (0, cctx, 1, coro_cctx); 598 Newz (0, cctx, 1, coro_cctx);
589 599
590#if HAVE_MMAP 600#if HAVE_MMAP
591 601
592 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; 602 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE;
593 /* mmap supposedly does allocate-on-write for us */ 603 /* mmap supposedly does allocate-on-write for us */
… …
688 cctx_first = cctx; 698 cctx_first = cctx;
689} 699}
690 700
691/* never call directly, always through the coro_state_transfer global variable */ 701/* never call directly, always through the coro_state_transfer global variable */
692static void NOINLINE 702static void NOINLINE
693transfer (struct coro *prev, struct coro *next, int flags) 703transfer (struct coro *prev, struct coro *next)
694{ 704{
695 dSTACKLEVEL; 705 dSTACKLEVEL;
696 706
697 /* sometimes transfer is only called to set idle_sp */ 707 /* sometimes transfer is only called to set idle_sp */
698 if (flags == TRANSFER_SET_STACKLEVEL) 708 if (!next)
709 {
699 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 710 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
711 assert (((coro_cctx *)prev)->top_env = PL_top_env); /* just for the side effetc when assert is enabled */
712 }
700 else if (prev != next) 713 else if (prev != next)
701 { 714 {
702 coro_cctx *prev__cctx; 715 coro_cctx *prev__cctx;
703 716
704 if (prev->flags & CF_NEW) 717 if (prev->flags & CF_NEW)
… …
725 if (next->flags & CF_NEW) 738 if (next->flags & CF_NEW)
726 { 739 {
727 /* need to start coroutine */ 740 /* need to start coroutine */
728 next->flags &= ~CF_NEW; 741 next->flags &= ~CF_NEW;
729 /* first get rid of the old state */ 742 /* first get rid of the old state */
730 SAVE (prev, -1); 743 save_perl (prev);
731 /* setup coroutine call */ 744 /* setup coroutine call */
732 setup_coro (next); 745 setup_coro (next);
733 /* need a new stack */ 746 /* need a new stack */
734 assert (!next->stack); 747 assert (!next->cctx);
735 } 748 }
736 else 749 else
737 { 750 {
738 /* coroutine already started */ 751 /* coroutine already started */
739 SAVE (prev, flags); 752 save_perl (prev);
740 LOAD (next); 753 load_perl (next);
741 } 754 }
742 755
743 prev__cctx = prev->cctx; 756 prev__cctx = prev->cctx;
744 757
745 /* possibly "free" the cctx */ 758 /* possibly "free" the cctx */
… …
775} 788}
776 789
777struct transfer_args 790struct transfer_args
778{ 791{
779 struct coro *prev, *next; 792 struct coro *prev, *next;
780 int flags;
781}; 793};
782 794
783#define TRANSFER(ta) transfer ((ta).prev, (ta).next, (ta).flags) 795#define TRANSFER(ta) transfer ((ta).prev, (ta).next)
784 796
785static void 797static void
786coro_state_destroy (struct coro *coro) 798coro_state_destroy (struct coro *coro)
787{ 799{
788 if (coro->refcnt--) 800 if (coro->refcnt--)
789 return; 801 return;
790 802
791 if (coro->mainstack && coro->mainstack != main_mainstack) 803 if (coro->mainstack && coro->mainstack != main_mainstack)
792 { 804 {
793 struct coro temp; 805 struct coro temp;
806 Zero (&temp, 1, struct coro);
807 temp.save = CORO_SAVE_ALL;
794 808
795 if (coro->flags & CF_RUNNING) 809 if (coro->flags & CF_RUNNING)
796 croak ("FATAL: tried to destroy currently running coroutine"); 810 croak ("FATAL: tried to destroy currently running coroutine");
797 811
798 SAVE ((&temp), TRANSFER_SAVE_ALL); 812 save_perl (&temp);
799 LOAD (coro); 813 load_perl (coro);
800 814
801 coro_destroy_stacks (); 815 coro_destroy_stacks ();
802 816
803 LOAD ((&temp)); /* this will get rid of defsv etc.. */ 817 load_perl (&temp); /* this will get rid of defsv etc.. */
804 818
805 coro->mainstack = 0; 819 coro->mainstack = 0;
806 } 820 }
807 821
808 cctx_destroy (coro->cctx); 822 cctx_destroy (coro->cctx);
… …
863 assert (mg->mg_type == PERL_MAGIC_ext); 877 assert (mg->mg_type == PERL_MAGIC_ext);
864 return (struct coro *)mg->mg_ptr; 878 return (struct coro *)mg->mg_ptr;
865} 879}
866 880
867static void 881static void
868prepare_transfer (struct transfer_args *ta, SV *prev, SV *next, int flags) 882prepare_transfer (struct transfer_args *ta, SV *prev_sv, SV *next_sv)
869{ 883{
870 ta->prev = SvSTATE (prev); 884 ta->prev = SvSTATE (prev_sv);
871 ta->next = SvSTATE (next); 885 ta->next = SvSTATE (next_sv);
872 ta->flags = flags;
873} 886}
874 887
875static void 888static void
876api_transfer (SV *prev, SV *next, int flags) 889api_transfer (SV *prev_sv, SV *next_sv)
877{ 890{
878 struct transfer_args ta; 891 struct transfer_args ta;
879 892
880 prepare_transfer (&ta, prev, next, flags); 893 prepare_transfer (&ta, prev_sv, next_sv);
881 TRANSFER (ta); 894 TRANSFER (ta);
895}
896
897static int
898api_save (SV *coro_sv, int new_save)
899{
900 struct coro *coro = SvSTATE (coro_sv);
901 int old_save = coro->save;
902
903 if (new_save >= 0)
904 coro->save = new_save;
905
906 return old_save;
882} 907}
883 908
884/** Coro ********************************************************************/ 909/** Coro ********************************************************************/
885 910
886#define PRIO_MAX 3 911#define PRIO_MAX 3
… …
932 coro = SvSTATE (coro_sv); 957 coro = SvSTATE (coro_sv);
933 958
934 if (coro->flags & CF_READY) 959 if (coro->flags & CF_READY)
935 return 0; 960 return 0;
936 961
937#if 0 /* this is actually harmless */
938 if (coro->flags & CF_RUNNING)
939 croak ("Coro::ready called on currently running coroutine");
940#endif
941
942 coro->flags |= CF_READY; 962 coro->flags |= CF_READY;
943 963
944 LOCK; 964 LOCK;
945 coro_enq (SvREFCNT_inc (coro_sv)); 965 coro_enq (SvREFCNT_inc (coro_sv));
946 UNLOCK; 966 UNLOCK;
… …
995 assert (!SvROK(prev));//D 1015 assert (!SvROK(prev));//D
996 assert (!SvROK(next));//D 1016 assert (!SvROK(next));//D
997 1017
998 ta->prev = SvSTATE (prev); 1018 ta->prev = SvSTATE (prev);
999 ta->next = SvSTATE (next); 1019 ta->next = SvSTATE (next);
1000 ta->flags = TRANSFER_SAVE_ALL;
1001 1020
1002 assert (ta->flags & CF_READY); 1021 assert (ta->next->flags & CF_READY);
1003 ta->next->flags &= ~CF_READY; 1022 ta->next->flags &= ~CF_READY;
1004} 1023}
1005 1024
1006static void 1025static void
1007prepare_cede (struct transfer_args *ta) 1026prepare_cede (struct transfer_args *ta)
… …
1040#endif 1059#endif
1041 BOOT_PAGESIZE; 1060 BOOT_PAGESIZE;
1042 1061
1043 coro_state_stash = gv_stashpv ("Coro::State", TRUE); 1062 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1044 1063
1045 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV)); 1064 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (CORO_SAVE_DEFAV));
1046 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV)); 1065 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (CORO_SAVE_DEFSV));
1047 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV)); 1066 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (CORO_SAVE_ERRSV));
1067 newCONSTSUB (coro_state_stash, "SAVE_IRSSV", newSViv (CORO_SAVE_IRSSV));
1068 newCONSTSUB (coro_state_stash, "SAVE_ALL", newSViv (CORO_SAVE_ALL));
1048 1069
1049 main_mainstack = PL_mainstack; 1070 main_mainstack = PL_mainstack;
1050 1071
1051 coroapi.ver = CORO_API_VERSION; 1072 coroapi.ver = CORO_API_VERSION;
1052 coroapi.transfer = api_transfer; 1073 coroapi.transfer = api_transfer;
… …
1062 HV *hv; 1083 HV *hv;
1063 int i; 1084 int i;
1064 1085
1065 Newz (0, coro, 1, struct coro); 1086 Newz (0, coro, 1, struct coro);
1066 coro->args = newAV (); 1087 coro->args = newAV ();
1088 coro->save = CORO_SAVE_ALL;
1067 coro->flags = CF_NEW; 1089 coro->flags = CF_NEW;
1068 1090
1069 hv = newHV (); 1091 hv = newHV ();
1070 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; 1092 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
1071 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 1093 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1072 1094
1073 for (i = 1; i < items; i++) 1095 for (i = 1; i < items; i++)
1074 av_push (coro->args, newSVsv (ST (i))); 1096 av_push (coro->args, newSVsv (ST (i)));
1075} 1097}
1076 OUTPUT: 1098 OUTPUT:
1099 RETVAL
1100
1101int
1102save (SV *coro, int new_save = -1)
1103 CODE:
1104 RETVAL = api_save (coro, new_save);
1105 OUTPUT:
1077 RETVAL 1106 RETVAL
1078 1107
1079void 1108void
1080_set_stacklevel (...) 1109_set_stacklevel (...)
1081 ALIAS: 1110 ALIAS:
… …
1089 switch (ix) 1118 switch (ix)
1090 { 1119 {
1091 case 0: 1120 case 0:
1092 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0))); 1121 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0)));
1093 ta.next = 0; 1122 ta.next = 0;
1094 ta.flags = TRANSFER_SET_STACKLEVEL;
1095 break; 1123 break;
1096 1124
1097 case 1: 1125 case 1:
1098 if (items != 3) 1126 if (items != 2)
1099 croak ("Coro::State::transfer (prev,next,flags) expects three arguments, not %d", items); 1127 croak ("Coro::State::transfer (prev,next) expects two arguments, not %d", items);
1100 1128
1101 prepare_transfer (&ta, ST (0), ST (1), SvIV (ST (2))); 1129 prepare_transfer (&ta, ST (0), ST (1));
1102 break; 1130 break;
1103 1131
1104 case 2: 1132 case 2:
1105 prepare_schedule (&ta); 1133 prepare_schedule (&ta);
1106 break; 1134 break;
… …
1169 1197
1170 { 1198 {
1171 SV *sv = perl_get_sv("Coro::API", 1); 1199 SV *sv = perl_get_sv("Coro::API", 1);
1172 1200
1173 coroapi.schedule = api_schedule; 1201 coroapi.schedule = api_schedule;
1202 coroapi.save = api_save;
1174 coroapi.cede = api_cede; 1203 coroapi.cede = api_cede;
1175 coroapi.ready = api_ready; 1204 coroapi.ready = api_ready;
1176 coroapi.is_ready = api_is_ready; 1205 coroapi.is_ready = api_is_ready;
1177 coroapi.nready = &coro_nready; 1206 coroapi.nready = &coro_nready;
1178 coroapi.current = coro_current; 1207 coroapi.current = coro_current;
… …
1181 sv_setiv (sv, (IV)&coroapi); 1210 sv_setiv (sv, (IV)&coroapi);
1182 SvREADONLY_on (sv); 1211 SvREADONLY_on (sv);
1183 } 1212 }
1184} 1213}
1185 1214
1215void
1216_set_current (SV *current)
1217 PROTOTYPE: $
1218 CODE:
1219 SvREFCNT_dec (SvRV (coro_current));
1220 SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1221
1186int 1222int
1187prio (Coro::State coro, int newprio = 0) 1223prio (Coro::State coro, int newprio = 0)
1188 ALIAS: 1224 ALIAS:
1189 nice = 1 1225 nice = 1
1190 CODE: 1226 CODE:
… …
1192 RETVAL = coro->prio; 1228 RETVAL = coro->prio;
1193 1229
1194 if (items > 1) 1230 if (items > 1)
1195 { 1231 {
1196 if (ix) 1232 if (ix)
1197 newprio += coro->prio; 1233 newprio = coro->prio - newprio;
1198 1234
1199 if (newprio < PRIO_MIN) newprio = PRIO_MIN; 1235 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1200 if (newprio > PRIO_MAX) newprio = PRIO_MAX; 1236 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1201 1237
1202 coro->prio = newprio; 1238 coro->prio = newprio;
… …
1225 CODE: 1261 CODE:
1226 RETVAL = coro_nready; 1262 RETVAL = coro_nready;
1227 OUTPUT: 1263 OUTPUT:
1228 RETVAL 1264 RETVAL
1229 1265
1230void
1231_set_current (SV *current)
1232 PROTOTYPE: $
1233 CODE:
1234 SvREFCNT_dec (SvRV (coro_current));
1235 SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1236
1237MODULE = Coro::State PACKAGE = Coro::AIO 1266MODULE = Coro::State PACKAGE = Coro::AIO
1238 1267
1239SV * 1268SV *
1240_get_state () 1269_get_state ()
1241 CODE: 1270 CODE:

Diff Legend

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