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.224 by root, Sun Mar 2 16:10:22 2008 UTC vs.
Revision 1.231 by root, Thu Apr 24 10:31:59 2008 UTC

10#include "patchlevel.h" 10#include "patchlevel.h"
11 11
12#include <stdio.h> 12#include <stdio.h>
13#include <errno.h> 13#include <errno.h>
14#include <assert.h> 14#include <assert.h>
15
16#ifdef WIN32
17# undef setjmp
18# undef longjmp
19# undef _exit
20#include <setjmp.h>
21#else
15#include <inttypes.h> /* portable stdint.h */ 22# include <inttypes.h> /* most portable stdint.h */
23#endif
16 24
17#ifdef HAVE_MMAP 25#ifdef HAVE_MMAP
18# include <unistd.h> 26# include <unistd.h>
19# include <sys/mman.h> 27# include <sys/mman.h>
20# ifndef MAP_ANONYMOUS 28# ifndef MAP_ANONYMOUS
266/** lowlevel stuff **********************************************************/ 274/** lowlevel stuff **********************************************************/
267 275
268static SV * 276static SV *
269coro_get_sv (pTHX_ const char *name, int create) 277coro_get_sv (pTHX_ const char *name, int create)
270{ 278{
271#if PERL_VERSION_ATLEAST (5,9,0) 279#if PERL_VERSION_ATLEAST (5,10,0)
272 /* silence stupid and wrong 5.10 warning that I am unable to switch off */ 280 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
273 get_sv (name, create); 281 get_sv (name, create);
274#endif 282#endif
275 return get_sv (name, create); 283 return get_sv (name, create);
276} 284}
277 285
278static AV * 286static AV *
279coro_get_av (pTHX_ const char *name, int create) 287coro_get_av (pTHX_ const char *name, int create)
280{ 288{
281#if PERL_VERSION_ATLEAST (5,9,0) 289#if PERL_VERSION_ATLEAST (5,10,0)
282 /* silence stupid and wrong 5.10 warning that I am unable to switch off */ 290 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
283 get_av (name, create); 291 get_av (name, create);
284#endif 292#endif
285 return get_av (name, create); 293 return get_av (name, create);
286} 294}
287 295
288static HV * 296static HV *
289coro_get_hv (pTHX_ const char *name, int create) 297coro_get_hv (pTHX_ const char *name, int create)
290{ 298{
291#if PERL_VERSION_ATLEAST (5,9,0) 299#if PERL_VERSION_ATLEAST (5,10,0)
292 /* silence stupid and wrong 5.10 warning that I am unable to switch off */ 300 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
293 get_hv (name, create); 301 get_hv (name, create);
294#endif 302#endif
295 return get_hv (name, create); 303 return get_hv (name, create);
296} 304}
301 AV *padlist = CvPADLIST (cv); 309 AV *padlist = CvPADLIST (cv);
302 AV *newpadlist, *newpad; 310 AV *newpadlist, *newpad;
303 311
304 newpadlist = newAV (); 312 newpadlist = newAV ();
305 AvREAL_off (newpadlist); 313 AvREAL_off (newpadlist);
306#if PERL_VERSION_ATLEAST (5,9,0) 314#if PERL_VERSION_ATLEAST (5,10,0)
307 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1); 315 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
308#else 316#else
309 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); 317 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
310#endif 318#endif
311 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; 319 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
592 600
593 New(54,PL_savestack,24,ANY); 601 New(54,PL_savestack,24,ANY);
594 PL_savestack_ix = 0; 602 PL_savestack_ix = 0;
595 PL_savestack_max = 24; 603 PL_savestack_max = 24;
596 604
597#if !PERL_VERSION_ATLEAST (5,9,0) 605#if !PERL_VERSION_ATLEAST (5,10,0)
598 New(54,PL_retstack,4,OP*); 606 New(54,PL_retstack,4,OP*);
599 PL_retstack_ix = 0; 607 PL_retstack_ix = 0;
600 PL_retstack_max = 4; 608 PL_retstack_max = 4;
601#endif 609#endif
602} 610}
625 633
626 Safefree (PL_tmps_stack); 634 Safefree (PL_tmps_stack);
627 Safefree (PL_markstack); 635 Safefree (PL_markstack);
628 Safefree (PL_scopestack); 636 Safefree (PL_scopestack);
629 Safefree (PL_savestack); 637 Safefree (PL_savestack);
630#if !PERL_VERSION_ATLEAST (5,9,0) 638#if !PERL_VERSION_ATLEAST (5,10,0)
631 Safefree (PL_retstack); 639 Safefree (PL_retstack);
632#endif 640#endif
633} 641}
634 642
635static size_t 643static size_t
659 rss += slot->tmps_max * sizeof (SV *); 667 rss += slot->tmps_max * sizeof (SV *);
660 rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32); 668 rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32);
661 rss += slot->scopestack_max * sizeof (I32); 669 rss += slot->scopestack_max * sizeof (I32);
662 rss += slot->savestack_max * sizeof (ANY); 670 rss += slot->savestack_max * sizeof (ANY);
663 671
664#if !PERL_VERSION_ATLEAST (5,9,0) 672#if !PERL_VERSION_ATLEAST (5,10,0)
665 rss += slot->retstack_max * sizeof (OP *); 673 rss += slot->retstack_max * sizeof (OP *);
666#endif 674#endif
667 } 675 }
668 676
669 return rss; 677 return rss;
712 if (svp) 720 if (svp)
713 { 721 {
714 SV *old = *svp; 722 SV *old = *svp;
715 *svp = newSVsv (sv); 723 *svp = newSVsv (sv);
716 SvREFCNT_dec (old); 724 SvREFCNT_dec (old);
717 return; 725 return 0;
718 } 726 }
719 } 727 }
720 728
721 return orig_sigelem_set ? orig_sigelem_set (aTHX_ sv, mg) : 0; 729 return orig_sigelem_set ? orig_sigelem_set (aTHX_ sv, mg) : 0;
722} 730}
736 PL_curpm = 0; 744 PL_curpm = 0;
737 PL_curpad = 0; 745 PL_curpad = 0;
738 PL_localizing = 0; 746 PL_localizing = 0;
739 PL_dirty = 0; 747 PL_dirty = 0;
740 PL_restartop = 0; 748 PL_restartop = 0;
749#if PERL_VERSION_ATLEAST (5,10,0)
750 PL_parser = 0;
751#endif
741 752
742 /* recreate the die/warn hooks */ 753 /* recreate the die/warn hooks */
743 PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook ); 754 PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );
744 PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook); 755 PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);
745 756
1126 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states"); 1137 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
1127 1138
1128 if (expect_false (next->flags & CF_DESTROYED)) 1139 if (expect_false (next->flags & CF_DESTROYED))
1129 croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states"); 1140 croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
1130 1141
1131 if (
1132#if PERL_VERSION_ATLEAST (5,9,0) 1142#if !PERL_VERSION_ATLEAST (5,10,0)
1133 expect_false (PL_parser && PL_parser->lex_state != LEX_NOTPARSING)
1134#else
1135 expect_false (PL_lex_state != LEX_NOTPARSING) 1143 if (expect_false (PL_lex_state != LEX_NOTPARSING))
1136#endif
1137 )
1138 croak ("Coro::State::transfer called while parsing, but this is not supported"); 1144 croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version");
1145#endif
1139 } 1146 }
1140} 1147}
1141 1148
1142/* always use the TRANSFER macro */ 1149/* always use the TRANSFER macro */
1143static void NOINLINE 1150static void NOINLINE
1144transfer (pTHX_ struct coro *prev, struct coro *next) 1151transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
1145{ 1152{
1146 dSTACKLEVEL; 1153 dSTACKLEVEL;
1147 static volatile int has_throw; 1154 static volatile int has_throw;
1148 1155
1149 /* sometimes transfer is only called to set idle_sp */ 1156 /* sometimes transfer is only called to set idle_sp */
1183 load_perl (aTHX_ next); 1190 load_perl (aTHX_ next);
1184 1191
1185 prev__cctx = prev->cctx; 1192 prev__cctx = prev->cctx;
1186 1193
1187 /* possibly "free" the cctx */ 1194 /* possibly "free" the cctx */
1188 if (expect_true (prev__cctx->idle_sp == STACKLEVEL && !(prev__cctx->flags & CC_TRACE))) 1195 if (expect_true (
1196 prev__cctx->idle_sp == STACKLEVEL
1197 && !(prev__cctx->flags & CC_TRACE)
1198 && !force_cctx
1199 ))
1189 { 1200 {
1190 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ 1201 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
1191 assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te)); 1202 assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te));
1192 1203
1193 prev->cctx = 0; 1204 prev->cctx = 0;
1236struct transfer_args 1247struct transfer_args
1237{ 1248{
1238 struct coro *prev, *next; 1249 struct coro *prev, *next;
1239}; 1250};
1240 1251
1241#define TRANSFER(ta) transfer (aTHX_ (ta).prev, (ta).next) 1252#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))
1242#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next) 1253#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1243 1254
1244/** high level stuff ********************************************************/ 1255/** high level stuff ********************************************************/
1245 1256
1246static int 1257static int
1340{ 1351{
1341 dTHX; 1352 dTHX;
1342 struct transfer_args ta; 1353 struct transfer_args ta;
1343 1354
1344 prepare_transfer (aTHX_ &ta, prev_sv, next_sv); 1355 prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1345 TRANSFER (ta); 1356 TRANSFER (ta, 1);
1346} 1357}
1347 1358
1348/** Coro ********************************************************************/ 1359/** Coro ********************************************************************/
1349 1360
1350static void 1361static void
1481{ 1492{
1482 dTHX; 1493 dTHX;
1483 struct transfer_args ta; 1494 struct transfer_args ta;
1484 1495
1485 prepare_schedule (aTHX_ &ta); 1496 prepare_schedule (aTHX_ &ta);
1486 TRANSFER (ta); 1497 TRANSFER (ta, 1);
1487} 1498}
1488 1499
1489static int 1500static int
1490api_cede (void) 1501api_cede (void)
1491{ 1502{
1494 1505
1495 prepare_cede (aTHX_ &ta); 1506 prepare_cede (aTHX_ &ta);
1496 1507
1497 if (expect_true (ta.prev != ta.next)) 1508 if (expect_true (ta.prev != ta.next))
1498 { 1509 {
1499 TRANSFER (ta); 1510 TRANSFER (ta, 1);
1500 return 1; 1511 return 1;
1501 } 1512 }
1502 else 1513 else
1503 return 0; 1514 return 0;
1504} 1515}
1509 dTHX; 1520 dTHX;
1510 struct transfer_args ta; 1521 struct transfer_args ta;
1511 1522
1512 if (prepare_cede_notself (aTHX_ &ta)) 1523 if (prepare_cede_notself (aTHX_ &ta))
1513 { 1524 {
1514 TRANSFER (ta); 1525 TRANSFER (ta, 1);
1515 return 1; 1526 return 1;
1516 } 1527 }
1517 else 1528 else
1518 return 0; 1529 return 0;
1519} 1530}
1661 } 1672 }
1662 SPAGAIN; 1673 SPAGAIN;
1663 1674
1664 BARRIER; 1675 BARRIER;
1665 PUTBACK; 1676 PUTBACK;
1666 TRANSFER (ta); 1677 TRANSFER (ta, 0);
1667 SPAGAIN; /* might be the sp of a different coroutine now */ 1678 SPAGAIN; /* might be the sp of a different coroutine now */
1668 /* be extra careful not to ever do anything after TRANSFER */ 1679 /* be extra careful not to ever do anything after TRANSFER */
1669} 1680}
1670 1681
1671bool 1682bool
1805 case 1: RETVAL = coro->usecount; break; 1816 case 1: RETVAL = coro->usecount; break;
1806 } 1817 }
1807 OUTPUT: 1818 OUTPUT:
1808 RETVAL 1819 RETVAL
1809 1820
1821void
1822force_cctx ()
1823 CODE:
1824 struct coro *coro = SvSTATE (coro_current);
1825 coro->cctx->idle_sp = 0;
1810 1826
1811MODULE = Coro::State PACKAGE = Coro 1827MODULE = Coro::State PACKAGE = Coro
1812 1828
1813BOOT: 1829BOOT:
1814{ 1830{
1911 CODE: 1927 CODE:
1912 if (!self->slot) 1928 if (!self->slot)
1913 croak ("cannot swap state with coroutine that has no saved state"); 1929 croak ("cannot swap state with coroutine that has no saved state");
1914 else 1930 else
1915 { 1931 {
1916 SV **src = ix ? (SV *)&GvAV (PL_defgv) : &GvSV (PL_defgv); 1932 SV **src = ix ? (SV **)&GvAV (PL_defgv) : &GvSV (PL_defgv);
1917 SV **dst = ix ? self->slot->defav : self->slot->defsv; 1933 SV **dst = ix ? (SV **)&self->slot->defav : (SV **)&self->slot->defsv;
1918 1934
1919 SV *tmp = *src; *src = *dst; *dst = tmp; 1935 SV *tmp = *src; *src = *dst; *dst = tmp;
1920 } 1936 }
1921 1937
1922# for async_pool speedup 1938# for async_pool speedup

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines