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.226 by root, Fri Apr 4 20:07:35 2008 UTC vs.
Revision 1.230 by root, Mon Apr 14 11:28:59 2008 UTC

… …
266/** lowlevel stuff **********************************************************/ 266/** lowlevel stuff **********************************************************/
267 267
268static SV * 268static SV *
269coro_get_sv (pTHX_ const char *name, int create) 269coro_get_sv (pTHX_ const char *name, int create)
270{ 270{
271#if PERL_VERSION_ATLEAST (5,9,0) 271#if PERL_VERSION_ATLEAST (5,10,0)
272 /* 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 */
273 get_sv (name, create); 273 get_sv (name, create);
274#endif 274#endif
275 return get_sv (name, create); 275 return get_sv (name, create);
276} 276}
277 277
278static AV * 278static AV *
279coro_get_av (pTHX_ const char *name, int create) 279coro_get_av (pTHX_ const char *name, int create)
280{ 280{
281#if PERL_VERSION_ATLEAST (5,9,0) 281#if PERL_VERSION_ATLEAST (5,10,0)
282 /* 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 */
283 get_av (name, create); 283 get_av (name, create);
284#endif 284#endif
285 return get_av (name, create); 285 return get_av (name, create);
286} 286}
287 287
288static HV * 288static HV *
289coro_get_hv (pTHX_ const char *name, int create) 289coro_get_hv (pTHX_ const char *name, int create)
290{ 290{
291#if PERL_VERSION_ATLEAST (5,9,0) 291#if PERL_VERSION_ATLEAST (5,10,0)
292 /* 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 */
293 get_hv (name, create); 293 get_hv (name, create);
294#endif 294#endif
295 return get_hv (name, create); 295 return get_hv (name, create);
296} 296}
… …
301 AV *padlist = CvPADLIST (cv); 301 AV *padlist = CvPADLIST (cv);
302 AV *newpadlist, *newpad; 302 AV *newpadlist, *newpad;
303 303
304 newpadlist = newAV (); 304 newpadlist = newAV ();
305 AvREAL_off (newpadlist); 305 AvREAL_off (newpadlist);
306#if PERL_VERSION_ATLEAST (5,9,0) 306#if PERL_VERSION_ATLEAST (5,10,0)
307 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1); 307 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
308#else 308#else
309 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); 309 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
310#endif 310#endif
311 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; 311 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
… …
592 592
593 New(54,PL_savestack,24,ANY); 593 New(54,PL_savestack,24,ANY);
594 PL_savestack_ix = 0; 594 PL_savestack_ix = 0;
595 PL_savestack_max = 24; 595 PL_savestack_max = 24;
596 596
597#if !PERL_VERSION_ATLEAST (5,9,0) 597#if !PERL_VERSION_ATLEAST (5,10,0)
598 New(54,PL_retstack,4,OP*); 598 New(54,PL_retstack,4,OP*);
599 PL_retstack_ix = 0; 599 PL_retstack_ix = 0;
600 PL_retstack_max = 4; 600 PL_retstack_max = 4;
601#endif 601#endif
602} 602}
… …
625 625
626 Safefree (PL_tmps_stack); 626 Safefree (PL_tmps_stack);
627 Safefree (PL_markstack); 627 Safefree (PL_markstack);
628 Safefree (PL_scopestack); 628 Safefree (PL_scopestack);
629 Safefree (PL_savestack); 629 Safefree (PL_savestack);
630#if !PERL_VERSION_ATLEAST (5,9,0) 630#if !PERL_VERSION_ATLEAST (5,10,0)
631 Safefree (PL_retstack); 631 Safefree (PL_retstack);
632#endif 632#endif
633} 633}
634 634
635static size_t 635static size_t
… …
659 rss += slot->tmps_max * sizeof (SV *); 659 rss += slot->tmps_max * sizeof (SV *);
660 rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32); 660 rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32);
661 rss += slot->scopestack_max * sizeof (I32); 661 rss += slot->scopestack_max * sizeof (I32);
662 rss += slot->savestack_max * sizeof (ANY); 662 rss += slot->savestack_max * sizeof (ANY);
663 663
664#if !PERL_VERSION_ATLEAST (5,9,0) 664#if !PERL_VERSION_ATLEAST (5,10,0)
665 rss += slot->retstack_max * sizeof (OP *); 665 rss += slot->retstack_max * sizeof (OP *);
666#endif 666#endif
667 } 667 }
668 668
669 return rss; 669 return rss;
… …
736 PL_curpm = 0; 736 PL_curpm = 0;
737 PL_curpad = 0; 737 PL_curpad = 0;
738 PL_localizing = 0; 738 PL_localizing = 0;
739 PL_dirty = 0; 739 PL_dirty = 0;
740 PL_restartop = 0; 740 PL_restartop = 0;
741#if PERL_VERSION_ATLEAST (5,10,0)
742 PL_parser = 0;
743#endif
741 744
742 /* recreate the die/warn hooks */ 745 /* recreate the die/warn hooks */
743 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 );
744 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);
745 748
… …
1126 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");
1127 1130
1128 if (expect_false (next->flags & CF_DESTROYED)) 1131 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"); 1132 croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
1130 1133
1131 if (
1132#if PERL_VERSION_ATLEAST (5,9,0) 1134#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) 1135 if (expect_false (PL_lex_state != LEX_NOTPARSING))
1136#endif
1137 )
1138 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 in your perl version");
1137#endif
1139 } 1138 }
1140} 1139}
1141 1140
1142/* always use the TRANSFER macro */ 1141/* always use the TRANSFER macro */
1143static void NOINLINE 1142static void NOINLINE
1144transfer (pTHX_ struct coro *prev, struct coro *next) 1143transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
1145{ 1144{
1146 dSTACKLEVEL; 1145 dSTACKLEVEL;
1147 static volatile int has_throw; 1146 static volatile int has_throw;
1148 1147
1149 /* sometimes transfer is only called to set idle_sp */ 1148 /* sometimes transfer is only called to set idle_sp */
… …
1183 load_perl (aTHX_ next); 1182 load_perl (aTHX_ next);
1184 1183
1185 prev__cctx = prev->cctx; 1184 prev__cctx = prev->cctx;
1186 1185
1187 /* possibly "free" the cctx */ 1186 /* possibly "free" the cctx */
1188 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 ))
1189 { 1192 {
1190 /* 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 */
1191 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));
1192 1195
1193 prev->cctx = 0; 1196 prev->cctx = 0;
… …
1236struct transfer_args 1239struct transfer_args
1237{ 1240{
1238 struct coro *prev, *next; 1241 struct coro *prev, *next;
1239}; 1242};
1240 1243
1241#define TRANSFER(ta) transfer (aTHX_ (ta).prev, (ta).next) 1244#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) 1245#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
1243 1246
1244/** high level stuff ********************************************************/ 1247/** high level stuff ********************************************************/
1245 1248
1246static int 1249static int
… …
1340{ 1343{
1341 dTHX; 1344 dTHX;
1342 struct transfer_args ta; 1345 struct transfer_args ta;
1343 1346
1344 prepare_transfer (aTHX_ &ta, prev_sv, next_sv); 1347 prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
1345 TRANSFER (ta); 1348 TRANSFER (ta, 1);
1346} 1349}
1347 1350
1348/** Coro ********************************************************************/ 1351/** Coro ********************************************************************/
1349 1352
1350static void 1353static void
… …
1481{ 1484{
1482 dTHX; 1485 dTHX;
1483 struct transfer_args ta; 1486 struct transfer_args ta;
1484 1487
1485 prepare_schedule (aTHX_ &ta); 1488 prepare_schedule (aTHX_ &ta);
1486 TRANSFER (ta); 1489 TRANSFER (ta, 1);
1487} 1490}
1488 1491
1489static int 1492static int
1490api_cede (void) 1493api_cede (void)
1491{ 1494{
… …
1494 1497
1495 prepare_cede (aTHX_ &ta); 1498 prepare_cede (aTHX_ &ta);
1496 1499
1497 if (expect_true (ta.prev != ta.next)) 1500 if (expect_true (ta.prev != ta.next))
1498 { 1501 {
1499 TRANSFER (ta); 1502 TRANSFER (ta, 1);
1500 return 1; 1503 return 1;
1501 } 1504 }
1502 else 1505 else
1503 return 0; 1506 return 0;
1504} 1507}
… …
1509 dTHX; 1512 dTHX;
1510 struct transfer_args ta; 1513 struct transfer_args ta;
1511 1514
1512 if (prepare_cede_notself (aTHX_ &ta)) 1515 if (prepare_cede_notself (aTHX_ &ta))
1513 { 1516 {
1514 TRANSFER (ta); 1517 TRANSFER (ta, 1);
1515 return 1; 1518 return 1;
1516 } 1519 }
1517 else 1520 else
1518 return 0; 1521 return 0;
1519} 1522}
… …
1661 } 1664 }
1662 SPAGAIN; 1665 SPAGAIN;
1663 1666
1664 BARRIER; 1667 BARRIER;
1665 PUTBACK; 1668 PUTBACK;
1666 TRANSFER (ta); 1669 TRANSFER (ta, 0);
1667 SPAGAIN; /* might be the sp of a different coroutine now */ 1670 SPAGAIN; /* might be the sp of a different coroutine now */
1668 /* be extra careful not to ever do anything after TRANSFER */ 1671 /* be extra careful not to ever do anything after TRANSFER */
1669} 1672}
1670 1673
1671bool 1674bool

Diff Legend

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