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.425 by root, Wed Dec 5 00:14:22 2012 UTC vs.
Revision 1.456 by root, Sun Mar 6 06:26:21 2016 UTC

1/* this works around a bug in mingw32 providing a non-working setjmp */ 1/* this works around a bug in mingw32 providing a non-working setjmp */
2#define USE_NO_MINGW_SETJMP_TWO_ARGS 2#define USE_NO_MINGW_SETJMP_TWO_ARGS
3 3
4#define NDEBUG 1 4#define NDEBUG 1 /* perl usually disables NDEBUG later */
5 5
6#include "libcoro/coro.c" 6#include "libcoro/coro.c"
7 7
8#define PERL_NO_GET_CONTEXT 8#define PERL_NO_GET_CONTEXT
9#define PERL_EXT 9#define PERL_EXT
14#include "perliol.h" 14#include "perliol.h"
15 15
16#include "schmorp.h" 16#include "schmorp.h"
17 17
18#define ECB_NO_THREADS 1 18#define ECB_NO_THREADS 1
19#define ECB_NO_LIBM 1
19#include "ecb.h" 20#include "ecb.h"
20 21
21#include <stddef.h> 22#include <stddef.h>
22#include <stdio.h> 23#include <stdio.h>
23#include <errno.h> 24#include <errno.h>
24#include <assert.h> 25#include <assert.h>
25 26
27#ifndef SvREFCNT_dec_NN
28 #define SvREFCNT_dec_NN(sv) SvREFCNT_dec (sv)
29#endif
30
31#ifndef SvREFCNT_inc_NN
32 #define SvREFCNT_inc_NN(sv) SvREFCNT_inc (sv)
33#endif
34
26#ifndef SVs_PADSTALE 35#ifndef SVs_PADSTALE
27# define SVs_PADSTALE 0 36# define SVs_PADSTALE 0
28#endif 37#endif
29 38
30#ifdef PadARRAY 39#ifdef PadARRAY
31# define NEWPADAPI 40# define NEWPADAPI 1
32# define newPADLIST(var) (Newz (0, var, 1, PADLIST), Newx (PadlistARRAY (var), 2, PAD *)) 41# define newPADLIST(var) (Newz (0, var, 1, PADLIST), Newx (PadlistARRAY (var), 2, PAD *))
33#else 42#else
34typedef AV PADNAMELIST; 43typedef AV PADNAMELIST;
35# if !PERL_VERSION_ATLEAST(5,8,0) 44# if !PERL_VERSION_ATLEAST(5,8,0)
36typedef AV PADLIST; 45typedef AV PADLIST;
41# define PadlistNAMES(pl) (*PadlistARRAY (pl)) 50# define PadlistNAMES(pl) (*PadlistARRAY (pl))
42# define PadARRAY AvARRAY 51# define PadARRAY AvARRAY
43# define PadMAX AvFILLp 52# define PadMAX AvFILLp
44# define newPADLIST(var) ((var) = newAV (), av_extend (var, 1)) 53# define newPADLIST(var) ((var) = newAV (), av_extend (var, 1))
45#endif 54#endif
55#ifndef PadnamelistREFCNT
56# define PadnamelistREFCNT(pnl) SvREFCNT (pnl)
57#endif
58#ifndef PadnamelistREFCNT_dec
59# define PadnamelistREFCNT_dec(pnl) SvREFCNT_dec (pnl)
60#endif
61
62/* 5.19.something has replaced SVt_BIND by SVt_INVLIST */
63/* we just alias it to SVt_IV, as that is sufficient for swap_sv for now */
64#if PERL_VERSION_ATLEAST(5,19,0)
65# define SVt_BIND SVt_IV
66#endif
46 67
47#if defined(_WIN32) 68#if defined(_WIN32)
48# undef HAS_GETTIMEOFDAY 69# undef HAS_GETTIMEOFDAY
49# undef setjmp 70# undef setjmp
50# undef longjmp 71# undef longjmp
52# define setjmp _setjmp /* deep magic */ 73# define setjmp _setjmp /* deep magic */
53#else 74#else
54# include <inttypes.h> /* most portable stdint.h */ 75# include <inttypes.h> /* most portable stdint.h */
55#endif 76#endif
56 77
57#if HAVE_MMAP
58# include <unistd.h>
59# include <sys/mman.h>
60# ifndef MAP_ANONYMOUS
61# ifdef MAP_ANON
62# define MAP_ANONYMOUS MAP_ANON
63# else
64# undef HAVE_MMAP
65# endif
66# endif
67# include <limits.h>
68# ifndef PAGESIZE
69# define PAGESIZE pagesize
70# define BOOT_PAGESIZE pagesize = sysconf (_SC_PAGESIZE)
71static long pagesize;
72# else
73# define BOOT_PAGESIZE (void)0
74# endif
75#else
76# define PAGESIZE 0
77# define BOOT_PAGESIZE (void)0
78#endif
79
80#if CORO_USE_VALGRIND
81# include <valgrind/valgrind.h>
82#endif
83
84/* the maximum number of idle cctx that will be pooled */ 78/* the maximum number of idle cctx that will be pooled */
85static int cctx_max_idle = 4; 79static int cctx_max_idle = 4;
86 80
87#if defined(DEBUGGING) && PERL_VERSION_ATLEAST(5,12,0) 81#if defined(DEBUGGING) && PERL_VERSION_ATLEAST(5,12,0)
88# define HAS_SCOPESTACK_NAME 1 82# define HAS_SCOPESTACK_NAME 1
89#endif
90
91#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
92# undef CORO_STACKGUARD
93#endif
94
95#ifndef CORO_STACKGUARD
96# define CORO_STACKGUARD 0
97#endif 83#endif
98 84
99/* prefer perl internal functions over our own? */ 85/* prefer perl internal functions over our own? */
100#ifndef CORO_PREFER_PERL_FUNCTIONS 86#ifndef CORO_PREFER_PERL_FUNCTIONS
101# define CORO_PREFER_PERL_FUNCTIONS 0 87# define CORO_PREFER_PERL_FUNCTIONS 0
154 140
155static GV *irsgv; /* $/ */ 141static GV *irsgv; /* $/ */
156static GV *stdoutgv; /* *STDOUT */ 142static GV *stdoutgv; /* *STDOUT */
157static SV *rv_diehook; 143static SV *rv_diehook;
158static SV *rv_warnhook; 144static SV *rv_warnhook;
159static HV *hv_sig; /* %SIG */
160 145
161/* async_pool helper stuff */ 146/* async_pool helper stuff */
162static SV *sv_pool_rss; 147static SV *sv_pool_rss;
163static SV *sv_pool_size; 148static SV *sv_pool_size;
164static SV *sv_async_pool_idle; /* description string */ 149static SV *sv_async_pool_idle; /* description string */
192typedef struct coro_cctx 177typedef struct coro_cctx
193{ 178{
194 struct coro_cctx *next; 179 struct coro_cctx *next;
195 180
196 /* the stack */ 181 /* the stack */
197 void *sptr; 182 struct coro_stack stack;
198 size_t ssize;
199 183
200 /* cpu state */ 184 /* cpu state */
201 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 185 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
202#ifndef NDEBUG 186#ifndef NDEBUG
203 JMPENV *idle_te; /* same as idle_sp, but for top_env */ 187 JMPENV *idle_te; /* same as idle_sp, but for top_env */
271 SV *saved_deffh; 255 SV *saved_deffh;
272 SV *invoke_cb; 256 SV *invoke_cb;
273 AV *invoke_av; 257 AV *invoke_av;
274 258
275 /* on_enter/on_leave */ 259 /* on_enter/on_leave */
276 AV *on_enter; 260 AV *on_enter; AV *on_enter_xs;
277 AV *on_leave; 261 AV *on_leave; AV *on_leave_xs;
278 262
279 /* swap_sv */ 263 /* swap_sv */
280 AV *swap_sv; 264 AV *swap_sv;
281 265
282 /* times */ 266 /* times */
312#define coro_nready coroapi.nready 296#define coro_nready coroapi.nready
313 297
314/** JIT *********************************************************************/ 298/** JIT *********************************************************************/
315 299
316#if CORO_JIT 300#if CORO_JIT
317 /* APPLE doesn't have HAVE_MMAP though */ 301 /* APPLE doesn't have mmap though */
318 #define CORO_JIT_UNIXY (__linux || __FreeBSD__ || __OpenBSD__ || __NetBSD__ || __solaris || __APPLE__) 302 #define CORO_JIT_UNIXY (__linux || __FreeBSD__ || __OpenBSD__ || __NetBSD__ || __solaris || __APPLE__)
319 #ifndef CORO_JIT_TYPE 303 #ifndef CORO_JIT_TYPE
320 #if __x86_64 && CORO_JIT_UNIXY 304 #if ECB_AMD64 && CORO_JIT_UNIXY
321 #define CORO_JIT_TYPE "amd64-unix" 305 #define CORO_JIT_TYPE "amd64-unix"
322 #elif __i386 && CORO_JIT_UNIXY 306 #elif __i386 && CORO_JIT_UNIXY
323 #define CORO_JIT_TYPE "x86-unix" 307 #define CORO_JIT_TYPE "x86-unix"
324 #endif 308 #endif
325 #endif 309 #endif
326#endif 310#endif
327 311
328#if !defined(CORO_JIT_TYPE) || !HAVE_MMAP 312#if !defined(CORO_JIT_TYPE) || _POSIX_MEMORY_PROTECTION <= 0
329 #undef CORO_JIT 313 #undef CORO_JIT
330#endif 314#endif
331 315
332#if CORO_JIT 316#if CORO_JIT
333 typedef void (*load_save_perl_slots_type)(perl_slots *); 317 typedef void (*load_save_perl_slots_type)(perl_slots *);
518 502
519 return 0; 503 return 0;
520} 504}
521 505
522ecb_inline struct coro * 506ecb_inline struct coro *
523SvSTATE_ (pTHX_ SV *coro) 507SvSTATE_ (pTHX_ SV *coro_sv)
524{ 508{
525 MAGIC *mg; 509 MAGIC *mg;
526 510
527 if (SvROK (coro)) 511 if (SvROK (coro_sv))
528 coro = SvRV (coro); 512 coro_sv = SvRV (coro_sv);
529 513
530 mg = SvSTATEhv_p (aTHX_ coro); 514 mg = SvSTATEhv_p (aTHX_ coro_sv);
531 if (!mg) 515 if (!mg)
532 croak ("Coro::State object required"); 516 croak ("Coro::State object required");
533 517
534 return (struct coro *)mg->mg_ptr; 518 return (struct coro *)mg->mg_ptr;
535} 519}
546ecb_inline PADLIST * 530ecb_inline PADLIST *
547coro_derive_padlist (pTHX_ CV *cv) 531coro_derive_padlist (pTHX_ CV *cv)
548{ 532{
549 PADLIST *padlist = CvPADLIST (cv); 533 PADLIST *padlist = CvPADLIST (cv);
550 PADLIST *newpadlist; 534 PADLIST *newpadlist;
535 PADNAMELIST *padnames;
551 PAD *newpad; 536 PAD *newpad;
552 PADOFFSET const off = PadlistMAX (padlist) + 1; 537 PADOFFSET off = PadlistMAX (padlist) + 1;
553 538
554 newPADLIST(newpadlist); 539#if NEWPADAPI
555#if !PERL_VERSION_ATLEAST(5,15,3) 540
556 /* Padlists are AvREAL as of 5.15.3. See perl bug #98092 and perl commit 7d953ba. */ 541 /* if we had the original CvDEPTH, we might be able to steal the CvDEPTH+1 entry instead */
557 AvREAL_off (newpadlist); 542 /* 20131102194744.GA6705@schmorp.de, 20131102195825.2013.qmail@lists-nntp.develooper.com */
558#endif 543 while (!PadlistARRAY (padlist)[off - 1])
544 --off;
545
546 Perl_pad_push (aTHX_ padlist, off);
547
548 newpad = PadlistARRAY (padlist)[off];
549 PadlistARRAY (padlist)[off] = 0;
550
551#else
552
559#if PERL_VERSION_ATLEAST (5,10,0) 553#if PERL_VERSION_ATLEAST (5,10,0)
560 Perl_pad_push (aTHX_ padlist, off); 554 Perl_pad_push (aTHX_ padlist, off);
561#else 555#else
562 Perl_pad_push (aTHX_ padlist, off, 1); 556 Perl_pad_push (aTHX_ padlist, off, 1);
563#endif 557#endif
558
564 newpad = PadlistARRAY (padlist)[off]; 559 newpad = PadlistARRAY (padlist)[off];
565 PadlistMAX (padlist) = off - 1; 560 PadlistMAX (padlist) = off - 1;
566 561
562#endif
563
564 newPADLIST (newpadlist);
565#if !PERL_VERSION_ATLEAST(5,15,3)
566 /* Padlists are AvREAL as of 5.15.3. See perl bug #98092 and perl commit 7d953ba. */
567 AvREAL_off (newpadlist);
568#endif
569
567 /* Already extended to 2 elements by newPADLIST. */ 570 /* Already extended to 2 elements by newPADLIST. */
568 PadlistMAX (newpadlist) = 1; 571 PadlistMAX (newpadlist) = 1;
569 PadlistNAMES (newpadlist) = (PADNAMELIST *)SvREFCNT_inc_NN (PadlistNAMES (padlist)); 572
573 padnames = PadlistNAMES (padlist);
574 ++PadnamelistREFCNT (padnames);
575 PadlistNAMES (newpadlist) = padnames;
576
570 PadlistARRAY (newpadlist)[1] = newpad; 577 PadlistARRAY (newpadlist)[1] = newpad;
571 578
572 return newpadlist; 579 return newpadlist;
573} 580}
574 581
582 589
583 while (i > 0) /* special-case index 0 */ 590 while (i > 0) /* special-case index 0 */
584 { 591 {
585 /* we try to be extra-careful here */ 592 /* we try to be extra-careful here */
586 PAD *pad = PadlistARRAY (padlist)[i--]; 593 PAD *pad = PadlistARRAY (padlist)[i--];
594
595 if (pad)
596 {
587 I32 j = PadMAX (pad); 597 I32 j = PadMAX (pad);
588 598
589 while (j >= 0) 599 while (j >= 0)
590 SvREFCNT_dec (PadARRAY (pad)[j--]); 600 SvREFCNT_dec (PadARRAY (pad)[j--]);
591 601
592 PadMAX (pad) = -1; 602 PadMAX (pad) = -1;
593 SvREFCNT_dec (pad); 603 SvREFCNT_dec (pad);
604 }
594 } 605 }
595 606
596 SvREFCNT_dec (PadlistNAMES (padlist)); 607 PadnamelistREFCNT_dec (PadlistNAMES (padlist));
597 608
598#ifdef NEWPADAPI 609#if NEWPADAPI
599 Safefree (PadlistARRAY (padlist)); 610 Safefree (PadlistARRAY (padlist));
600 Safefree (padlist); 611 Safefree (padlist);
601#else 612#else
602 AvFILLp (padlist) = -1; 613 AvFILLp (padlist) = -1;
603 AvREAL_off (padlist); 614 AvREAL_off (padlist);
697 tmp.sv_u = a->sv_u; a->sv_u = b->sv_u; b->sv_u = tmp.sv_u; 708 tmp.sv_u = a->sv_u; a->sv_u = b->sv_u; b->sv_u = tmp.sv_u;
698 709
699 /* if SvANY points to the head, we need to adjust the pointers, 710 /* if SvANY points to the head, we need to adjust the pointers,
700 * as the pointer for a still points to b, and maybe vice versa. 711 * as the pointer for a still points to b, and maybe vice versa.
701 */ 712 */
702 #define svany_in_head(type) \ 713 U32 svany_in_head_set = (1 << SVt_NULL) | (1 << SVt_BIND) | (1 << SVt_IV) | (1 << SVt_RV);
703 (((1 << SVt_NULL) | (1 << SVt_BIND) | (1 << SVt_IV) | (1 << SVt_RV)) & (1 << (type))) 714 #if NVSIZE <= IVSIZE && PERL_VERSION_ATLEAST(5,22,0)
715 svany_in_head_set |= 1 << SVt_NV;
716 #endif
717
718 #define svany_in_head(type) (svany_in_head_set & (1 << (type)))
704 719
705 if (svany_in_head (SvTYPE (a))) 720 if (svany_in_head (SvTYPE (a)))
706 SvANY (a) = (void *)((PTRV)SvANY (a) - (PTRV)b + (PTRV)a); 721 SvANY (a) = (void *)((PTRV)SvANY (a) - (PTRV)b + (PTRV)a);
707 722
708 if (svany_in_head (SvTYPE (b))) 723 if (svany_in_head (SvTYPE (b)))
776 791
777 for (i = 0; i <= AvFILLp (c->on_enter); ++i) 792 for (i = 0; i <= AvFILLp (c->on_enter); ++i)
778 on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]); 793 on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);
779 } 794 }
780 795
796 if (ecb_expect_false (c->on_enter_xs))
797 {
798 int i;
799
800 for (i = 0; i <= AvFILLp (c->on_enter_xs); i += 2)
801 ((coro_enterleave_hook)AvARRAY (c->on_enter_xs)[i]) (aTHX_ AvARRAY (c->on_enter_xs)[i + 1]);
802 }
803
781 SWAP_SVS (c); 804 SWAP_SVS (c);
782} 805}
783 806
784static void 807static void
785save_perl (pTHX_ Coro__State c) 808save_perl (pTHX_ Coro__State c)
786{ 809{
787 SWAP_SVS (c); 810 SWAP_SVS (c);
811
812 if (ecb_expect_false (c->on_leave_xs))
813 {
814 int i;
815
816 for (i = AvFILLp (c->on_leave_xs) - 1; i >= 0; i -= 2)
817 ((coro_enterleave_hook)AvARRAY (c->on_leave_xs)[i]) (aTHX_ AvARRAY (c->on_leave_xs)[i + 1]);
818 }
788 819
789 if (ecb_expect_false (c->on_leave)) 820 if (ecb_expect_false (c->on_leave))
790 { 821 {
791 int i; 822 int i;
792 823
1145 1176
1146 GvSV (PL_defgv) = newSV (0); 1177 GvSV (PL_defgv) = newSV (0);
1147 GvAV (PL_defgv) = coro->args; coro->args = 0; 1178 GvAV (PL_defgv) = coro->args; coro->args = 0;
1148 GvSV (PL_errgv) = newSV (0); 1179 GvSV (PL_errgv) = newSV (0);
1149 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0); 1180 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
1150 GvHV (PL_hintgv) = 0; 1181 GvHV (PL_hintgv) = newHV ();
1182#if PERL_VERSION_ATLEAST (5,10,0)
1183 hv_magic (GvHV (PL_hintgv), 0, PERL_MAGIC_hints);
1184#endif
1151 PL_rs = newSVsv (GvSV (irsgv)); 1185 PL_rs = newSVsv (GvSV (irsgv));
1152 PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv); 1186 PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);
1153 1187
1154 { 1188 {
1155 dSP; 1189 dSP;
1265 1299
1266 SvREFCNT_dec (coro->saved_deffh); 1300 SvREFCNT_dec (coro->saved_deffh);
1267 SvREFCNT_dec (coro->rouse_cb); 1301 SvREFCNT_dec (coro->rouse_cb);
1268 SvREFCNT_dec (coro->invoke_cb); 1302 SvREFCNT_dec (coro->invoke_cb);
1269 SvREFCNT_dec (coro->invoke_av); 1303 SvREFCNT_dec (coro->invoke_av);
1304 SvREFCNT_dec (coro->on_enter_xs);
1305 SvREFCNT_dec (coro->on_leave_xs);
1270 } 1306 }
1271} 1307}
1272 1308
1273ecb_inline void 1309ecb_inline void
1274free_coro_mortal (pTHX) 1310free_coro_mortal (pTHX)
1337 1373
1338 if (PL_curcop != &PL_compiling) 1374 if (PL_curcop != &PL_compiling)
1339 { 1375 {
1340 SV **cb; 1376 SV **cb;
1341 1377
1342 if (oldcxix != cxstack_ix && cctx_current->flags & CC_TRACE_SUB) 1378 if (oldcxix != cxstack_ix && cctx_current->flags & CC_TRACE_SUB && cxstack_ix >= 0)
1343 { 1379 {
1344 PERL_CONTEXT *cx = &cxstack[cxstack_ix]; 1380 PERL_CONTEXT *cx = &cxstack[cxstack_ix];
1345 1381
1346 if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix) 1382 if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)
1347 { 1383 {
1519static coro_cctx * 1555static coro_cctx *
1520cctx_new_empty (void) 1556cctx_new_empty (void)
1521{ 1557{
1522 coro_cctx *cctx = cctx_new (); 1558 coro_cctx *cctx = cctx_new ();
1523 1559
1524 cctx->sptr = 0; 1560 cctx->stack.sptr = 0;
1525 coro_create (&cctx->cctx, 0, 0, 0, 0); 1561 coro_create (&cctx->cctx, 0, 0, 0, 0);
1526 1562
1527 return cctx; 1563 return cctx;
1528} 1564}
1529 1565
1530/* create a new cctx suitable as destination/running a perl interpreter */ 1566/* create a new cctx suitable as destination/running a perl interpreter */
1531static coro_cctx * 1567static coro_cctx *
1532cctx_new_run (void) 1568cctx_new_run (void)
1533{ 1569{
1534 coro_cctx *cctx = cctx_new (); 1570 coro_cctx *cctx = cctx_new ();
1535 void *stack_start;
1536 size_t stack_size;
1537 1571
1538#if HAVE_MMAP 1572 if (!coro_stack_alloc (&cctx->stack, cctx_stacksize))
1539 cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
1540 /* mmap supposedly does allocate-on-write for us */
1541 cctx->sptr = mmap (0, cctx->ssize, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS, -1, 0);
1542
1543 if (cctx->sptr != (void *)-1)
1544 {
1545 #if CORO_STACKGUARD
1546 mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);
1547 #endif
1548 stack_start = (char *)cctx->sptr + CORO_STACKGUARD * PAGESIZE;
1549 stack_size = cctx->ssize - CORO_STACKGUARD * PAGESIZE;
1550 cctx->flags |= CC_MAPPED;
1551 } 1573 {
1552 else
1553#endif
1554 {
1555 cctx->ssize = cctx_stacksize * (long)sizeof (long);
1556 New (0, cctx->sptr, cctx_stacksize, long);
1557
1558 if (!cctx->sptr)
1559 {
1560 perror ("FATAL: unable to allocate stack for coroutine, exiting."); 1574 perror ("FATAL: unable to allocate stack for coroutine, exiting.");
1561 _exit (EXIT_FAILURE); 1575 _exit (EXIT_FAILURE);
1562 }
1563
1564 stack_start = cctx->sptr;
1565 stack_size = cctx->ssize;
1566 } 1576 }
1567 1577
1568 #if CORO_USE_VALGRIND
1569 cctx->valgrind_id = VALGRIND_STACK_REGISTER ((char *)stack_start, (char *)stack_start + stack_size);
1570 #endif
1571
1572 coro_create (&cctx->cctx, cctx_run, (void *)cctx, stack_start, stack_size); 1578 coro_create (&cctx->cctx, cctx_run, (void *)cctx, cctx->stack.sptr, cctx->stack.ssze);
1573 1579
1574 return cctx; 1580 return cctx;
1575} 1581}
1576 1582
1577static void 1583static void
1583 assert (("FATAL: tried to destroy current cctx", cctx != cctx_current)); 1589 assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));
1584 1590
1585 --cctx_count; 1591 --cctx_count;
1586 coro_destroy (&cctx->cctx); 1592 coro_destroy (&cctx->cctx);
1587 1593
1588 /* coro_transfer creates new, empty cctx's */ 1594 coro_stack_free (&cctx->stack);
1589 if (cctx->sptr)
1590 {
1591 #if CORO_USE_VALGRIND
1592 VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);
1593 #endif
1594
1595#if HAVE_MMAP
1596 if (cctx->flags & CC_MAPPED)
1597 munmap (cctx->sptr, cctx->ssize);
1598 else
1599#endif
1600 Safefree (cctx->sptr);
1601 }
1602 1595
1603 Safefree (cctx); 1596 Safefree (cctx);
1604} 1597}
1605 1598
1606/* wether this cctx should be destructed */ 1599/* wether this cctx should be destructed */
1625} 1618}
1626 1619
1627static void 1620static void
1628cctx_put (coro_cctx *cctx) 1621cctx_put (coro_cctx *cctx)
1629{ 1622{
1630 assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr)); 1623 assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->stack.sptr));
1631 1624
1632 /* free another cctx if overlimit */ 1625 /* free another cctx if overlimit */
1633 if (ecb_expect_false (cctx_idle >= cctx_max_idle)) 1626 if (ecb_expect_false (cctx_idle >= cctx_max_idle))
1634 { 1627 {
1635 coro_cctx *first = cctx_first; 1628 coro_cctx *first = cctx_first;
1967 /* nothing to schedule: call the idle handler */ 1960 /* nothing to schedule: call the idle handler */
1968 if (SvROK (sv_idle) 1961 if (SvROK (sv_idle)
1969 && SvOBJECT (SvRV (sv_idle))) 1962 && SvOBJECT (SvRV (sv_idle)))
1970 { 1963 {
1971 if (SvRV (sv_idle) == SvRV (coro_current)) 1964 if (SvRV (sv_idle) == SvRV (coro_current))
1965 {
1966 require_pv ("Carp");
1967
1968 {
1969 dSP;
1970
1971 ENTER;
1972 SAVETMPS;
1973
1974 PUSHMARK (SP);
1972 croak ("FATAL: $Coro::IDLE blocked itself - did you try to block inside an event loop callback? Caught"); 1975 XPUSHs (sv_2mortal (newSVpv ("FATAL: $Coro::idle blocked itself - did you try to block inside an event loop callback? Caught", 0)));
1976 PUTBACK;
1977 call_pv ("Carp::confess", G_VOID | G_DISCARD);
1978
1979 FREETMPS;
1980 LEAVE;
1981 }
1982 }
1973 1983
1974 ++coro_nready; /* hack so that api_ready doesn't invoke ready hook */ 1984 ++coro_nready; /* hack so that api_ready doesn't invoke ready hook */
1975 api_ready (aTHX_ SvRV (sv_idle)); 1985 api_ready (aTHX_ SvRV (sv_idle));
1976 --coro_nready; 1986 --coro_nready;
1977 } 1987 }
2175 AV *od = coro->on_destroy; 2185 AV *od = coro->on_destroy;
2176 2186
2177 if (!od) 2187 if (!od)
2178 return; 2188 return;
2179 2189
2190 coro->on_destroy = 0;
2191 sv_2mortal ((SV *)od);
2192
2180 while (AvFILLp (od) >= 0) 2193 while (AvFILLp (od) >= 0)
2181 { 2194 {
2182 SV *cb = sv_2mortal (av_pop (od)); 2195 SV *cb = sv_2mortal (av_pop (od));
2183 2196
2184 /* coro hv's (and only hv's at the moment) are supported as well */ 2197 /* coro hv's (and only hv's at the moment) are supported as well */
2278 slf_init_terminate_cancel_common (aTHX_ frame, coro_hv); 2291 slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
2279 } 2292 }
2280 else 2293 else
2281 { 2294 {
2282 struct coro *self = SvSTATE_current; 2295 struct coro *self = SvSTATE_current;
2296
2297 if (!self)
2298 croak ("Coro::cancel called outside of thread content,");
2283 2299
2284 /* otherwise we cancel directly, purely for speed reasons 2300 /* otherwise we cancel directly, purely for speed reasons
2285 * unfortunately, this requires some magic trickery, as 2301 * unfortunately, this requires some magic trickery, as
2286 * somebody else could cancel us, so we have to fight the cancellation. 2302 * somebody else could cancel us, so we have to fight the cancellation.
2287 * this is ugly, and hopefully fully worth the extra speed. 2303 * this is ugly, and hopefully fully worth the extra speed.
2629 2645
2630/* "undo"/cancel a running slf call - used when cancelling a coro, mainly */ 2646/* "undo"/cancel a running slf call - used when cancelling a coro, mainly */
2631static void 2647static void
2632slf_destroy (pTHX_ struct coro *coro) 2648slf_destroy (pTHX_ struct coro *coro)
2633{ 2649{
2634 /* this callback is reserved for slf functions needing to do cleanup */ 2650 struct CoroSLF frame = coro->slf_frame;
2635 if (coro->slf_frame.destroy && coro->slf_frame.prepare && !PL_dirty)
2636 coro->slf_frame.destroy (aTHX_ &coro->slf_frame);
2637 2651
2638 /* 2652 /*
2639 * The on_destroy above most likely is from an SLF call. 2653 * The on_destroy below most likely is from an SLF call.
2640 * Since by definition the SLF call will not finish when we destroy 2654 * Since by definition the SLF call will not finish when we destroy
2641 * the coro, we will have to force-finish it here, otherwise 2655 * the coro, we will have to force-finish it here, otherwise
2642 * cleanup functions cannot call SLF functions. 2656 * cleanup functions cannot call SLF functions.
2643 */ 2657 */
2644 coro->slf_frame.prepare = 0; 2658 coro->slf_frame.prepare = 0;
2659
2660 /* this callback is reserved for slf functions needing to do cleanup */
2661 if (frame.destroy && frame.prepare && !PL_dirty)
2662 frame.destroy (aTHX_ &frame);
2645} 2663}
2646 2664
2647/* 2665/*
2648 * these not obviously related functions are all rolled into one 2666 * these not obviously related functions are all rolled into one
2649 * function to increase chances that they all will call transfer with the same 2667 * function to increase chances that they all will call transfer with the same
2832static void 2850static void
2833coro_pop_on_leave (pTHX_ void *coro) 2851coro_pop_on_leave (pTHX_ void *coro)
2834{ 2852{
2835 SV *cb = coro_avp_pop_and_free (aTHX_ &((struct coro *)coro)->on_leave); 2853 SV *cb = coro_avp_pop_and_free (aTHX_ &((struct coro *)coro)->on_leave);
2836 on_enterleave_call (aTHX_ sv_2mortal (cb)); 2854 on_enterleave_call (aTHX_ sv_2mortal (cb));
2855}
2856
2857static void
2858enterleave_hook_xs (pTHX_ struct coro *coro, AV **avp, coro_enterleave_hook hook, void *arg)
2859{
2860 if (!hook)
2861 return;
2862
2863 if (!*avp)
2864 {
2865 *avp = newAV ();
2866 AvREAL_off (*avp);
2867 }
2868
2869 av_push (*avp, (SV *)hook);
2870 av_push (*avp, (SV *)arg);
2871}
2872
2873static void
2874enterleave_unhook_xs (pTHX_ struct coro *coro, AV **avp, coro_enterleave_hook hook, int execute)
2875{
2876 AV *av = *avp;
2877 int i;
2878
2879 if (!av)
2880 return;
2881
2882 for (i = AvFILLp (av) - 1; i >= 0; i -= 2)
2883 if (AvARRAY (av)[i] == (SV *)hook)
2884 {
2885 if (execute)
2886 hook (aTHX_ (void *)AvARRAY (av)[i + 1]);
2887
2888 memmove (AvARRAY (av) + i, AvARRAY (av) + i + 2, AvFILLp (av) - i - 1);
2889 av_pop (av);
2890 av_pop (av);
2891 break;
2892 }
2893
2894 if (AvFILLp (av) >= 0)
2895 {
2896 *avp = 0;
2897 SvREFCNT_dec_NN (av);
2898 }
2899}
2900
2901static void
2902api_enterleave_hook (pTHX_ SV *coro_sv, coro_enterleave_hook enter, void *enter_arg, coro_enterleave_hook leave, void *leave_arg)
2903{
2904 struct coro *coro = SvSTATE (coro_sv);
2905
2906 if (SvSTATE_current == coro)
2907 if (enter)
2908 enter (aTHX_ enter_arg);
2909
2910 enterleave_hook_xs (aTHX_ coro, &coro->on_enter_xs, enter, enter_arg);
2911 enterleave_hook_xs (aTHX_ coro, &coro->on_leave_xs, leave, leave_arg);
2912}
2913
2914static void
2915api_enterleave_unhook (pTHX_ SV *coro_sv, coro_enterleave_hook enter, coro_enterleave_hook leave)
2916{
2917 struct coro *coro = SvSTATE (coro_sv);
2918
2919 enterleave_unhook_xs (aTHX_ coro, &coro->on_enter_xs, enter, 0);
2920 enterleave_unhook_xs (aTHX_ coro, &coro->on_leave_xs, leave, SvSTATE_current == coro);
2921}
2922
2923static void
2924savedestructor_unhook_enter (pTHX_ coro_enterleave_hook enter)
2925{
2926 struct coro *coro = SvSTATE_current;
2927
2928 enterleave_unhook_xs (aTHX_ coro, &coro->on_enter_xs, enter, 0);
2929}
2930
2931static void
2932savedestructor_unhook_leave (pTHX_ coro_enterleave_hook leave)
2933{
2934 struct coro *coro = SvSTATE_current;
2935
2936 enterleave_unhook_xs (aTHX_ coro, &coro->on_leave_xs, leave, 1);
2937}
2938
2939static void
2940api_enterleave_scope_hook (pTHX_ coro_enterleave_hook enter, void *enter_arg, coro_enterleave_hook leave, void *leave_arg)
2941{
2942 api_enterleave_hook (aTHX_ coro_current, enter, enter_arg, leave, leave_arg);
2943
2944 /* this ought to be much cheaper than malloc + a single destructor call */
2945 if (enter) SAVEDESTRUCTOR_X (savedestructor_unhook_enter, enter);
2946 if (leave) SAVEDESTRUCTOR_X (savedestructor_unhook_leave, leave);
2837} 2947}
2838 2948
2839/*****************************************************************************/ 2949/*****************************************************************************/
2840/* PerlIO::cede */ 2950/* PerlIO::cede */
2841 2951
2971 XPUSHs (sv_2mortal (newRV_inc ((SV *)av))); 3081 XPUSHs (sv_2mortal (newRV_inc ((SV *)av)));
2972 PUTBACK; 3082 PUTBACK;
2973 call_sv (cb, G_VOID | G_DISCARD | G_EVAL | G_KEEPERR); 3083 call_sv (cb, G_VOID | G_DISCARD | G_EVAL | G_KEEPERR);
2974 } 3084 }
2975 3085
2976 SvREFCNT_dec (cb); 3086 SvREFCNT_dec_NN (cb);
2977 } 3087 }
2978} 3088}
2979 3089
2980static void 3090static void
2981coro_semaphore_destroy (pTHX_ struct CoroSLF *frame) 3091coro_semaphore_destroy (pTHX_ struct CoroSLF *frame)
2989{ 3099{
2990 AV *av = (AV *)frame->data; 3100 AV *av = (AV *)frame->data;
2991 SV *count_sv = AvARRAY (av)[0]; 3101 SV *count_sv = AvARRAY (av)[0];
2992 SV *coro_hv = SvRV (coro_current); 3102 SV *coro_hv = SvRV (coro_current);
2993 3103
3104 frame->destroy = 0;
3105
2994 /* if we are about to throw, don't actually acquire the lock, just throw */ 3106 /* if we are about to throw, don't actually acquire the lock, just throw */
2995 if (CORO_THROW) 3107 if (ecb_expect_false (CORO_THROW))
3108 {
3109 /* we still might be responsible for the semaphore, so wake up others */
3110 coro_semaphore_adjust (aTHX_ av, 0);
3111
2996 return 0; 3112 return 0;
3113 }
2997 else if (SvIVX (count_sv) > 0) 3114 else if (SvIVX (count_sv) > 0)
2998 { 3115 {
2999 frame->destroy = 0;
3000
3001 if (acquire) 3116 if (acquire)
3002 SvIVX (count_sv) = SvIVX (count_sv) - 1; 3117 SvIVX (count_sv) = SvIVX (count_sv) - 1;
3003 else 3118 else
3004 coro_semaphore_adjust (aTHX_ av, 0); 3119 coro_semaphore_adjust (aTHX_ av, 0);
3005 3120
3116 { 3231 {
3117 api_ready (aTHX_ cb); 3232 api_ready (aTHX_ cb);
3118 sv_setiv (cb, 0); /* signal waiter */ 3233 sv_setiv (cb, 0); /* signal waiter */
3119 } 3234 }
3120 3235
3121 SvREFCNT_dec (cb); 3236 SvREFCNT_dec_NN (cb);
3122 3237
3123 --count; 3238 --count;
3124 } 3239 }
3125} 3240}
3126 3241
3211 } 3326 }
3212 3327
3213 av_push (state, data_sv); 3328 av_push (state, data_sv);
3214 3329
3215 api_ready (aTHX_ coro); 3330 api_ready (aTHX_ coro);
3216 SvREFCNT_dec (coro); 3331 SvREFCNT_dec_NN (coro);
3217 SvREFCNT_dec ((AV *)state); 3332 SvREFCNT_dec_NN ((AV *)state);
3218} 3333}
3219 3334
3220static int 3335static int
3221slf_check_aio_req (pTHX_ struct CoroSLF *frame) 3336slf_check_aio_req (pTHX_ struct CoroSLF *frame)
3222{ 3337{
3227 /* it quickly returns */ 3342 /* it quickly returns */
3228 if (CORO_THROW) 3343 if (CORO_THROW)
3229 return 0; 3344 return 0;
3230 3345
3231 /* one element that is an RV? repeat! */ 3346 /* one element that is an RV? repeat! */
3232 if (AvFILLp (state) == 0 && SvROK (AvARRAY (state)[0])) 3347 if (AvFILLp (state) == 0 && SvTYPE (AvARRAY (state)[0]) != SVt_PV)
3233 return 1; 3348 return 1;
3234 3349
3235 /* restore status */ 3350 /* restore status */
3236 { 3351 {
3237 SV *data_sv = av_pop (state); 3352 SV *data_sv = av_pop (state);
3240 errno = data->errorno; 3355 errno = data->errorno;
3241 PL_laststype = data->laststype; 3356 PL_laststype = data->laststype;
3242 PL_laststatval = data->laststatval; 3357 PL_laststatval = data->laststatval;
3243 PL_statcache = data->statcache; 3358 PL_statcache = data->statcache;
3244 3359
3245 SvREFCNT_dec (data_sv); 3360 SvREFCNT_dec_NN (data_sv);
3246 } 3361 }
3247 3362
3248 /* push result values */ 3363 /* push result values */
3249 { 3364 {
3250 dSP; 3365 dSP;
3465 3580
3466PROTOTYPES: DISABLE 3581PROTOTYPES: DISABLE
3467 3582
3468BOOT: 3583BOOT:
3469{ 3584{
3585#define VARx(name,expr,type) if (sizeof (type) < sizeof (expr)) croak ("FATAL: Coro thread context slot '" # name "' too small for this version of perl.");
3586#include "state.h"
3470#ifdef USE_ITHREADS 3587#ifdef USE_ITHREADS
3471# if CORO_PTHREAD 3588# if CORO_PTHREAD
3472 coro_thx = PERL_GET_CONTEXT; 3589 coro_thx = PERL_GET_CONTEXT;
3473# endif 3590# endif
3474#endif 3591#endif
3475 BOOT_PAGESIZE;
3476
3477 /* perl defines these to check for existance first, but why it doesn't */ 3592 /* perl defines these to check for existance first, but why it doesn't */
3478 /* just create them one at init time is not clear to me, except for */ 3593 /* just create them one at init time is not clear to me, except for */
3479 /* programs trying to delete them, but... */ 3594 /* programs trying to delete them, but... */
3480 /* anyway, we declare this as invalid and make sure they are initialised here */ 3595 /* anyway, we declare this as invalid and make sure they are initialised here */
3481 DEFSV; 3596 DEFSV;
3488 3603
3489 orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get; 3604 orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;
3490 orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set; 3605 orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;
3491 orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr; 3606 orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr;
3492 3607
3493 hv_sig = coro_get_hv (aTHX_ "SIG", TRUE);
3494 rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV)); 3608 rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
3495 rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV)); 3609 rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
3496 3610
3497 coro_state_stash = gv_stashpv ("Coro::State", TRUE); 3611 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
3498 3612
3551void 3665void
3552transfer (...) 3666transfer (...)
3553 PROTOTYPE: $$ 3667 PROTOTYPE: $$
3554 CODE: 3668 CODE:
3555 CORO_EXECUTE_SLF_XS (slf_init_transfer); 3669 CORO_EXECUTE_SLF_XS (slf_init_transfer);
3556
3557void
3558_exit (int code)
3559 PROTOTYPE: $
3560 CODE:
3561 _exit (code);
3562 3670
3563SV * 3671SV *
3564clone (Coro::State coro) 3672clone (Coro::State coro)
3565 CODE: 3673 CODE:
3566{ 3674{
3621void 3729void
3622list () 3730list ()
3623 PROTOTYPE: 3731 PROTOTYPE:
3624 PPCODE: 3732 PPCODE:
3625{ 3733{
3626 struct coro *coro; 3734 struct coro *coro;
3627 for (coro = coro_first; coro; coro = coro->next) 3735 for (coro = coro_first; coro; coro = coro->next)
3628 if (coro->hv) 3736 if (coro->hv)
3629 XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv))); 3737 XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv)));
3630} 3738}
3631 3739
3793 3901
3794void 3902void
3795times (Coro::State self) 3903times (Coro::State self)
3796 PPCODE: 3904 PPCODE:
3797{ 3905{
3798 struct coro *current = SvSTATE (coro_current); 3906 struct coro *current = SvSTATE (coro_current);
3799 3907
3800 if (ecb_expect_false (current == self)) 3908 if (ecb_expect_false (current == self))
3801 { 3909 {
3802 coro_times_update (); 3910 coro_times_update ();
3803 coro_times_add (SvSTATE (coro_current)); 3911 coro_times_add (SvSTATE (coro_current));
3833 3941
3834MODULE = Coro::State PACKAGE = Coro 3942MODULE = Coro::State PACKAGE = Coro
3835 3943
3836BOOT: 3944BOOT:
3837{ 3945{
3946 if (SVt_LAST > 32)
3947 croak ("Coro internal error: SVt_LAST > 32, swap_sv might need adjustment");
3948
3838 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE); 3949 sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
3839 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE); 3950 sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
3840 cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD); 3951 cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);
3841 coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current); 3952 coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);
3842 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE); 3953 av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
3868 coroapi.ready = api_ready; 3979 coroapi.ready = api_ready;
3869 coroapi.is_ready = api_is_ready; 3980 coroapi.is_ready = api_is_ready;
3870 coroapi.nready = coro_nready; 3981 coroapi.nready = coro_nready;
3871 coroapi.current = coro_current; 3982 coroapi.current = coro_current;
3872 3983
3984 coroapi.enterleave_hook = api_enterleave_hook;
3985 coroapi.enterleave_unhook = api_enterleave_unhook;
3986 coroapi.enterleave_scope_hook = api_enterleave_scope_hook;
3987
3873 /*GCoroAPI = &coroapi;*/ 3988 /*GCoroAPI = &coroapi;*/
3874 sv_setiv (sv, (IV)&coroapi); 3989 sv_setiv (sv, (IV)&coroapi);
3875 SvREADONLY_on (sv); 3990 SvREADONLY_on (sv);
3876 } 3991 }
3877} 3992}
3942 4057
3943void 4058void
3944_set_current (SV *current) 4059_set_current (SV *current)
3945 PROTOTYPE: $ 4060 PROTOTYPE: $
3946 CODE: 4061 CODE:
3947 SvREFCNT_dec (SvRV (coro_current)); 4062 SvREFCNT_dec_NN (SvRV (coro_current));
3948 SvRV_set (coro_current, SvREFCNT_inc_NN (SvRV (current))); 4063 SvRV_set (coro_current, SvREFCNT_inc_NN (SvRV (current)));
3949 4064
3950void 4065void
3951_set_readyhook (SV *hook) 4066_set_readyhook (SV *hook)
3952 PROTOTYPE: $ 4067 PROTOTYPE: $
4036 4151
4037 if ((SV *)hv == &PL_sv_undef) 4152 if ((SV *)hv == &PL_sv_undef)
4038 { 4153 {
4039 SV *sv = coro_new (aTHX_ coro_stash, (SV **)&cv_pool_handler, 1, 1); 4154 SV *sv = coro_new (aTHX_ coro_stash, (SV **)&cv_pool_handler, 1, 1);
4040 hv = (HV *)SvREFCNT_inc_NN (SvRV (sv)); 4155 hv = (HV *)SvREFCNT_inc_NN (SvRV (sv));
4041 SvREFCNT_dec (sv); 4156 SvREFCNT_dec_NN (sv);
4042 } 4157 }
4043 4158
4044 { 4159 {
4045 struct coro *coro = SvSTATE_hv (hv); 4160 struct coro *coro = SvSTATE_hv (hv);
4046 4161
4053 api_ready (aTHX_ (SV *)hv); 4168 api_ready (aTHX_ (SV *)hv);
4054 4169
4055 if (GIMME_V != G_VOID) 4170 if (GIMME_V != G_VOID)
4056 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv))); 4171 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));
4057 else 4172 else
4058 SvREFCNT_dec (hv); 4173 SvREFCNT_dec_NN (hv);
4059} 4174}
4060 4175
4061SV * 4176SV *
4062rouse_cb () 4177rouse_cb ()
4063 PROTOTYPE: 4178 PROTOTYPE:
4078 on_leave = 1 4193 on_leave = 1
4079 PROTOTYPE: & 4194 PROTOTYPE: &
4080 CODE: 4195 CODE:
4081{ 4196{
4082 struct coro *coro = SvSTATE_current; 4197 struct coro *coro = SvSTATE_current;
4083 AV **avp = ix ? &coro->on_leave : &coro->on_enter; 4198 AV **avp = ix ? &coro->on_leave : &coro->on_enter;
4084 4199
4085 block = s_get_cv_croak (block); 4200 block = s_get_cv_croak (block);
4086 4201
4087 if (!*avp) 4202 if (!*avp)
4088 *avp = newAV (); 4203 *avp = newAV ();
4108 4223
4109SV * 4224SV *
4110new (SV *klass, SV *count = 0) 4225new (SV *klass, SV *count = 0)
4111 CODE: 4226 CODE:
4112{ 4227{
4113 int semcnt = 1; 4228 int semcnt = 1;
4114 4229
4115 if (count) 4230 if (count)
4116 { 4231 {
4117 SvGETMAGIC (count); 4232 SvGETMAGIC (count);
4118 4233
4142 RETVAL = newSVsv (AvARRAY ((AV *)SvRV (self))[0]); 4257 RETVAL = newSVsv (AvARRAY ((AV *)SvRV (self))[0]);
4143 OUTPUT: 4258 OUTPUT:
4144 RETVAL 4259 RETVAL
4145 4260
4146void 4261void
4147up (SV *self, int adjust = 1) 4262up (SV *self)
4148 ALIAS:
4149 adjust = 1
4150 CODE: 4263 CODE:
4264 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), 1);
4265
4266void
4267adjust (SV *self, int adjust)
4268 CODE:
4151 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), ix ? adjust : 1); 4269 coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), adjust);
4152 4270
4153void 4271void
4154down (...) 4272down (...)
4155 CODE: 4273 CODE:
4156 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down); 4274 CORO_EXECUTE_SLF_XS (slf_init_semaphore_down);
4178 XSRETURN_NO; 4296 XSRETURN_NO;
4179} 4297}
4180 4298
4181void 4299void
4182waiters (SV *self) 4300waiters (SV *self)
4183 PPCODE: 4301 PPCODE:
4184{ 4302{
4185 AV *av = (AV *)SvRV (self); 4303 AV *av = (AV *)SvRV (self);
4186 int wcount = AvFILLp (av) + 1 - 1; 4304 int wcount = AvFILLp (av) + 1 - 1;
4187 4305
4188 if (GIMME_V == G_SCALAR) 4306 if (GIMME_V == G_SCALAR)
4200 4318
4201void 4319void
4202_may_delete (SV *sem, int count, unsigned int extra_refs) 4320_may_delete (SV *sem, int count, unsigned int extra_refs)
4203 PPCODE: 4321 PPCODE:
4204{ 4322{
4205 AV *av = (AV *)SvRV (sem); 4323 AV *av = (AV *)SvRV (sem);
4206 4324
4207 if (SvREFCNT ((SV *)av) == 1 + extra_refs 4325 if (SvREFCNT ((SV *)av) == 1 + extra_refs
4208 && AvFILLp (av) == 0 /* no waiters, just count */ 4326 && AvFILLp (av) == 0 /* no waiters, just count */
4209 && SvIV (AvARRAY (av)[0]) == count) 4327 && SvIV (AvARRAY (av)[0]) == count)
4210 XSRETURN_YES; 4328 XSRETURN_YES;
4231 4349
4232void 4350void
4233broadcast (SV *self) 4351broadcast (SV *self)
4234 CODE: 4352 CODE:
4235{ 4353{
4236 AV *av = (AV *)SvRV (self); 4354 AV *av = (AV *)SvRV (self);
4237 coro_signal_wake (aTHX_ av, AvFILLp (av)); 4355 coro_signal_wake (aTHX_ av, AvFILLp (av));
4238} 4356}
4239 4357
4240void 4358void
4241send (SV *self) 4359send (SV *self)
4249 SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */ 4367 SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */
4250} 4368}
4251 4369
4252IV 4370IV
4253awaited (SV *self) 4371awaited (SV *self)
4254 CODE: 4372 CODE:
4255 RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1; 4373 RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1;
4256 OUTPUT: 4374 OUTPUT:
4257 RETVAL 4375 RETVAL
4258 4376
4259 4377
4264 4382
4265void 4383void
4266_schedule (...) 4384_schedule (...)
4267 CODE: 4385 CODE:
4268{ 4386{
4269 static int incede; 4387 static int incede;
4270 4388
4271 api_cede_notself (aTHX); 4389 api_cede_notself (aTHX);
4272 4390
4273 ++incede; 4391 ++incede;
4274 while (coro_nready >= incede && api_cede (aTHX)) 4392 while (coro_nready >= incede && api_cede (aTHX))
4318 { 4436 {
4319 PL_ppaddr [OP_SSELECT] = coro_old_pp_sselect; 4437 PL_ppaddr [OP_SSELECT] = coro_old_pp_sselect;
4320 coro_old_pp_sselect = 0; 4438 coro_old_pp_sselect = 0;
4321 } 4439 }
4322 4440
4441MODULE = Coro::State PACKAGE = Coro::Util
4442
4443void
4444_exit (int code)
4445 CODE:
4446 _exit (code);
4447
4448NV
4449time ()
4450 CODE:
4451 RETVAL = nvtime (aTHX);
4452 OUTPUT:
4453 RETVAL
4454
4455NV
4456gettimeofday ()
4457 PPCODE:
4458{
4459 UV tv [2];
4460 u2time (aTHX_ tv);
4461 EXTEND (SP, 2);
4462 PUSHs (sv_2mortal (newSVuv (tv [0])));
4463 PUSHs (sv_2mortal (newSVuv (tv [1])));
4464}
4465

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines