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.222 by root, Sun Jan 20 10:22:07 2008 UTC vs.
Revision 1.228 by root, Sun Apr 6 17:51:15 2008 UTC

… …
72# ifndef IS_PADCONST 72# ifndef IS_PADCONST
73# define IS_PADCONST(v) 0 73# define IS_PADCONST(v) 0
74# endif 74# endif
75#endif 75#endif
76 76
77/* 5.8.8 */
78#ifndef GV_NOTQUAL
79# define GV_NOTQUAL 0
80#endif
81#ifndef newSV
82# define newSV(l) NEWSV(0,l)
83#endif
84
85/* 5.11 */
86#ifndef CxHASARGS
87# define CxHASARGS(cx) (cx)->blk_sub.hasargs
88#endif
89
77/* 5.8.7 */ 90/* 5.8.7 */
78#ifndef SvRV_set 91#ifndef SvRV_set
79# define SvRV_set(s,v) SvRV(s) = (v) 92# define SvRV_set(s,v) SvRV(s) = (v)
80#endif
81
82/* 5.8.8 */
83#ifndef GV_NOTQUAL
84# define GV_NOTQUAL 0
85#endif
86#ifndef newSV
87# define newSV(l) NEWSV(0,l)
88#endif 93#endif
89 94
90#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64 95#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
91# undef CORO_STACKGUARD 96# undef CORO_STACKGUARD
92#endif 97#endif
… …
261/** lowlevel stuff **********************************************************/ 266/** lowlevel stuff **********************************************************/
262 267
263static SV * 268static SV *
264coro_get_sv (pTHX_ const char *name, int create) 269coro_get_sv (pTHX_ const char *name, int create)
265{ 270{
266#if PERL_VERSION_ATLEAST (5,9,0) 271#if PERL_VERSION_ATLEAST (5,10,0)
267 /* silence stupid and wrong 5.10 warning that I am unable to switch off */ 272 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
268 get_sv (name, create); 273 get_sv (name, create);
269#endif 274#endif
270 return get_sv (name, create); 275 return get_sv (name, create);
271} 276}
272 277
273static AV * 278static AV *
274coro_get_av (pTHX_ const char *name, int create) 279coro_get_av (pTHX_ const char *name, int create)
275{ 280{
276#if PERL_VERSION_ATLEAST (5,9,0) 281#if PERL_VERSION_ATLEAST (5,10,0)
277 /* silence stupid and wrong 5.10 warning that I am unable to switch off */ 282 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
278 get_av (name, create); 283 get_av (name, create);
279#endif 284#endif
280 return get_av (name, create); 285 return get_av (name, create);
281} 286}
282 287
283static HV * 288static HV *
284coro_get_hv (pTHX_ const char *name, int create) 289coro_get_hv (pTHX_ const char *name, int create)
285{ 290{
286#if PERL_VERSION_ATLEAST (5,9,0) 291#if PERL_VERSION_ATLEAST (5,10,0)
287 /* silence stupid and wrong 5.10 warning that I am unable to switch off */ 292 /* silence stupid and wrong 5.10 warning that I am unable to switch off */
288 get_hv (name, create); 293 get_hv (name, create);
289#endif 294#endif
290 return get_hv (name, create); 295 return get_hv (name, create);
291} 296}
… …
296 AV *padlist = CvPADLIST (cv); 301 AV *padlist = CvPADLIST (cv);
297 AV *newpadlist, *newpad; 302 AV *newpadlist, *newpad;
298 303
299 newpadlist = newAV (); 304 newpadlist = newAV ();
300 AvREAL_off (newpadlist); 305 AvREAL_off (newpadlist);
301#if PERL_VERSION_ATLEAST (5,9,0) 306#if PERL_VERSION_ATLEAST (5,10,0)
302 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1); 307 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
303#else 308#else
304 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); 309 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
305#endif 310#endif
306 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; 311 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
… …
587 592
588 New(54,PL_savestack,24,ANY); 593 New(54,PL_savestack,24,ANY);
589 PL_savestack_ix = 0; 594 PL_savestack_ix = 0;
590 PL_savestack_max = 24; 595 PL_savestack_max = 24;
591 596
592#if !PERL_VERSION_ATLEAST (5,9,0) 597#if !PERL_VERSION_ATLEAST (5,10,0)
593 New(54,PL_retstack,4,OP*); 598 New(54,PL_retstack,4,OP*);
594 PL_retstack_ix = 0; 599 PL_retstack_ix = 0;
595 PL_retstack_max = 4; 600 PL_retstack_max = 4;
596#endif 601#endif
597} 602}
… …
620 625
621 Safefree (PL_tmps_stack); 626 Safefree (PL_tmps_stack);
622 Safefree (PL_markstack); 627 Safefree (PL_markstack);
623 Safefree (PL_scopestack); 628 Safefree (PL_scopestack);
624 Safefree (PL_savestack); 629 Safefree (PL_savestack);
625#if !PERL_VERSION_ATLEAST (5,9,0) 630#if !PERL_VERSION_ATLEAST (5,10,0)
626 Safefree (PL_retstack); 631 Safefree (PL_retstack);
627#endif 632#endif
628} 633}
629 634
630static size_t 635static size_t
… …
654 rss += slot->tmps_max * sizeof (SV *); 659 rss += slot->tmps_max * sizeof (SV *);
655 rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32); 660 rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32);
656 rss += slot->scopestack_max * sizeof (I32); 661 rss += slot->scopestack_max * sizeof (I32);
657 rss += slot->savestack_max * sizeof (ANY); 662 rss += slot->savestack_max * sizeof (ANY);
658 663
659#if !PERL_VERSION_ATLEAST (5,9,0) 664#if !PERL_VERSION_ATLEAST (5,10,0)
660 rss += slot->retstack_max * sizeof (OP *); 665 rss += slot->retstack_max * sizeof (OP *);
661#endif 666#endif
662 } 667 }
663 668
664 return rss; 669 return rss;
… …
731 PL_curpm = 0; 736 PL_curpm = 0;
732 PL_curpad = 0; 737 PL_curpad = 0;
733 PL_localizing = 0; 738 PL_localizing = 0;
734 PL_dirty = 0; 739 PL_dirty = 0;
735 PL_restartop = 0; 740 PL_restartop = 0;
741#if !PERL_VERSION_ATLEAST (5,10,0)
742 PL_parser = 0;
743#endif
736 744
737 /* recreate the die/warn hooks */ 745 /* recreate the die/warn hooks */
738 PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook ); 746 PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );
739 PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook); 747 PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);
740 748
… …
895 SAVETMPS; 903 SAVETMPS;
896 EXTEND (SP, 3); 904 EXTEND (SP, 3);
897 PUSHMARK (SP); 905 PUSHMARK (SP);
898 PUSHs (&PL_sv_yes); 906 PUSHs (&PL_sv_yes);
899 PUSHs (fullname); 907 PUSHs (fullname);
900 PUSHs (cx->blk_sub.hasargs ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef); 908 PUSHs (CxHASARGS (cx) ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
901 PUTBACK; 909 PUTBACK;
902 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0); 910 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
903 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); 911 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
904 SPAGAIN; 912 SPAGAIN;
905 FREETMPS; 913 FREETMPS;
… …
1121 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states"); 1129 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
1122 1130
1123 if (expect_false (next->flags & CF_DESTROYED)) 1131 if (expect_false (next->flags & CF_DESTROYED))
1124 croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states"); 1132 croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
1125 1133
1126 if (
1127#if PERL_VERSION_ATLEAST (5,9,0) 1134#if !PERL_VERSION_ATLEAST (5,10,0)
1128 expect_false (PL_parser && PL_parser->lex_state != LEX_NOTPARSING)
1129#else
1130 expect_false (PL_lex_state != LEX_NOTPARSING) 1135 if (expect_false (PL_lex_state != LEX_NOTPARSING)
1131#endif
1132 )
1133 croak ("Coro::State::transfer called while parsing, but this is not supported"); 1136 croak ("Coro::State::transfer called while parsing, but this is not supported");
1137#endif
1134 } 1138 }
1135} 1139}
1136 1140
1137/* always use the TRANSFER macro */ 1141/* always use the TRANSFER macro */
1138static void NOINLINE 1142static void NOINLINE
1139transfer (pTHX_ struct coro *prev, struct coro *next) 1143transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
1140{ 1144{
1141 dSTACKLEVEL; 1145 dSTACKLEVEL;
1142 static volatile int has_throw; 1146 static volatile int has_throw;
1143 1147
1144 /* sometimes transfer is only called to set idle_sp */ 1148 /* sometimes transfer is only called to set idle_sp */
… …
1178 load_perl (aTHX_ next); 1182 load_perl (aTHX_ next);
1179 1183
1180 prev__cctx = prev->cctx; 1184 prev__cctx = prev->cctx;
1181 1185
1182 /* possibly "free" the cctx */ 1186 /* possibly "free" the cctx */
1183 if (expect_true (prev__cctx->idle_sp == STACKLEVEL && !(prev__cctx->flags & CC_TRACE))) 1187 if (expect_true (
1188 prev__cctx->idle_sp == STACKLEVEL
1189 && !(prev__cctx->flags & CC_TRACE)
1190 && !force_cctx
1191 ))
1184 { 1192 {
1185 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ 1193 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
1186 assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te)); 1194 assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te));
1187 1195
1188 prev->cctx = 0; 1196 prev->cctx = 0;
… …
1231struct transfer_args 1239struct transfer_args
1232{ 1240{
1233 struct coro *prev, *next; 1241 struct coro *prev, *next;
1234}; 1242};
1235 1243
1236#define TRANSFER(ta) transfer (aTHX_ (ta).prev, (ta).next) 1244#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))
1237#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next) 1245#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1238 1246
1239/** high level stuff ********************************************************/ 1247/** high level stuff ********************************************************/
1240 1248
1241static int 1249static int
… …
1335{ 1343{
1336 dTHX; 1344 dTHX;
1337 struct transfer_args ta; 1345 struct transfer_args ta;
1338 1346
1339 prepare_transfer (aTHX_ &ta, prev_sv, next_sv); 1347 prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1340 TRANSFER (ta); 1348 TRANSFER (ta, 1);
1341} 1349}
1342 1350
1343/** Coro ********************************************************************/ 1351/** Coro ********************************************************************/
1344 1352
1345static void 1353static void
… …
1476{ 1484{
1477 dTHX; 1485 dTHX;
1478 struct transfer_args ta; 1486 struct transfer_args ta;
1479 1487
1480 prepare_schedule (aTHX_ &ta); 1488 prepare_schedule (aTHX_ &ta);
1481 TRANSFER (ta); 1489 TRANSFER (ta, 1);
1482} 1490}
1483 1491
1484static int 1492static int
1485api_cede (void) 1493api_cede (void)
1486{ 1494{
… …
1489 1497
1490 prepare_cede (aTHX_ &ta); 1498 prepare_cede (aTHX_ &ta);
1491 1499
1492 if (expect_true (ta.prev != ta.next)) 1500 if (expect_true (ta.prev != ta.next))
1493 { 1501 {
1494 TRANSFER (ta); 1502 TRANSFER (ta, 1);
1495 return 1; 1503 return 1;
1496 } 1504 }
1497 else 1505 else
1498 return 0; 1506 return 0;
1499} 1507}
… …
1504 dTHX; 1512 dTHX;
1505 struct transfer_args ta; 1513 struct transfer_args ta;
1506 1514
1507 if (prepare_cede_notself (aTHX_ &ta)) 1515 if (prepare_cede_notself (aTHX_ &ta))
1508 { 1516 {
1509 TRANSFER (ta); 1517 TRANSFER (ta, 1);
1510 return 1; 1518 return 1;
1511 } 1519 }
1512 else 1520 else
1513 return 0; 1521 return 0;
1514} 1522}
… …
1656 } 1664 }
1657 SPAGAIN; 1665 SPAGAIN;
1658 1666
1659 BARRIER; 1667 BARRIER;
1660 PUTBACK; 1668 PUTBACK;
1661 TRANSFER (ta); 1669 TRANSFER (ta, 0);
1662 SPAGAIN; /* might be the sp of a different coroutine now */ 1670 SPAGAIN; /* might be the sp of a different coroutine now */
1663 /* be extra careful not to ever do anything after TRANSFER */ 1671 /* be extra careful not to ever do anything after TRANSFER */
1664} 1672}
1665 1673
1666bool 1674bool
… …
1800 case 1: RETVAL = coro->usecount; break; 1808 case 1: RETVAL = coro->usecount; break;
1801 } 1809 }
1802 OUTPUT: 1810 OUTPUT:
1803 RETVAL 1811 RETVAL
1804 1812
1813void
1814force_cctx ()
1815 CODE:
1816 struct coro *coro = SvSTATE (coro_current);
1817 coro->cctx->idle_sp = 0;
1805 1818
1806MODULE = Coro::State PACKAGE = Coro 1819MODULE = Coro::State PACKAGE = Coro
1807 1820
1808BOOT: 1821BOOT:
1809{ 1822{
… …
1896 PROTOTYPE: $;$ 1909 PROTOTYPE: $;$
1897 CODE: 1910 CODE:
1898 SvREFCNT_dec (self->throw); 1911 SvREFCNT_dec (self->throw);
1899 self->throw = SvOK (throw) ? newSVsv (throw) : 0; 1912 self->throw = SvOK (throw) ? newSVsv (throw) : 0;
1900 1913
1914void
1915swap_defsv (Coro::State self)
1916 PROTOTYPE: $
1917 ALIAS:
1918 swap_defav = 1
1919 CODE:
1920 if (!self->slot)
1921 croak ("cannot swap state with coroutine that has no saved state");
1922 else
1923 {
1924 SV **src = ix ? (SV **)&GvAV (PL_defgv) : &GvSV (PL_defgv);
1925 SV **dst = ix ? (SV **)&self->slot->defav : (SV **)&self->slot->defsv;
1926
1927 SV *tmp = *src; *src = *dst; *dst = tmp;
1928 }
1929
1901# for async_pool speedup 1930# for async_pool speedup
1902void 1931void
1903_pool_1 (SV *cb) 1932_pool_1 (SV *cb)
1904 CODE: 1933 CODE:
1905{ 1934{

Diff Legend

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