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.261 by root, Mon Nov 10 05:09:30 2008 UTC vs.
Revision 1.266 by root, Fri Nov 14 03:26:22 2008 UTC

… …
46# define BOOT_PAGESIZE (void)0 46# define BOOT_PAGESIZE (void)0
47#endif 47#endif
48 48
49#if CORO_USE_VALGRIND 49#if CORO_USE_VALGRIND
50# include <valgrind/valgrind.h> 50# include <valgrind/valgrind.h>
51# define REGISTER_STACK(cctx,start,end) (cctx)->valgrind_id = VALGRIND_STACK_REGISTER ((start), (end))
52#else
53# define REGISTER_STACK(cctx,start,end)
54#endif 51#endif
55 52
56/* the maximum number of idle cctx that will be pooled */ 53/* the maximum number of idle cctx that will be pooled */
57static int cctx_max_idle = 4; 54static int cctx_max_idle = 4;
58 55
… …
126 123
127#define IN_DESTRUCT (PL_main_cv == Nullcv) 124#define IN_DESTRUCT (PL_main_cv == Nullcv)
128 125
129#if __GNUC__ >= 3 126#if __GNUC__ >= 3
130# define attribute(x) __attribute__(x) 127# define attribute(x) __attribute__(x)
131# define BARRIER __asm__ __volatile__ ("" : : : "memory")
132# define expect(expr,value) __builtin_expect ((expr),(value)) 128# define expect(expr,value) __builtin_expect ((expr),(value))
129# define INLINE static inline
133#else 130#else
134# define attribute(x) 131# define attribute(x)
135# define BARRIER
136# define expect(expr,value) (expr) 132# define expect(expr,value) (expr)
133# define INLINE static
137#endif 134#endif
138 135
139#define expect_false(expr) expect ((expr) != 0, 0) 136#define expect_false(expr) expect ((expr) != 0, 0)
140#define expect_true(expr) expect ((expr) != 0, 1) 137#define expect_true(expr) expect ((expr) != 0, 1)
141 138
… …
413 : 0 410 : 0
414 411
415#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv) 412#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
416#define CORO_MAGIC_state(sv) CORO_MAGIC (((SV *)(sv)), CORO_MAGIC_type_state) 413#define CORO_MAGIC_state(sv) CORO_MAGIC (((SV *)(sv)), CORO_MAGIC_type_state)
417 414
418static struct coro * 415INLINE struct coro *
419SvSTATE_ (pTHX_ SV *coro) 416SvSTATE_ (pTHX_ SV *coro)
420{ 417{
421 HV *stash; 418 HV *stash;
422 MAGIC *mg; 419 MAGIC *mg;
423 420
… …
714 } 711 }
715 712
716 return rss; 713 return rss;
717} 714}
718 715
716/** set stacklevel support **************************************************/
717
718/* we sometimes need to create the effect of pp_set_stacklevel calling us */
719#define SSL_HEAD (void)0
720/* we somtimes need to create the effect of leaving via pp_set_stacklevel */
721#define SSL_TAIL set_stacklevel_tail (aTHX)
722
723INLINE void
724set_stacklevel_tail (pTHX)
725{
726 dSP;
727 SV **bot = SP;
728
729 int gimme = GIMME_V;
730
731 /* make sure we put something on the stack in scalar context */
732 if (gimme == G_SCALAR)
733 {
734 if (sp == bot)
735 XPUSHs (&PL_sv_undef);
736
737 SP = bot + 1;
738 }
739
740 PUTBACK;
741}
742
719/** coroutine stack handling ************************************************/ 743/** coroutine stack handling ************************************************/
720 744
721static int (*orig_sigelem_get) (pTHX_ SV *sv, MAGIC *mg); 745static int (*orig_sigelem_get) (pTHX_ SV *sv, MAGIC *mg);
722static int (*orig_sigelem_set) (pTHX_ SV *sv, MAGIC *mg); 746static int (*orig_sigelem_set) (pTHX_ SV *sv, MAGIC *mg);
723static int (*orig_sigelem_clr) (pTHX_ SV *sv, MAGIC *mg); 747static int (*orig_sigelem_clr) (pTHX_ SV *sv, MAGIC *mg);
… …
855 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 879 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
856 SPAGAIN; 880 SPAGAIN;
857 } 881 }
858 882
859 /* this newly created coroutine might be run on an existing cctx which most 883 /* this newly created coroutine might be run on an existing cctx which most
860 * likely was suspended in set_stacklevel, called from entersub. 884 * likely was suspended in set_stacklevel, called from pp_set_stacklevel,
861 * set_stacklevel doesn't do anything on return, but entersub does LEAVE, 885 * so we have to emulate entering pp_set_stacklevel here.
862 * so we ENTER here for symmetry.
863 */ 886 */
864 ENTER; 887 SSL_HEAD;
865} 888}
866 889
867static void 890static void
868coro_destruct (pTHX_ struct coro *coro) 891coro_destruct (pTHX_ struct coro *coro)
869{ 892{
… …
898 SvREFCNT_dec (coro->throw); 921 SvREFCNT_dec (coro->throw);
899 922
900 coro_destruct_stacks (aTHX); 923 coro_destruct_stacks (aTHX);
901} 924}
902 925
903static void 926INLINE void
904free_coro_mortal (pTHX) 927free_coro_mortal (pTHX)
905{ 928{
906 if (expect_true (coro_mortal)) 929 if (expect_true (coro_mortal))
907 { 930 {
908 SvREFCNT_dec (coro_mortal); 931 SvREFCNT_dec (coro_mortal);
… …
1068 PL_op = (OP *)&myop; 1091 PL_op = (OP *)&myop;
1069 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 1092 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
1070 SPAGAIN; 1093 SPAGAIN;
1071} 1094}
1072 1095
1073/* the tail of transfer: execute stuff we can onyl do afetr a transfer */ 1096/* the tail of transfer: execute stuff we can only do after a transfer */
1074static void 1097INLINE void
1075transfer_tail (void) 1098transfer_tail (pTHX)
1076{ 1099{
1077 struct coro *next = (struct coro *)transfer_next; 1100 struct coro *next = (struct coro *)transfer_next;
1078 transfer_next = 0; //D for temporary assertion in transfer 1101 assert (!(transfer_next = 0)); /* just used for the side effect when asserts are enabled */
1079 assert (("FATAL ERROR: internal error 1067 in Coro module, please report", next));//D 1102 assert (("FATAL: next coroutine was zero in transfer_tail (please report)", next));
1080 1103
1081 free_coro_mortal (aTHX); 1104 free_coro_mortal (aTHX);
1082 UNLOCK; 1105 UNLOCK;
1083 1106
1084 if (expect_false (next->throw)) 1107 if (expect_false (next->throw))
… …
1103# endif 1126# endif
1104#endif 1127#endif
1105 { 1128 {
1106 dTHX; 1129 dTHX;
1107 1130
1108 /* entersub called ENTER, but we never 'returned', undo that here */ 1131 /* we are the alternative tail to pp_set_stacklevel */
1109 LEAVE; 1132 /* so do the same things here */
1133 SSL_TAIL;
1110 1134
1111 /* we now skip the entersub that did lead to transfer() */ 1135 /* we now skip the op that did lead to transfer() */
1112 PL_op = PL_op->op_next; 1136 PL_op = PL_op->op_next;
1113 1137
1114 /* inject a fake subroutine call to cctx_init */ 1138 /* inject a fake subroutine call to cctx_init */
1115 cctx_prepare (aTHX_ (coro_cctx *)arg); 1139 cctx_prepare (aTHX_ (coro_cctx *)arg);
1116 1140
1117 /* cctx_run is the alternative tail of transfer() */ 1141 /* cctx_run is the alternative tail of transfer() */
1118 transfer_tail (); 1142 transfer_tail (aTHX);
1119 1143
1120 /* somebody or something will hit me for both perl_run and PL_restartop */ 1144 /* somebody or something will hit me for both perl_run and PL_restartop */
1121 PL_restartop = PL_op; 1145 PL_restartop = PL_op;
1122 perl_run (PL_curinterp); 1146 perl_run (PL_curinterp);
1123 1147
… …
1173 /* mmap supposedly does allocate-on-write for us */ 1197 /* mmap supposedly does allocate-on-write for us */
1174 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 1198 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
1175 1199
1176 if (cctx->sptr != (void *)-1) 1200 if (cctx->sptr != (void *)-1)
1177 { 1201 {
1178# if CORO_STACKGUARD 1202 #if CORO_STACKGUARD
1179 mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE); 1203 mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);
1180# endif 1204 #endif
1181 stack_start = CORO_STACKGUARD * PAGESIZE + (char *)cctx->sptr; 1205 stack_start = (char *)cctx->sptr + CORO_STACKGUARD * PAGESIZE;
1182 stack_size = cctx->ssize - CORO_STACKGUARD * PAGESIZE; 1206 stack_size = cctx->ssize - CORO_STACKGUARD * PAGESIZE;
1183 cctx->flags |= CC_MAPPED; 1207 cctx->flags |= CC_MAPPED;
1184 } 1208 }
1185 else 1209 else
1186#endif 1210#endif
1187 { 1211 {
1188 cctx->ssize = cctx_stacksize * (long)sizeof (long); 1212 cctx->ssize = cctx_stacksize * (long)sizeof (long);
1189 New (0, cctx->sptr, cctx_stacksize, long); 1213 New (0, cctx->sptr, cctx_stacksize, long);
1190 1214
1191 if (!cctx->sptr) 1215 if (!cctx->sptr)
1192 { 1216 {
1193 perror ("FATAL: unable to allocate stack for coroutine"); 1217 perror ("FATAL: unable to allocate stack for coroutine, exiting.");
1194 _exit (EXIT_FAILURE); 1218 _exit (EXIT_FAILURE);
1195 } 1219 }
1196 1220
1197 stack_start = cctx->sptr; 1221 stack_start = cctx->sptr;
1198 stack_size = cctx->ssize; 1222 stack_size = cctx->ssize;
1199 } 1223 }
1200 1224
1201 REGISTER_STACK (cctx, (char *)stack_start, (char *)stack_start + stack_size); 1225 #if CORO_USE_VALGRIND
1226 cctx->valgrind_id = VALGRIND_STACK_REGISTER ((char *)stack_start, (char *)stack_start + stack_size);
1227 #endif
1228
1202 coro_create (&cctx->cctx, cctx_run, (void *)cctx, stack_start, stack_size); 1229 coro_create (&cctx->cctx, cctx_run, (void *)cctx, stack_start, stack_size);
1203 1230
1204 return cctx; 1231 return cctx;
1205} 1232}
1206 1233
… …
1214 coro_destroy (&cctx->cctx); 1241 coro_destroy (&cctx->cctx);
1215 1242
1216 /* coro_transfer creates new, empty cctx's */ 1243 /* coro_transfer creates new, empty cctx's */
1217 if (cctx->sptr) 1244 if (cctx->sptr)
1218 { 1245 {
1219#if CORO_USE_VALGRIND 1246 #if CORO_USE_VALGRIND
1220 VALGRIND_STACK_DEREGISTER (cctx->valgrind_id); 1247 VALGRIND_STACK_DEREGISTER (cctx->valgrind_id);
1221#endif 1248 #endif
1222 1249
1223#if HAVE_MMAP 1250#if HAVE_MMAP
1224 if (cctx->flags & CC_MAPPED) 1251 if (cctx->flags & CC_MAPPED)
1225 munmap (cctx->sptr, cctx->ssize); 1252 munmap (cctx->sptr, cctx->ssize);
1226 else 1253 else
… …
1253} 1280}
1254 1281
1255static void 1282static void
1256cctx_put (coro_cctx *cctx) 1283cctx_put (coro_cctx *cctx)
1257{ 1284{
1258 assert (("cctx_put called on non-initialised cctx", cctx->sptr)); 1285 assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr));
1259 1286
1260 /* free another cctx if overlimit */ 1287 /* free another cctx if overlimit */
1261 if (expect_false (cctx_idle >= cctx_max_idle)) 1288 if (expect_false (cctx_idle >= cctx_max_idle))
1262 { 1289 {
1263 coro_cctx *first = cctx_first; 1290 coro_cctx *first = cctx_first;
… …
1345 && !(prev__cctx->flags & CC_TRACE) 1372 && !(prev__cctx->flags & CC_TRACE)
1346 && !force_cctx 1373 && !force_cctx
1347 )) 1374 ))
1348 { 1375 {
1349 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ 1376 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
1350 assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te)); 1377 assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == prev__cctx->idle_te));
1351 1378
1352 prev->cctx = 0; 1379 prev->cctx = 0;
1353 1380
1354 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */ 1381 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */
1355 /* without this the next cctx_get might destroy the prev__cctx while still in use */ 1382 /* without this the next cctx_get might destroy the prev__cctx while still in use */
… …
1363 ++next->usecount; 1390 ++next->usecount;
1364 1391
1365 if (expect_true (!next->cctx)) 1392 if (expect_true (!next->cctx))
1366 next->cctx = cctx_get (aTHX); 1393 next->cctx = cctx_get (aTHX);
1367 1394
1368 assert (("FATAL ERROR: internal error 1352 in Coro, please report", !transfer_next));//D 1395 assert (("FATAL: transfer_next already nonzero in Coro (please report)", !transfer_next));
1369 transfer_next = next; 1396 transfer_next = next;
1370 1397
1371 if (expect_false (prev__cctx != next->cctx)) 1398 if (expect_false (prev__cctx != next->cctx))
1372 { 1399 {
1373 prev__cctx->top_env = PL_top_env; 1400 prev__cctx->top_env = PL_top_env;
1374 PL_top_env = next->cctx->top_env; 1401 PL_top_env = next->cctx->top_env;
1375 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx); 1402 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
1376 } 1403 }
1377 1404
1378 transfer_tail (); 1405 transfer_tail (aTHX);
1379 } 1406 }
1380} 1407}
1381 1408
1382#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx)) 1409#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))
1383#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next) 1410#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
… …
1558 1585
1559static int 1586static int
1560api_is_ready (SV *coro_sv) 1587api_is_ready (SV *coro_sv)
1561{ 1588{
1562 dTHX; 1589 dTHX;
1590
1563 return !!(SvSTATE (coro_sv)->flags & CF_READY); 1591 return !!(SvSTATE (coro_sv)->flags & CF_READY);
1564} 1592}
1565 1593
1566static void 1594INLINE void
1567prepare_schedule (pTHX_ struct transfer_args *ta) 1595prepare_schedule (pTHX_ struct transfer_args *ta)
1568{ 1596{
1569 SV *prev_sv, *next_sv; 1597 SV *prev_sv, *next_sv;
1570 1598
1571 for (;;) 1599 for (;;)
… …
1610 1638
1611 /* free this only after the transfer */ 1639 /* free this only after the transfer */
1612 prev_sv = SvRV (coro_current); 1640 prev_sv = SvRV (coro_current);
1613 ta->prev = SvSTATE (prev_sv); 1641 ta->prev = SvSTATE (prev_sv);
1614 TRANSFER_CHECK (*ta); 1642 TRANSFER_CHECK (*ta);
1615 assert (ta->next->flags & CF_READY); 1643 assert (("FATAL: next coroutine isn't marked as ready in Coro (please report)", ta->next->flags & CF_READY));
1616 ta->next->flags &= ~CF_READY; 1644 ta->next->flags &= ~CF_READY;
1617 SvRV_set (coro_current, next_sv); 1645 SvRV_set (coro_current, next_sv);
1618 1646
1619 LOCK; 1647 LOCK;
1620 free_coro_mortal (aTHX); 1648 free_coro_mortal (aTHX);
1621 coro_mortal = prev_sv; 1649 coro_mortal = prev_sv;
1622 UNLOCK; 1650 UNLOCK;
1623} 1651}
1624 1652
1625static void 1653INLINE void
1626prepare_cede (pTHX_ struct transfer_args *ta) 1654prepare_cede (pTHX_ struct transfer_args *ta)
1627{ 1655{
1628 api_ready (coro_current); 1656 api_ready (coro_current);
1629 prepare_schedule (aTHX_ ta); 1657 prepare_schedule (aTHX_ ta);
1630} 1658}
… …
1802 PerlIOBuf_get_ptr, 1830 PerlIOBuf_get_ptr,
1803 PerlIOBuf_get_cnt, 1831 PerlIOBuf_get_cnt,
1804 PerlIOBuf_set_ptrcnt, 1832 PerlIOBuf_set_ptrcnt,
1805}; 1833};
1806 1834
1835/*****************************************************************************/
1836
1837static const CV *ssl_cv; /* for quick consistency check */
1838
1839static UNOP ssl_restore; /* restore stack as entersub did, for first-re-run */
1840static SV *ssl_arg0;
1841static SV *ssl_arg1;
1842
1843/* this restores the stack in the case we patched the entersub, to */
1844/* recreate the stack frame as perl will on following calls */
1845/* since entersub cleared the stack */
1846static OP *
1847pp_restore (pTHX)
1848{
1849 dSP;
1850
1851 PUSHMARK (SP);
1852
1853 EXTEND (SP, 3);
1854 if (ssl_arg0) PUSHs (sv_2mortal (ssl_arg0)), ssl_arg0 = 0;
1855 if (ssl_arg1) PUSHs (sv_2mortal (ssl_arg1)), ssl_arg1 = 0;
1856 PUSHs ((SV *)CvGV (ssl_cv));
1857
1858 RETURNOP (ssl_restore.op_first);
1859}
1860
1861/* declare prototype */
1862XS(XS_Coro__State__set_stacklevel);
1863
1864#define OPpENTERSUB_SSL 15
1865
1866static OP *
1867pp_set_stacklevel (pTHX)
1868{
1869 dSP;
1870 struct transfer_args ta;
1871 SV **arg = PL_stack_base + TOPMARK + 1;
1872 int items = SP - arg; /* args without function object */
1873
1874 /* do a quick consistency check on the "function" object, and if it isn't */
1875 /* for us, divert to the real entersub */
1876 if (SvTYPE (*sp) != SVt_PVGV || CvXSUB (GvCV (*sp)) != XS_Coro__State__set_stacklevel)
1877 return PL_ppaddr[OP_ENTERSUB](aTHX);
1878
1879 /* pop args */
1880 SP = PL_stack_base + POPMARK;
1881
1882 if (!(PL_op->op_flags & OPf_STACKED))
1883 {
1884 /* ampersand-form of call, use @_ instead of stack */
1885 AV *av = GvAV (PL_defgv);
1886 arg = AvARRAY (av);
1887 items = AvFILLp (av) + 1;
1888 }
1889
1890 PUTBACK;
1891 switch (PL_op->op_private & OPpENTERSUB_SSL)
1892 {
1893 case 0:
1894 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (arg [0]));
1895 break;
1896
1897 case 1:
1898 if (items != 2)
1899 croak ("Coro::State::transfer (prev, next) expects two arguments, not %d.", items);
1900
1901 prepare_transfer (aTHX_ &ta, arg [0], arg [1]);
1902 break;
1903
1904 case 2:
1905 prepare_schedule (aTHX_ &ta);
1906 break;
1907
1908 case 3:
1909 prepare_cede (aTHX_ &ta);
1910 break;
1911
1912 case 4:
1913 if (!prepare_cede_notself (aTHX_ &ta))
1914 goto skip;
1915
1916 break;
1917 }
1918
1919 TRANSFER (ta, 0);
1920 SPAGAIN;
1921
1922skip:
1923 PUTBACK;
1924 SSL_TAIL;
1925 SPAGAIN;
1926 RETURN;
1927}
1807 1928
1808MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_ 1929MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1809 1930
1810PROTOTYPES: DISABLE 1931PROTOTYPES: DISABLE
1811
1812BOOT:
1813{
1814#ifdef USE_ITHREADS
1815 MUTEX_INIT (&coro_lock);
1816# if CORO_PTHREAD
1817 coro_thx = PERL_GET_CONTEXT;
1818# endif
1819#endif
1820 BOOT_PAGESIZE;
1821
1822 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
1823 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
1824
1825 orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;
1826 orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;
1827 orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr;
1828
1829 hv_sig = coro_get_hv (aTHX_ "SIG", TRUE);
1830 rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
1831 rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
1832
1833 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1834
1835 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
1836 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
1837 newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));
1838 newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));
1839
1840 main_mainstack = PL_mainstack;
1841 main_top_env = PL_top_env;
1842
1843 while (main_top_env->je_prev)
1844 main_top_env = main_top_env->je_prev;
1845
1846 coroapi.ver = CORO_API_VERSION;
1847 coroapi.rev = CORO_API_REVISION;
1848 coroapi.transfer = api_transfer;
1849
1850 {
1851 SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
1852
1853 if (!svp) croak ("Time::HiRes is required");
1854 if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
1855
1856 nvtime = INT2PTR (double (*)(), SvIV (*svp));
1857 }
1858
1859 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
1860}
1861
1862SV *
1863new (char *klass, ...)
1864 CODE:
1865{
1866 struct coro *coro;
1867 MAGIC *mg;
1868 HV *hv;
1869 int i;
1870
1871 Newz (0, coro, 1, struct coro);
1872 coro->args = newAV ();
1873 coro->flags = CF_NEW;
1874
1875 if (coro_first) coro_first->prev = coro;
1876 coro->next = coro_first;
1877 coro_first = coro;
1878
1879 coro->hv = hv = newHV ();
1880 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
1881 mg->mg_flags |= MGf_DUP;
1882 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1883
1884 av_extend (coro->args, items - 1);
1885 for (i = 1; i < items; i++)
1886 av_push (coro->args, newSVsv (ST (i)));
1887}
1888 OUTPUT:
1889 RETVAL
1890 1932
1891# these not obviously related functions are all rolled into the same xs 1933# these not obviously related functions are all rolled into the same xs
1892# function to increase chances that they all will call transfer with the same 1934# function to increase chances that they all will call transfer with the same
1893# stack offset 1935# stack offset
1894void 1936void
… …
1898 Coro::schedule = 2 1940 Coro::schedule = 2
1899 Coro::cede = 3 1941 Coro::cede = 3
1900 Coro::cede_notself = 4 1942 Coro::cede_notself = 4
1901 CODE: 1943 CODE:
1902{ 1944{
1903 struct transfer_args ta; 1945 assert (("FATAL: ssl call recursion in Coro module (please report)", PL_op->op_ppaddr != pp_set_stacklevel));
1904 1946
1905 PUTBACK; 1947 assert (("FATAL: ssl call with illegal CV value", CvGV (cv)));
1906 switch (ix) 1948 ssl_cv = cv;
1949
1950 /* we patch the op, and then re-run the whole call */
1951 /* we have to put some dummy argument on the stack for this to work */
1952 ssl_restore.op_next = (OP *)&ssl_restore;
1953 ssl_restore.op_type = OP_NULL;
1954 ssl_restore.op_ppaddr = pp_restore;
1955 ssl_restore.op_first = PL_op;
1956
1957 ssl_arg0 = items > 0 ? SvREFCNT_inc (ST (0)) : 0;
1958 ssl_arg1 = items > 1 ? SvREFCNT_inc (ST (1)) : 0;
1959
1960 PL_op->op_ppaddr = pp_set_stacklevel;
1961 PL_op->op_private = PL_op->op_private & ~OPpENTERSUB_SSL | ix; /* we potentially share our private flags with entersub */
1962
1963 PL_op = (OP *)&ssl_restore;
1964}
1965
1966BOOT:
1967{
1968#ifdef USE_ITHREADS
1969 MUTEX_INIT (&coro_lock);
1970# if CORO_PTHREAD
1971 coro_thx = PERL_GET_CONTEXT;
1972# endif
1973#endif
1974 BOOT_PAGESIZE;
1975
1976 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
1977 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
1978
1979 orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;
1980 orig_sigelem_set = PL_vtbl_sigelem.svt_set; PL_vtbl_sigelem.svt_set = coro_sigelem_set;
1981 orig_sigelem_clr = PL_vtbl_sigelem.svt_clear; PL_vtbl_sigelem.svt_clear = coro_sigelem_clr;
1982
1983 hv_sig = coro_get_hv (aTHX_ "SIG", TRUE);
1984 rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
1985 rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
1986
1987 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1988
1989 newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
1990 newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
1991 newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));
1992 newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));
1993
1994 main_mainstack = PL_mainstack;
1995 main_top_env = PL_top_env;
1996
1997 while (main_top_env->je_prev)
1998 main_top_env = main_top_env->je_prev;
1999
2000 coroapi.ver = CORO_API_VERSION;
2001 coroapi.rev = CORO_API_REVISION;
2002 coroapi.transfer = api_transfer;
2003
1907 { 2004 {
1908 case 0: 2005 SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
1909 prepare_set_stacklevel (&ta, (struct coro_cctx *)SvIV (ST (0)));
1910 break;
1911 2006
1912 case 1: 2007 if (!svp) croak ("Time::HiRes is required");
1913 if (items != 2) 2008 if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
1914 croak ("Coro::State::transfer (prev, next) expects two arguments, not %d", items);
1915 2009
1916 prepare_transfer (aTHX_ &ta, ST (0), ST (1)); 2010 nvtime = INT2PTR (double (*)(), SvIV (*svp));
1917 break;
1918
1919 case 2:
1920 prepare_schedule (aTHX_ &ta);
1921 break;
1922
1923 case 3:
1924 prepare_cede (aTHX_ &ta);
1925 break;
1926
1927 case 4:
1928 if (!prepare_cede_notself (aTHX_ &ta))
1929 XSRETURN_EMPTY;
1930
1931 break;
1932 } 2011 }
1933 SPAGAIN;
1934 2012
1935 BARRIER; 2013 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
1936 PUTBACK;
1937 TRANSFER (ta, 0);
1938 SPAGAIN; /* might be the sp of a different coroutine now */
1939 /* be extra careful not to ever do anything after TRANSFER */
1940} 2014}
2015
2016SV *
2017new (char *klass, ...)
2018 CODE:
2019{
2020 struct coro *coro;
2021 MAGIC *mg;
2022 HV *hv;
2023 int i;
2024
2025 Newz (0, coro, 1, struct coro);
2026 coro->args = newAV ();
2027 coro->flags = CF_NEW;
2028
2029 if (coro_first) coro_first->prev = coro;
2030 coro->next = coro_first;
2031 coro_first = coro;
2032
2033 coro->hv = hv = newHV ();
2034 mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
2035 mg->mg_flags |= MGf_DUP;
2036 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
2037
2038 av_extend (coro->args, items - 1);
2039 for (i = 1; i < items; i++)
2040 av_push (coro->args, newSVsv (ST (i)));
2041}
2042 OUTPUT:
2043 RETVAL
1941 2044
1942bool 2045bool
1943_destroy (SV *coro_sv) 2046_destroy (SV *coro_sv)
1944 CODE: 2047 CODE:
1945 RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv)); 2048 RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));
… …
2142 2245
2143 for (i = PRIO_MAX - PRIO_MIN + 1; i--; ) 2246 for (i = PRIO_MAX - PRIO_MIN + 1; i--; )
2144 coro_ready[i] = newAV (); 2247 coro_ready[i] = newAV ();
2145 2248
2146 { 2249 {
2147 SV *sv = perl_get_sv ("Coro::API", TRUE); 2250 SV *sv = coro_get_sv (aTHX_ "Coro::API", TRUE);
2148 perl_get_sv ("Coro::API", TRUE); /* silence 5.10 warning */
2149 2251
2150 coroapi.schedule = api_schedule; 2252 coroapi.schedule = api_schedule;
2151 coroapi.cede = api_cede; 2253 coroapi.cede = api_cede;
2152 coroapi.cede_notself = api_cede_notself; 2254 coroapi.cede_notself = api_cede_notself;
2153 coroapi.ready = api_ready; 2255 coroapi.ready = api_ready;
… …
2421 2523
2422MODULE = Coro::State PACKAGE = PerlIO::cede 2524MODULE = Coro::State PACKAGE = PerlIO::cede
2423 2525
2424BOOT: 2526BOOT:
2425 PerlIO_define_layer (aTHX_ &PerlIO_cede); 2527 PerlIO_define_layer (aTHX_ &PerlIO_cede);
2528

Diff Legend

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