Commit 23746cad42edc7f4c90db1fd472e349f623563c5 - libcoro-perl

+18

-0

Changes less more

4	4	TODO: __GCC_HAVE_DWARF2_CFI_ASM
5	5	TODO: swap_sv, maybe add scope_swap_sv, andallow to unswap by repeat?
6	6	TODO: swap_sv not undone in pool
	7
	8	6.37 Tue Mar 4 13:27:33 CET 2014
	9	- sigh, removed leftover dbeugging code from debugging a
	10	perl bug, of all things.
	11
	12	6.36 Tue Mar 4 07:11:59 CET 2014
	13	- semaphores would not clear the destroy hook when interrupted
	14	by ->throw, causing segfaults or worse.
	15	- ->throw on a thread waiting for a semaphore did not acquire
	16	the semaphore, but also didn't wake up other waiters,
	17	possibly causing a deadlock.
	18	- "FATAL: $Coro::IDLE blocked itself" will now use Carp::confess
	19	to report a full stacktrace, which should help find out
	20	where the actual call is.
	21	- "atomically" destroy data in slf_destroy, because it is
	22	the right thing to do, just in case.
	23	- disable ecb.h libm dependency, to compile on ancient systems
	24	or under adverse conditions.
7	25
8	26	6.33 Mon Nov 18 11:26:27 CET 2013
9	27	- do not crash when freeing padlists with holes (in 5.18).

+1

-1

Coro/AIO.pm less more

68	68
69	69	use base Exporter::;
70	70
71		our $VERSION = 6.33;
	71	our $VERSION = 6.37;
72	72
73	73	our @EXPORT = (@IO::AIO::EXPORT, qw(aio_wait));
74	74	our @EXPORT_OK = @IO::AIO::EXPORT_OK;

+2

-2

Coro/AnyEvent.pm less more

162	162	use Coro;
163	163	use AnyEvent ();
164	164
165		our $VERSION = 6.33;
	165	our $VERSION = 6.37;
166	166
167	167	#############################################################################
168	168	# idle handler

253	253
254	254	my $long_calc = async {
255	255	for (1..10000) {
256		Coro::AnyEvent::poll:
	256	Coro::AnyEvent::poll;
257	257	# do some stuff, make sure it takes at least 0.001s or so
258	258	}
259	259	}

+1

-1

Coro/BDB.pm less more

46	46
47	47	use base Exporter::;
48	48
49		our $VERSION = 6.33;
	49	our $VERSION = 6.37;
