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.320 by root, Fri Nov 21 07:29:04 2008 UTC vs.
Revision 1.322 by root, Sat Nov 22 05:13:34 2008 UTC

101# define CvISXSUB_on(cv) (void)cv 101# define CvISXSUB_on(cv) (void)cv
102#endif 102#endif
103#ifndef CvISXSUB 103#ifndef CvISXSUB
104# define CvISXSUB(cv) (CvXSUB (cv) ? TRUE : FALSE) 104# define CvISXSUB(cv) (CvXSUB (cv) ? TRUE : FALSE)
105#endif 105#endif
106#ifndef Newx
107# define Newx(ptr,nitems,type) New (0,ptr,nitems,type)
108#endif
106 109
107/* 5.8.7 */ 110/* 5.8.7 */
108#ifndef SvRV_set 111#ifndef SvRV_set
109# define SvRV_set(s,v) SvRV(s) = (v) 112# define SvRV_set(s,v) SvRV(s) = (v)
110#endif 113#endif
225 int valgrind_id; 228 int valgrind_id;
226#endif 229#endif
227 unsigned char flags; 230 unsigned char flags;
228} coro_cctx; 231} coro_cctx;
229 232
233coro_cctx *cctx_current; /* the currently running cctx */
234
235/*****************************************************************************/
236
230enum { 237enum {
231 CF_RUNNING = 0x0001, /* coroutine is running */ 238 CF_RUNNING = 0x0001, /* coroutine is running */
232 CF_READY = 0x0002, /* coroutine is ready */ 239 CF_READY = 0x0002, /* coroutine is ready */
233 CF_NEW = 0x0004, /* has never been switched to */ 240 CF_NEW = 0x0004, /* has never been switched to */
234 CF_DESTROYED = 0x0008, /* coroutine data has been freed */ 241 CF_DESTROYED = 0x0008, /* coroutine data has been freed */
347 GV *gvp; 354 GV *gvp;
348 return sv_2cv (sv, &st, &gvp, 0); 355 return sv_2cv (sv, &st, &gvp, 0);
349} 356}
350 357
351static AV * 358static AV *
352coro_clone_padlist (pTHX_ CV *cv) 359coro_derive_padlist (pTHX_ CV *cv)
353{ 360{
354 AV *padlist = CvPADLIST (cv); 361 AV *padlist = CvPADLIST (cv);
355 AV *newpadlist, *newpad; 362 AV *newpadlist, *newpad;
356 363
357 newpadlist = newAV (); 364 newpadlist = newAV ();
477 CV *cp = Perl_cv_clone (aTHX_ cv); 484 CV *cp = Perl_cv_clone (aTHX_ cv);
478 CvPADLIST (cv) = CvPADLIST (cp); 485 CvPADLIST (cv) = CvPADLIST (cp);
479 CvPADLIST (cp) = 0; 486 CvPADLIST (cp) = 0;
480 SvREFCNT_dec (cp); 487 SvREFCNT_dec (cp);
481#else 488#else
482 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv); 489 CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);
483#endif 490#endif
484 } 491 }
485} 492}
486 493
487static void 494static void
1082 1089
1083 TAINT_NOT; 1090 TAINT_NOT;
1084 return 0; 1091 return 0;
1085} 1092}
1086 1093
1087static struct coro_cctx *cctx_ssl_cctx;
1088static struct CoroSLF cctx_ssl_frame; 1094static struct CoroSLF cctx_ssl_frame;
1089 1095
1090static void 1096static void
1091slf_prepare_set_stacklevel (pTHX_ struct coro_transfer_args *ta) 1097slf_prepare_set_stacklevel (pTHX_ struct coro_transfer_args *ta)
1092{ 1098{
1093 ta->prev = (struct coro *)cctx_ssl_cctx;
1094 ta->next = 0; 1099 ta->prev = 0;
1095} 1100}
1096 1101
1097static int 1102static int
1098slf_check_set_stacklevel (pTHX_ struct CoroSLF *frame) 1103slf_check_set_stacklevel (pTHX_ struct CoroSLF *frame)
1099{ 1104{
1102 return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */ 1107 return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */
1103} 1108}
1104 1109
1105/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */ 1110/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */
1106static void NOINLINE 1111static void NOINLINE
1107cctx_prepare (pTHX_ coro_cctx *cctx) 1112cctx_prepare (pTHX)
1108{ 1113{
1109 PL_top_env = &PL_start_env; 1114 PL_top_env = &PL_start_env;
1110 1115
1111 if (cctx->flags & CC_TRACE) 1116 if (cctx_current->flags & CC_TRACE)
1112 PL_runops = runops_trace; 1117 PL_runops = runops_trace;
1113 1118
1114 /* we already must be executing an SLF op, there is no other valid way 1119 /* we already must be executing an SLF op, there is no other valid way
1115 * that can lead to creation of a new cctx */ 1120 * that can lead to creation of a new cctx */
1116 assert (("FATAL: can't prepare slf-less cctx in Coro module (please report)", 1121 assert (("FATAL: can't prepare slf-less cctx in Coro module (please report)",
1117 slf_frame.prepare && PL_op->op_ppaddr == pp_slf)); 1122 slf_frame.prepare && PL_op->op_ppaddr == pp_slf));
1118 1123
1119 /* we must emulate leaving pp_slf, which is done inside slf_check_set_stacklevel */ 1124 /* we must emulate leaving pp_slf, which is done inside slf_check_set_stacklevel */
1120 cctx_ssl_cctx = cctx;
1121 cctx_ssl_frame = slf_frame; 1125 cctx_ssl_frame = slf_frame;
1122 1126
1123 slf_frame.prepare = slf_prepare_set_stacklevel; 1127 slf_frame.prepare = slf_prepare_set_stacklevel;
1124 slf_frame.check = slf_check_set_stacklevel; 1128 slf_frame.check = slf_check_set_stacklevel;
1125} 1129}
1148 /* normally we would need to skip the entersub here */ 1152 /* normally we would need to skip the entersub here */
1149 /* not doing so will re-execute it, which is exactly what we want */ 1153 /* not doing so will re-execute it, which is exactly what we want */
1150 /* PL_nop = PL_nop->op_next */ 1154 /* PL_nop = PL_nop->op_next */
1151 1155
1152 /* inject a fake subroutine call to cctx_init */ 1156 /* inject a fake subroutine call to cctx_init */
1153 cctx_prepare (aTHX_ (coro_cctx *)arg); 1157 cctx_prepare (aTHX);
1154 1158
1155 /* cctx_run is the alternative tail of transfer() */ 1159 /* cctx_run is the alternative tail of transfer() */
1156 transfer_tail (aTHX); 1160 transfer_tail (aTHX);
1157 1161
1158 /* somebody or something will hit me for both perl_run and PL_restartop */ 1162 /* somebody or something will hit me for both perl_run and PL_restartop */
1253cctx_destroy (coro_cctx *cctx) 1257cctx_destroy (coro_cctx *cctx)
1254{ 1258{
1255 if (!cctx) 1259 if (!cctx)
1256 return; 1260 return;
1257 1261
1262 assert (cctx != cctx_current);//D temporary
1263
1258 --cctx_count; 1264 --cctx_count;
1259 coro_destroy (&cctx->cctx); 1265 coro_destroy (&cctx->cctx);
1260 1266
1261 /* coro_transfer creates new, empty cctx's */ 1267 /* coro_transfer creates new, empty cctx's */
1262 if (cctx->sptr) 1268 if (cctx->sptr)
1347transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx) 1353transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
1348{ 1354{
1349 dSTACKLEVEL; 1355 dSTACKLEVEL;
1350 1356
1351 /* sometimes transfer is only called to set idle_sp */ 1357 /* sometimes transfer is only called to set idle_sp */
1352 if (expect_false (!next)) 1358 if (expect_false (!prev))
1353 { 1359 {
1354 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 1360 cctx_current->idle_sp = STACKLEVEL;
1355 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */ 1361 assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1356 } 1362 }
1357 else if (expect_true (prev != next)) 1363 else if (expect_true (prev != next))
1358 { 1364 {
1359 coro_cctx *prev__cctx; 1365 coro_cctx *cctx_prev;
1360 1366
1361 if (expect_false (prev->flags & CF_NEW)) 1367 if (expect_false (prev->flags & CF_NEW))
1362 { 1368 {
1363 /* create a new empty/source context */ 1369 /* create a new empty/source context */
1364 prev->cctx = cctx_new_empty ();
1365 prev->flags &= ~CF_NEW; 1370 prev->flags &= ~CF_NEW;
1366 prev->flags |= CF_RUNNING; 1371 prev->flags |= CF_RUNNING;
1367 } 1372 }
1368 1373
1369 prev->flags &= ~CF_RUNNING; 1374 prev->flags &= ~CF_RUNNING;
1380 coro_setup (aTHX_ next); 1385 coro_setup (aTHX_ next);
1381 } 1386 }
1382 else 1387 else
1383 load_perl (aTHX_ next); 1388 load_perl (aTHX_ next);
1384 1389
1385 prev__cctx = prev->cctx;
1386
1387 /* possibly untie and reuse the cctx */ 1390 /* possibly untie and reuse the cctx */
1388 if (expect_true ( 1391 if (expect_true (
1389 prev__cctx->idle_sp == STACKLEVEL 1392 cctx_current->idle_sp == STACKLEVEL
1390 && !(prev__cctx->flags & CC_TRACE) 1393 && !(cctx_current->flags & CC_TRACE)
1391 && !force_cctx 1394 && !force_cctx
1392 )) 1395 ))
1393 { 1396 {
1394 /* I assume that stacklevel is a stronger indicator than PL_top_env changes */ 1397 /* I assume that stacklevel is a stronger indicator than PL_top_env changes */
1395 assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == prev__cctx->idle_te)); 1398 assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));
1396
1397 prev->cctx = 0;
1398 1399
1399 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */ 1400 /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */
1400 /* without this the next cctx_get might destroy the prev__cctx while still in use */ 1401 /* without this the next cctx_get might destroy the prev__cctx while still in use */
1401 if (expect_false (CCTX_EXPIRED (prev__cctx))) 1402 if (expect_false (CCTX_EXPIRED (cctx_current)))
1402 if (!next->cctx) 1403 if (!next->cctx)
1403 next->cctx = cctx_get (aTHX); 1404 next->cctx = cctx_get (aTHX);
1404 1405
1405 cctx_put (prev__cctx); 1406 cctx_put (cctx_current);
1407 assert (!prev->cctx);//D temporary
1406 } 1408 }
1409 else
1410 prev->cctx = cctx_current;
1407 1411
1408 ++next->usecount; 1412 ++next->usecount;
1409 1413
1410 if (expect_true (!next->cctx)) 1414 cctx_prev = cctx_current;
1411 next->cctx = cctx_get (aTHX); 1415 cctx_current = expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);
1412 1416
1413 if (expect_false (prev__cctx != next->cctx)) 1417 next->cctx = 0;
1418
1419 if (expect_false (cctx_prev != cctx_current))
1414 { 1420 {
1415 prev__cctx->top_env = PL_top_env; 1421 cctx_prev->top_env = PL_top_env;
1416 PL_top_env = next->cctx->top_env; 1422 PL_top_env = cctx_current->top_env;
1417 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx); 1423 coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);
1418 } 1424 }
1419 1425
1420 transfer_tail (aTHX); 1426 transfer_tail (aTHX);
1421 } 1427 }
1422} 1428}
2724 XSRETURN_EMPTY; 2730 XSRETURN_EMPTY;
2725} 2731}
2726 2732
2727/*****************************************************************************/ 2733/*****************************************************************************/
2728 2734
2735#if CORO_CLONE
2736# include "clone.c"
2737#endif
2738
2729MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_ 2739MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
2730 2740
2731PROTOTYPES: DISABLE 2741PROTOTYPES: DISABLE
2732 2742
2733BOOT: 2743BOOT:
2736# if CORO_PTHREAD 2746# if CORO_PTHREAD
2737 coro_thx = PERL_GET_CONTEXT; 2747 coro_thx = PERL_GET_CONTEXT;
2738# endif 2748# endif
2739#endif 2749#endif
2740 BOOT_PAGESIZE; 2750 BOOT_PAGESIZE;
2751
2752 cctx_current = cctx_new_empty ();
2741 2753
2742 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV); 2754 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
2743 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); 2755 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
2744 2756
2745 orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get; 2757 orig_sigelem_get = PL_vtbl_sigelem.svt_get; PL_vtbl_sigelem.svt_get = coro_sigelem_get;
2871void 2883void
2872_exit (int code) 2884_exit (int code)
2873 PROTOTYPE: $ 2885 PROTOTYPE: $
2874 CODE: 2886 CODE:
2875 _exit (code); 2887 _exit (code);
2888
2889SV *
2890clone (Coro::State coro)
2891 CODE:
2892{
2893#if CORO_CLONE
2894 struct coro *ncoro = coro_clone (coro);
2895 MAGIC *mg;
2896 /* TODO: too much duplication */
2897 ncoro->hv = newHV ();
2898 mg = sv_magicext ((SV *)ncoro->hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)ncoro, 0);
2899 mg->mg_flags |= MGf_DUP;
2900 RETVAL = sv_bless (newRV_noinc ((SV *)ncoro->hv), SvSTASH (coro->hv));
2901#else
2902 croak ("Coro::State->clone has not been configured into this installation of Coro, realised");
2903#endif
2904}
2905 OUTPUT:
2906 RETVAL
2876 2907
2877int 2908int
2878cctx_stacksize (int new_stacksize = 0) 2909cctx_stacksize (int new_stacksize = 0)
2879 PROTOTYPE: ;$ 2910 PROTOTYPE: ;$
2880 CODE: 2911 CODE:

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines