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.424 by root, Fri Nov 30 19:27:28 2012 UTC vs.
Revision 1.450 by root, Sun Jun 28 22:31:03 2015 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
26#ifndef SVs_PADSTALE 27#ifndef SVs_PADSTALE
27# define SVs_PADSTALE 0 28# define SVs_PADSTALE 0
29#endif
30
31#ifdef PadARRAY
32# define NEWPADAPI 1
33# define newPADLIST(var) (Newz (0, var, 1, PADLIST), Newx (PadlistARRAY (var), 2, PAD *))
34#else
35typedef AV PADNAMELIST;
36# if !PERL_VERSION_ATLEAST(5,8,0)
37typedef AV PADLIST;
38typedef AV PAD;
39# endif
40# define PadlistARRAY(pl) ((PAD **)AvARRAY (pl))
41# define PadlistMAX(pl) AvFILLp (pl)
42# define PadlistNAMES(pl) (*PadlistARRAY (pl))
43# define PadARRAY AvARRAY
44# define PadMAX AvFILLp
45# define newPADLIST(var) ((var) = newAV (), av_extend (var, 1))
46#endif
47#ifndef PadnamelistREFCNT
48# define PadnamelistREFCNT(pnl) SvREFCNT (pnl)
49#endif
50#ifndef PadnamelistREFCNT_dec
51# define PadnamelistREFCNT_dec(pnl) SvREFCNT_dec (pnl)
52#endif
53
54/* 5.19.something has replaced SVt_BIND by SVt_INVLIST */
55/* we just alias it to SVt_IV, as that is sufficient for swap_sv for now */
56#if PERL_VERSION_ATLEAST(5,19,0)
57# define SVt_BIND SVt_IV
28#endif 58#endif
29 59
30#if defined(_WIN32) 60#if defined(_WIN32)
31# undef HAS_GETTIMEOFDAY 61# undef HAS_GETTIMEOFDAY
32# undef setjmp 62# undef setjmp
… …
35# define setjmp _setjmp /* deep magic */ 65# define setjmp _setjmp /* deep magic */
36#else 66#else
37# include <inttypes.h> /* most portable stdint.h */ 67# include <inttypes.h> /* most portable stdint.h */
38#endif 68#endif
39 69
40#if HAVE_MMAP
41# include <unistd.h>
42# include <sys/mman.h>
43# ifndef MAP_ANONYMOUS
44# ifdef MAP_ANON
45# define MAP_ANONYMOUS MAP_ANON
46# else
47# undef HAVE_MMAP
48# endif
49# endif
50# include <limits.h>
51# ifndef PAGESIZE
52# define PAGESIZE pagesize
53# define BOOT_PAGESIZE pagesize = sysconf (_SC_PAGESIZE)
54static long pagesize;
55# else
56# define BOOT_PAGESIZE (void)0
57# endif
58#else
59# define PAGESIZE 0
60# define BOOT_PAGESIZE (void)0
61#endif
62
63#if CORO_USE_VALGRIND
64# include <valgrind/valgrind.h>
65#endif
66
67/* the maximum number of idle cctx that will be pooled */ 70/* the maximum number of idle cctx that will be pooled */
68static int cctx_max_idle = 4; 71static int cctx_max_idle = 4;
69 72
70#if defined(DEBUGGING) && PERL_VERSION_ATLEAST(5,12,0) 73#if defined(DEBUGGING) && PERL_VERSION_ATLEAST(5,12,0)
71# define HAS_SCOPESTACK_NAME 1 74# define HAS_SCOPESTACK_NAME 1
72#endif
73
74#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
75# undef CORO_STACKGUARD
76#endif
77
78#ifndef CORO_STACKGUARD
79# define CORO_STACKGUARD 0
80#endif 75#endif
81 76
82/* prefer perl internal functions over our own? */ 77/* prefer perl internal functions over our own? */
83#ifndef CORO_PREFER_PERL_FUNCTIONS 78#ifndef CORO_PREFER_PERL_FUNCTIONS
84# define CORO_PREFER_PERL_FUNCTIONS 0 79# define CORO_PREFER_PERL_FUNCTIONS 0
… …
175typedef struct coro_cctx 170typedef struct coro_cctx
176{ 171{
177 struct coro_cctx *next; 172 struct coro_cctx *next;
178 173
179 /* the stack */ 174 /* the stack */
180 void *sptr; 175 struct coro_stack stack;
181 size_t ssize;
182 176
183 /* cpu state */ 177 /* cpu state */
184 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 178 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
185#ifndef NDEBUG 179#ifndef NDEBUG
186 JMPENV *idle_te; /* same as idle_sp, but for top_env */ 180 JMPENV *idle_te; /* same as idle_sp, but for top_env */
… …
254 SV *saved_deffh; 248 SV *saved_deffh;
255 SV *invoke_cb; 249 SV *invoke_cb;
256 AV *invoke_av; 250 AV *invoke_av;
257 251
258 /* on_enter/on_leave */ 252 /* on_enter/on_leave */
259 AV *on_enter; 253 AV *on_enter; AV *on_enter_xs;
260 AV *on_leave; 254 AV *on_leave; AV *on_leave_xs;
261 255
262 /* swap_sv */ 256 /* swap_sv */
263 AV *swap_sv; 257 AV *swap_sv;
264 258
265 /* times */ 259 /* times */
… …
295#define coro_nready coroapi.nready 289#define coro_nready coroapi.nready
296 290
297/** JIT *********************************************************************/ 291/** JIT *********************************************************************/
298 292
299#if CORO_JIT 293#if CORO_JIT
300 /* APPLE doesn't have HAVE_MMAP though */ 294 /* APPLE doesn't have mmap though */
301 #define CORO_JIT_UNIXY (__linux || __FreeBSD__ || __OpenBSD__ || __NetBSD__ || __solaris || __APPLE__) 295 #define CORO_JIT_UNIXY (__linux || __FreeBSD__ || __OpenBSD__ || __NetBSD__ || __solaris || __APPLE__)
302 #ifndef CORO_JIT_TYPE 296 #ifndef CORO_JIT_TYPE
303 #if __x86_64 && CORO_JIT_UNIXY 297 #if ECB_AMD64 && CORO_JIT_UNIXY
304 #define CORO_JIT_TYPE "amd64-unix" 298 #define CORO_JIT_TYPE "amd64-unix"
305 #elif __i386 && CORO_JIT_UNIXY 299 #elif __i386 && CORO_JIT_UNIXY
306 #define CORO_JIT_TYPE "x86-unix" 300 #define CORO_JIT_TYPE "x86-unix"
307 #endif 301 #endif
308 #endif 302 #endif
309#endif 303#endif
310 304
311#if !defined(CORO_JIT_TYPE) || !HAVE_MMAP 305#if !defined(CORO_JIT_TYPE) || _POSIX_MEMORY_PROTECTION <= 0
312 #undef CORO_JIT 306 #undef CORO_JIT
313#endif 307#endif
314 308
315#if CORO_JIT 309#if CORO_JIT
316 typedef void (*load_save_perl_slots_type)(perl_slots *); 310 typedef void (*load_save_perl_slots_type)(perl_slots *);
… …
501 495
502 return 0; 496 return 0;
503} 497}
504 498
505ecb_inline struct coro * 499ecb_inline struct coro *
506SvSTATE_ (pTHX_ SV *coro) 500SvSTATE_ (pTHX_ SV *coro_sv)
507{ 501{
508 MAGIC *mg; 502 MAGIC *mg;
509 503
510 if (SvROK (coro)) 504 if (SvROK (coro_sv))
511 coro = SvRV (coro); 505 coro_sv = SvRV (coro_sv);
512 506
513 mg = SvSTATEhv_p (aTHX_ coro); 507 mg = SvSTATEhv_p (aTHX_ coro_sv);
514 if (!mg) 508 if (!mg)
515 croak ("Coro::State object required"); 509 croak ("Coro::State object required");
516 510
517 return (struct coro *)mg->mg_ptr; 511 return (struct coro *)mg->mg_ptr;
518} 512}
… …
524#define SvSTATE_current SvSTATE_hv (SvRV (coro_current)) 518#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
525 519
526/*****************************************************************************/ 520/*****************************************************************************/
527/* padlist management and caching */ 521/* padlist management and caching */
528 522
529ecb_inline AV * 523ecb_inline PADLIST *
530coro_derive_padlist (pTHX_ CV *cv) 524coro_derive_padlist (pTHX_ CV *cv)
531{ 525{
532 AV *padlist = CvPADLIST (cv); 526 PADLIST *padlist = CvPADLIST (cv);
533 AV *newpadlist, *newpad; 527 PADLIST *newpadlist;
528 PADNAMELIST *padnames;
529 PAD *newpad;
530 PADOFFSET off = PadlistMAX (padlist) + 1;
534 531
535 newpadlist = newAV (); 532#if NEWPADAPI
533
534 /* if we had the original CvDEPTH, we might be able to steal the CvDEPTH+1 entry instead */
535 /* 20131102194744.GA6705@schmorp.de, 20131102195825.2013.qmail@lists-nntp.develooper.com */
536 while (!PadlistARRAY (padlist)[off - 1])
537 --off;
538
539 Perl_pad_push (aTHX_ padlist, off);
540
541 newpad = PadlistARRAY (padlist)[off];
542 PadlistARRAY (padlist)[off] = 0;
543
544#else
545
546#if PERL_VERSION_ATLEAST (5,10,0)
547 Perl_pad_push (aTHX_ padlist, off);
548#else
549 Perl_pad_push (aTHX_ padlist, off, 1);
550#endif
551
552 newpad = PadlistARRAY (padlist)[off];
553 PadlistMAX (padlist) = off - 1;
554
555#endif
556
557 newPADLIST (newpadlist);
558#if !PERL_VERSION_ATLEAST(5,15,3)
559 /* Padlists are AvREAL as of 5.15.3. See perl bug #98092 and perl commit 7d953ba. */
536 AvREAL_off (newpadlist); 560 AvREAL_off (newpadlist);
537#if PERL_VERSION_ATLEAST (5,10,0)
538 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
539#else
540 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
541#endif 561#endif
542 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
543 --AvFILLp (padlist);
544 562
545 av_store (newpadlist, 0, SvREFCNT_inc_NN (AvARRAY (padlist)[0])); 563 /* Already extended to 2 elements by newPADLIST. */
546 av_store (newpadlist, 1, (SV *)newpad); 564 PadlistMAX (newpadlist) = 1;
565
566 padnames = PadlistNAMES (padlist);
567 ++PadnamelistREFCNT (padnames);
568 PadlistNAMES (newpadlist) = padnames;
569
570 PadlistARRAY (newpadlist)[1] = newpad;
547 571
548 return newpadlist; 572 return newpadlist;
549} 573}
550 574
551ecb_inline void 575ecb_inline void
552free_padlist (pTHX_ AV *padlist) 576free_padlist (pTHX_ PADLIST *padlist)
553{ 577{
554 /* may be during global destruction */ 578 /* may be during global destruction */
555 if (!IN_DESTRUCT) 579 if (!IN_DESTRUCT)
556 { 580 {
557 I32 i = AvFILLp (padlist); 581 I32 i = PadlistMAX (padlist);
558 582
559 while (i > 0) /* special-case index 0 */ 583 while (i > 0) /* special-case index 0 */
560 { 584 {
561 /* we try to be extra-careful here */ 585 /* we try to be extra-careful here */
562 AV *av = (AV *)AvARRAY (padlist)[i--]; 586 PAD *pad = PadlistARRAY (padlist)[i--];
563 I32 j = AvFILLp (av);
564 587
588 if (pad)
589 {
590 I32 j = PadMAX (pad);
591
565 while (j >= 0) 592 while (j >= 0)
566 SvREFCNT_dec (AvARRAY (av)[j--]); 593 SvREFCNT_dec (PadARRAY (pad)[j--]);
567 594
568 AvFILLp (av) = -1; 595 PadMAX (pad) = -1;
569 SvREFCNT_dec (av); 596 SvREFCNT_dec (pad);
597 }
570 } 598 }
571 599
572 SvREFCNT_dec (AvARRAY (padlist)[0]); 600 PadnamelistREFCNT_dec (PadlistNAMES (padlist));
573 601
602#if NEWPADAPI
603 Safefree (PadlistARRAY (padlist));
604 Safefree (padlist);
605#else
574 AvFILLp (padlist) = -1; 606 AvFILLp (padlist) = -1;
607 AvREAL_off (padlist);
575 SvREFCNT_dec ((SV*)padlist); 608 SvREFCNT_dec ((SV*)padlist);
609#endif
576 } 610 }
577} 611}
578 612
579static int 613static int
580coro_cv_free (pTHX_ SV *sv, MAGIC *mg) 614coro_cv_free (pTHX_ SV *sv, MAGIC *mg)
581{ 615{
582 AV *padlist; 616 PADLIST *padlist;
583 AV *av = (AV *)mg->mg_obj; 617 PADLIST **padlists = (PADLIST **)(mg->mg_ptr + sizeof(size_t));
618 size_t len = *(size_t *)mg->mg_ptr;
584 619
585 /* perl manages to free our internal AV and _then_ call us */ 620 /* perl manages to free our internal AV and _then_ call us */
586 if (IN_DESTRUCT) 621 if (IN_DESTRUCT)
587 return 0; 622 return 0;
588 623
589 /* casting is fun. */ 624 while (len--)
590 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))
591 free_padlist (aTHX_ padlist); 625 free_padlist (aTHX_ padlists[len]);
592
593 SvREFCNT_dec (av); /* sv_magicext increased the refcount */
594 626
595 return 0; 627 return 0;
596} 628}
597 629
598static MGVTBL coro_cv_vtbl = { 630static MGVTBL coro_cv_vtbl = {
… …
603/* the next two functions merely cache the padlists */ 635/* the next two functions merely cache the padlists */
604ecb_inline void 636ecb_inline void
605get_padlist (pTHX_ CV *cv) 637get_padlist (pTHX_ CV *cv)
606{ 638{
607 MAGIC *mg = CORO_MAGIC_cv (cv); 639 MAGIC *mg = CORO_MAGIC_cv (cv);
608 AV *av; 640 size_t *lenp;
609 641
610 if (ecb_expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)) 642 if (ecb_expect_true (mg && *(lenp = (size_t *)mg->mg_ptr)))
611 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--]; 643 CvPADLIST (cv) = ((PADLIST **)(mg->mg_ptr + sizeof(size_t)))[--*lenp];
612 else 644 else
613 { 645 {
614#if CORO_PREFER_PERL_FUNCTIONS 646#if CORO_PREFER_PERL_FUNCTIONS
615 /* this is probably cleaner? but also slower! */ 647 /* this is probably cleaner? but also slower! */
616 /* in practise, it seems to be less stable */ 648 /* in practise, it seems to be less stable */
… …
626 658
627ecb_inline void 659ecb_inline void
628put_padlist (pTHX_ CV *cv) 660put_padlist (pTHX_ CV *cv)
629{ 661{
630 MAGIC *mg = CORO_MAGIC_cv (cv); 662 MAGIC *mg = CORO_MAGIC_cv (cv);
631 AV *av;
632 663
633 if (ecb_expect_false (!mg)) 664 if (ecb_expect_false (!mg))
665 {
634 mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0); 666 mg = sv_magicext ((SV *)cv, 0, CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
667 Newz (0, mg->mg_ptr ,sizeof (size_t) + sizeof (PADLIST *), char);
668 mg->mg_len = 1; /* so mg_free frees mg_ptr */
669 }
670 else
671 Renew (mg->mg_ptr,
672 sizeof(size_t) + (*(size_t *)mg->mg_ptr + 1) * sizeof(PADLIST *),
673 char);
635 674
636 av = (AV *)mg->mg_obj; 675 ((PADLIST **)(mg->mg_ptr + sizeof (size_t))) [(*(size_t *)mg->mg_ptr)++] = CvPADLIST (cv);
637
638 if (ecb_expect_false (AvFILLp (av) >= AvMAX (av)))
639 av_extend (av, AvFILLp (av) + 1);
640
641 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
642} 676}
643 677
644/** load & save, init *******************************************************/ 678/** load & save, init *******************************************************/
645 679
646ecb_inline void 680ecb_inline void
… …
721 /* now do the ugly restore mess */ 755 /* now do the ugly restore mess */
722 while (ecb_expect_true (cv = (CV *)POPs)) 756 while (ecb_expect_true (cv = (CV *)POPs))
723 { 757 {
724 put_padlist (aTHX_ cv); /* mark this padlist as available */ 758 put_padlist (aTHX_ cv); /* mark this padlist as available */
725 CvDEPTH (cv) = PTR2IV (POPs); 759 CvDEPTH (cv) = PTR2IV (POPs);
726 CvPADLIST (cv) = (AV *)POPs; 760 CvPADLIST (cv) = (PADLIST *)POPs;
727 } 761 }
728 762
729 PUTBACK; 763 PUTBACK;
730 } 764 }
731 765
… …
746 780
747 for (i = 0; i <= AvFILLp (c->on_enter); ++i) 781 for (i = 0; i <= AvFILLp (c->on_enter); ++i)
748 on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]); 782 on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);
749 } 783 }
750 784
785 if (ecb_expect_false (c->on_enter_xs))
786 {
787 int i;
788
789 for (i = 0; i <= AvFILLp (c->on_enter_xs); i += 2)
790 ((coro_enterleave_hook)AvARRAY (c->on_enter_xs)[i]) (aTHX_ AvARRAY (c->on_enter_xs)[i + 1]);
791 }
792
751 SWAP_SVS (c); 793 SWAP_SVS (c);
752} 794}
753 795
754static void 796static void
755save_perl (pTHX_ Coro__State c) 797save_perl (pTHX_ Coro__State c)
756{ 798{
757 SWAP_SVS (c); 799 SWAP_SVS (c);
800
801 if (ecb_expect_false (c->on_leave_xs))
802 {
803 int i;
804
805 for (i = AvFILLp (c->on_leave_xs) - 1; i >= 0; i -= 2)
806 ((coro_enterleave_hook)AvARRAY (c->on_leave_xs)[i]) (aTHX_ AvARRAY (c->on_leave_xs)[i + 1]);
807 }
758 808
759 if (ecb_expect_false (c->on_leave)) 809 if (ecb_expect_false (c->on_leave))
760 { 810 {
761 int i; 811 int i;
762 812
… …
1115 1165
1116 GvSV (PL_defgv) = newSV (0); 1166 GvSV (PL_defgv) = newSV (0);
1117 GvAV (PL_defgv) = coro->args; coro->args = 0; 1167 GvAV (PL_defgv) = coro->args; coro->args = 0;
1118 GvSV (PL_errgv) = newSV (0); 1168 GvSV (PL_errgv) = newSV (0);
1119 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0); 1169 GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
1120 GvHV (PL_hintgv) = 0; 1170 GvHV (PL_hintgv) = newHV ();
1171#if PERL_VERSION_ATLEAST (5,10,0)
1172 hv_magic (GvHV (PL_hintgv), 0, PERL_MAGIC_hints);
1173#endif
1121 PL_rs = newSVsv (GvSV (irsgv)); 1174 PL_rs = newSVsv (GvSV (irsgv));
1122 PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv); 1175 PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);
1123 1176
1124 { 1177 {
1125 dSP; 1178 dSP;
… …
1235 1288
1236 SvREFCNT_dec (coro->saved_deffh); 1289 SvREFCNT_dec (coro->saved_deffh);
1237 SvREFCNT_dec (coro->rouse_cb); 1290 SvREFCNT_dec (coro->rouse_cb);
1238 SvREFCNT_dec (coro->invoke_cb); 1291 SvREFCNT_dec (coro->invoke_cb);
1239 SvREFCNT_dec (coro->invoke_av); 1292 SvREFCNT_dec (coro->invoke_av);
1293 SvREFCNT_dec (coro->on_enter_xs);
1294 SvREFCNT_dec (coro->on_leave_xs);
1240 } 1295 }
1241} 1296}
1242 1297
1243ecb_inline void 1298ecb_inline void
1244free_coro_mortal (pTHX) 1299free_coro_mortal (pTHX)
… …
1307 1362
1308 if (PL_curcop != &PL_compiling) 1363 if (PL_curcop != &PL_compiling)
1309 { 1364 {
1310 SV **cb; 1365 SV **cb;
1311 1366
1312 if (oldcxix != cxstack_ix && cctx_current->flags & CC_TRACE_SUB) 1367 if (oldcxix != cxstack_ix && cctx_current->flags & CC_TRACE_SUB && cxstack_ix >= 0)
1313 { 1368 {
1314 PERL_CONTEXT *cx = &cxstack[cxstack_ix]; 1369 PERL_CONTEXT *cx = &cxstack[cxstack_ix];
1315 1370
1316 if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix) 1371 if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)
1317 { 1372 {
… …
1489static coro_cctx * 1544static coro_cctx *
1490cctx_new_empty (void) 1545cctx_new_empty (void)
1491{ 1546{
1492 coro_cctx *cctx = cctx_new (); 1547 coro_cctx *cctx = cctx_new ();
1493 1548
1494 cctx->sptr = 0; 1549 cctx->stack.sptr = 0;
1495 coro_create (&cctx->cctx, 0, 0, 0, 0); 1550 coro_create (&cctx->cctx, 0, 0, 0, 0);
1496 1551
1497 return cctx; 1552 return cctx;
1498} 1553}
1499 1554
1500/* create a new cctx suitable as destination/running a perl interpreter */ 1555/* create a new cctx suitable as destination/running a perl interpreter */
1501static coro_cctx * 1556static coro_cctx *
1502cctx_new_run (void) 1557cctx_new_run (void)
1503{ 1558{
1504 coro_cctx *cctx = cctx_new (); 1559 coro_cctx *cctx = cctx_new ();
1505 void *stack_start;
1506 size_t stack_size;
1507 1560
1508#if HAVE_MMAP 1561 if (!coro_stack_alloc (&cctx->stack, cctx_stacksize))
1509 cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
1510 /* mmap supposedly does allocate-on-write for us */
1511 cctx->sptr = mmap (0, cctx->ssize, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS, -1, 0);
1512
1513 if (cctx->sptr != (void *)-1)
1514 {
1515 #if CORO_STACKGUARD
1516 mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);
1517 #endif
1518 stack_start = (char *)cctx->sptr + CORO_STACKGUARD * PAGESIZE;
1519 stack_size = cctx->ssize - CORO_STACKGUARD * PAGESIZE;
1520 cctx->flags |= CC_MAPPED;
1521 } 1562 {
1522 else
1523#endif
1524 {
1525 cctx->ssize = cctx_stacksize * (long)sizeof (long);
1526 New (0, cctx->sptr, cctx_stacksize, long);
1527
1528 if (!cctx->sptr)
1529 {
1530 perror ("FATAL: unable to allocate stack for coroutine, exiting."); 1563 perror ("FATAL: unable to allocate stack for coroutine, exiting.");
1531 _exit (EXIT_FAILURE); 1564 _exit (EXIT_FAILURE);
1532 }
1533
1534 stack_start = cctx->sptr;
1535 stack_size = cctx->ssize;
1536 } 1565 }
1537 1566
1538 #if CORO_USE_VALGRIND
1539 cctx->valgrind_id = VALGRIND_STACK_REGISTER ((char *)stack_start, (char *)stack_start + stack_size);
1540 #endif
1541
1542 coro_create (&cctx->cctx, cctx_run, (void *)cctx, stack_start, stack_size); 1567 coro_create (&cctx->cctx, cctx_run, (void *)cctx, cctx->stack.sptr, cctx->stack.ssze);
1543 1568
1544 return cctx; 1569 return cctx;
1545} 1570}
1546 1571
1547static void 1572static void
… …
1553 assert (("FATAL: tried to destroy current cctx", cctx != cctx_current)); 1578 assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));
1554 1579
1555 --cctx_count; 1580 --cctx_count;
1556 coro_destroy (&cctx->cctx); 1581 coro_destroy (&cctx->cctx);
1557 1582
1558 /* coro_transfer creates new, empty cctx's */ 1583 coro_stack_free (&cctx->stack);
1559 if (cctx->sptr)
1560 {
1561 #if CORO_USE_VALGRIND
1562 VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);
1563 #endif
1564
1565#if HAVE_MMAP
1566 if (cctx->flags & CC_MAPPED)
1567 munmap (cctx->sptr, cctx->ssize);
1568 else
1569#endif
1570 Safefree (cctx->sptr);
1571 }
1572 1584
1573 Safefree (cctx); 1585 Safefree (cctx);
1574} 1586}
1575 1587
1576/* wether this cctx should be destructed */ 1588/* wether this cctx should be destructed */
… …
1595} 1607}
1596 1608
1597static void 1609static void
1598cctx_put (coro_cctx *cctx) 1610cctx_put (coro_cctx *cctx)
1599{ 1611{
1600 assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr)); 1612 assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->stack.sptr));
1601 1613
1602 /* free another cctx if overlimit */ 1614 /* free another cctx if overlimit */
1603 if (ecb_expect_false (cctx_idle >= cctx_max_idle)) 1615 if (ecb_expect_false (cctx_idle >= cctx_max_idle))
1604 { 1616 {
1605 coro_cctx *first = cctx_first; 1617 coro_cctx *first = cctx_first;
… …
1937 /* nothing to schedule: call the idle handler */ 1949 /* nothing to schedule: call the idle handler */
1938 if (SvROK (sv_idle) 1950 if (SvROK (sv_idle)
1939 && SvOBJECT (SvRV (sv_idle))) 1951 && SvOBJECT (SvRV (sv_idle)))
1940 { 1952 {
1941 if (SvRV (sv_idle) == SvRV (coro_current)) 1953 if (SvRV (sv_idle) == SvRV (coro_current))
1954 {
1955 require_pv ("Carp");
1956
1957 {
1958 dSP;
1959
1960 ENTER;
1961 SAVETMPS;
1962
1963 PUSHMARK (SP);
1942 croak ("FATAL: $Coro::IDLE blocked itself - did you try to block inside an event loop callback? Caught"); 1964 XPUSHs (sv_2mortal (newSVpv ("FATAL: $Coro::idle blocked itself - did you try to block inside an event loop callback? Caught", 0)));
1965 PUTBACK;
1966 call_pv ("Carp::confess", G_VOID | G_DISCARD);
1967
1968 FREETMPS;
1969 LEAVE;
1970 }
1971 }
1943 1972
1944 ++coro_nready; /* hack so that api_ready doesn't invoke ready hook */ 1973 ++coro_nready; /* hack so that api_ready doesn't invoke ready hook */
1945 api_ready (aTHX_ SvRV (sv_idle)); 1974 api_ready (aTHX_ SvRV (sv_idle));
1946 --coro_nready; 1975 --coro_nready;
1947 } 1976 }
… …
2145 AV *od = coro->on_destroy; 2174 AV *od = coro->on_destroy;
2146 2175
2147 if (!od) 2176 if (!od)
2148 return; 2177 return;
2149 2178
2179 coro->on_destroy = 0;
2180 sv_2mortal ((SV *)od);
2181
2150 while (AvFILLp (od) >= 0) 2182 while (AvFILLp (od) >= 0)
2151 { 2183 {
2152 SV *cb = sv_2mortal (av_pop (od)); 2184 SV *cb = sv_2mortal (av_pop (od));
2153 2185
2154 /* coro hv's (and only hv's at the moment) are supported as well */ 2186 /* coro hv's (and only hv's at the moment) are supported as well */
… …
2248 slf_init_terminate_cancel_common (aTHX_ frame, coro_hv); 2280 slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
2249 } 2281 }
2250 else 2282 else
2251 { 2283 {
2252 struct coro *self = SvSTATE_current; 2284 struct coro *self = SvSTATE_current;
2285
2286 if (!self)
2287 croak ("Coro::cancel called outside of thread content,");
2253 2288
2254 /* otherwise we cancel directly, purely for speed reasons 2289 /* otherwise we cancel directly, purely for speed reasons
2255 * unfortunately, this requires some magic trickery, as 2290 * unfortunately, this requires some magic trickery, as
2256 * somebody else could cancel us, so we have to fight the cancellation. 2291 * somebody else could cancel us, so we have to fight the cancellation.
2257 * this is ugly, and hopefully fully worth the extra speed. 2292 * this is ugly, and hopefully fully worth the extra speed.
… …
2599 2634
2600/* "undo"/cancel a running slf call - used when cancelling a coro, mainly */ 2635/* "undo"/cancel a running slf call - used when cancelling a coro, mainly */
2601static void 2636static void
2602slf_destroy (pTHX_ struct coro *coro) 2637slf_destroy (pTHX_ struct coro *coro)
2603{ 2638{
2604 /* this callback is reserved for slf functions needing to do cleanup */ 2639 struct CoroSLF frame = coro->slf_frame;
2605 if (coro->slf_frame.destroy && coro->slf_frame.prepare && !PL_dirty)
2606 coro->slf_frame.destroy (aTHX_ &coro->slf_frame);
2607 2640
2608 /* 2641 /*
2609 * The on_destroy above most likely is from an SLF call. 2642 * The on_destroy below most likely is from an SLF call.
2610 * Since by definition the SLF call will not finish when we destroy 2643 * Since by definition the SLF call will not finish when we destroy
2611 * the coro, we will have to force-finish it here, otherwise 2644 * the coro, we will have to force-finish it here, otherwise
2612 * cleanup functions cannot call SLF functions. 2645 * cleanup functions cannot call SLF functions.
2613 */ 2646 */
2614 coro->slf_frame.prepare = 0; 2647 coro->slf_frame.prepare = 0;
2648
2649 /* this callback is reserved for slf functions needing to do cleanup */
2650 if (frame.destroy && frame.prepare && !PL_dirty)
2651 frame.destroy (aTHX_ &frame);
2615} 2652}
2616 2653
2617/* 2654/*
2618 * these not obviously related functions are all rolled into one 2655 * these not obviously related functions are all rolled into one
2619 * function to increase chances that they all will call transfer with the same 2656 * function to increase chances that they all will call transfer with the same
… …
2802static void 2839static void
2803coro_pop_on_leave (pTHX_ void *coro) 2840coro_pop_on_leave (pTHX_ void *coro)
2804{ 2841{
2805 SV *cb = coro_avp_pop_and_free (aTHX_ &((struct coro *)coro)->on_leave); 2842 SV *cb = coro_avp_pop_and_free (aTHX_ &((struct coro *)coro)->on_leave);
2806 on_enterleave_call (aTHX_ sv_2mortal (cb)); 2843 on_enterleave_call (aTHX_ sv_2mortal (cb));
2844}
2845
2846static void
2847enterleave_hook_xs (pTHX_ struct coro *coro, AV **avp, coro_enterleave_hook hook, void *arg)
2848{
2849 if (!hook)
2850 return;
2851
2852 if (!*avp)
2853 {
2854 *avp = newAV ();
2855 AvREAL_off (*avp);
2856 }
2857
2858 av_push (*avp, (SV *)hook);
2859 av_push (*avp, (SV *)arg);
2860}
2861
2862static void
2863enterleave_unhook_xs (pTHX_ struct coro *coro, AV **avp, coro_enterleave_hook hook, int execute)
2864{
2865 AV *av = *avp;
2866 int i;
2867
2868 if (!av)
2869 return;
2870
2871 for (i = AvFILLp (av) - 1; i >= 0; i -= 2)
2872 if (AvARRAY (av)[i] == (SV *)hook)
2873 {
2874 if (execute)
2875 hook ((void *)AvARRAY (av)[i + 1]);
2876
2877 memmove (AvARRAY (av) + i, AvARRAY (av) + i + 2, AvFILLp (av) - i - 1);
2878 av_pop (av);
2879 av_pop (av);
2880 break;
2881 }
2882
2883 if (AvFILLp (av) >= 0)
2884 {
2885 *avp = 0;
2886 SvREFCNT_dec_NN (av);
2887 }
2888}
2889
2890static void
2891api_enterleave_hook (pTHX_ SV *coro_sv, coro_enterleave_hook enter, void *enter_arg, coro_enterleave_hook leave, void *leave_arg)
2892{
2893 struct coro *coro = SvSTATE (coro_sv);
2894
2895 if (SvSTATE_current == coro)
2896 if (enter)
2897 enter (aTHX enter_arg);
2898
2899 enterleave_hook_xs (aTHX_ coro, &coro->on_enter_xs, enter, enter_arg);
2900 enterleave_hook_xs (aTHX_ coro, &coro->on_leave_xs, leave, leave_arg);
2901}
2902
2903static void
2904api_enterleave_unhook (pTHX_ SV *coro_sv, coro_enterleave_hook enter, coro_enterleave_hook leave)
2905{
2906 struct coro *coro = SvSTATE (coro_sv);
2907
2908 enterleave_unhook_xs (aTHX_ coro, &coro->on_enter_xs, enter, 0);
2909 enterleave_unhook_xs (aTHX_ coro, &coro->on_leave_xs, leave, SvSTATE_current == coro);
2910}
2911
2912static void
2913savedestructor_unhook_enter (pTHX_ coro_enterleave_hook enter)
2914{
2915 struct coro *coro = SvSTATE_current;
2916
2917 enterleave_unhook_xs (aTHX_ coro, &coro->on_enter_xs, enter, 0);
2918}
2919
2920static void
2921savedestructor_unhook_leave (pTHX_ coro_enterleave_hook leave)
2922{
2923 struct coro *coro = SvSTATE_current;
2924
2925 enterleave_unhook_xs (aTHX_ coro, &coro->on_leave_xs, leave, 1);
2926}
2927
2928static void
2929api_enterleave_scope_hook (pTHX_ coro_enterleave_hook enter, void *enter_arg, coro_enterleave_hook leave, void *leave_arg)
2930{
2931 api_enterleave_hook (aTHX_ coro_current, enter, enter_arg, leave, leave_arg);
2932
2933 /* this ought to be much cheaper than malloc + a single destructor call */
2934 if (enter) SAVEDESTRUCTOR_X (savedestructor_unhook_enter, enter);
2935 if (leave) SAVEDESTRUCTOR_X (savedestructor_unhook_leave, leave);
2807} 2936}
2808 2937
2809/*****************************************************************************/ 2938/*****************************************************************************/
2810/* PerlIO::cede */ 2939/* PerlIO::cede */
2811 2940
… …
2941 XPUSHs (sv_2mortal (newRV_inc ((SV *)av))); 3070 XPUSHs (sv_2mortal (newRV_inc ((SV *)av)));
2942 PUTBACK; 3071 PUTBACK;
2943 call_sv (cb, G_VOID | G_DISCARD | G_EVAL | G_KEEPERR); 3072 call_sv (cb, G_VOID | G_DISCARD | G_EVAL | G_KEEPERR);
2944 } 3073 }
2945 3074
2946 SvREFCNT_dec (cb); 3075 SvREFCNT_dec_NN (cb);
2947 } 3076 }
2948} 3077}
2949 3078
2950static void 3079static void
2951coro_semaphore_destroy (pTHX_ struct CoroSLF *frame) 3080coro_semaphore_destroy (pTHX_ struct CoroSLF *frame)
… …
2959{ 3088{
2960 AV *av = (AV *)frame->data; 3089 AV *av = (AV *)frame->data;
2961 SV *count_sv = AvARRAY (av)[0]; 3090 SV *count_sv = AvARRAY (av)[0];
2962 SV *coro_hv = SvRV (coro_current); 3091 SV *coro_hv = SvRV (coro_current);
2963 3092
3093 frame->destroy = 0;
3094
2964 /* if we are about to throw, don't actually acquire the lock, just throw */ 3095 /* if we are about to throw, don't actually acquire the lock, just throw */
2965 if (CORO_THROW) 3096 if (ecb_expect_false (CORO_THROW))
3097 {
3098 /* we still might be responsible for the semaphore, so wake up others */
3099 coro_semaphore_adjust (aTHX_ av, 0);
3100
2966 return 0; 3101 return 0;
3102 }
2967 else if (SvIVX (count_sv) > 0) 3103 else if (SvIVX (count_sv) > 0)
2968 { 3104 {
2969 frame->destroy = 0;
2970
2971 if (acquire) 3105 if (acquire)
2972 SvIVX (count_sv) = SvIVX (count_sv) - 1; 3106 SvIVX (count_sv) = SvIVX (count_sv) - 1;
2973 else 3107 else
2974 coro_semaphore_adjust (aTHX_ av, 0); 3108 coro_semaphore_adjust (aTHX_ av, 0);
2975 3109
… …
3086 { 3220 {
3087 api_ready (aTHX_ cb); 3221 api_ready (aTHX_ cb);
3088 sv_setiv (cb, 0); /* signal waiter */ 3222 sv_setiv (cb, 0); /* signal waiter */
3089 } 3223 }
3090 3224
3091 SvREFCNT_dec (cb); 3225 SvREFCNT_dec_NN (cb);
3092 3226
3093 --count; 3227 --count;
3094 } 3228 }
3095} 3229}
3096 3230
… …
3181 } 3315 }
3182 3316
3183 av_push (state, data_sv); 3317 av_push (state, data_sv);
3184 3318
3185 api_ready (aTHX_ coro); 3319 api_ready (aTHX_ coro);
3186 SvREFCNT_dec (coro); 3320 SvREFCNT_dec_NN (coro);
3187 SvREFCNT_dec ((AV *)state); 3321 SvREFCNT_dec_NN ((AV *)state);
3188} 3322}
3189 3323
3190static int 3324static int
3191slf_check_aio_req (pTHX_ struct CoroSLF *frame) 3325slf_check_aio_req (pTHX_ struct CoroSLF *frame)
3192{ 3326{
… …
3197 /* it quickly returns */ 3331 /* it quickly returns */
3198 if (CORO_THROW) 3332 if (CORO_THROW)
3199 return 0; 3333 return 0;
3200 3334
3201 /* one element that is an RV? repeat! */ 3335 /* one element that is an RV? repeat! */
3202 if (AvFILLp (state) == 0 && SvROK (AvARRAY (state)[0])) 3336 if (AvFILLp (state) == 0 && SvTYPE (AvARRAY (state)[0]) != SVt_PV)
3203 return 1; 3337 return 1;
3204 3338
3205 /* restore status */ 3339 /* restore status */
3206 { 3340 {
3207 SV *data_sv = av_pop (state); 3341 SV *data_sv = av_pop (state);
… …
3210 errno = data->errorno; 3344 errno = data->errorno;
3211 PL_laststype = data->laststype; 3345 PL_laststype = data->laststype;
3212 PL_laststatval = data->laststatval; 3346 PL_laststatval = data->laststatval;
3213 PL_statcache = data->statcache; 3347 PL_statcache = data->statcache;
3214 3348
3215 SvREFCNT_dec (data_sv); 3349 SvREFCNT_dec_NN (data_sv);
3216 } 3350 }
3217 3351
3218 /* push result values */ 3352 /* push result values */
3219 { 3353 {
3220 dSP; 3354 dSP;
… …
3435 3569
3436PROTOTYPES: DISABLE 3570PROTOTYPES: DISABLE
3437 3571
3438BOOT: 3572BOOT:
3439{ 3573{
3574#define VARx(name,expr,type) if (sizeof (type) < sizeof (expr)) croak ("FATAL: Coro thread context slot '" # name "' too small for this version of perl.");
3575#include "state.h"
3440#ifdef USE_ITHREADS 3576#ifdef USE_ITHREADS
3441# if CORO_PTHREAD 3577# if CORO_PTHREAD
3442 coro_thx = PERL_GET_CONTEXT; 3578 coro_thx = PERL_GET_CONTEXT;
3443# endif 3579# endif
3444#endif 3580#endif
3445 BOOT_PAGESIZE;
3446
3447 /* perl defines these to check for existance first, but why it doesn't */ 3581 /* perl defines these to check for existance first, but why it doesn't */
3448 /* just create them one at init time is not clear to me, except for */ 3582 /* just create them one at init time is not clear to me, except for */
3449 /* programs trying to delete them, but... */ 3583 /* programs trying to delete them, but... */
3450 /* anyway, we declare this as invalid and make sure they are initialised here */ 3584 /* anyway, we declare this as invalid and make sure they are initialised here */
3451 DEFSV; 3585 DEFSV;
… …
3521void 3655void
3522transfer (...) 3656transfer (...)
3523 PROTOTYPE: $$ 3657 PROTOTYPE: $$
3524 CODE: 3658 CODE:
3525 CORO_EXECUTE_SLF_XS (slf_init_transfer); 3659 CORO_EXECUTE_SLF_XS (slf_init_transfer);
3526
3527void
3528_exit (int code)
3529 PROTOTYPE: $
3530 CODE:
3531 _exit (code);
3532 3660
3533SV * 3661SV *
3534clone (Coro::State coro) 3662clone (Coro::State coro)
3535 CODE: 3663 CODE:
3536{ 3664{
… …
3591void 3719void
3592list () 3720list ()
3593 PROTOTYPE: 3721 PROTOTYPE:
3594 PPCODE: 3722 PPCODE:
3595{ 3723{
3596 struct coro *coro; 3724 struct coro *coro;
3597 for (coro = coro_first; coro; coro = coro->next) 3725 for (coro = coro_first; coro; coro = coro->next)
3598 if (coro->hv) 3726 if (coro->hv)
3599 XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv))); 3727 XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv)));
3600} 3728}
3601 3729
… …
3763 3891
3764void 3892void
3765times (Coro::State self) 3893times (Coro::State self)
3766 PPCODE: 3894 PPCODE:
3767{ 3895{
3768 struct coro *current = SvSTATE (coro_current); 3896 struct coro *current = SvSTATE (coro_current);
3769 3897
3770 if (ecb_expect_false (current == self)) 3898 if (ecb_expect_false (current == self))
3771 { 3899 {
3772 coro_times_update (); 3900 coro_times_update ();
3773 coro_times_add (SvSTATE (coro_current)); 3901 coro_times_add (SvSTATE (coro_current));
… …
3838 coroapi.ready = api_ready; 3966 coroapi.ready = api_ready;
3839 coroapi.is_ready = api_is_ready; 3967 coroapi.is_ready = api_is_ready;
3840 coroapi.nready = coro_nready; 3968 coroapi.nready = coro_nready;
3841 coroapi.current = coro_current; 3969 coroapi.current = coro_current;
3842 3970
3971 coroapi.enterleave_hook = api_enterleave_hook;
3972 coroapi.enterleave_unhook = api_enterleave_unhook;
3973 coroapi.enterleave_scope_hook = api_enterleave_scope_hook;
3974
3843 /*GCoroAPI = &coroapi;*/ 3975 /*GCoroAPI = &coroapi;*/
3844 sv_setiv (sv, (IV)&coroapi); 3976 sv_setiv (sv, (IV)&coroapi);
3845 SvREADONLY_on (sv); 3977 SvREADONLY_on (sv);
3846 } 3978 }
3847} 3979}
… …
3912 4044
3913void 4045void
3914_set_current (SV *current) 4046_set_current (SV *current)
3915 PROTOTYPE: $ 4047 PROTOTYPE: $
3916 CODE: 4048 CODE:
3917 SvREFCNT_dec (SvRV (coro_current)); 4049 SvREFCNT_dec_NN (SvRV (coro_current));
3918 SvRV_set (coro_current, SvREFCNT_inc_NN (SvRV (current))); 4050 SvRV_set (coro_current, SvREFCNT_inc_NN (SvRV (current)));
3919 4051
3920void 4052void
3921_set_readyhook (SV *hook) 4053_set_readyhook (SV *hook)
3922 PROTOTYPE: $ 4054 PROTOTYPE: $
… …
4006 4138
4007 if ((SV *)hv == &PL_sv_undef) 4139 if ((SV *)hv == &PL_sv_undef)
4008 { 4140 {
4009 SV *sv = coro_new (aTHX_ coro_stash, (SV **)&cv_pool_handler, 1, 1); 4141 SV *sv = coro_new (aTHX_ coro_stash, (SV **)&cv_pool_handler, 1, 1);
4010 hv = (HV *)SvREFCNT_inc_NN (SvRV (sv)); 4142 hv = (HV *)SvREFCNT_inc_NN (SvRV (sv));
4011 SvREFCNT_dec (sv); 4143 SvREFCNT_dec_NN (sv);
4012 } 4144 }
4013 4145
4014 { 4146 {
4015 struct coro *coro = SvSTATE_hv (hv); 4147 struct coro *coro = SvSTATE_hv (hv);
4016 4148
… …
4023 api_ready (aTHX_ (SV *)hv); 4155 api_ready (aTHX_ (SV *)hv);
4024 4156
4025 if (GIMME_V != G_VOID) 4157 if (GIMME_V != G_VOID)
4026 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv))); 4158 XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));
4027 else 4159 else
4028 SvREFCNT_dec (hv); 4160 SvREFCNT_dec_NN (hv);
4029} 4161}
4030 4162
4031SV * 4163SV *
4032rouse_cb () 4164rouse_cb ()
4033 PROTOTYPE: 4165 PROTOTYPE:
… …
4048 on_leave = 1 4180 on_leave = 1
4049 PROTOTYPE: & 4181 PROTOTYPE: &
4050 CODE: 4182 CODE:
4051{ 4183{
4052 struct coro *coro = SvSTATE_current; 4184 struct coro *coro = SvSTATE_current;
4053 AV **avp = ix ? &coro->on_leave : &coro->on_enter; 4185 AV **avp = ix ? &coro->on_leave : &coro->on_enter;
4054 4186
4055 block = s_get_cv_croak (block); 4187 block = s_get_cv_croak (block);
4056 4188
4057 if (!*avp) 4189 if (!*avp)
4058 *avp = newAV (); 4190 *avp = newAV ();
… …
4078 4210
4079SV * 4211SV *
4080new (SV *klass, SV *count = 0) 4212new (SV *klass, SV *count = 0)
4081 CODE: 4213 CODE:
4082{ 4214{
4083 int semcnt = 1; 4215 int semcnt = 1;
4084 4216
4085 if (count) 4217 if (count)
4086 { 4218 {
4087 SvGETMAGIC (count); 4219 SvGETMAGIC (count);
4088 4220
… …
4148 XSRETURN_NO; 4280 XSRETURN_NO;
4149} 4281}
4150 4282
4151void 4283void
4152waiters (SV *self) 4284waiters (SV *self)
4153 PPCODE: 4285 PPCODE:
4154{ 4286{
4155 AV *av = (AV *)SvRV (self); 4287 AV *av = (AV *)SvRV (self);
4156 int wcount = AvFILLp (av) + 1 - 1; 4288 int wcount = AvFILLp (av) + 1 - 1;
4157 4289
4158 if (GIMME_V == G_SCALAR) 4290 if (GIMME_V == G_SCALAR)
… …
4170 4302
4171void 4303void
4172_may_delete (SV *sem, int count, unsigned int extra_refs) 4304_may_delete (SV *sem, int count, unsigned int extra_refs)
4173 PPCODE: 4305 PPCODE:
4174{ 4306{
4175 AV *av = (AV *)SvRV (sem); 4307 AV *av = (AV *)SvRV (sem);
4176 4308
4177 if (SvREFCNT ((SV *)av) == 1 + extra_refs 4309 if (SvREFCNT ((SV *)av) == 1 + extra_refs
4178 && AvFILLp (av) == 0 /* no waiters, just count */ 4310 && AvFILLp (av) == 0 /* no waiters, just count */
4179 && SvIV (AvARRAY (av)[0]) == count) 4311 && SvIV (AvARRAY (av)[0]) == count)
4180 XSRETURN_YES; 4312 XSRETURN_YES;
… …
4201 4333
4202void 4334void
4203broadcast (SV *self) 4335broadcast (SV *self)
4204 CODE: 4336 CODE:
4205{ 4337{
4206 AV *av = (AV *)SvRV (self); 4338 AV *av = (AV *)SvRV (self);
4207 coro_signal_wake (aTHX_ av, AvFILLp (av)); 4339 coro_signal_wake (aTHX_ av, AvFILLp (av));
4208} 4340}
4209 4341
4210void 4342void
4211send (SV *self) 4343send (SV *self)
… …
4219 SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */ 4351 SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */
4220} 4352}
4221 4353
4222IV 4354IV
4223awaited (SV *self) 4355awaited (SV *self)
4224 CODE: 4356 CODE:
4225 RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1; 4357 RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1;
4226 OUTPUT: 4358 OUTPUT:
4227 RETVAL 4359 RETVAL
4228 4360
4229 4361
… …
4234 4366
4235void 4367void
4236_schedule (...) 4368_schedule (...)
4237 CODE: 4369 CODE:
4238{ 4370{
4239 static int incede; 4371 static int incede;
4240 4372
4241 api_cede_notself (aTHX); 4373 api_cede_notself (aTHX);
4242 4374
4243 ++incede; 4375 ++incede;
4244 while (coro_nready >= incede && api_cede (aTHX)) 4376 while (coro_nready >= incede && api_cede (aTHX))
… …
4288 { 4420 {
4289 PL_ppaddr [OP_SSELECT] = coro_old_pp_sselect; 4421 PL_ppaddr [OP_SSELECT] = coro_old_pp_sselect;
4290 coro_old_pp_sselect = 0; 4422 coro_old_pp_sselect = 0;
4291 } 4423 }
4292 4424
4425MODULE = Coro::State PACKAGE = Coro::Util
4426
4427void
4428_exit (int code)
4429 CODE:
4430 _exit (code);
4431
4432NV
4433time ()
4434 CODE:
4435 RETVAL = nvtime (aTHX);
4436 OUTPUT:
4437 RETVAL
4438
4439NV
4440gettimeofday ()
4441 PPCODE:
4442{
4443 UV tv [2];
4444 u2time (aTHX_ tv);
4445 EXTEND (SP, 2);
4446 PUSHs (sv_2mortal (newSVuv (tv [0])));
4447 PUSHs (sv_2mortal (newSVuv (tv [1])));
4448}
4449

Diff Legend

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