50	50	our $WATCHER;
51	51
52	52	BDB::set_sync_prepare {

+1

-1

Coro/Channel.pm less more

34	34	use Coro ();
35	35	use Coro::Semaphore ();
36	36
37		our $VERSION = 6.33;
	37	our $VERSION = 6.37;
38	38
39	39	sub DATA (){ 0 }
40	40	sub SGET (){ 1 }

+2

-2

Coro/Debug.pm less more

119	119	use Coro::AnyEvent ();
120	120	use Coro::Timer ();
121	121
122		our $VERSION = 6.33;
	122	our $VERSION = 6.37;
123	123
124	124	our %log;
125	125	our $SESLOGLEVEL = exists $ENV{PERL_CORO_DEFAULT_LOGLEVEL} ? $ENV{PERL_CORO_DEFAULT_LOGLEVEL} : -1;

276	276	for my $coro (reverse Coro::State::list) {
277	277	my @bt;
278	278	Coro::State::call ($coro, sub {
279		# we try to find the definite frame that gives msot useful info
	279	# we try to find the definite frame that gives most useful info
280	280	# by skipping Coro frames and pseudo-frames.
281	281	for my $frame (1..10) {
282	282	my @frame = caller $frame;

+1

-1

Coro/Handle.pm less more

45	45
46	46	use base 'Exporter';
47	47
48		our $VERSION = 6.33;
	48	our $VERSION = 6.37;
49	49	our @EXPORT = qw(unblock);
50	50
51	51	=item $fh = new_from_fh Coro::Handle $fhandle [, arg => value...]

+1

-1

Coro/LWP.pm less more

125	125	use Net::FTP ();
126	126	use Net::NNTP ();
127	127
128		our $VERSION = 6.33;
	128	our $VERSION = 6.37;
129	129
130	130	*Socket::inet_aton = \&Coro::Util::inet_aton;
131	131

+1

-1

Coro/MakeMaker.pm less more

6	6
7	7	our $installsitearch;
8	8
9		our $VERSION = 6.33;
	9	our $VERSION = 6.37;
10	10	our @EXPORT_OK = qw(&coro_args $installsitearch);
11	11
12	12	my %opt;

+3

-2

Coro/Makefile.PL less more

320	320
321	321	EOF
322	322
323		my $valgrind = prompt ("Enable valgrind support (y/n)?",
324		-r "/usr/include/valgrind/valgrind.h" ? "y" : "n");
	323	my $valgrind = -r "/usr/include/valgrind/valgrind.h" ? "y" : "n";
	324	$valgrind = $ENV{CORO_USE_VALGRIND} if exists $ENV{CORO_USE_VALGRIND};
	325	$valgrind = prompt ("Enable valgrind support (y/n)?", $valgrind);
325	326	$DEFINE .= " -DCORO_USE_VALGRIND=1" if $valgrind =~ /[yY]/;
326	327
327	328

+1

-1

Coro/RWLock.pm less more

37	37
38	38	use Coro ();
39	39
40		our $VERSION = 6.33;
	40	our $VERSION = 6.37;
41	41
42	42	=item $l = new Coro::RWLock;
43	43

+1

-1

Coro/Select.pm less more

66	66
67	67	use base Exporter::;
68	68
69		our $VERSION = 6.33;
	69	our $VERSION = 6.37;
70	70	our @EXPORT_OK = "select";
71	71
72	72	sub import {

+4

-3

Coro/Semaphore.pm less more

41	41
42	42	use Coro ();
43	43
44		our $VERSION = 6.33;
	44	our $VERSION = 6.37;
45	45
46	46	=item new [inital count]
47	47

52	52
53	53	=item $sem->count
54	54
55		Returns the current semaphore count.
	55	Returns the current semaphore count. The semaphore can be down'ed without
	56	blocking when the count is strictly higher than C<0>.
56	57
57	58	=item $sem->adjust ($diff)
58	59

63	64	=item $sem->down
64	65
65	66	Decrement the counter, therefore "locking" the semaphore. This method
66		waits until the semaphore is available if the counter is zero.
	67	waits until the semaphore is available if the counter is zero or less.
67	68
68	69	=item $sem->wait
69	70

+1

-1

Coro/SemaphoreSet.pm less more

34	34
35	35	use common::sense;
36	36
37		our $VERSION = 6.33;
	37	our $VERSION = 6.37;
38	38
39	39	use Coro::Semaphore ();
40	40

+2

-2

Coro/Signal.pm less more

37	37
38	38	use Coro::Semaphore ();
39	39
40		our $VERSION = 6.33;
	40	our $VERSION = 6.37;
41	41
42	42	=item $sig = new Coro::Signal;
43	43

48	48	Wait for the signal to occur (via either C<send> or C<broadcast>). Returns
49	49	immediately if the signal has been sent before.
50	50
51		=item $sem->wait ($callback)
	51	=item $sig->wait ($callback)
52	52
53	53	If you pass a callback argument to C<wait>, it will not wait, but
54	54	immediately return. The callback will be called under the same conditions

+1

-1

Coro/Socket.pm less more

72	72
73	73	use base qw(Coro::Handle IO::Socket::INET);
74	74
75		our $VERSION = 6.33;
	75	our $VERSION = 6.37;
76	76
77	77	our (%_proto, %_port);
78	78

+1

-1

Coro/Specific.pm less more

35	35
36	36	use common::sense;
37	37
38		our $VERSION = 6.33;
	38	our $VERSION = 6.37;
39	39
40	40	=item new
41	41

+6

-5

Coro/State.pm less more

92	92	use XSLoader;
93	93
94	94	BEGIN {
95		our $VERSION = 6.33;
	95	our $VERSION = 6.37;
96	96
97	97	# must be done here because the xs part expects it to exist
98	98	# it might exist already because Coro::Specific created it.

389	389	=item $old = Coro::State::cctx_stacksize [$new_stacksize]
390	390
391	391	Returns the current C stack size and optionally sets the new I<minimum>
392		stack size to C<$new_stacksize> I<pointers>s. Existing stacks will not
393		be changed, but Coro will try to replace smaller stacks as soon as
394		possible. Any Coro::State that starts to use a stack after this call is
395		guaranteed this minimum stack size.
	392	stack size to C<$new_stacksize> (in units of pointer sizes, i.e. typically
	393	4 on 32 bit and 8 on 64 bit hosts). Existing stacks will not be changed,
	394	but Coro will try to replace smaller stacks as soon as possible. Any
	395	Coro::State that starts to use a stack after this call is guaranteed this
	396	minimum stack size.
396	397
397	398	Please note that coros will only need to use a C-level stack if the
398	399	interpreter recurses or calls a function in a module that calls back into

+34

-9

Coro/State.xs less more

15	15	#include "schmorp.h"
16	16
17	17	#define ECB_NO_THREADS 1
	18	#define ECB_NO_LIBM 1
18	19	#include "ecb.h"
19	20
20	21	#include <stddef.h>

1917	1918	&& SvOBJECT (SvRV (sv_idle)))
1918	1919	{
1919	1920	if (SvRV (sv_idle) == SvRV (coro_current))
1920		croak ("FATAL: $Coro::IDLE blocked itself - did you try to block inside an event loop callback? Caught");
	1921	{
	1922	require_pv ("Carp");
	1923
	1924	{
	1925	dSP;
	1926
	1927	ENTER;
	1928	SAVETMPS;
	1929
	1930	PUSHMARK (SP);
	1931	XPUSHs (sv_2mortal (newSVpv ("FATAL: $Coro::IDLE blocked itself - did you try to block inside an event loop callback? Caught", 0)));
	1932	PUTBACK;
	1933	call_pv ("Carp::confess", G_VOID \| G_DISCARD);
	1934
	1935	FREETMPS;
	1936	LEAVE;
	1937	}
	1938	}
1921	1939
1922	1940	++coro_nready; /* hack so that api_ready doesn't invoke ready hook */
1923	1941	api_ready (aTHX_ SvRV (sv_idle));

2582	2600	static void
2583	2601	slf_destroy (pTHX_ struct coro *coro)
2584	2602	{
2585		/* this callback is reserved for slf functions needing to do cleanup */
2586		if (coro->slf_frame.destroy && coro->slf_frame.prepare && !PL_dirty)
2587		coro->slf_frame.destroy (aTHX_ &coro->slf_frame);
	2603	struct CoroSLF frame = coro->slf_frame;
2588	2604
2589	2605	/*
2590		* The on_destroy above most likely is from an SLF call.
	2606	* The on_destroy below most likely is from an SLF call.
2591	2607	* Since by definition the SLF call will not finish when we destroy
2592	2608	* the coro, we will have to force-finish it here, otherwise
2593	2609	* cleanup functions cannot call SLF functions.
2594	2610	*/
2595	2611	coro->slf_frame.prepare = 0;
	2612
	2613	/* this callback is reserved for slf functions needing to do cleanup */
	2614	if (frame.destroy && frame.prepare && !PL_dirty)
	2615	frame.destroy (aTHX_ &frame);
2596	2616	}
2597	2617
2598	2618	/*

2942	2962	SV *count_sv = AvARRAY (av)[0];
2943	2963	SV *coro_hv = SvRV (coro_current);
2944	2964
	2965	frame->destroy = 0;
	2966
2945	2967	/* if we are about to throw, don't actually acquire the lock, just throw */
2946		if (CORO_THROW)
2947		return 0;
	2968	if (ecb_expect_false (CORO_THROW))
	2969	{
	2970	/* we still might be responsible for the semaphore, so wake up others */
	2971	coro_semaphore_adjust (aTHX_ av, 0);
	2972
	2973	return 0;
	2974	}
2948	2975	else if (SvIVX (count_sv) > 0)
2949	2976	{
2950		frame->destroy = 0;
2951
2952	2977	if (acquire)
2953	2978	SvIVX (count_sv) = SvIVX (count_sv) - 1;
2954	2979	else

+1

-1

Coro/Storable.pm less more

83	83	use Storable;
84	84	use base "Exporter";
85	85
86		our $VERSION = 6.33;
	86	our $VERSION = 6.37;
87	87	our @EXPORT = qw(thaw freeze nfreeze blocking_thaw blocking_freeze blocking_nfreeze);
88	88
89	89	our $GRANULARITY = 0.01;

+1

-1

Coro/Timer.pm less more

27	27	use Coro ();
28	28	use Coro::AnyEvent ();
29	29
30		our $VERSION = 6.33;
	30	our $VERSION = 6.37;
31	31	our @EXPORT_OK = qw(timeout sleep);
32	32
33	33	# compatibility with older programs

+1

-1

Coro/Util.pm less more

40	40	our @EXPORT = qw(gethostbyname gethostbyaddr);
41	41	our @EXPORT_OK = qw(inet_aton fork_eval);
42	42
43		our $VERSION = 6.33;
	43	our $VERSION = 6.37;
44	44
45	45	our $MAXPARALLEL = 16; # max. number of parallel jobs
46	46

+30

-5

Coro/ecb.h less more

65	65	#endif
66	66
67	67	/* work around x32 idiocy by defining proper macros */
68		#if __x86_64 \|\| _M_AMD64
	68	#if __amd64 \|\| __x86_64 \|\| _M_AMD64 \|\| _M_X64
69	69	#if _ILP32
70	70	#define ECB_AMD64_X32 1
71	71	#else

88	88	#endif
89	89	#endif
90	90
91		#define ECB_C (__STDC__+0) /* this assumes that __STDC__ is either empty or a number */
92		#define ECB_C99 (__STDC_VERSION__ >= 199901L)
93		#define ECB_C11 (__STDC_VERSION__ >= 201112L)
94	91	#define ECB_CPP (__cplusplus+0)
95	92	#define ECB_CPP11 (__cplusplus >= 201103L)
	93
	94	#if ECB_CPP
	95	#define ECB_C 0
	96	#define ECB_STDC_VERSION 0
	97	#else
	98	#define ECB_C 1
	99	#define ECB_STDC_VERSION __STDC_VERSION__
	100	#endif
	101
	102	#define ECB_C99 (ECB_STDC_VERSION >= 199901L)
	103	#define ECB_C11 (ECB_STDC_VERSION >= 201112L)
96	104
97	105	#if ECB_CPP
98	106	#define ECB_EXTERN_C extern "C"

135	143	#elif defined __ARM_ARCH_7__ \|\| defined __ARM_ARCH_7A__ \
136	144	\|\| defined __ARM_ARCH_7M__ \|\| defined __ARM_ARCH_7R__
137	145	#define ECB_MEMORY_FENCE __asm__ __volatile__ ("dmb" : : : "memory")
138		#elif __sparc \|\| __sparc__
	146	#elif (__sparc \|\| __sparc__) && !__sparcv8
139	147	#define ECB_MEMORY_FENCE __asm__ __volatile__ ("membar #LoadStore \| #LoadLoad \| #StoreStore \| #StoreLoad" : : : "memory")
140	148	#define ECB_MEMORY_FENCE_ACQUIRE __asm__ __volatile__ ("membar #LoadStore \| #LoadLoad" : : : "memory")
141	149	#define ECB_MEMORY_FENCE_RELEASE __asm__ __volatile__ ("membar #LoadStore \| #StoreStore")

166	174	#if ECB_GCC_VERSION(4,7)
167	175	/* see comment below (stdatomic.h) about the C11 memory model. */
168	176	#define ECB_MEMORY_FENCE __atomic_thread_fence (__ATOMIC_SEQ_CST)
	177	#define ECB_MEMORY_FENCE_ACQUIRE __atomic_thread_fence (__ATOMIC_ACQUIRE)
	178	#define ECB_MEMORY_FENCE_RELEASE __atomic_thread_fence (__ATOMIC_RELEASE)
169	179
170	180	/* The __has_feature syntax from clang is so misdesigned that we cannot use it
171	181	* without risking compile time errors with other compilers. We could

174	184	* #elif defined __clang && __has_feature (cxx_atomic)
175	185	* // see comment below (stdatomic.h) about the C11 memory model.
176	186	* #define ECB_MEMORY_FENCE __c11_atomic_thread_fence (__ATOMIC_SEQ_CST)
	187	* #define ECB_MEMORY_FENCE_ACQUIRE __c11_atomic_thread_fence (__ATOMIC_ACQUIRE)
	188	* #define ECB_MEMORY_FENCE_RELEASE __c11_atomic_thread_fence (__ATOMIC_RELEASE)
177	189	*/
178	190
179	191	#elif ECB_GCC_VERSION(4,4) \|\| defined __INTEL_COMPILER \|\| defined __clang__
180	192	#define ECB_MEMORY_FENCE __sync_synchronize ()
	193	#elif _MSC_VER >= 1500 /* VC++ 2008 */
	194	/* apparently, microsoft broke all the memory barrier stuff in Visual Studio 2008... */
	195	#pragma intrinsic(_ReadBarrier,_WriteBarrier,_ReadWriteBarrier)
	196	#define ECB_MEMORY_FENCE _ReadWriteBarrier (); MemoryBarrier()
	197	#define ECB_MEMORY_FENCE_ACQUIRE _ReadWriteBarrier (); MemoryBarrier() /* according to msdn, _ReadBarrier is not a load fence */
	198	#define ECB_MEMORY_FENCE_RELEASE _WriteBarrier (); MemoryBarrier()
181	199	#elif _MSC_VER >= 1400 /* VC++ 2005 */
182	200	#pragma intrinsic(_ReadBarrier,_WriteBarrier,_ReadWriteBarrier)
183	201	#define ECB_MEMORY_FENCE _ReadWriteBarrier ()

207	225	/* for most usages, or gcc and clang have a bug */
208	226	/* I currently lean towards the latter, and inefficiently implement */
209	227	/* all three of ecb's fences as a seq_cst fence */
	228	/* Update, gcc-4.8 generates mfence for all c++ fences, but nothing */
	229	/* for all __atomic_thread_fence's except seq_cst */
210	230	#define ECB_MEMORY_FENCE atomic_thread_fence (memory_order_seq_cst)
211	231	#endif
212	232	#endif

273	293	#define ecb_prefetch(addr,rw,locality) __builtin_prefetch (addr, rw, locality)
274	294	#else
275	295	#define ecb_attribute(attrlist)
	296
	297	/* possible C11 impl for integral types
	298	typedef struct ecb_is_constant_struct ecb_is_constant_struct;
	299	#define ecb_is_constant(expr) _Generic ((1 ? (struct ecb_is_constant_struct )0 : (void )((expr) - (expr)), ecb_is_constant_struct : 0, default: 1)) /
	300
276	301	#define ecb_is_constant(expr) 0
277	302	#define ecb_expect(expr,value) (expr)
278	303	#define ecb_prefetch(addr,rw,locality)

+6

-6

Coro.pm less more

367	367	our $main; # main coro
368	368	our $current; # current coro
369	369
370		our $VERSION = 6.33;
	370	our $VERSION = 6.37;
371	371
372	372	our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub rouse_cb rouse_wait);
373	373	our %EXPORT_TAGS = (

653	653	$SIG{VTALRM} = sub { cede };
654	654	# and then start the interval timer
655	655	Time::HiRes::setitimer &Time::HiRes::ITIMER_VIRTUAL, 0.01, 0.01;
656		};
	656	};
657	657	Coro::on_leave {
658	658	# on leaving the thread, we stop the interval timer again
659	659	Time::HiRes::setitimer &Time::HiRes::ITIMER_VIRTUAL, 0, 0;
660		};
	660	};
661	661
662	662	&{+shift};
663		}
	663	}
664	664
665	665	# use like this:
666	666	timeslice {

668	668	# monopolise the process. Since it runs in a timesliced
669	669	# environment, it will regularly cede to other threads.
670	670	while () { }
671		};
	671	};
672	672
673	673
674	674	=item killall

915	915	not> die, under any circumstances.
916	916
917	917	There can be any number of C<on_destroy> callbacks per coro, and there is
918		no way currently to remove a callback once added.
	918	currently no way to remove a callback once added.
919	919
920	920	=item $oldprio = $coro->prio ($newprio)
921	921

+1

-1

EV/EV.pm less more

59	59	use XSLoader;
60	60
61	61	BEGIN {
62		our $VERSION = 6.33;
	62	our $VERSION = 6.37;
63	63
64	64	local $^W = 0; # avoid redefine warning for Coro::ready;
65	65	XSLoader::load __PACKAGE__, $VERSION;

+1

-1

Event/Event.pm less more

91	91	our @EXPORT = qw(loop unloop sweep);
92	92
93	93	BEGIN {
94		our $VERSION = 6.33;
	94	our $VERSION = 6.37;
95	95
96	96	local $^W = 0; # avoid redefine warning for Coro::ready;
97	97	XSLoader::load __PACKAGE__, $VERSION;

+2

-2

META.json less more

3	3	"unknown"
4	4	],
5	5	"dynamic_config" : 1,
6		"generated_by" : "ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.120921",
	6	"generated_by" : "ExtUtils::MakeMaker version 6.86, CPAN::Meta::Converter version 2.133380",
7	7	"license" : [
8	8	"unknown"
9	9	],

49	49	}
50	50	},
51	51	"release_status" : "stable",
52		"version" : "6.33"
	52	"version" : "6.37"
53	53	}

+2

-2

META.yml less more

6	6	configure_requires:
7	7	ExtUtils::MakeMaker: 0
8	8	dynamic_config: 1
9		generated_by: 'ExtUtils::MakeMaker version 6.8, CPAN::Meta::Converter version 2.120921'
	9	generated_by: 'ExtUtils::MakeMaker version 6.86, CPAN::Meta::Converter version 2.133380'
10	10	license: unknown
11	11	meta-spec:
12	12	url: http://module-build.sourceforge.net/META-spec-v1.4.html

30	30	Scalar::Util: 0
31	31	Storable: 2.15
32	32	common::sense: 0
33		version: 6.33
	33	version: 6.37

+4

-4

README less more

550	550	$SIG{VTALRM} = sub { cede };
551	551	# and then start the interval timer
552	552	Time::HiRes::setitimer &Time::HiRes::ITIMER_VIRTUAL, 0.01, 0.01;
553		};
	553	};
554	554	Coro::on_leave {
555	555	# on leaving the thread, we stop the interval timer again
556	556	Time::HiRes::setitimer &Time::HiRes::ITIMER_VIRTUAL, 0, 0;
557		};
	557	};
558	558
559	559	&{+shift};
560		}
	560	}
561	561
562	562	# use like this:
563	563	timeslice {

779	779	arguments, if any, and must not die, under any circumstances.
780	780
781	781	There can be any number of "on_destroy" callbacks per coro, and
782		there is no way currently to remove a callback once added.
	782	there is currently no way to remove a callback once added.
783	783
784	784	$oldprio = $coro->prio ($newprio)
785	785	Sets (or gets, if the argument is missing) the priority of the coro

+6

-6

t/15_semaphore.t less more

40	40	$as1 = async {
41	41	my $g = $sem->guard;
42	42	print "not ok 2\n";
43		};
	43	};
44	44
45	45	$as2 = async {
46	46	my $g = $sem->guard;
47	47	print "ok 2\n";
48		};
	48	};
49	49
50	50	cede;
51	51

64	64	$sem->guard;
65	65	};
66	66	print $@ ? "" : "not ", "ok 3\n";
67		};
	67	};
68	68
69	69	$as2 = async {
70	70	my $g = $sem->guard;
71	71	print "ok 4\n";
72		};
	72	};
73	73
74	74	cede;
75	75

86	86	$as1 = async {
87	87	$sem->wait;
88	88	print "ok 5\n";
89		};
	89	};
90	90
91	91	$as2 = async {
92	92	my $g = $sem->guard;
93	93	print "ok 6\n";
94		};
	94	};
95	95
96	96	cede;
97	97