[ViewVC] Diff of: cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.328 by root, Tue Nov 25 09:49:43 2008 UTC vs.
Revision 1.337 by root, Fri Dec 5 18:26:10 2008 UTC

…		…
133	#else	133	#else
134	# define dSTACKLEVEL volatile void *stacklevel	134	# define dSTACKLEVEL volatile void *stacklevel
135	# define STACKLEVEL ((void *)&stacklevel)	135	# define STACKLEVEL ((void *)&stacklevel)
136	#endif	136	#endif
137		137
138	#define IN_DESTRUCT (PL_main_cv == Nullcv)	138	#define IN_DESTRUCT PL_dirty
139		139
140	#if __GNUC__ >= 3	140	#if __GNUC__ >= 3
141	# define attribute(x) __attribute__(x)	141	# define attribute(x) __attribute__(x)
142	# define expect(expr,value) __builtin_expect ((expr),(value))	142	# define expect(expr,value) __builtin_expect ((expr),(value))
143	# define INLINE static inline	143	# define INLINE static inline
…		…
355	HV *st;	355	HV *st;
356	GV *gvp;	356	GV *gvp;
357	return sv_2cv (sv, &st, &gvp, 0);	357	return sv_2cv (sv, &st, &gvp, 0);
358	}	358	}
359		359
		360	/*****************************************************************************/
		361	/* magic glue */
		362
		363	#define CORO_MAGIC_type_cv 26
		364	#define CORO_MAGIC_type_state PERL_MAGIC_ext
		365
		366	#define CORO_MAGIC_NN(sv, type) \
		367	(expect_true (SvMAGIC (sv)->mg_type == type) \
		368	? SvMAGIC (sv) \
		369	: mg_find (sv, type))
		370
		371	#define CORO_MAGIC(sv, type) \
		372	(expect_true (SvMAGIC (sv)) \
		373	? CORO_MAGIC_NN (sv, type) \
		374	: 0)
		375
		376	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
		377	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
		378
		379	INLINE struct coro *
		380	SvSTATE_ (pTHX_ SV *coro)
		381	{
		382	HV *stash;
		383	MAGIC *mg;
		384
		385	if (SvROK (coro))
		386	coro = SvRV (coro);
		387
		388	if (expect_false (SvTYPE (coro) != SVt_PVHV))
		389	croak ("Coro::State object required");
		390
		391	stash = SvSTASH (coro);
		392	if (expect_false (stash != coro_stash && stash != coro_state_stash))
		393	{
		394	/* very slow, but rare, check */
		395	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
		396	croak ("Coro::State object required");
		397	}
		398
		399	mg = CORO_MAGIC_state (coro);
		400	return (struct coro *)mg->mg_ptr;
		401	}
		402
		403	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
		404
		405	/* faster than SvSTATE, but expects a coroutine hv */
		406	#define SvSTATE_hv(hv) ((struct coro )CORO_MAGIC_NN ((SV )hv, CORO_MAGIC_type_state)->mg_ptr)
		407	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
		408
		409	/*****************************************************************************/
		410	/* padlist management and caching */
		411
360	static AV *	412	static AV *
361	coro_derive_padlist (pTHX_ CV *cv)	413	coro_derive_padlist (pTHX_ CV *cv)
362	{	414	{
363	AV *padlist = CvPADLIST (cv);	415	AV *padlist = CvPADLIST (cv);
364	AV newpadlist, newpad;	416	AV newpadlist, newpad;
…		…
371	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);	423	Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
372	#endif	424	#endif
373	newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];	425	newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
374	--AvFILLp (padlist);	426	--AvFILLp (padlist);
375		427
376	av_store (newpadlist, 0, SvREFCNT_inc_NN (*av_fetch (padlist, 0, FALSE)));	428	av_store (newpadlist, 0, SvREFCNT_inc_NN (AvARRAY (padlist)[0]));
377	av_store (newpadlist, 1, (SV *)newpad);	429	av_store (newpadlist, 1, (SV *)newpad);
378		430
379	return newpadlist;	431	return newpadlist;
380	}	432	}
381		433
382	static void	434	static void
383	free_padlist (pTHX_ AV *padlist)	435	free_padlist (pTHX_ AV *padlist)
384	{	436	{
385	/* may be during global destruction */	437	/* may be during global destruction */
386	if (SvREFCNT (padlist))	438	if (!IN_DESTRUCT)
387	{	439	{
388	I32 i = AvFILLp (padlist);	440	I32 i = AvFILLp (padlist);
389	while (i >= 0)	441
		442	while (i > 0) /* special-case index 0 */
390	{	443	{
391	SV **svp = av_fetch (padlist, i--, FALSE);	444	/* we try to be extra-careful here */
392	if (svp)	445	AV av = (AV )AvARRAY (padlist)[i--];
393	{	446	I32 j = AvFILLp (av);
394	SV *sv;	447
395	while (&PL_sv_undef != (sv = av_pop ((AV )svp)))	448	while (j >= 0)
		449	SvREFCNT_dec (AvARRAY (av)[j--]);
		450
		451	AvFILLp (av) = -1;
396	SvREFCNT_dec (sv);	452	SvREFCNT_dec (av);
397
398	SvREFCNT_dec (*svp);
399	}
400	}	453	}
401		454
		455	SvREFCNT_dec (AvARRAY (padlist)[0]);
		456
		457	AvFILLp (padlist) = -1;
402	SvREFCNT_dec ((SV*)padlist);	458	SvREFCNT_dec ((SV*)padlist);
403	}	459	}
404	}	460	}
405		461
406	static int	462	static int
…		…
415		471
416	SvREFCNT_dec (av); /* sv_magicext increased the refcount */	472	SvREFCNT_dec (av); /* sv_magicext increased the refcount */
417		473
418	return 0;	474	return 0;
419	}	475	}
420
421	#define CORO_MAGIC_type_cv 26
422	#define CORO_MAGIC_type_state PERL_MAGIC_ext
423		476
424	static MGVTBL coro_cv_vtbl = {	477	static MGVTBL coro_cv_vtbl = {
425	0, 0, 0, 0,	478	0, 0, 0, 0,
426	coro_cv_free	479	coro_cv_free
427	};	480	};
428
429	#define CORO_MAGIC_NN(sv, type) \
430	(expect_true (SvMAGIC (sv)->mg_type == type) \
431	? SvMAGIC (sv) \
432	: mg_find (sv, type))
433
434	#define CORO_MAGIC(sv, type) \
435	(expect_true (SvMAGIC (sv)) \
436	? CORO_MAGIC_NN (sv, type) \
437	: 0)
438
439	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
440	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
441
442	INLINE struct coro *
443	SvSTATE_ (pTHX_ SV *coro)
444	{
445	HV *stash;
446	MAGIC *mg;
447
448	if (SvROK (coro))
449	coro = SvRV (coro);
450
451	if (expect_false (SvTYPE (coro) != SVt_PVHV))
452	croak ("Coro::State object required");
453
454	stash = SvSTASH (coro);
455	if (expect_false (stash != coro_stash && stash != coro_state_stash))
456	{
457	/* very slow, but rare, check */
458	if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
459	croak ("Coro::State object required");
460	}
461
462	mg = CORO_MAGIC_state (coro);
463	return (struct coro *)mg->mg_ptr;
464	}
465
466	#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
467
468	/* faster than SvSTATE, but expects a coroutine hv */
469	#define SvSTATE_hv(hv) ((struct coro )CORO_MAGIC_NN ((SV )hv, CORO_MAGIC_type_state)->mg_ptr)
470	#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
471		481
472	/* the next two functions merely cache the padlists */	482	/* the next two functions merely cache the padlists */
473	static void	483	static void
474	get_padlist (pTHX_ CV *cv)	484	get_padlist (pTHX_ CV *cv)
475	{	485	{
…		…
503	mg = sv_magicext ((SV )cv, (SV )newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);	513	mg = sv_magicext ((SV )cv, (SV )newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
504		514
505	av = (AV *)mg->mg_obj;	515	av = (AV *)mg->mg_obj;
506		516
507	if (expect_false (AvFILLp (av) >= AvMAX (av)))	517	if (expect_false (AvFILLp (av) >= AvMAX (av)))
508	av_extend (av, AvMAX (av) + 1);	518	av_extend (av, AvFILLp (av) + 1);
509		519
510	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);	520	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
511	}	521	}
512		522
513	/ load & save, init *****************************************************/	523	/ load & save, init *****************************************************/
…		…
928	/* copy throw, in case it was set before coro_setup */	938	/* copy throw, in case it was set before coro_setup */
929	CORO_THROW = coro->except;	939	CORO_THROW = coro->except;
930	}	940	}
931		941
932	static void	942	static void
933	coro_destruct (pTHX_ struct coro *coro)	943	coro_unwind_stacks (pTHX)
934	{	944	{
935	if (!IN_DESTRUCT)	945	if (!IN_DESTRUCT)
936	{	946	{
937	/* restore all saved variables and stuff */	947	/* restore all saved variables and stuff */
938	LEAVE_SCOPE (0);	948	LEAVE_SCOPE (0);
…		…
946	POPSTACK_TO (PL_mainstack);	956	POPSTACK_TO (PL_mainstack);
947		957
948	/* unwind main stack */	958	/* unwind main stack */
949	dounwind (-1);	959	dounwind (-1);
950	}	960	}
		961	}
		962
		963	static void
		964	coro_destruct_perl (pTHX_ struct coro *coro)
		965	{
		966	coro_unwind_stacks (aTHX);
951		967
952	SvREFCNT_dec (GvSV (PL_defgv));	968	SvREFCNT_dec (GvSV (PL_defgv));
953	SvREFCNT_dec (GvAV (PL_defgv));	969	SvREFCNT_dec (GvAV (PL_defgv));
954	SvREFCNT_dec (GvSV (PL_errgv));	970	SvREFCNT_dec (GvSV (PL_errgv));
955	SvREFCNT_dec (PL_defoutgv);	971	SvREFCNT_dec (PL_defoutgv);
…		…
1267	cctx_destroy (coro_cctx *cctx)	1283	cctx_destroy (coro_cctx *cctx)
1268	{	1284	{
1269	if (!cctx)	1285	if (!cctx)
1270	return;	1286	return;
1271		1287
1272	assert (cctx != cctx_current);//D temporary	1288	assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));//D temporary?
1273		1289
1274	--cctx_count;	1290	--cctx_count;
1275	coro_destroy (&cctx->cctx);	1291	coro_destroy (&cctx->cctx);
1276		1292
1277	/* coro_transfer creates new, empty cctx's */	1293	/* coro_transfer creates new, empty cctx's */
…		…
1395	coro_setup (aTHX_ next);	1411	coro_setup (aTHX_ next);
1396	}	1412	}
1397	else	1413	else
1398	load_perl (aTHX_ next);	1414	load_perl (aTHX_ next);
1399		1415
1400	assert (!prev->cctx);//D temporary
1401
1402	/* possibly untie and reuse the cctx */	1416	/* possibly untie and reuse the cctx */
1403	if (expect_true (	1417	if (expect_true (
1404	cctx_current->idle_sp == STACKLEVEL	1418	cctx_current->idle_sp == STACKLEVEL
1405	&& !(cctx_current->flags & CC_TRACE)	1419	&& !(cctx_current->flags & CC_TRACE)
1406	&& !force_cctx	1420	&& !force_cctx
…		…
1461	--coro_nready;	1475	--coro_nready;
1462	}	1476	}
1463	else	1477	else
1464	coro->flags \|= CF_READY; /* make sure it is NOT put into the readyqueue */	1478	coro->flags \|= CF_READY; /* make sure it is NOT put into the readyqueue */
1465		1479
1466	if (coro->mainstack && coro->mainstack != main_mainstack)	1480	if (coro->mainstack
		1481	&& coro->mainstack != main_mainstack
		1482	&& coro->slot
		1483	&& !PL_dirty)
1467	{	1484	{
1468	struct coro temp;	1485	struct coro temp;
1469		1486
1470	assert (("FATAL: tried to destroy currently running coroutine (please report)", !(coro->flags & CF_RUNNING)));	1487	assert (("FATAL: tried to destroy currently running coroutine", coro->mainstack != PL_mainstack));
1471		1488
1472	save_perl (aTHX_ &temp);	1489	save_perl (aTHX_ &temp);
1473	load_perl (aTHX_ coro);	1490	load_perl (aTHX_ coro);
1474		1491
1475	coro_destruct (aTHX_ coro);	1492	coro_destruct_perl (aTHX_ coro);
1476		1493
1477	load_perl (aTHX_ &temp);	1494	load_perl (aTHX_ &temp);
1478		1495
1479	coro->slot = 0;	1496	coro->slot = 0;
1480	}	1497	}
…		…
1852	av_push (av_destroy, (SV )newRV_inc ((SV )hv)); /* RVinc for perl */	1869	av_push (av_destroy, (SV )newRV_inc ((SV )hv)); /* RVinc for perl */
1853	api_ready (aTHX_ sv_manager);	1870	api_ready (aTHX_ sv_manager);
1854		1871
1855	frame->prepare = prepare_schedule;	1872	frame->prepare = prepare_schedule;
1856	frame->check = slf_check_repeat;	1873	frame->check = slf_check_repeat;
		1874
		1875	/* as a minor optimisation, we could unwind all stacks here */
		1876	/* but that puts extra pressure on pp_slf, and is not worth much */
		1877	/coro_unwind_stacks (aTHX);/
1857	}	1878	}
1858		1879
1859	/*****************************************************************************/	1880	/*****************************************************************************/
1860	/* async pool handler */	1881	/* async pool handler */
1861		1882
…		…
2370	SV **ary;	2391	SV **ary;
2371		2392
2372	/* unfortunately, building manually saves memory */	2393	/* unfortunately, building manually saves memory */
2373	Newx (ary, 2, SV *);	2394	Newx (ary, 2, SV *);
2374	AvALLOC (av) = ary;	2395	AvALLOC (av) = ary;
		2396	#if PERL_VERSION_ATLEAST (5,10,0)
2375	/AvARRAY (av) = ary;/	2397	AvARRAY (av) = ary;
		2398	#else
2376	SvPVX ((SV )av) = (char )ary; /* 5.8.8 needs this syntax instead of AvARRAY = ary */	2399	/* 5.8.8 needs this syntax instead of AvARRAY = ary, yet */
		2400	/* -DDEBUGGING flags this as a bug, despite it perfectly working */
		2401	SvPVX ((SV )av) = (char )ary;
		2402	#endif
2377	AvMAX (av) = 1;	2403	AvMAX (av) = 1;
2378	AvFILLp (av) = 0;	2404	AvFILLp (av) = 0;
2379	ary [0] = newSViv (count);	2405	ary [0] = newSViv (count);
2380		2406
2381	return newRV_noinc ((SV *)av);	2407	return newRV_noinc ((SV *)av);
…		…
2910	SV *	2936	SV *
2911	clone (Coro::State coro)	2937	clone (Coro::State coro)
2912	CODE:	2938	CODE:
2913	{	2939	{
2914	#if CORO_CLONE	2940	#if CORO_CLONE
2915	struct coro *ncoro = coro_clone (coro);	2941	struct coro *ncoro = coro_clone (aTHX_ coro);
2916	MAGIC *mg;	2942	MAGIC *mg;
2917	/* TODO: too much duplication */	2943	/* TODO: too much duplication */
2918	ncoro->hv = newHV ();	2944	ncoro->hv = newHV ();
2919	mg = sv_magicext ((SV )ncoro->hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char )ncoro, 0);	2945	mg = sv_magicext ((SV )ncoro->hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char )ncoro, 0);
2920	mg->mg_flags \|= MGf_DUP;	2946	mg->mg_flags \|= MGf_DUP;
…		…
3111	{	3137	{
3112	int i;	3138	int i;
3113		3139
3114	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);	3140	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
3115	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);	3141	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
3116	cv_coro_run = get_cv ( "Coro::_terminate", GV_ADD);	3142	cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);
3117	cv_coro_terminate = get_cv ( "Coro::terminate" , GV_ADD);	3143	cv_coro_terminate = get_cv ( "Coro::terminate" , GV_ADD);
3118	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);	3144	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);
3119	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);	3145	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
3120	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);	3146	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);
3121	sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);	3147	sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.328 by root, Tue Nov 25 09:49:43 2008 UTC vs. Revision 1.337 by root, Fri Dec 5 18:26:10 2008 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.328 by root, Tue Nov 25 09:49:43 2008 UTC vs.
Revision 1.337 by root, Fri Dec 5 18:26:10 2008 UTC