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.237 by root, Fri May 23 00:27:06 2008 UTC vs.
Revision 1.255 by root, Sat Nov 8 04:52:01 2008 UTC

4#define PERL_EXT 4#define PERL_EXT
5 5
6#include "EXTERN.h" 6#include "EXTERN.h"
7#include "perl.h" 7#include "perl.h"
8#include "XSUB.h" 8#include "XSUB.h"
9#include "perliol.h"
9 10
10#include "patchlevel.h" 11#include "patchlevel.h"
11 12
12#include <stdio.h> 13#include <stdio.h>
13#include <errno.h> 14#include <errno.h>
51#else 52#else
52# define REGISTER_STACK(cctx,start,end) 53# define REGISTER_STACK(cctx,start,end)
53#endif 54#endif
54 55
55/* the maximum number of idle cctx that will be pooled */ 56/* the maximum number of idle cctx that will be pooled */
56#define MAX_IDLE_CCTX 8 57static int cctx_max_idle = 4;
57 58
58#define PERL_VERSION_ATLEAST(a,b,c) \ 59#define PERL_VERSION_ATLEAST(a,b,c) \
59 (PERL_REVISION > (a) \ 60 (PERL_REVISION > (a) \
60 || (PERL_REVISION == (a) \ 61 || (PERL_REVISION == (a) \
61 && (PERL_VERSION > (b) \ 62 && (PERL_VERSION > (b) \
80# ifndef IS_PADCONST 81# ifndef IS_PADCONST
81# define IS_PADCONST(v) 0 82# define IS_PADCONST(v) 0
82# endif 83# endif
83#endif 84#endif
84 85
86/* 5.11 */
87#ifndef CxHASARGS
88# define CxHASARGS(cx) (cx)->blk_sub.hasargs
89#endif
90
91/* 5.10.0 */
92#ifndef SvREFCNT_inc_NN
93# define SvREFCNT_inc_NN(sv) SvREFCNT_inc (sv)
94#endif
95
85/* 5.8.8 */ 96/* 5.8.8 */
86#ifndef GV_NOTQUAL 97#ifndef GV_NOTQUAL
87# define GV_NOTQUAL 0 98# define GV_NOTQUAL 0
88#endif 99#endif
89#ifndef newSV 100#ifndef newSV
90# define newSV(l) NEWSV(0,l) 101# define newSV(l) NEWSV(0,l)
91#endif
92
93/* 5.11 */
94#ifndef CxHASARGS
95# define CxHASARGS(cx) (cx)->blk_sub.hasargs
96#endif 102#endif
97 103
98/* 5.8.7 */ 104/* 5.8.7 */
99#ifndef SvRV_set 105#ifndef SvRV_set
100# define SvRV_set(s,v) SvRV(s) = (v) 106# define SvRV_set(s,v) SvRV(s) = (v)
136#define NOINLINE attribute ((noinline)) 142#define NOINLINE attribute ((noinline))
137 143
138#include "CoroAPI.h" 144#include "CoroAPI.h"
139 145
140#ifdef USE_ITHREADS 146#ifdef USE_ITHREADS
141static perl_mutex coro_mutex; 147static perl_mutex coro_lock;
142# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0) 148# define LOCK do { MUTEX_LOCK (&coro_lock); } while (0)
143# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0) 149# define UNLOCK do { MUTEX_UNLOCK (&coro_lock); } while (0)
144#else 150#else
145# define LOCK (void)0 151# define LOCK (void)0
146# define UNLOCK (void)0 152# define UNLOCK (void)0
147#endif 153#endif
148 154
149/* helper storage struct for Coro::AIO */ 155/* helper storage struct for Coro::AIO */
150struct io_state 156struct io_state
151{ 157{
158 AV *res;
152 int errorno; 159 int errorno;
153 I32 laststype; 160 I32 laststype; /* U16 in 5.10.0 */
154 int laststatval; 161 int laststatval;
155 Stat_t statcache; 162 Stat_t statcache;
156}; 163};
157 164
165static double (*nvtime)(); /* so why doesn't it take void? */
166
167static U32 cctx_gen;
158static size_t coro_stacksize = CORO_STACKSIZE; 168static size_t cctx_stacksize = CORO_STACKSIZE;
159static struct CoroAPI coroapi; 169static struct CoroAPI coroapi;
160static AV *main_mainstack; /* used to differentiate between $main and others */ 170static AV *main_mainstack; /* used to differentiate between $main and others */
161static JMPENV *main_top_env; 171static JMPENV *main_top_env;
162static HV *coro_state_stash, *coro_stash; 172static HV *coro_state_stash, *coro_stash;
163static volatile SV *coro_mortal; /* will be freed after next transfer */ 173static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */
164 174
165static GV *irsgv; /* $/ */ 175static GV *irsgv; /* $/ */
166static GV *stdoutgv; /* *STDOUT */ 176static GV *stdoutgv; /* *STDOUT */
167static SV *rv_diehook; 177static SV *rv_diehook;
168static SV *rv_warnhook; 178static SV *rv_warnhook;
200 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 210 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
201 JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */ 211 JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */
202 JMPENV *top_env; 212 JMPENV *top_env;
203 coro_context cctx; 213 coro_context cctx;
204 214
215 U32 gen;
205#if CORO_USE_VALGRIND 216#if CORO_USE_VALGRIND
206 int valgrind_id; 217 int valgrind_id;
207#endif 218#endif
208 unsigned char flags; 219 unsigned char flags;
209} coro_cctx; 220} coro_cctx;
321 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); 332 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
322#endif 333#endif
323 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; 334 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
324 --AvFILLp (padlist); 335 --AvFILLp (padlist);
325 336
326 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE))); 337 av_store (newpadlist, 0, SvREFCNT_inc_NN (*av_fetch (padlist, 0, FALSE)));
327 av_store (newpadlist, 1, (SV *)newpad); 338 av_store (newpadlist, 1, (SV *)newpad);
328 339
329 return newpadlist; 340 return newpadlist;
330} 341}
331 342
361 372
362 /* casting is fun. */ 373 /* casting is fun. */
363 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av))) 374 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))
364 free_padlist (aTHX_ padlist); 375 free_padlist (aTHX_ padlist);
365 376
377 SvREFCNT_dec (av); /* sv_magicext increased the refcount */
378
366 return 0; 379 return 0;
367} 380}
368 381
369#define CORO_MAGIC_type_cv PERL_MAGIC_ext 382#define CORO_MAGIC_type_cv PERL_MAGIC_ext
370#define CORO_MAGIC_type_state PERL_MAGIC_ext 383#define CORO_MAGIC_type_state PERL_MAGIC_ext
372static MGVTBL coro_cv_vtbl = { 385static MGVTBL coro_cv_vtbl = {
373 0, 0, 0, 0, 386 0, 0, 0, 0,
374 coro_cv_free 387 coro_cv_free
375}; 388};
376 389
377#define CORO_MAGIC(sv,type) \ 390#define CORO_MAGIC(sv, type) \
378 SvMAGIC (sv) \ 391 SvMAGIC (sv) \
379 ? SvMAGIC (sv)->mg_type == type \ 392 ? SvMAGIC (sv)->mg_type == type \
380 ? SvMAGIC (sv) \ 393 ? SvMAGIC (sv) \
381 : mg_find (sv, type) \ 394 : mg_find (sv, type) \
382 : 0 395 : 0
383 396
384#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv) 397#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
385#define CORO_MAGIC_state(sv) CORO_MAGIC (((SV *)(sv)), CORO_MAGIC_type_state) 398#define CORO_MAGIC_state(sv) CORO_MAGIC (((SV *)(sv)), CORO_MAGIC_type_state)
386 399
387static struct coro * 400static struct coro *
420 if (expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)) 433 if (expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))
421 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--]; 434 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
422 else 435 else
423 { 436 {
424#if CORO_PREFER_PERL_FUNCTIONS 437#if CORO_PREFER_PERL_FUNCTIONS
425 /* this is probably cleaner, but also slower? */ 438 /* this is probably cleaner? but also slower! */
439 /* in practise, it seems to be less stable */
426 CV *cp = Perl_cv_clone (cv); 440 CV *cp = Perl_cv_clone (cv);
427 CvPADLIST (cv) = CvPADLIST (cp); 441 CvPADLIST (cv) = CvPADLIST (cp);
428 CvPADLIST (cp) = 0; 442 CvPADLIST (cp) = 0;
429 SvREFCNT_dec (cp); 443 SvREFCNT_dec (cp);
430#else 444#else
616 630
617/* 631/*
618 * destroy the stacks, the callchain etc... 632 * destroy the stacks, the callchain etc...
619 */ 633 */
620static void 634static void
621coro_destroy_stacks (pTHX) 635coro_destruct_stacks (pTHX)
622{ 636{
623 while (PL_curstackinfo->si_next) 637 while (PL_curstackinfo->si_next)
624 PL_curstackinfo = PL_curstackinfo->si_next; 638 PL_curstackinfo = PL_curstackinfo->si_next;
625 639
626 while (PL_curstackinfo) 640 while (PL_curstackinfo)
663 #undef VAR 677 #undef VAR
664 } 678 }
665 else 679 else
666 slot = coro->slot; 680 slot = coro->slot;
667 681
682 if (slot)
683 {
668 rss += sizeof (slot->curstackinfo); 684 rss += sizeof (slot->curstackinfo);
669 rss += (slot->curstackinfo->si_cxmax + 1) * sizeof (PERL_CONTEXT); 685 rss += (slot->curstackinfo->si_cxmax + 1) * sizeof (PERL_CONTEXT);
670 rss += sizeof (SV) + sizeof (struct xpvav) + (1 + AvMAX (slot->curstack)) * sizeof (SV *); 686 rss += sizeof (SV) + sizeof (struct xpvav) + (1 + AvMAX (slot->curstack)) * sizeof (SV *);
671 rss += slot->tmps_max * sizeof (SV *); 687 rss += slot->tmps_max * sizeof (SV *);
672 rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32); 688 rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32);
673 rss += slot->scopestack_max * sizeof (I32); 689 rss += slot->scopestack_max * sizeof (I32);
674 rss += slot->savestack_max * sizeof (ANY); 690 rss += slot->savestack_max * sizeof (ANY);
675 691
676#if !PERL_VERSION_ATLEAST (5,10,0) 692#if !PERL_VERSION_ATLEAST (5,10,0)
677 rss += slot->retstack_max * sizeof (OP *); 693 rss += slot->retstack_max * sizeof (OP *);
678#endif 694#endif
695 }
679 } 696 }
680 697
681 return rss; 698 return rss;
682} 699}
683 700
684/** coroutine stack handling ************************************************/ 701/** coroutine stack handling ************************************************/
685 702
686static int (*orig_sigelem_get) (pTHX_ SV *sv, MAGIC *mg); 703static int (*orig_sigelem_get) (pTHX_ SV *sv, MAGIC *mg);
687static int (*orig_sigelem_set) (pTHX_ SV *sv, MAGIC *mg); 704static int (*orig_sigelem_set) (pTHX_ SV *sv, MAGIC *mg);
705static int (*orig_sigelem_clr) (pTHX_ SV *sv, MAGIC *mg);
706
707/* apparently < 5.8.8 */
708#ifndef MgPV_nolen_const
709#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \
710 SvPV_nolen((SV*)((mg)->mg_ptr)) : \
711 (const char*)(mg)->mg_ptr)
712#endif
688 713
689/* 714/*
690 * This overrides the default magic get method of %SIG elements. 715 * This overrides the default magic get method of %SIG elements.
691 * The original one doesn't provide for reading back of PL_diehook/PL_warnhook 716 * The original one doesn't provide for reading back of PL_diehook/PL_warnhook
692 * and instead of tryign to save and restore the hash elements, we just provide 717 * and instead of tryign to save and restore the hash elements, we just provide
700{ 725{
701 const char *s = MgPV_nolen_const (mg); 726 const char *s = MgPV_nolen_const (mg);
702 727
703 if (*s == '_') 728 if (*s == '_')
704 { 729 {
705 if (strEQ (s, "__DIE__" ) && PL_diehook ) return sv_setsv (sv, PL_diehook ), 0; 730 SV **svp = 0;
706 if (strEQ (s, "__WARN__") && PL_warnhook) return sv_setsv (sv, PL_warnhook), 0; 731
732 if (strEQ (s, "__DIE__" )) svp = &PL_diehook;
733 if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
734
735 if (svp)
736 {
737 sv_setsv (sv, *svp ? *svp : &PL_sv_undef);
738 return 0;
739 }
707 } 740 }
708 741
709 return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0; 742 return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;
743}
744
745static int
746coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)
747{
748 const char *s = MgPV_nolen_const (mg);
749
750 if (*s == '_')
751 {
752 SV **svp = 0;
753
754 if (strEQ (s, "__DIE__" )) svp = &PL_diehook;
755 if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
756
757 if (svp)
758 {
759 SV *old = *svp;
760 *svp = 0;
761 SvREFCNT_dec (old);
762 return 0;
763 }
764 }
765
766 return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;
710} 767}
711 768
712static int 769static int
713coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg) 770coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)
714{ 771{
761 GvSV (PL_defgv) = newSV (0); 818 GvSV (PL_defgv) = newSV (0);
762 GvAV (PL_defgv) = coro->args; coro->args = 0; 819 GvAV (PL_defgv) = coro->args; coro->args = 0;
763 GvSV (PL_errgv) = newSV (0); 820 GvSV (PL_errgv) = newSV (0);
764 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0); 821 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
765 PL_rs = newSVsv (GvSV (irsgv)); 822 PL_rs = newSVsv (GvSV (irsgv));
766 PL_defoutgv = (GV *)SvREFCNT_inc (stdoutgv); 823 PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);
767 824
768 { 825 {
769 dSP; 826 dSP;
770 LOGOP myop; 827 LOGOP myop;
771 828
788 */ 845 */
789 ENTER; 846 ENTER;
790} 847}
791 848
792static void 849static void
793coro_destroy (pTHX_ struct coro *coro) 850coro_destruct (pTHX_ struct coro *coro)
794{ 851{
795 if (!IN_DESTRUCT) 852 if (!IN_DESTRUCT)
796 { 853 {
797 /* restore all saved variables and stuff */ 854 /* restore all saved variables and stuff */
798 LEAVE_SCOPE (0); 855 LEAVE_SCOPE (0);
820 SvREFCNT_dec (PL_warnhook); 877 SvREFCNT_dec (PL_warnhook);
821 878
822 SvREFCNT_dec (coro->saved_deffh); 879 SvREFCNT_dec (coro->saved_deffh);
823 SvREFCNT_dec (coro->throw); 880 SvREFCNT_dec (coro->throw);
824 881
825 coro_destroy_stacks (aTHX); 882 coro_destruct_stacks (aTHX);
826} 883}
827 884
828static void 885static void
829free_coro_mortal (pTHX) 886free_coro_mortal (pTHX)
830{ 887{
867 : cx->blk_gimme == G_SCALAR ? bot + 1 924 : cx->blk_gimme == G_SCALAR ? bot + 1
868 : bot; 925 : bot;
869 926
870 av_extend (av, top - bot); 927 av_extend (av, top - bot);
871 while (bot < top) 928 while (bot < top)
872 av_push (av, SvREFCNT_inc (*bot++)); 929 av_push (av, SvREFCNT_inc_NN (*bot++));
873 930
874 PL_runops = RUNOPS_DEFAULT; 931 PL_runops = RUNOPS_DEFAULT;
875 ENTER; 932 ENTER;
876 SAVETMPS; 933 SAVETMPS;
877 EXTEND (SP, 3); 934 EXTEND (SP, 3);
1025 coro_cctx *cctx; 1082 coro_cctx *cctx;
1026 void *stack_start; 1083 void *stack_start;
1027 size_t stack_size; 1084 size_t stack_size;
1028 1085
1029 ++cctx_count; 1086 ++cctx_count;
1030
1031 Newz (0, cctx, 1, coro_cctx); 1087 Newz (0, cctx, 1, coro_cctx);
1032 1088
1089 cctx->gen = cctx_gen;
1090
1033#if HAVE_MMAP 1091#if HAVE_MMAP
1034 cctx->ssize = ((coro_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE; 1092 cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
1035 /* mmap supposedly does allocate-on-write for us */ 1093 /* mmap supposedly does allocate-on-write for us */
1036 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 1094 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
1037 1095
1038 if (cctx->sptr != (void *)-1) 1096 if (cctx->sptr != (void *)-1)
1039 { 1097 {
1045 cctx->flags |= CC_MAPPED; 1103 cctx->flags |= CC_MAPPED;
1046 } 1104 }
1047 else 1105 else
1048#endif 1106#endif
1049 { 1107 {
1050 cctx->ssize = coro_stacksize * (long)sizeof (long); 1108 cctx->ssize = cctx_stacksize * (long)sizeof (long);
1051 New (0, cctx->sptr, coro_stacksize, long); 1109 New (0, cctx->sptr, cctx_stacksize, long);
1052 1110
1053 if (!cctx->sptr) 1111 if (!cctx->sptr)
1054 { 1112 {
1055 perror ("FATAL: unable to allocate stack for coroutine"); 1113 perror ("FATAL: unable to allocate stack for coroutine");
1056 _exit (EXIT_FAILURE); 1114 _exit (EXIT_FAILURE);
1071{ 1129{
1072 if (!cctx) 1130 if (!cctx)
1073 return; 1131 return;
1074 1132
1075 --cctx_count; 1133 --cctx_count;
1134 coro_destroy (&cctx->cctx);
1076 1135
1136 /* coro_transfer creates new, empty cctx's */
1137 if (cctx->sptr)
1138 {
1077#if CORO_USE_VALGRIND 1139#if CORO_USE_VALGRIND
1078 VALGRIND_STACK_DEREGISTER (cctx->valgrind_id); 1140 VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);
1079#endif 1141#endif
1080 1142
1081#if HAVE_MMAP 1143#if HAVE_MMAP
1082 if (cctx->flags & CC_MAPPED) 1144 if (cctx->flags & CC_MAPPED)
1083 munmap (cctx->sptr, cctx->ssize); 1145 munmap (cctx->sptr, cctx->ssize);
1084 else 1146 else
1085#endif 1147#endif
1086 Safefree (cctx->sptr); 1148 Safefree (cctx->sptr);
1149 }
1087 1150
1088 Safefree (cctx); 1151 Safefree (cctx);
1089} 1152}
1090 1153
1091/* wether this cctx should be destructed */ 1154/* wether this cctx should be destructed */
1092#define CCTX_EXPIRED(cctx) ((cctx)->ssize < coro_stacksize || ((cctx)->flags & CC_NOREUSE)) 1155#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))
1093 1156
1094static coro_cctx * 1157static coro_cctx *
1095cctx_get (pTHX) 1158cctx_get (pTHX)
1096{ 1159{
1097 while (expect_true (cctx_first)) 1160 while (expect_true (cctx_first))
1110} 1173}
1111 1174
1112static void 1175static void
1113cctx_put (coro_cctx *cctx) 1176cctx_put (coro_cctx *cctx)
1114{ 1177{
1178 assert (("cctx_put called on non-initialised cctx", cctx->sptr));
1179
1115 /* free another cctx if overlimit */ 1180 /* free another cctx if overlimit */
1116 if (expect_false (cctx_idle >= MAX_IDLE_CCTX)) 1181 if (expect_false (cctx_idle >= cctx_max_idle))
1117 { 1182 {
1118 coro_cctx *first = cctx_first; 1183 coro_cctx *first = cctx_first;
1119 cctx_first = first->next; 1184 cctx_first = first->next;
1120 --cctx_idle; 1185 --cctx_idle;
1121 1186
1153/* always use the TRANSFER macro */ 1218/* always use the TRANSFER macro */
1154static void NOINLINE 1219static void NOINLINE
1155transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx) 1220transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
1156{ 1221{
1157 dSTACKLEVEL; 1222 dSTACKLEVEL;
1158 static volatile int has_throw;
1159 1223
1160 /* sometimes transfer is only called to set idle_sp */ 1224 /* sometimes transfer is only called to set idle_sp */
1161 if (expect_false (!next)) 1225 if (expect_false (!next))
1162 { 1226 {
1163 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 1227 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
1164 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */ 1228 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1165 } 1229 }
1166 else if (expect_true (prev != next)) 1230 else if (expect_true (prev != next))
1167 { 1231 {
1232 static volatile int has_throw;
1168 coro_cctx *prev__cctx; 1233 coro_cctx *prev__cctx;
1169 1234
1170 if (expect_false (prev->flags & CF_NEW)) 1235 if (expect_false (prev->flags & CF_NEW))
1171 { 1236 {
1172 /* create a new empty context */ 1237 /* create a new empty/source context */
1238 ++cctx_count;
1173 Newz (0, prev->cctx, 1, coro_cctx); 1239 New (0, prev->cctx, 1, coro_cctx);
1240 prev->cctx->sptr = 0;
1241 coro_create (&prev->cctx->cctx, 0, 0, 0, 0);
1242
1174 prev->flags &= ~CF_NEW; 1243 prev->flags &= ~CF_NEW;
1175 prev->flags |= CF_RUNNING; 1244 prev->flags |= CF_RUNNING;
1176 } 1245 }
1177 1246
1178 prev->flags &= ~CF_RUNNING; 1247 prev->flags &= ~CF_RUNNING;
1285 croak ("FATAL: tried to destroy currently running coroutine"); 1354 croak ("FATAL: tried to destroy currently running coroutine");
1286 1355
1287 save_perl (aTHX_ &temp); 1356 save_perl (aTHX_ &temp);
1288 load_perl (aTHX_ coro); 1357 load_perl (aTHX_ coro);
1289 1358
1290 coro_destroy (aTHX_ coro); 1359 coro_destruct (aTHX_ coro);
1291 1360
1292 load_perl (aTHX_ &temp); 1361 load_perl (aTHX_ &temp);
1293 1362
1294 coro->slot = 0; 1363 coro->slot = 0;
1295 } 1364 }
1401 LOCK; 1470 LOCK;
1402 1471
1403 sv_hook = coro_nready ? 0 : coro_readyhook; 1472 sv_hook = coro_nready ? 0 : coro_readyhook;
1404 xs_hook = coro_nready ? 0 : coroapi.readyhook; 1473 xs_hook = coro_nready ? 0 : coroapi.readyhook;
1405 1474
1406 coro_enq (aTHX_ SvREFCNT_inc (coro_sv)); 1475 coro_enq (aTHX_ SvREFCNT_inc_NN (coro_sv));
1407 ++coro_nready; 1476 ++coro_nready;
1408 1477
1409 UNLOCK; 1478 UNLOCK;
1410 1479
1411 if (sv_hook) 1480 if (sv_hook)
1583 else 1652 else
1584 coro->slot->runops = RUNOPS_DEFAULT; 1653 coro->slot->runops = RUNOPS_DEFAULT;
1585 } 1654 }
1586} 1655}
1587 1656
1657#if 0
1658static int
1659coro_gensub_free (pTHX_ SV *sv, MAGIC *mg)
1660{
1661 AV *padlist;
1662 AV *av = (AV *)mg->mg_obj;
1663
1664 abort ();
1665
1666 return 0;
1667}
1668
1669static MGVTBL coro_gensub_vtbl = {
1670 0, 0, 0, 0,
1671 coro_gensub_free
1672};
1673#endif
1674
1675/*****************************************************************************/
1676/* PerlIO::cede */
1677
1678typedef struct
1679{
1680 PerlIOBuf base;
1681 NV next, every;
1682} PerlIOCede;
1683
1684static IV
1685PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
1686{
1687 PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
1688
1689 self->every = SvCUR (arg) ? SvNV (arg) : 0.01;
1690 self->next = nvtime () + self->every;
1691
1692 return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);
1693}
1694
1695static SV *
1696PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
1697{
1698 PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
1699
1700 return newSVnv (self->every);
1701}
1702
1703static IV
1704PerlIOCede_flush (pTHX_ PerlIO *f)
1705{
1706 PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
1707 double now = nvtime ();
1708
1709 if (now >= self->next)
1710 {
1711 api_cede ();
1712 self->next = now + self->every;
1713 }
1714
1715 return PerlIOBuf_flush (aTHX_ f);
1716}
1717
1718static PerlIO_funcs PerlIO_cede =
1719{
1720 sizeof(PerlIO_funcs),
1721 "cede",
1722 sizeof(PerlIOCede),
1723 PERLIO_K_DESTRUCT | PERLIO_K_RAW,
1724 PerlIOCede_pushed,
1725 PerlIOBuf_popped,
1726 PerlIOBuf_open,
1727 PerlIOBase_binmode,
1728 PerlIOCede_getarg,
1729 PerlIOBase_fileno,
1730 PerlIOBuf_dup,
1731 PerlIOBuf_read,
1732 PerlIOBuf_unread,
1733 PerlIOBuf_write,
1734 PerlIOBuf_seek,
1735 PerlIOBuf_tell,
1736 PerlIOBuf_close,
1737 PerlIOCede_flush,
1738 PerlIOBuf_fill,
1739 PerlIOBase_eof,
1740 PerlIOBase_error,
1741 PerlIOBase_clearerr,
1742 PerlIOBase_setlinebuf,
1743 PerlIOBuf_get_base,
1744 PerlIOBuf_bufsiz,
1745 PerlIOBuf_get_ptr,
1746 PerlIOBuf_get_cnt,
1747 PerlIOBuf_set_ptrcnt,
1748};
1749
1750
1588MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_ 1751MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1589 1752
1590PROTOTYPES: DISABLE 1753PROTOTYPES: DISABLE
1591 1754
1592BOOT: 1755BOOT:
1593{ 1756{
1594#ifdef USE_ITHREADS 1757#ifdef USE_ITHREADS
1595 MUTEX_INIT (&coro_mutex); 1758 MUTEX_INIT (&coro_lock);
1596#endif 1759#endif
1597 BOOT_PAGESIZE; 1760 BOOT_PAGESIZE;
1598 1761
1599 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV); 1762 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
1600 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); 1763 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
1601 1764
1602 orig_sigelem_get = PL_vtbl_sigelem.svt_get; 1765 orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;
1603 PL_vtbl_sigelem.svt_get = coro_sigelem_get; 1766 orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;
1604 orig_sigelem_set = PL_vtbl_sigelem.svt_set; 1767 orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr;
1605 PL_vtbl_sigelem.svt_set = coro_sigelem_set;
1606 1768
1607 hv_sig = coro_get_hv (aTHX_ "SIG", TRUE); 1769 hv_sig = coro_get_hv (aTHX_ "SIG", TRUE);
1608 rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV)); 1770 rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
1609 rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV)); 1771 rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
1610 1772
1622 main_top_env = main_top_env->je_prev; 1784 main_top_env = main_top_env->je_prev;
1623 1785
1624 coroapi.ver = CORO_API_VERSION; 1786 coroapi.ver = CORO_API_VERSION;
1625 coroapi.rev = CORO_API_REVISION; 1787 coroapi.rev = CORO_API_REVISION;
1626 coroapi.transfer = api_transfer; 1788 coroapi.transfer = api_transfer;
1789
1790 {
1791 SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
1792
1793 if (!svp) croak ("Time::HiRes is required");
1794 if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
1795
1796 nvtime = INT2PTR (double (*)(), SvIV (*svp));
1797 }
1627 1798
1628 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL)); 1799 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
1629} 1800}
1630 1801
1631SV * 1802SV *
1679 ta.next = 0; 1850 ta.next = 0;
1680 break; 1851 break;
1681 1852
1682 case 1: 1853 case 1:
1683 if (items != 2) 1854 if (items != 2)
1684 croak ("Coro::State::transfer (prev,next) expects two arguments, not %d", items); 1855 croak ("Coro::State::transfer (prev, next) expects two arguments, not %d", items);
1685 1856
1686 prepare_transfer (aTHX_ &ta, ST (0), ST (1)); 1857 prepare_transfer (aTHX_ &ta, ST (0), ST (1));
1687 break; 1858 break;
1688 1859
1689 case 2: 1860 case 2:
1723 _exit (code); 1894 _exit (code);
1724 1895
1725int 1896int
1726cctx_stacksize (int new_stacksize = 0) 1897cctx_stacksize (int new_stacksize = 0)
1727 CODE: 1898 CODE:
1728 RETVAL = coro_stacksize; 1899 RETVAL = cctx_stacksize;
1729 if (new_stacksize) 1900 if (new_stacksize)
1901 {
1730 coro_stacksize = new_stacksize; 1902 cctx_stacksize = new_stacksize;
1903 ++cctx_gen;
1904 }
1905 OUTPUT:
1906 RETVAL
1907
1908int
1909cctx_max_idle (int max_idle = 0)
1910 CODE:
1911 RETVAL = cctx_max_idle;
1912 if (max_idle > 1)
1913 cctx_max_idle = max_idle;
1731 OUTPUT: 1914 OUTPUT:
1732 RETVAL 1915 RETVAL
1733 1916
1734int 1917int
1735cctx_count () 1918cctx_count ()
1759call (Coro::State coro, SV *coderef) 1942call (Coro::State coro, SV *coderef)
1760 ALIAS: 1943 ALIAS:
1761 eval = 1 1944 eval = 1
1762 CODE: 1945 CODE:
1763{ 1946{
1764 if (coro->mainstack) 1947 if (coro->mainstack && ((coro->flags & CF_RUNNING) || coro->slot))
1765 { 1948 {
1766 struct coro temp; 1949 struct coro temp;
1767 1950
1768 if (!(coro->flags & CF_RUNNING)) 1951 if (!(coro->flags & CF_RUNNING))
1769 { 1952 {
1831 CODE: 2014 CODE:
1832 RETVAL = (coro->cctx ? coro->cctx->flags : 0) & CC_TRACE_ALL; 2015 RETVAL = (coro->cctx ? coro->cctx->flags : 0) & CC_TRACE_ALL;
1833 OUTPUT: 2016 OUTPUT:
1834 RETVAL 2017 RETVAL
1835 2018
1836IV 2019UV
1837rss (Coro::State coro) 2020rss (Coro::State coro)
1838 PROTOTYPE: $ 2021 PROTOTYPE: $
1839 ALIAS: 2022 ALIAS:
1840 usecount = 1 2023 usecount = 1
1841 CODE: 2024 CODE:
1851force_cctx () 2034force_cctx ()
1852 CODE: 2035 CODE:
1853 struct coro *coro = SvSTATE (coro_current); 2036 struct coro *coro = SvSTATE (coro_current);
1854 coro->cctx->idle_sp = 0; 2037 coro->cctx->idle_sp = 0;
1855 2038
1856MODULE = Coro::State PACKAGE = Coro
1857
1858BOOT:
1859{
1860 int i;
1861
1862 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
1863 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
1864 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
1865
1866 coro_current = coro_get_sv (aTHX_ "Coro::current", FALSE);
1867 SvREADONLY_on (coro_current);
1868
1869 coro_stash = gv_stashpv ("Coro", TRUE);
1870
1871 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
1872 newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
1873 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
1874 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
1875 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
1876 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
1877
1878 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
1879 coro_ready[i] = newAV ();
1880
1881 {
1882 SV *sv = perl_get_sv ("Coro::API", TRUE);
1883 perl_get_sv ("Coro::API", TRUE); /* silence 5.10 warning */
1884
1885 coroapi.schedule = api_schedule;
1886 coroapi.cede = api_cede;
1887 coroapi.cede_notself = api_cede_notself;
1888 coroapi.ready = api_ready;
1889 coroapi.is_ready = api_is_ready;
1890 coroapi.nready = &coro_nready;
1891 coroapi.current = coro_current;
1892
1893 GCoroAPI = &coroapi;
1894 sv_setiv (sv, (IV)&coroapi);
1895 SvREADONLY_on (sv);
1896 }
1897}
1898
1899void
1900_set_current (SV *current)
1901 PROTOTYPE: $
1902 CODE:
1903 SvREFCNT_dec (SvRV (coro_current));
1904 SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1905
1906void
1907_set_readyhook (SV *hook)
1908 PROTOTYPE: $
1909 CODE:
1910 LOCK;
1911 SvREFCNT_dec (coro_readyhook);
1912 coro_readyhook = SvOK (hook) ? newSVsv (hook) : 0;
1913 UNLOCK;
1914
1915int
1916prio (Coro::State coro, int newprio = 0)
1917 ALIAS:
1918 nice = 1
1919 CODE:
1920{
1921 RETVAL = coro->prio;
1922
1923 if (items > 1)
1924 {
1925 if (ix)
1926 newprio = coro->prio - newprio;
1927
1928 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1929 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1930
1931 coro->prio = newprio;
1932 }
1933}
1934 OUTPUT:
1935 RETVAL
1936
1937SV *
1938ready (SV *self)
1939 PROTOTYPE: $
1940 CODE:
1941 RETVAL = boolSV (api_ready (self));
1942 OUTPUT:
1943 RETVAL
1944
1945int
1946nready (...)
1947 PROTOTYPE:
1948 CODE:
1949 RETVAL = coro_nready;
1950 OUTPUT:
1951 RETVAL
1952
1953void
1954throw (Coro::State self, SV *throw = &PL_sv_undef)
1955 PROTOTYPE: $;$
1956 CODE:
1957 SvREFCNT_dec (self->throw);
1958 self->throw = SvOK (throw) ? newSVsv (throw) : 0;
1959
1960void 2039void
1961swap_defsv (Coro::State self) 2040swap_defsv (Coro::State self)
1962 PROTOTYPE: $ 2041 PROTOTYPE: $
1963 ALIAS: 2042 ALIAS:
1964 swap_defav = 1 2043 swap_defav = 1
1971 SV **dst = ix ? (SV **)&self->slot->defav : (SV **)&self->slot->defsv; 2050 SV **dst = ix ? (SV **)&self->slot->defav : (SV **)&self->slot->defsv;
1972 2051
1973 SV *tmp = *src; *src = *dst; *dst = tmp; 2052 SV *tmp = *src; *src = *dst; *dst = tmp;
1974 } 2053 }
1975 2054
2055MODULE = Coro::State PACKAGE = Coro
2056
2057BOOT:
2058{
2059 int i;
2060
2061 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
2062 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
2063 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
2064
2065 coro_current = coro_get_sv (aTHX_ "Coro::current", FALSE);
2066 SvREADONLY_on (coro_current);
2067
2068 coro_stash = gv_stashpv ("Coro", TRUE);
2069
2070 newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (PRIO_MAX));
2071 newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (PRIO_HIGH));
2072 newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (PRIO_NORMAL));
2073 newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (PRIO_LOW));
2074 newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (PRIO_IDLE));
2075 newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (PRIO_MIN));
2076
2077 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
2078 coro_ready[i] = newAV ();
2079
2080 {
2081 SV *sv = perl_get_sv ("Coro::API", TRUE);
2082 perl_get_sv ("Coro::API", TRUE); /* silence 5.10 warning */
2083
2084 coroapi.schedule = api_schedule;
2085 coroapi.cede = api_cede;
2086 coroapi.cede_notself = api_cede_notself;
2087 coroapi.ready = api_ready;
2088 coroapi.is_ready = api_is_ready;
2089 coroapi.nready = &coro_nready;
2090 coroapi.current = coro_current;
2091
2092 GCoroAPI = &coroapi;
2093 sv_setiv (sv, (IV)&coroapi);
2094 SvREADONLY_on (sv);
2095 }
2096}
2097
2098void
2099_set_current (SV *current)
2100 PROTOTYPE: $
2101 CODE:
2102 SvREFCNT_dec (SvRV (coro_current));
2103 SvRV_set (coro_current, SvREFCNT_inc_NN (SvRV (current)));
2104
2105void
2106_set_readyhook (SV *hook)
2107 PROTOTYPE: $
2108 CODE:
2109 LOCK;
2110 SvREFCNT_dec (coro_readyhook);
2111 coro_readyhook = SvOK (hook) ? newSVsv (hook) : 0;
2112 UNLOCK;
2113
2114int
2115prio (Coro::State coro, int newprio = 0)
2116 ALIAS:
2117 nice = 1
2118 CODE:
2119{
2120 RETVAL = coro->prio;
2121
2122 if (items > 1)
2123 {
2124 if (ix)
2125 newprio = coro->prio - newprio;
2126
2127 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
2128 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
2129
2130 coro->prio = newprio;
2131 }
2132}
2133 OUTPUT:
2134 RETVAL
2135
2136SV *
2137ready (SV *self)
2138 PROTOTYPE: $
2139 CODE:
2140 RETVAL = boolSV (api_ready (self));
2141 OUTPUT:
2142 RETVAL
2143
2144int
2145nready (...)
2146 PROTOTYPE:
2147 CODE:
2148 RETVAL = coro_nready;
2149 OUTPUT:
2150 RETVAL
2151
2152void
2153throw (Coro::State self, SV *throw = &PL_sv_undef)
2154 PROTOTYPE: $;$
2155 CODE:
2156 SvREFCNT_dec (self->throw);
2157 self->throw = SvOK (throw) ? newSVsv (throw) : 0;
2158
1976# for async_pool speedup 2159# for async_pool speedup
1977void 2160void
1978_pool_1 (SV *cb) 2161_pool_1 (SV *cb)
1979 CODE: 2162 CODE:
1980{ 2163{
1985 AV *invoke_av; 2168 AV *invoke_av;
1986 int i, len; 2169 int i, len;
1987 2170
1988 if (!invoke) 2171 if (!invoke)
1989 { 2172 {
1990 SvREFCNT_dec (PL_diehook); PL_diehook = 0; 2173 SV *old = PL_diehook;
2174 PL_diehook = 0;
2175 SvREFCNT_dec (old);
1991 croak ("\3async_pool terminate\2\n"); 2176 croak ("\3async_pool terminate\2\n");
1992 } 2177 }
1993 2178
1994 SvREFCNT_dec (coro->saved_deffh); 2179 SvREFCNT_dec (coro->saved_deffh);
1995 coro->saved_deffh = SvREFCNT_inc ((SV *)PL_defoutgv); 2180 coro->saved_deffh = SvREFCNT_inc_NN ((SV *)PL_defoutgv);
1996 2181
1997 hv_store (hv, "desc", sizeof ("desc") - 1, 2182 hv_store (hv, "desc", sizeof ("desc") - 1,
1998 newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0); 2183 newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0);
1999 2184
2000 invoke_av = (AV *)SvRV (invoke); 2185 invoke_av = (AV *)SvRV (invoke);
2004 2189
2005 if (len > 0) 2190 if (len > 0)
2006 { 2191 {
2007 av_fill (defav, len - 1); 2192 av_fill (defav, len - 1);
2008 for (i = 0; i < len; ++i) 2193 for (i = 0; i < len; ++i)
2009 av_store (defav, i, SvREFCNT_inc (AvARRAY (invoke_av)[i + 1])); 2194 av_store (defav, i, SvREFCNT_inc_NN (AvARRAY (invoke_av)[i + 1]));
2010 } 2195 }
2011 2196
2012 SvREFCNT_dec (invoke); 2197 SvREFCNT_dec (invoke);
2013} 2198}
2014 2199
2021 sv_setsv (cb, &PL_sv_undef); 2206 sv_setsv (cb, &PL_sv_undef);
2022 2207
2023 SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh; 2208 SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
2024 coro->saved_deffh = 0; 2209 coro->saved_deffh = 0;
2025 2210
2026 if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss) 2211 if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)
2027 || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size)) 2212 || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
2028 { 2213 {
2029 SvREFCNT_dec (PL_diehook); PL_diehook = 0; 2214 SV *old = PL_diehook;
2215 PL_diehook = 0;
2216 SvREFCNT_dec (old);
2030 croak ("\3async_pool terminate\2\n"); 2217 croak ("\3async_pool terminate\2\n");
2031 } 2218 }
2032 2219
2033 av_clear (GvAV (PL_defgv)); 2220 av_clear (GvAV (PL_defgv));
2034 hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1, 2221 hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1,
2040 api_trace (coro_current, 0); 2227 api_trace (coro_current, 0);
2041 2228
2042 av_push (av_async_pool, newSVsv (coro_current)); 2229 av_push (av_async_pool, newSVsv (coro_current));
2043} 2230}
2044 2231
2232#if 0
2233
2234void
2235_generator_call (...)
2236 PROTOTYPE: @
2237 PPCODE:
2238 fprintf (stderr, "call %p\n", CvXSUBANY(cv).any_ptr);
2239 xxxx
2240 abort ();
2241
2242SV *
2243gensub (SV *sub, ...)
2244 PROTOTYPE: &;@
2245 CODE:
2246{
2247 struct coro *coro;
2248 MAGIC *mg;
2249 CV *xcv;
2250 CV *ncv = (CV *)newSV_type (SVt_PVCV);
2251 int i;
2252
2253 CvGV (ncv) = CvGV (cv);
2254 CvFILE (ncv) = CvFILE (cv);
2255
2256 Newz (0, coro, 1, struct coro);
2257 coro->args = newAV ();
2258 coro->flags = CF_NEW;
2259
2260 av_extend (coro->args, items - 1);
2261 for (i = 1; i < items; i++)
2262 av_push (coro->args, newSVsv (ST (i)));
2263
2264 CvISXSUB_on (ncv);
2265 CvXSUBANY (ncv).any_ptr = (void *)coro;
2266
2267 xcv = GvCV (gv_fetchpv ("Coro::_generator_call", 0, SVt_PVCV));
2268
2269 CvXSUB (ncv) = CvXSUB (xcv);
2270 CvANON_on (ncv);
2271
2272 mg = sv_magicext ((SV *)ncv, 0, CORO_MAGIC_type_state, &coro_gensub_vtbl, (char *)coro, 0);
2273 RETVAL = newRV_noinc ((SV *)ncv);
2274}
2275 OUTPUT:
2276 RETVAL
2277
2278#endif
2279
2045 2280
2046MODULE = Coro::State PACKAGE = Coro::AIO 2281MODULE = Coro::State PACKAGE = Coro::AIO
2047 2282
2048SV * 2283void
2049_get_state () 2284_get_state (SV *self)
2050 CODE: 2285 PPCODE:
2051{ 2286{
2052 struct io_state *data; 2287 AV *defav = GvAV (PL_defgv);
2053 2288 AV *av = newAV ();
2289 int i;
2054 RETVAL = newSV (sizeof (struct io_state)); 2290 SV *data_sv = newSV (sizeof (struct io_state));
2055 data = (struct io_state *)SvPVX (RETVAL); 2291 struct io_state *data = (struct io_state *)SvPVX (data_sv);
2056 SvCUR_set (RETVAL, sizeof (struct io_state)); 2292 SvCUR_set (data_sv, sizeof (struct io_state));
2057 SvPOK_only (RETVAL); 2293 SvPOK_only (data_sv);
2058 2294
2059 data->errorno = errno; 2295 data->errorno = errno;
2060 data->laststype = PL_laststype; 2296 data->laststype = PL_laststype;
2061 data->laststatval = PL_laststatval; 2297 data->laststatval = PL_laststatval;
2062 data->statcache = PL_statcache; 2298 data->statcache = PL_statcache;
2299
2300 av_extend (av, AvFILLp (defav) + 1 + 1);
2301
2302 for (i = 0; i <= AvFILLp (defav); ++i)
2303 av_push (av, SvREFCNT_inc_NN (AvARRAY (defav)[i]));
2304
2305 av_push (av, data_sv);
2306
2307 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
2308
2309 api_ready (self);
2063} 2310}
2064 OUTPUT:
2065 RETVAL
2066 2311
2067void 2312void
2068_set_state (char *data_) 2313_set_state (SV *state)
2069 PROTOTYPE: $ 2314 PROTOTYPE: $
2070 CODE: 2315 PPCODE:
2071{ 2316{
2072 struct io_state *data = (void *)data_; 2317 AV *av = (AV *)SvRV (state);
2318 struct io_state *data = (struct io_state *)SvPVX (AvARRAY (av)[AvFILLp (av)]);
2319 int i;
2073 2320
2074 errno = data->errorno; 2321 errno = data->errorno;
2075 PL_laststype = data->laststype; 2322 PL_laststype = data->laststype;
2076 PL_laststatval = data->laststatval; 2323 PL_laststatval = data->laststatval;
2077 PL_statcache = data->statcache; 2324 PL_statcache = data->statcache;
2325
2326 EXTEND (SP, AvFILLp (av));
2327 for (i = 0; i < AvFILLp (av); ++i)
2328 PUSHs (sv_2mortal (SvREFCNT_inc_NN (AvARRAY (av)[i])));
2078} 2329}
2079 2330
2080 2331
2081MODULE = Coro::State PACKAGE = Coro::AnyEvent 2332MODULE = Coro::State PACKAGE = Coro::AnyEvent
2082 2333
2106 } 2357 }
2107 2358
2108 --incede; 2359 --incede;
2109} 2360}
2110 2361
2362
2363MODULE = Coro::State PACKAGE = PerlIO::cede
2364
2365BOOT:
2366 PerlIO_define_layer (aTHX_ &PerlIO_cede);

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines