Commit bee858f5053c8eb462746e8be308cfdb69a8cdaf - libcoro-perl

[svn-upgrade] new version libcoro-perl (6.000) Alessandro Ghedini 12 years ago

41 changed file(s) with 2003 addition(s) and 638 deletion(s). Raw diff Collapse all Expand all

+43

-0

Changes less more

2	2	TODO: should explore PerlIO::coroaio (perl leaks like hell).
3	3	TODO: channel->maxsize(newsize)?
4	4	TODO: http://www.microsoft.com/msj/archive/s2ce.aspx
	5
	6	6.0 Wed Jun 29 19:43:35 CEST 2011
	7	- INCOMPATIBLE CHANGE: unreferenced coro objects will now be
	8	destroyed and cleaned up automatically (e.g. async { schedule }).
	9	- implement a JIT compiler for part of the thread switch code,
	10	which gives a 50% speed improvement on threaded perls, and
	11	about 4% on non-thraeded perls (so threaded perls now finally
	12	reach about half the speed of non-threaded perls).
	13	- slightly modernise Coro::Intro, add section about rouse functions.
	14	- avoid DEFSV and ERRSV, giving another 10% improvement
	15	in thread switching.
	16	- Coro::State->is_destroyed is now called is_zombie.
	17	- implement a Coro->safe_cancel method that might fail, but
	18	cancels in a "safer" way if it succeeds.
	19	- add preliminary support for DEBUGGING perls.
	20	- get rid of two hash-accesses when initialising a new Coro - this
	21	speeds up coro creation by almost a factor of two.
	22	- croak when a coro that is being cancelled tries to block
	23	(e.g. while executing a guard block), instead of crashing or
	24	deadlocking.
	25	- use a more robust and also faster method to identify Coro::State
	26	objects - speeds up everything a bit.
	27	- implement Coro->cancel in XS for a 20% speed improvement, and to
	28	be able to implement mutual cancellation.
	29	- speed up context switches by a percent or two by more efficiently
	30	allocating context stack entries.
	31	- implement Coro->join and Coro->on_destroy in XS for a speedup and
	32	a reduction in memory use.
	33	- cancelling a coro while it itself is cancelling another coro is
	34	now supported and working, instead of triggering an assertion.
	35	- be a bit more crash-resistant when calling (buggy) on_destroy
	36	callbacks (best effort).
	37	- move on_destroy into the slf_frame, to allow extension slf
	38	functions to have destructors.
	39	- get rid if coro refcounting - simply crash in other interpreter
	40	threads by nulling the pointers on clone.
	41	- simplify warn/die hook handling when loading Coro - the convoluted
	42	logic seems to be no longer neccessary.
	43	- use libecb instead of our own home-grown gcc hacks.
	44	- document alternatives to Coro::LWP. Please use them :)
	45	- work around another mindless idiotic NEEDLESS bug in openbsd/mirbsds
	46	sigaltstack. Really. wine suffers from it, erlang suffers from it,
	47	and it's known since at least 2006.
5	48
6	49	5.372 Wed Feb 23 06:14:30 CET 2011
7	50	- apparently mingw doesn't provide a working gettimeofday, try to

-1

Coro/AIO.pm less more

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

-6

Coro/AnyEvent.pm less more

163	163	use Coro;
164	164	use AnyEvent ();
165	165
166		our $VERSION = 5.372;
	166	our $VERSION = 6.0;
167	167
168	168	#############################################################################
169	169	# idle handler

239	239	=item Coro::AnyEvent::poll
240	240
241	241	This call will block the current thread until the event loop has polled
242		for new events and instructs the event loop to poll for new events once,
243		without blocking.
244
245		Note that this call will not actually execute the poll, just block until
246		new events have been polled, so other threads will have a chance to run.
	242	for potential new events and instructs the event loop to poll for new
	243	events once, without blocking.
	244
	245	Note that this call will not actually execute the poll, nor will it wait
	246	until there are some events, just block until the event loop has polled
	247	for new events, so other threads will have a chance to run.
247	248
248	249	This is useful when you have a thread that does some computations, but you
249	250	still want to poll for new events from time to time. Simply call C<poll>

-1

Coro/BDB.pm less more

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

-1

Coro/Channel.pm less more

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

-3

Coro/CoroAPI.h less more

27	27	{
28	28	void (prepare) (pTHX_ struct coro_transfer_args ta); /* 0 means not yet initialised */
29	29	int (check) (pTHX_ struct CoroSLF frame);
30		void data; / for use by prepare/check */
	30	void data; / for use by prepare/check/destroy */
	31	void (destroy) (pTHX_ struct CoroSLF frame);
31	32	};
32	33
33	34	/* needs to fill in the frame /

39	40	/* private */
40	41	I32 ver;
41	42	I32 rev;
42		#define CORO_API_VERSION 7
43		#define CORO_API_REVISION 0
	43	#define CORO_API_VERSION 7 /* reorder CoroSLF on change */
	44	#define CORO_API_REVISION 1
44	45
45	46	/* Coro */
46	47	int nready;

-1

Coro/Debug.pm less more

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

-1

Coro/Handle.pm less more

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

+248

-139

Coro/Intro.pod less more

14	14	allowing you to return at any time, as kind of non-local jump, not unlike
15	15	C's C<setjmp>/C<longjmp>. This is nowadays known as a L<Coro::State>.
16	16
17		The natural application for these is to include a scheduler, resulting in
	17	One natural application for these is to include a scheduler, resulting in
18	18	cooperative threads, which is the main use case for Coro today. Still,
19	19	much of the documentation and custom refers to these threads as
20	20	"coroutines" or often just "coros".

27	27	variable or location.
28	28
29	29	Cooperative means that these threads must cooperate with each other, when
30		it coems to CPU usage - only one thread ever has the CPU, and if another
	30	it comes to CPU usage - only one thread ever has the CPU, and if another
31	31	thread wants the CPU, the running thread has to give it up. The latter
32	32	is either explicitly, by calling a function to do so, or implicity, when
33	33	waiting on a resource (such as a Semaphore, or the completion of some I/O
34		request).
	34	request). This threading model is popular in scripting languages (such as
	35	python or ruby), and this implementation is typically far more efficient
	36	than threads implemented in other languages.
35	37
36	38	Perl itself uses rather confusing terminilogy - what perl calls a "thread"
37		is actually called a "process" everywhere else: The so-called "perl
38		threads" are actually artifacts of the unix process emulation code used
39		on Windows, which is consequently why they are actually processes and not
40		threads. The biggest difference is that neither variables (nor code) are
41		shared between processes.
	39	(or "ithread") is actually called a "process" everywhere else: The
	40	so-called "perl threads" are actually artifacts of the unix process
	41	emulation code used on Windows, which is consequently why they are
	42	actually processes and not threads. The biggest difference is that neither
	43	variables (nor code) are shared between processes or ithreads.
42	44
43	45
44	46	=head1 Cooperative Threads
45	47
46		Cooperative threads is what the Coro module gives you:
	48	Cooperative threads is what the Coro module gives you. Obviously, you have
	49	to C<use> it first:
47	50
48	51	use Coro;
49	52

55	58	};
56	59
57	60	Async expects a code block as first argument (in indirect object
58		notation). You can pass it more arguments, and these will end up in C<@_>
59		when executing the codeblock, but since it is a closure, you can also just
60		refer to any lexical variables that are currently visible.
61
62		If you save the above lines in a file and execute it as a perl program,
63		you will not get any output.
	61	notation). You can actually pass it extra arguments, and these will end up
	62	in C<@_> when executing the codeblock, but since it is a closure, you can
	63	also just refer to any lexical variables that are currently visible.
	64
	65	The above lines create a thread, but if you save them in a file and
	66	execute it as a perl program, you will not get any output.
64	67
65	68	The reasons is that, although you created a thread, and the thread is
66	69	ready to execute (because C<async> puts it into the so-called I<ready
67	70	queue>), it never gets any CPU time to actually execute, as the main
68	71	program - which also is a thread almost like any other - never gives up
69		the CPU but instead exits the whole program, by running off the end of the
70		file.
	72	the CPU but instead exits the whole program, by running off the end of
	73	the file. Since Coro threads are cooperative, the main thread has to
	74	cooperate, and give up the CPU.
71	75
72	76	To explicitly give up the CPU, use the C<cede> function (which is often
73	77	called C<yield> in other thread implementations):

82	86
83	87	Running the above prints C<hello> and exits.
84	88
85		This is not very interetsing, so let's try a slightly more interesting
86		program:
	89	Now, this is not very interesting, so let's try a slightly more
	90	interesting program:
87	91
88	92	use Coro;
89	93

111	115	"async 1", and itself yields the CPU. Since the only other thread
112	116	available is the main program, it continues running and so on.
113	117
114		In more detail, C<async> creates a new thread. All new threads
115		start in a suspended state. To make them run, they need to be put into
116		the ready queue, which is the second thing that C<async> does. Each time
117		a thread gives up the CPU, Coro runs a so-called I<scheduler>. The
118		scheduler selects the next thread from the ready queue, removes it from
119		the queue, and runs it.
	118	Let's look at the example in more detail: C<async> first creates a new
	119	thread. All new threads start in a suspended state. To make them run,
	120	they need to be put into the ready queue, which is the second thing that
	121	C<async> does. Each time a thread gives up the CPU, Coro runs a so-called
	122	I<scheduler>. The scheduler selects the next thread from the ready queue,
	123	removes it from the queue, and runs it.
120	124
121	125	C<cede> also does two things: first it puts the running thread into the
122	126	ready queue, and then it jumps into the scheduler. This has the effect of
123		giving up the CPU, but also ensures that, eventually, the thread gets
124		run again.
	127	giving up the CPU, but also ensures that, eventually, the thread gets run
	128	again.
125	129
126	130	In fact, C<cede> could be implemented like this:
127	131

130	134	schedule;
131	135	}
132	136
133		This works because C<$Coro::current> always contains the currently running
134		thread, and the scheduler itself can be called via C<Coro::schedule>.
135
136		What's the effect of just calling C<schedule>? Simple, the scheduler
137		selects the next ready thread and runs it - the current thread, as
138		it hasn't been put into the ready queue, will go to sleep until something
139		wakes it up.
	137	This works because C<$Coro::current> always contains the currently
	138	running thread, and the scheduler itself can be called directly via
	139	C<Coro::schedule>.
	140
	141	What is the effect of just calling C<schedule> without putting the current
	142	thread into the ready queue first? Simple: the scheduler selects the
	143	next ready thread and runs it. And the current thread, as it hasn't been
	144	put into the ready queue, will go to sleep until something wakes it
	145	up. If. Ever.
140	146
141	147	The following example remembers the current thread in a variable,
142	148	creates a thread and then puts the main program to sleep.

149	155	my $wakeme = $Coro::current;
150	156
151	157	async {
152		$wakeme->ready if 0.5 < rand;
	158	$wakeme->ready if 0.5 > rand;
153	159	};
154	160
155	161	schedule;
156	162
157		Now, when you run it, one of two things happen: Either the C<async>
158		thread wakes up main again, in which case the program silently exits,
159		or it doesn't, in which case you get:
160
161		FATAL: deadlock detected at - line 0
162
163		Why is that? When the C<async> thread falls of the end, it will be
164		terminated (via a call to C<Coro::terminate>) and the scheduler gets run
165		again. Since the C<async> thread hasn't woken up the main thread,
166		and there aren't any other threads, there is nothing to wake up,
167		and the program cannot continue. Since there I<are> threads that
	163	Now, when you run it, one of two things happen: Either the C<async> thread
	164	wakes up the main thread again, in which case the program silently exits,
	165	or it doesn't, in which case you get something like this:
	166
	167	FATAL: deadlock detected.
	168	PID SC RSS USES Description Where
	169	31976480 -C 19k 0 [main::] [program:9]
	170	32223768 UC 12k 1 [Coro.pm:691]
	171	32225088 -- 2068 1 [coro manager] [Coro.pm:691]
	172	32225184 N- 216 0 [unblock_sub scheduler] -
	173
	174	Why is that? Well, when the C<async> thread runs into the end of its
	175	block, it will be terminated (via a call to C<Coro::terminate>) and the
	176	scheduler is called again. Since the C<async> thread hasn't woken up the
	177	main thread, and there aren't any other threads, there is nothing to wake
	178	up, and the program cannot continue. Since there I<are> threads that
168	179	I<could> be running (main) but none are I<ready> to do so, Coro signals a
169		I<deadlock> - no progress is possible.
170
171		In fact, there is an important case where progress I<is>, in fact,
172		possible - namely in an event-based program. In such a case, the program
173		could well wait for I<external> events, such as a timeout, or some data to
174		arrive on a socket.
	180	I<deadlock> - no progress is possible. Usually you also get a listing of
	181	all threads, which might help you track down the problem.
	182
	183	However, there is an important case where progress I<is>, in fact,
	184	possible, despite no threads being ready - namely in an event-based
	185	program. In such a program, some threads could wait for I<external>
	186	events, such as a timeout, or some data to arrive on a socket.
175	187
176	188	Since a deadlock in such a case would not be very useful, there is a
177	189	module named L<Coro::AnyEvent> that integrates threads into an event
178		loop. It configures Coro in a way that instead of dieing with an error
	190	loop. It configures Coro in a way that, instead of C<die>ing with an error
179	191	message, it instead runs the event loop in the hope of receiving an event
180	192	that will wake up some thread.
181	193

188	200	ways. The first such primitives is L<Coro::Semaphore>, which implements
189	201	counting semaphores (binary semaphores are available as L<Coro::Signal>,
190	202	and there are L<Coro::SemaphoreSet> and L<Coro::RWLock> primitives as
191		well):
	203	well).
	204
	205	Counting semaphores, in a sense, store a count of resources. You can
	206	remove/allocate/reserve a resource by calling the C<< ->down >> method,
	207	which decrements the counter, and you can add or free a resource by
	208	calling the C<< ->up >> method, which increments the counter. If the
	209	counter is C<0>, then C<< ->down >> cannot decrement the semaphore - it is
	210	locked - and the thread will wait until a count becomes available again.
	211
	212	Here is an example:
192	213
193	214	use Coro;
194	215

204	225	print "we got it!\n";
205	226
206	227	This program creates a I<locked> semaphore (a semaphore with count C<0>)
207		and tries to lock it. Since the semaphore is already locked, this will
208		block the main thread until the semaphore becomes available.
209
210		This yields the CPU to the C<async> thread, which unlocks the semaphore
211		(and instantly terminates itself by returning).
	228	and tries to lock it (by trying to decrement it's counter in the C<down>
	229	method). Since the semaphore count is already exhausted, this will block
	230	the main thread until the semaphore becomes available.
	231
	232	This yields the CPU to the only other read thread in the process,t he
	233	one created with C<async>, which unlocks the semaphore (and instantly
	234	terminates itself by returning).
212	235
213	236	Since the semaphore is now available, the main program locks it and
214		continues.
215
216		Semaphores are most often used to lock resources, or to exclude other
217		threads from accessing or using a resource. For example, consider
	237	continues: "we got it!".
	238
	239	Counting semaphores are most often used to lock resources, or to exclude
	240	other threads from accessing or using a resource. For example, consider
218	241	a very costly function (that temporarily allocates a lot of ram, for
219		example). You wouldn't want to have many threads calling this function,
220		so you use a semaphore:
221
222		my $lock = new Coro::Semaphore; # unlocked initially
	242	example). You wouldn't want to have many threads calling this function at
	243	the same time, so you use a semaphore:
	244
	245	my $lock = new Coro::Semaphore; # unlocked initially - default is 1
223	246
224	247	sub costly_function {
225	248	$lock->down; # acquire semaphore

230	253	}
231	254
232	255	No matter how many threads call C<costly_function>, only one will run
233		the body of it, all others will wait in the C<down> call.
234
235		Why does the comment mention "operation the blocks"? That's because coro's
236		threads are cooperative: unless C<costly_function> willingly gives up the
237		CPU, other threads of control will simply not run. This makes locking
238		superfluous in cases where the fucntion itself never gives up the CPU, but
239		when dealing with the outside world, this is rare.
	256	the body of it, all others will wait in the C<down> call. If you want to
	257	limit the number of concurrent executions to five, you could create the
	258	semaphore with an initial count of C<5>.
	259
	260	Why does the comment mention an "operation the blocks"? Again, that's
	261	because coro's threads are cooperative: unless C<costly_function>
	262	willingly gives up the CPU, other threads of control will simply not
	263	run. This makes locking superfluous in cases where the function itself
	264	never gives up the CPU, but when dealing with the outside world, this is
	265	rare.
240	266
241	267	Now consider what happens when the code C<die>s after executing C<down>,
242	268	but before C<up>. This will leave the semaphore in a locked state, which
243		usually isn't what you want: normally you would want to free the lock
244		again.
245
246		This is what the C<guard> method is for:
	269	often isn't what you want - imagine the caller expecting a failure and
	270	wrapping the call into an C<eval {}>.
	271
	272	So normally you would want to free the lock again if execution somehow
	273	leaves the function, whether "normally" or via an exception. Here the
	274	C<guard> method proves useful:
247	275
248	276	my $lock = new Coro::Semaphore; # unlocked initially
249	277

253	281	# do costly operation that blocks
254	282	}
255	283
256		This method C<down>s the semaphore and returns a so-called guard
257		object. Nothing happens as long as there are references to it, but when
258		all references are gone, for example, when C<costly_function> returns or
259		throws an exception, it will automatically call C<up> on the semaphore,
260		no way to forget it. Even when the thread gets C<cancel>ed by another
261		thread will the guard object ensure that the lock is freed.
262
263		Apart from L<Coro::Semaphore> and L<Coro::Signal>, there is
264		also a reader-writer lock (L<Coro::RWLock>) and a semaphore set
265		(L<Coro::SemaphoreSet>).
	284	The C<guard> method C<down>s the semaphore and returns a so-called guard
	285	object. Nothing happens as long as there are references to it (i.e. it is
	286	in scope somehow), but when all references are gone, for example, when
	287	C<costly_function> returns or throws an exception, it will automatically
	288	call C<up> on the semaphore, no way to forget it. Even when the thread
	289	gets C<cancel>ed by another thread will the guard object ensure that the
	290	lock is freed.
	291
	292	This concludes this introduction to semaphores and locks. Apart from
	293	L<Coro::Semaphore> and L<Coro::Signal>, there is also a reader-writer lock
	294	(L<Coro::RWLock>) and a semaphore set (L<Coro::SemaphoreSet>). All of
	295	these come with their own manpage.
266	296
267	297
268	298	=head2 Channels
269	299
270	300	Semaphores are fine, but usually you want to communicate by exchanging
271		data as well. This is where L<Coro::Channel> comes in useful: Channels
272		are the Coro equivalent of a unix pipe (and very similar to amiga message
273		ports :) - you can put stuff into it on one side, and read data from it on
274		the other.
275
276		Here is a simple example that creates a thread and sends it
277		numbers. The thread calculates the square of the number, and puts it
278		into another channel, which the main thread reads the result from:
	301	data as well. Of course, you can just use some locks, and array of sorts
	302	and use that to communicate, but there is a useful abstraction for
	303	communicaiton between threads: L<Coro::Channel>. Channels are the Coro
	304	equivalent of a unix pipe (and very similar to AmigaOS message ports :) -
	305	you can put stuff into it on one side, and read data from it on the other.
	306
	307	Here is a simple example that creates a thread and sends numbers to
	308	it. The thread calculates the square of each number and puts that into
	309	another channel, which the main thread reads the result from:
279	310
280	311	use Coro;
281	312

304	335	10 ** 2 = 100
305	336	77 ** 2 = 5929
306	337
307		Both C<get> and C<put> methods can block the current thread: C<get>
308		first checks whether there I<is> some data available, and if not, it block
309		the current thread until some data arrives. C<put> can also block, as
310		each Channel has a "maximum buffering capacity", i.e. you cannot store
311		more than a specific number of items, which can be configured when the
312		Channel gets created.
	338	Both C<get> and C<put> methods can block the current thread: C<get> first
	339	checks whether there I<is> some data available, and if not, it block the
	340	current thread until some data arrives. C<put> can also block, as each
	341	Channel has a "maximum item capacity", i.e. you cannot store more than a
	342	specific number of items, which can be configured when the Channel gets
	343	created.
313	344
314	345	In the above example, C<put> never blocks, as the default capacity
315		of a Channel is very high. So the for loop first puts data into the
	346	of a Channel is very high. So the for loop first puts data into the
316	347	channel, then tries to C<get> the result. Since the async thread hasn't
317		put anything in there yet (on the firts iteration it hasn't even run
	348	put anything in there yet (on the first iteration it hasn't even run
318	349	yet), the result Channel is still empty, so the main thread blocks.
319	350
320	351	Since the only other runnable/ready thread at this point is the squaring

327	358	calculate channel will it block (because nothing is there yet) and the
328	359	main thread will continue running. And so on.
329	360
330		In general, Coro will I<only ever block> a thread when it has to: Neither
331		the Coro module itself nor any of its submodules will ever give up the
332		CPU unless they have to, because they wait for some event to happen.
	361	This illustrates a general principle used by Coro: a thread will I<only
	362	ever block> when it has to. Neither the Coro module itself nor any of its
	363	submodules will ever give up the CPU unless they have to, because they
	364	wait for some event to happen.
333	365
334	366	Be careful, however: when multiple threads put numbers into C<$calculate>
335	367	and read from C<$result>, they won't know which result is theirs. The
336	368	solution for this is to either use a semaphore, or send not just the
337	369	number, but also your own private result channel.
338	370
339		L<Coro::Channel> can buffer some amount of items.
340
341	371
342	372	=head2 What is mine, what is ours?
343	373
344	374	What, exactly, constitutes a thread? Obviously it contains the current
345		point of execution. Not so obviously, it also has to include all
	375	point of execution. Not so obviously, it also has to include all
346	376	lexical variables, that means, every thread has its own set of lexical
347		variables. To see why this is necessary, consider this program:
	377	variables.
	378
	379	To see why this is necessary, consider this program:
348	380
349	381	use Coro;
350	382

366	398	C<World!\nWorld\n>, which is rather unexpected, and would make it very
367	399	difficult to make good use of threads.
368	400
369		There are quite a number of other things that are per-thread:
	401	To make things run smoothly, there are quite a number of other things that
	402	are per-thread:
370	403
371	404	=over 4
372	405

383	416	=item $/ and the default output file handle
384	417
385	418	Threads most often block when doing I/O. Since C<$/> is used when reading
386		lines, it would be very inconvenient if it were a shared variable, so it is per-thread.
	419	lines, it would be very inconvenient if it were a shared variable, so it
	420	is per-thread.
387	421
388	422	The default output handle (see C<select>) is a difficult case: sometimes
389	423	being global is preferable, sometimes per-thread is preferable. Since

399	433	};
400	434
401	435	Would not allow coroutine switching. Since exception-handling is
402		per-thread, those variables should be per-thread too.
	436	per-thread, those variables should be per-thread as well.
403	437
404	438	=item Lots of other esoteric stuff
405	439
406	440	For example, C<$^H> is per-thread. Most of the additional per-thread state
407		is not directly visible to perl, but required to make the interpreter
	441	is not directly visible to Perl, but required to make the interpreter
408	442	work. You won't normally notice these.
409	443
410	444	=back

426	460
427	461	=head2 Debugging
428	462
429		Sometimes it can be useful to find out what each thread is doing (or
430		which threads exist in the first place). The L<Coro::Debug> module has
431		(among other goodies), a function that allows you to print a "ps"-like
432		listing:
	463	Sometimes it can be useful to find out what each thread is doing (or which
	464	threads exist in the first place). The L<Coro::Debug> module has (among
	465	other goodies), a function that allows you to print a "ps"-like listing -
	466	you have seen it in action earlier when Coro detected a deadlock.
	467
	468	You use it like this:
433	469
434	470	use Coro::Debug;
435	471
436	472	Coro::Debug::command "ps";
437	473
438		Running it just after C<< $calculate->get >> outputs something similar to this:
	474	Remember the example with the two channels and a worker thread that
	475	squared numbers? Running "ps" just after C<< $calculate->get >> outputs
	476	something similar to this:
439	477
440	478	PID SC RSS USES Description Where
441	479	8917312 -C 22k 0 [main::] [introscript:20]

464	502	=head1 The Real World - Event Loops
465	503
466	504	Coro really wants to run in a program using some event loop. In fact, most
467		real-world programs using Coro's threads are written in a combination of
	505	real-world programs using Coro threads are written with a combination of
468	506	event-based and thread-based techniques, as it is easy to get the best of
469	507	both worlds with Coro.
470	508
471		Coro integrates well into any event loop supported by L<AnyEvent>, simply
472		by C<use>ing L<Coro::AnyEvent>, but can take special advantage of the
	509	Coro integrates automatically into any event loop supported by L<AnyEvent>
	510	(see L<Coro::AnyEvent> for details), but can take special advantage of the
473	511	L<EV> and L<Event> modules.
474	512
475	513	Here is a simple finger client, using whatever event loop L<AnyEvent>
476		comes up with (L<Coro::Socket> automatically initialises all the event
477		stuff):
	514	comes up with:
478	515
479	516	use Coro;
480	517	use Coro::Socket;

500	537	$_->join; # wait for the result
501	538	}
502	539
503		There are quite a few new things here. First of all, there
504		is L<Coro::Socket>. This module works much the same way as
	540	There are a few new things here. First of all, there is
	541	L<Coro::Socket>. This module works much the same way as
505	542	L<IO::Socket::INET>, except that it is coroutine-aware. This means that
506	543	L<IO::Socket::INET>, when waiting for the network, will block the whole
507	544	process - that means all threads, which is clearly undesirable.
508	545
509	546	On the other hand, L<Coro::Socket> knows how to give up the CPU to other
510		threads when it waits for the network, which makes parallel processing
	547	threads when it waits for the network, which makes parallel execution
511	548	possible.
512	549
513	550	The other new thing is the C<join> method: All we want to do in this

516	553	much simpler to synchronously wait for them to C<terminate>, which is
517	554	exactly what the C<join> method does.
518	555
519		It doesn't matter that the three async's will probably finish in a
520		different order then the for loop C<join>s them - when the thread
521		is still running, C<join> simply waits. If the thread has already
522		terminated, it will simply fetch its return status.
	556	It doesn't matter that the three C<async>s will probably finish in a
	557	different order then the for loop C<join>s them - when the thread is still
	558	running, C<join> simply waits. If the thread has already terminated, it
	559	will simply fetch its return status.
523	560
524	561	If you are experienced in event-based programming, you will see that the
525	562	above program doesn't quite follow the normal pattern, where you start

535	572
536	573	EV::loop; # and loop
537	574
538		In fact, for debugging, you often do something like this:
	575	And in fact, for debugging, you often do something like this:
539	576
540	577	use EV;
541	578	use Coro::Debug;

583	620
584	621	Fortunately, the L<IO::AIO> module on CPAN allows you to move these
585	622	I/O calls into the background, letting you do useful work in the
586		foreground. It is event-/callback-based, but Coro has a nice interface to
587		it, called L<Coro::AIO>, which let's you use its functions naturally from
588		within threads:
	623	foreground. It is event-/callback-based, but Coro has a nice wrapper
	624	around it, called L<Coro::AIO>, which lets you use its functions
	625	naturally from within threads:
589	626
590	627	use Fcntl;
591	628	use Coro::AIO;

602	639	and atomically replaces a base file with a new copy.
603	640
604	641
	642	=head2 Inversion of control - rouse functions
	643
	644	Last not least, me talk about inversion of control. The "control" refers
	645	to "who calls whom", who is in control of the program. In this program,
	646	the main program is in control and passes this to all functions it calls:
	647
	648	use LWP;
	649
	650	# pass control to get
	651	my $res = get "http://example.org/";
	652	# control returned to us
	653
	654	print $res;
	655
	656	When switching to event-based programs, instead of "us calling them",
	657	"they call us" - this is the inversion of control form the title:
	658
	659	use AnyEvent::HTTP;
	660
	661	# do not pass control for long - http_get immediately returns
	662	http_get "http://example.org/", sub {
	663	print $_[0];
	664	};
	665
	666	# we stay in control and can do other things
	667
	668	Event based programming can be nice, but sometimes it's just easier to
	669	write down some processing in "linear" fashion, without callbacks. Coro
	670	provides some special functions to reduce typing:
	671
	672	use AnyEvent::HTTP;
	673
	674	# do not pass control for long - http_get immediately returns
	675	http_get "http://example.org/", Coro::rouse_cb;
	676
	677	# we stay in control and can do other things...
	678	# ...such as wait for the result
	679	my ($res) = Coro::rouse_wait;
	680
	681	C<Coro::rouse_cb> creates and returns a special callback. You can pass
	682	this callback to any function that would expect a callback.
	683
	684	C<Coro::rouse_wait> waits (block the current thread) until the most
	685	recently created callback has been called, and returns whatever was passed
	686	to it.
	687
	688	These two functions allow you to I<mechanically> invert the control from
	689	"callback based style" used by most event-based libraries to "blocking
	690	style", whenever you wish to.
	691
	692	The pattern is simple: instead of...
	693
	694	some_func ..., sub {
	695	my @res = @_;
	696	...
	697	};
	698
	699	... you write:
	700
	701	some_func ..., Coro::rouse_cb;
	702	my @res = Coro::rouse_wait;
	703	...
	704
	705	Callback-based interfaces are plenty, and the rouse functions allow you to
	706	use them in an often more convenient way.
	707
	708
605	709	=head1 Other Modules
606	710
607		This introduction only mentions a very few methods and modules, Coro has
608		many other functions (see the L<Coro> manpage) and modules (documented in
609		the C<SEE ALSO> section of the L<Coro> manpage).
	711	This introduction only mentions a few methods and modules, Coro has many
	712	other functions (see the L<Coro> manpage) and modules (documented in the
	713	C<SEE ALSO> section of the L<Coro> manpage).
610	714
611	715	Noteworthy modules are L<Coro::LWP> (for parallel LWP requests, but see
612	716	L<AnyEvent::HTTP> for a better HTTP-only alternative), L<Coro::BDB>, for

615	719	C<STDOUT>) and L<Coro::EV>, the optimised interface to L<EV> (which gets
616	720	used automatically by L<Coro::AnyEvent>).
617	721
	722	There are a number of Coro-related moduels that might be useful for your problem
	723	(see L<http://search.cpan.org/search?query=Coro&mode=module>). And since Coro
	724	integrates so well into AnyEvent, it's often easy to adapt existing AnyEvent modules
	725	(see L<http://search.cpan.org/search?query=AnyEvent&mode=module>).
	726
618	727
619	728	=head1 AUTHOR
620	729

+33

-1

Coro/LWP.pm less more

4	4	=head1 SYNOPSIS
5	5
6	6	use Coro::LWP; # afterwards LWP should not block
	7
	8	=head1 ALTERNATIVES
	9
	10	Over the years, a number of less-invasive alternatives have popped up,
	11	which you might find more acceptable than this rather invasive and fragile
	12	module. All of them only support HTTP (and sometimes HTTPS).
	13
	14	=over 4
	15
	16	=item L<AnyEvent::HTTP>
	17
	18	Works fine without Coro. Requires using a very different API than
	19	LWP. Probably the best choice I<iff> you can do with a completely
	20	different event-based API.
	21
	22	=item L<LWP::Protocol::AnyEvent::http>
	23
	24	Makes LWP use L<AnyEvent::HTTP>. Does not make LWP event-based, but allows
	25	Coro threads to schedule unimpeded through its AnyEvent integration.
	26
	27	Let's you use the LWP API normally.
	28
	29	=item L<LWP::Protocol::Coro::http>
	30
	31	Basically the same as above, distinction unclear. :)
	32
	33	=item L<AnyEvent::HTTP::LWP::UserAgent>
	34
	35	A different user agent implementation, not completely transparent to
	36	users, requires Coro.
	37
	38	=back
7	39
8	40	=head1 DESCRIPTION
9	41

93	125	use Net::FTP ();
94	126	use Net::NNTP ();
95	127
96		our $VERSION = 5.372;
	128	our $VERSION = 6.0;
97	129
98	130	*Socket::inet_aton = \&Coro::Util::inet_aton;
99	131

-1

Coro/MakeMaker.pm less more

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

+35

-8

Coro/Makefile.PL less more

86	86	}
87	87
88	88	} elsif ($^O =~ /(openbsd\|mirbsd)/) {
89		# openbsd:
90		# asm seems to work, setjmp might, ucontext is missing, threads lets not talk about
91		# try setjmp/longjmp on 4.4, but pthread on earlier
92		# mirbsd:
93		# seems to be bug-to-bug compatible openbsd fork,
	89	# mirbsd seems to be bug-to-bug compatible openbsd fork,
94	90	# with the name change being the biggest difference.
95		$iface = $iface_asm \|\| ($Config{osvers} >= 4.4 ? "s" : "p");
	91	if ($Config{libs} !~ "-lpthread") {
	92	# asm seems to work, setjmp might, ucontext is missing,
	93	# threads lets not talk about
	94	# try setjmp/longjmp on 4.4, but pthread on earlier
	95	$iface = $iface_asm \|\| ($Config{osvers} >= 4.4 ? "s" : "p");
	96	} else {
	97	# seems newer openbsd platforms have marginally working pthreads, but
	98	# their pthreads break sigaltstack - reading the sigaltstack sources
	99	# again shows how fundamentally clueless those people are (if no thread
	100	# has ever been created, then the program is bound to a kernel-scheduled
	101	# entity. get that? GET THAT?)
	102	$iface = "p";
	103	}
96	104
97	105	} elsif ($^O =~ /solaris/) {
98	106	# setjmp, ucontext seem to work, as well as asm

126	134
127	135	u The unix 'ucontext.h' functions are relatively new and not implemented
128	136	or well-tested in older unices. They allow very fast coroutine creation
129		and reasonably fast switching. They are, however, usually slower than
	137	and reasonably fast switching. They are, however, usually slower than
130	138	the other alternatives due to an extra syscall done by swapcontext. And
131	139	while nominally most portable (it's the only POSIX-standardised
132	140	interface for coroutines), ucontext functions are, as usual, broken on

321	329
322	330	* * * * * * * * * * * * * * * * * *
323	331
	332	Coro can use a simple JIT compiler to compile a part of the thread switch
	333	function at runtime. On perls with windows process emulation (most!),
	334	this results in a 50% speed improvement. On sane perls, the gain is much
	335	less, usually around 5%. If you enable this option, then the JIT will
	336	be enabled, on compatible operating systems and CPUs (currently only
	337	x86/amd64 on certain unix clones). Otherwise, it will be disabled. It
	338	should be safe to leave on - this setting is only here so you can switch
	339	it off in case of problems.
	340
	341	EOF
	342
	343	my $orgasm = $ENV{CORO_JIT} \|\| "y";
	344	$orgasm = prompt ("Try to use the JIT compiler, if available?", $orgasm);
	345	$DEFINE .= " -DCORO_JIT=1" if $orgasm =~ /[yY]/;
	346
	347	print <<EOF;
	348
	349	* * * * * * * * * * * * * * * * * *
	350
324	351	Coro has experimental support for cloning states. This can be used
325	352	to implement a scheme-like call/cc. However, this doesn't add to the
326	353	expressiveness in general, and is likely perl-version specific (and perl

348	375	LIBS => @LIBS,
349	376	DIR => [],
350	377	depend => {
351		"State.c" => "state.h clone.c libcoro/coro.h libcoro/coro.c",
	378	"State.c" => "state.h clone.c ecb.h libcoro/coro.h libcoro/coro.c",
352	379	},
353	380	);
354	381

-1

Coro/RWLock.pm less more

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

-1

Coro/Select.pm less more

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

-1

Coro/Semaphore.pm less more

39	39
40	40	use Coro ();
41	41
42		our $VERSION = 5.372;
	42	our $VERSION = 6.0;
43	43
44	44	=item new [inital count]
45	45

-1

Coro/SemaphoreSet.pm less more

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

-1

Coro/Signal.pm less more

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

-1

Coro/Socket.pm less more

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

-1

Coro/Specific.pm less more

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

-24

Coro/State.pm less more

89	89	use XSLoader;
90	90
91	91	BEGIN {
92		our $VERSION = 5.372;
	92	our $VERSION = 6.0;
93	93
94	94	# must be done here because the xs part expects it to exist
95	95	# it might exist already because Coro::Specific created it.
96	96	$Coro::current \|\|= { };
97	97
98		{
99		# save/restore the handlers before/after overwriting %SIG magic
100		local $SIG{__DIE__};
101		local $SIG{__WARN__};
102
103		XSLoader::load __PACKAGE__, $VERSION;
104		}
	98	XSLoader::load __PACKAGE__, $VERSION;
105	99
106	100	# need to do it after overwriting the %SIG magic
107	101	$SIG{__DIE__} \|\|= \&diehook;

230	224	The "state" of a subroutine includes the scope, i.e. lexical variables and
231	225	the current execution state (subroutine, stack).
232	226
	227	=item $state->throw ([$scalar])
	228
233	229	=item $state->is_new
234	230
235		Returns true iff this Coro::State object is "new", i.e. has never been run
236		yet. Those states basically consist of only the code reference to call and
237		the arguments, but consumes very little other resources. New states will
238		automatically get assigned a perl interpreter when they are transfered to.
239
240		=item $state->is_destroyed
241
242		Returns true iff the Coro::State object has been destroyed (by
243		C<cancel>), i.e. it's resources freed because they were C<cancel>'d (or
244		C<terminate>'d).
	231	=item $state->is_zombie
	232
	233	See the corresponding method for L<Coro> objects.
245	234
246	235	=item $state->cancel
247	236
248	237	Forcefully destructs the given Coro::State. While you can keep the
249	238	reference, and some memory is still allocated, the Coro::State object is
250		effecticely dead, destructors have been freed, it cannot be transfered to
251		anymore.
252
253		=item $state->throw ([$scalar])
254
255		See L<< Coro->throw >>.
	239	effectively dead, destructors have been freed, it cannot be transfered to
	240	anymore, it's pushing up the daisies.
256	241
257	242	=item $state->call ($coderef)
258	243

+606

-254

Coro/State.xs less more

13	13	#include "perliol.h"
14	14
15	15	#include "schmorp.h"
16
	16	#include "ecb.h"
	17
	18	#include <stddef.h>
17	19	#include <stdio.h>
18	20	#include <errno.h>
19	21	#include <assert.h>

22	24	# define SVs_PADSTALE 0
23	25	#endif
24	26
25		#ifdef WIN32
	27	#if defined(_WIN32)
26	28	# undef HAS_GETTIMEOFDAY
27	29	# undef setjmp
28	30	# undef longjmp

32	34	# include <inttypes.h> /* most portable stdint.h */
33	35	#endif
34	36
35		#ifdef HAVE_MMAP
	37	#if HAVE_MMAP
36	38	# include <unistd.h>
37	39	# include <sys/mman.h>
38	40	# ifndef MAP_ANONYMOUS

62	64	/* the maximum number of idle cctx that will be pooled */
63	65	static int cctx_max_idle = 4;
64	66
	67	#if defined(DEBUGGING) && PERL_VERSION_ATLEAST(5,12,0)
	68	# define HAS_SCOPESTACK_NAME 1
	69	#endif
	70
65	71	#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
66	72	# undef CORO_STACKGUARD
67	73	#endif

87	93
88	94	#define IN_DESTRUCT PL_dirty
89	95
90		#if __GNUC__ >= 3
91		# define attribute(x) __attribute__(x)
92		# define expect(expr,value) __builtin_expect ((expr), (value))
93		# define INLINE static inline
94		#else
95		# define attribute(x)
96		# define expect(expr,value) (expr)
97		# define INLINE static
98		#endif
99
100		#define expect_false(expr) expect ((expr) != 0, 0)
101		#define expect_true(expr) expect ((expr) != 0, 1)
102
103		#define NOINLINE attribute ((noinline))
104
105	96	#include "CoroAPI.h"
106	97	#define GCoroAPI (&coroapi) /* very sneaky */
107	98

110	101	static void *coro_thx;
111	102	# endif
112	103	#endif
	104
	105	/* used in state.h */
	106	#define VAR(name,type) VARx(name, PL_ ## name, type)
113	107
114	108	#ifdef __linux
115	109	# include <time.h> /* for timespec */

127	121	/* we hijack an hopefully unused CV flag for our purposes */
128	122	#define CVf_SLF 0x4000
129	123	static OP *pp_slf (pTHX);
	124	static void slf_destroy (pTHX_ struct coro *coro);
130	125
131	126	static U32 cctx_gen;
132	127	static size_t cctx_stacksize = CORO_STACKSIZE;

166	161	static struct coro_cctx *cctx_first;
167	162	static int cctx_count, cctx_idle;
168	163
169		enum {
	164	enum
	165	{
170	166	CC_MAPPED = 0x01,
171	167	CC_NOREUSE = 0x02, /* throw this away after tracing */
172	168	CC_TRACE = 0x04,

197	193	unsigned char flags;
198	194	} coro_cctx;
199	195
200		coro_cctx cctx_current; / the currently running cctx */
	196	static coro_cctx cctx_current; / the currently running cctx */
201	197
202	198	/*****************************************************************************/
203	199
204		enum {
	200	static MGVTBL coro_state_vtbl;
	201
	202	enum
	203	{
205	204	CF_RUNNING = 0x0001, /* coroutine is running */
206	205	CF_READY = 0x0002, /* coroutine is ready */
207	206	CF_NEW = 0x0004, /* has never been switched to */
208		CF_DESTROYED = 0x0008, /* coroutine data has been freed */
	207	CF_ZOMBIE = 0x0008, /* coroutine data has been freed */
209	208	CF_SUSPENDED = 0x0010, /* coroutine can't be scheduled */
	209	CF_NOCANCEL = 0x0020, /* cannot cancel, set slf_frame.data to 1 (hackish) */
210	210	};
211	211
212	212	/* the structure where most of the perl state is stored, overlaid on the cxstack */
213	213	typedef struct
214	214	{
215		SV *defsv;
216		AV *defav;
217		SV *errsv;
218		SV *irsgv;
219		HV *hinthv;
220		#define VAR(name,type) type name;
	215	#define VARx(name,expr,type) type name;
221	216	# include "state.h"
222		#undef VAR
	217	#undef VARx
223	218	} perl_slots;
224	219
	220	/* how many context stack entries do we need for perl_slots */
225	221	#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))
226	222
227	223	/* this is a structure representing a perl-level coroutine */
228		struct coro {
	224	struct coro
	225	{
229	226	/* the C coroutine allocated to this perl coroutine, if any */
230	227	coro_cctx *cctx;
231	228

237	234	AV *mainstack;
238	235	perl_slots slot; / basically the saved sp */
239	236
240		CV startcv; / the CV to execute */
241		AV args; / data associated with this coroutine (initial args) */
242		int refcnt; /* coroutines are refcounted, yes */
243		int flags; /* CF_ flags */
244		HV hv; / the perl hash associated with this coro, if any */
245		void (on_destroy)(pTHX_ struct coro coro); /* for temporary use by xs in critical sections */
	237	CV startcv; / the CV to execute */
	238	AV args; / data associated with this coroutine (initial args) */
	239	int flags; /* CF_ flags */
	240	HV hv; / the perl hash associated with this coro, if any */
246	241
247	242	/* statistics */
248	243	int usecount; /* number of transfers to this coro */
249	244
250	245	/* coro process data */
251	246	int prio;
252		SV except; / exception to be thrown */
253		SV *rouse_cb;
	247	SV except; / exception to be thrown */
	248	SV rouse_cb; / last rouse callback */
	249	AV on_destroy; / callbacks or coros to notify on destroy */
	250	AV status; / the exit status list */
254	251
255	252	/* async_pool */
256	253	SV *saved_deffh;

276	273
277	274	/* the following variables are effectively part of the perl context */
278	275	/* and get copied between struct coro and these variables */
279		/* the mainr easonw e don't support windows process emulation */
	276	/* the main reason we don't support windows process emulation */
280	277	static struct CoroSLF slf_frame; /* the current slf frame */
281	278
282	279	/ Coro ******************************************************************/

292	289	static SV *coro_current;
293	290	static SV *coro_readyhook;
294	291	static struct coro coro_ready [CORO_PRIO_MAX - CORO_PRIO_MIN + 1][2]; / head\|tail */
295		static CV cv_coro_run, cv_coro_terminate;
	292	static CV *cv_coro_run;
296	293	static struct coro *coro_first;
297	294	#define coro_nready coroapi.nready
	295
	296	/ JIT *******************************************************************/
	297
	298	#if CORO_JIT
	299	/* APPLE doesn't have HAVE_MMAP though */
	300	#define CORO_JIT_UNIXY (__linux \|\| __FreeBSD__ \|\| __OpenBSD__ \|\| __NetBSD__ \|\| __solaris \|\| __APPLE__)
	301	#ifndef CORO_JIT_TYPE
	302	#if __x86_64 && CORO_JIT_UNIXY
	303	#define CORO_JIT_TYPE "amd64-unix"
	304	#elif __i386 && CORO_JIT_UNIXY
	305	#define CORO_JIT_TYPE "x86-unix"
	306	#endif
	307	#endif
	308	#endif
	309
	310	#if !defined(CORO_JIT_TYPE) \|\| !HAVE_MMAP
	311	#undef CORO_JIT
	312	#endif
	313
	314	#if CORO_JIT
	315	typedef void (load_save_perl_slots_type)(perl_slots );
	316	static load_save_perl_slots_type load_perl_slots, save_perl_slots;
	317	#endif
298	318
299	319	/ Coro::Select **********************************************************/
300	320

320	340
321	341	#ifdef HAS_GETTIMEOFDAY
322	342
323		static void
	343	ecb_inline void
324	344	coro_u2time (pTHX_ UV ret[2])
325	345	{
326	346	struct timeval tv;

330	350	ret [1] = tv.tv_usec;
331	351	}
332	352
333		static double
334		coro_nvtime ()
	353	ecb_inline double
	354	coro_nvtime (void)
335	355	{
336	356	struct timeval tv;
337	357	gettimeofday (&tv, 0);

339	359	return tv.tv_sec + tv.tv_usec * 1e-6;
340	360	}
341	361
342		static void
	362	ecb_inline void
343	363	time_init (pTHX)
344	364	{
345	365	nvtime = coro_nvtime;

348	368
349	369	#else
350	370
351		static void
	371	ecb_inline void
352	372	time_init (pTHX)
353	373	{
354	374	SV **svp;

357	377
358	378	svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
359	379
360		if (!svp) croak ("Time::HiRes is required, but missing.");
361		if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
	380	if (!svp) croak ("Time::HiRes is required, but missing. Caught");
	381	if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer. Caught");
362	382
363	383	nvtime = INT2PTR (double ()(), SvIV (svp));
364	384

370	390
371	391	/ lowlevel stuff ********************************************************/
372	392
373		static SV *
	393	static SV * ecb_noinline
374	394	coro_get_sv (pTHX_ const char *name, int create)
375	395	{
376	396	#if PERL_VERSION_ATLEAST (5,10,0)

380	400	return get_sv (name, create);
381	401	}
382	402
383		static AV *
	403	static AV * ecb_noinline
384	404	coro_get_av (pTHX_ const char *name, int create)
385	405	{
386	406	#if PERL_VERSION_ATLEAST (5,10,0)

390	410	return get_av (name, create);
391	411	}
392	412
393		static HV *
	413	static HV * ecb_noinline
394	414	coro_get_hv (pTHX_ const char *name, int create)
395	415	{
396	416	#if PERL_VERSION_ATLEAST (5,10,0)

400	420	return get_hv (name, create);
401	421	}
402	422
403		INLINE void
404		coro_times_update ()
	423	ecb_inline void
	424	coro_times_update (void)
405	425	{
406	426	#ifdef coro_clock_gettime
407	427	struct timespec ts;

423	443	#endif
424	444	}
425	445
426		INLINE void
	446	ecb_inline void
427	447	coro_times_add (struct coro *c)
428	448	{
429	449	c->t_real [1] += time_real [1];

435	455	c->t_cpu [0] += time_cpu [0];
436	456	}
437	457
438		INLINE void
	458	ecb_inline void
439	459	coro_times_sub (struct coro *c)
440	460	{
441	461	if (c->t_real [1] < time_real [1]) { c->t_real [1] += 1000000000; --c->t_real [0]; }

453	473	#define CORO_MAGIC_type_cv 26
454	474	#define CORO_MAGIC_type_state PERL_MAGIC_ext
455	475
456		#define CORO_MAGIC_NN(sv, type) \
457		(expect_true (SvMAGIC (sv)->mg_type == type) \
458		? SvMAGIC (sv) \
	476	#define CORO_MAGIC_NN(sv, type) \
	477	(ecb_expect_true (SvMAGIC (sv)->mg_type == type) \
	478	? SvMAGIC (sv) \
459	479	: mg_find (sv, type))
460	480
461		#define CORO_MAGIC(sv, type) \
462		(expect_true (SvMAGIC (sv)) \
463		? CORO_MAGIC_NN (sv, type) \
	481	#define CORO_MAGIC(sv, type) \
	482	(ecb_expect_true (SvMAGIC (sv)) \
	483	? CORO_MAGIC_NN (sv, type) \
464	484	: 0)
465	485
466	486	#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
467	487	#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
468	488
469		INLINE struct coro *
	489	ecb_inline MAGIC *
	490	SvSTATEhv_p (pTHX_ SV *coro)
	491	{
	492	MAGIC *mg;
	493
	494	if (ecb_expect_true (
	495	SvTYPE (coro) == SVt_PVHV
	496	&& (mg = CORO_MAGIC_state (coro))
	497	&& mg->mg_virtual == &coro_state_vtbl
	498	))
	499	return mg;
	500
	501	return 0;
	502	}
	503
	504	ecb_inline struct coro *
470	505	SvSTATE_ (pTHX_ SV *coro)
471	506	{
472		HV *stash;
473	507	MAGIC *mg;
474	508
475	509	if (SvROK (coro))
476	510	coro = SvRV (coro);
477	511
478		if (expect_false (SvTYPE (coro) != SVt_PVHV))
	512	mg = SvSTATEhv_p (aTHX_ coro);
	513	if (!mg)
479	514	croak ("Coro::State object required");
480	515
481		stash = SvSTASH (coro);
482		if (expect_false (stash != coro_stash && stash != coro_state_stash))
483		{
484		/* very slow, but rare, check */
485		if (!sv_derived_from (sv_2mortal (newRV_inc (coro)), "Coro::State"))
486		croak ("Coro::State object required");
487		}
488
489		mg = CORO_MAGIC_state (coro);
490	516	return (struct coro *)mg->mg_ptr;
491	517	}
492	518

499	525	/*****************************************************************************/
500	526	/* padlist management and caching */
501	527
502		static AV *
	528	ecb_inline AV *
503	529	coro_derive_padlist (pTHX_ CV *cv)
504	530	{
505	531	AV *padlist = CvPADLIST (cv);

521	547	return newpadlist;
522	548	}
523	549
524		static void
	550	ecb_inline void
525	551	free_padlist (pTHX_ AV *padlist)
526	552	{
527	553	/* may be during global destruction */

574	600	};
575	601
576	602	/* the next two functions merely cache the padlists */
577		static void
	603	ecb_inline void
578	604	get_padlist (pTHX_ CV *cv)
579	605	{
580	606	MAGIC *mg = CORO_MAGIC_cv (cv);
581	607	AV *av;
582	608
583		if (expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))
	609	if (ecb_expect_true (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0))
584	610	CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
585	611	else
586	612	{

597	623	}
598	624	}
599	625
600		static void
	626	ecb_inline void
601	627	put_padlist (pTHX_ CV *cv)
602	628	{
603	629	MAGIC *mg = CORO_MAGIC_cv (cv);
604	630	AV *av;
605	631
606		if (expect_false (!mg))
	632	if (ecb_expect_false (!mg))
607	633	mg = sv_magicext ((SV )cv, (SV )newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
608	634
609	635	av = (AV *)mg->mg_obj;
610	636
611		if (expect_false (AvFILLp (av) >= AvMAX (av)))
	637	if (ecb_expect_false (AvFILLp (av) >= AvMAX (av)))
612	638	av_extend (av, AvFILLp (av) + 1);
613	639
614	640	AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);

663	689	}
664	690	}
665	691
666		#define SWAP_SVS(coro) \
667		if (expect_false ((coro)->swap_sv)) \
	692	#define SWAP_SVS(coro) \
	693	if (ecb_expect_false ((coro)->swap_sv)) \
668	694	swap_svs (aTHX_ (coro))
669	695
670	696	static void

678	704
679	705	PL_mainstack = c->mainstack;
680	706
681		GvSV (PL_defgv) = slot->defsv;
682		GvAV (PL_defgv) = slot->defav;
683		GvSV (PL_errgv) = slot->errsv;
684		GvSV (irsgv) = slot->irsgv;
685		GvHV (PL_hintgv) = slot->hinthv;
686
687		#define VAR(name,type) PL_ ## name = slot->name;
	707	#if CORO_JIT
	708	load_perl_slots (slot);
	709	#else
	710	#define VARx(name,expr,type) expr = slot->name;
688	711	# include "state.h"
689		#undef VAR
	712	#undef VARx
	713	#endif
690	714
691	715	{
692	716	dSP;

694	718	CV *cv;
695	719
696	720	/* now do the ugly restore mess */
697		while (expect_true (cv = (CV *)POPs))
	721	while (ecb_expect_true (cv = (CV *)POPs))
698	722	{
699	723	put_padlist (aTHX_ cv); /* mark this padlist as available */
700	724	CvDEPTH (cv) = PTR2IV (POPs);

707	731	slf_frame = c->slf_frame;
708	732	CORO_THROW = c->except;
709	733
710		if (expect_false (enable_times))
711		{
712		if (expect_false (!times_valid))
	734	if (ecb_expect_false (enable_times))
	735	{
	736	if (ecb_expect_false (!times_valid))
713	737	coro_times_update ();
714	738
715	739	coro_times_sub (c);
716	740	}
717	741
718		if (expect_false (c->on_enter))
	742	if (ecb_expect_false (c->on_enter))
719	743	{
720	744	int i;
721	745

731	755	{
732	756	SWAP_SVS (c);
733	757
734		if (expect_false (c->on_leave))
	758	if (ecb_expect_false (c->on_leave))
735	759	{
736	760	int i;
737	761

741	765
742	766	times_valid = 0;
743	767
744		if (expect_false (enable_times))
	768	if (ecb_expect_false (enable_times))
745	769	{
746	770	coro_times_update (); times_valid = 1;
747	771	coro_times_add (c);

765	789	/* this loop was inspired by pp_caller */
766	790	for (;;)
767	791	{
768		while (expect_true (cxix >= 0))
	792	while (ecb_expect_true (cxix >= 0))
769	793	{
770	794	PERL_CONTEXT *cx = &ccstk[cxix--];
771	795
772		if (expect_true (CxTYPE (cx) == CXt_SUB) \|\| expect_false (CxTYPE (cx) == CXt_FORMAT))
	796	if (ecb_expect_true (CxTYPE (cx) == CXt_SUB) \|\| ecb_expect_false (CxTYPE (cx) == CXt_FORMAT))
773	797	{
774	798	CV *cv = cx->blk_sub.cv;
775	799
776		if (expect_true (CvDEPTH (cv)))
	800	if (ecb_expect_true (CvDEPTH (cv)))
777	801	{
778	802	EXTEND (SP, 3);
779	803	PUSHs ((SV *)CvPADLIST (cv));

786	810	}
787	811	}
788	812
789		if (expect_true (top_si->si_type == PERLSI_MAIN))
	813	if (ecb_expect_true (top_si->si_type == PERLSI_MAIN))
790	814	break;
791	815
792	816	top_si = top_si->si_prev;

798	822	}
799	823
800	824	/* allocate some space on the context stack for our purposes */
801		/* we manually unroll here, as usually 2 slots is enough */
802		if (SLOT_COUNT >= 1) CXINC;
803		if (SLOT_COUNT >= 2) CXINC;
804		if (SLOT_COUNT >= 3) CXINC;
805		{
806		unsigned int i;
807		for (i = 3; i < SLOT_COUNT; ++i)
808		CXINC;
809		}
810		cxstack_ix -= SLOT_COUNT; /* undo allocation */
	825	if (ecb_expect_false (cxstack_ix + (int)SLOT_COUNT >= cxstack_max))
	826	{
	827	unsigned int i;
	828
	829	for (i = 0; i < SLOT_COUNT; ++i)
	830	CXINC;
	831
	832	cxstack_ix -= SLOT_COUNT; /* undo allocation */
	833	}
811	834
812	835	c->mainstack = PL_mainstack;
813	836
814	837	{
815	838	perl_slots slot = c->slot = (perl_slots )(cxstack + cxstack_ix + 1);
816	839
817		slot->defav = GvAV (PL_defgv);
818		slot->defsv = DEFSV;
819		slot->errsv = ERRSV;
820		slot->irsgv = GvSV (irsgv);
821		slot->hinthv = GvHV (PL_hintgv);
822
823		#define VAR(name,type) slot->name = PL_ ## name;
	840	#if CORO_JIT
	841	save_perl_slots (slot);
	842	#else
	843	#define VARx(name,expr,type) slot->name = expr;
824	844	# include "state.h"
825		#undef VAR
	845	#undef VARx
	846	#endif
826	847	}
827	848	}
828	849

838	859	static void
839	860	coro_init_stacks (pTHX)
840	861	{
841		PL_curstackinfo = new_stackinfo(32, 8);
	862	PL_curstackinfo = new_stackinfo(32, 4 + SLOT_COUNT); /* 3 is minimum due to perl rounding down in scope.c:GROW() */
842	863	PL_curstackinfo->si_type = PERLSI_MAIN;
843	864	PL_curstack = PL_curstackinfo->si_stack;
844	865	PL_mainstack = PL_curstack; /* remember in case we switch stacks */

863	884	New(54,PL_scopestack,8,I32);
864	885	PL_scopestack_ix = 0;
865	886	PL_scopestack_max = 8;
	887	#if HAS_SCOPESTACK_NAME
	888	New(54,PL_scopestack_name,8,const char*);
	889	#endif
866	890
867	891	New(54,PL_savestack,24,ANY);
868	892	PL_savestack_ix = 0;

900	924	Safefree (PL_tmps_stack);
901	925	Safefree (PL_markstack);
902	926	Safefree (PL_scopestack);
	927	#if HAS_SCOPESTACK_NAME
	928	Safefree (PL_scopestack_name);
	929	#endif
903	930	Safefree (PL_savestack);
904	931	#if !PERL_VERSION_ATLEAST (5,10,0)
905	932	Safefree (PL_retstack);

955	982	/*
956	983	* This overrides the default magic get method of %SIG elements.
957	984	* The original one doesn't provide for reading back of PL_diehook/PL_warnhook
958		* and instead of trying to save and restore the hash elements, we just provide
959		* readback here.
	985	* and instead of trying to save and restore the hash elements (extremely slow),
	986	* we just provide our own readback here.
960	987	*/
961		static int
	988	static int ecb_cold
962	989	coro_sigelem_get (pTHX_ SV sv, MAGIC mg)
963	990	{
964	991	const char *s = MgPV_nolen_const (mg);

980	1007	return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;
981	1008	}
982	1009
983		static int
	1010	static int ecb_cold
984	1011	coro_sigelem_clr (pTHX_ SV sv, MAGIC mg)
985	1012	{
986	1013	const char *s = MgPV_nolen_const (mg);

1004	1031	return orig_sigelem_clr ? orig_sigelem_clr (aTHX_ sv, mg) : 0;
1005	1032	}
1006	1033
1007		static int
	1034	static int ecb_cold
1008	1035	coro_sigelem_set (pTHX_ SV sv, MAGIC mg)
1009	1036	{
1010	1037	const char *s = MgPV_nolen_const (mg);

1049	1076
1050	1077	static UNOP init_perl_op;
1051	1078
1052		static void NOINLINE /* noinline to keep it out of the transfer fast path */
	1079	ecb_noinline static void /* noinline to keep it out of the transfer fast path */
1053	1080	init_perl (pTHX_ struct coro *coro)
1054	1081	{
1055	1082	/*

1074	1101	PL_hints = 0;
1075	1102
1076	1103	/* recreate the die/warn hooks */
1077		PL_diehook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );
1078		PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);
	1104	PL_diehook = SvREFCNT_inc (rv_diehook);
	1105	PL_warnhook = SvREFCNT_inc (rv_warnhook);
1079	1106
1080	1107	GvSV (PL_defgv) = newSV (0);
1081	1108	GvAV (PL_defgv) = coro->args; coro->args = 0;

1106	1133	*/
1107	1134	slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */
1108	1135	slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */
	1136	slf_frame.destroy = 0;
1109	1137
1110	1138	/* and we have to provide the pp_slf op in any case, so pp_slf can skip it */
1111	1139	init_perl_op.op_next = PL_op;

1120	1148
1121	1149	SWAP_SVS (coro);
1122	1150
1123		if (expect_false (enable_times))
	1151	if (ecb_expect_false (enable_times))
1124	1152	{
1125	1153	coro_times_update ();
1126	1154	coro_times_sub (coro);

1154	1182	SV *svf [9];
1155	1183
1156	1184	{
1157		struct coro *current = SvSTATE_current;
	1185	SV *old_current = SvRV (coro_current);
	1186	struct coro *current = SvSTATE (old_current);
1158	1187
1159	1188	assert (("FATAL: tried to destroy currently running coroutine", coro->mainstack != PL_mainstack));
1160	1189
1161	1190	save_perl (aTHX_ current);
	1191
	1192	/* this will cause transfer_check to croak on block*/
	1193	SvRV_set (coro_current, (SV *)coro->hv);
	1194
1162	1195	load_perl (aTHX_ coro);
1163	1196
1164	1197	coro_unwind_stacks (aTHX);
1165		coro_destruct_stacks (aTHX);
1166	1198
1167	1199	/* restore swapped sv's */
1168	1200	SWAP_SVS (coro);
1169	1201
1170		// now save some sv's to be free'd later
	1202	coro_destruct_stacks (aTHX);
	1203
	1204	/* now save some sv's to be free'd later */
1171	1205	svf [0] = GvSV (PL_defgv);
1172	1206	svf [1] = (SV *)GvAV (PL_defgv);
1173	1207	svf [2] = GvSV (PL_errgv);

1179	1213	svf [8] = PL_warnhook;
1180	1214	assert (9 == sizeof (svf) / sizeof (*svf));
1181	1215
	1216	SvRV_set (coro_current, old_current);
	1217
1182	1218	load_perl (aTHX_ current);
1183	1219	}
1184	1220

1195	1231	}
1196	1232	}
1197	1233
1198		INLINE void
	1234	ecb_inline void
1199	1235	free_coro_mortal (pTHX)
1200	1236	{
1201		if (expect_true (coro_mortal))
1202		{
1203		SvREFCNT_dec (coro_mortal);
	1237	if (ecb_expect_true (coro_mortal))
	1238	{
	1239	SvREFCNT_dec ((SV *)coro_mortal);
1204	1240	coro_mortal = 0;
1205	1241	}
1206	1242	}

1343	1379	}
1344	1380
1345	1381	/* initialises PL_top_env and injects a pseudo-slf-call to set the stacklevel */
1346		static void NOINLINE
	1382	static void ecb_noinline
1347	1383	cctx_prepare (pTHX)
1348	1384	{
1349	1385	PL_top_env = &PL_start_env;

1364	1400	}
1365	1401
1366	1402	/* the tail of transfer: execute stuff we can only do after a transfer */
1367		INLINE void
	1403	ecb_inline void
1368	1404	transfer_tail (pTHX)
1369	1405	{
1370	1406	free_coro_mortal (aTHX);

1418	1454	}
1419	1455
1420	1456	static coro_cctx *
1421		cctx_new ()
	1457	cctx_new (void)
1422	1458	{
1423	1459	coro_cctx *cctx;
1424	1460

1434	1470
1435	1471	/* create a new cctx only suitable as source */
1436	1472	static coro_cctx *
1437		cctx_new_empty ()
	1473	cctx_new_empty (void)
1438	1474	{
1439	1475	coro_cctx *cctx = cctx_new ();
1440	1476

1446	1482
1447	1483	/* create a new cctx suitable as destination/running a perl interpreter */
1448	1484	static coro_cctx *
1449		cctx_new_run ()
	1485	cctx_new_run (void)
1450	1486	{
1451	1487	coro_cctx *cctx = cctx_new ();
1452	1488	void *stack_start;

1455	1491	#if HAVE_MMAP
1456	1492	cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
1457	1493	/* mmap supposedly does allocate-on-write for us */
1458		cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC\|PROT_READ\|PROT_WRITE, MAP_PRIVATE\|MAP_ANONYMOUS, 0, 0);
	1494	cctx->sptr = mmap (0, cctx->ssize, PROT_READ \| PROT_WRITE \| PROT_EXEC, MAP_ANONYMOUS, 0, 0);
1459	1495
1460	1496	if (cctx->sptr != (void *)-1)
1461	1497	{

1497	1533	if (!cctx)
1498	1534	return;
1499	1535
1500		assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));//D temporary?
	1536	assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));
1501	1537
1502	1538	--cctx_count;
1503	1539	coro_destroy (&cctx->cctx);

1526	1562	static coro_cctx *
1527	1563	cctx_get (pTHX)
1528	1564	{
1529		while (expect_true (cctx_first))
	1565	while (ecb_expect_true (cctx_first))
1530	1566	{
1531	1567	coro_cctx *cctx = cctx_first;
1532	1568	cctx_first = cctx->next;
1533	1569	--cctx_idle;
1534	1570
1535		if (expect_true (!CCTX_EXPIRED (cctx)))
	1571	if (ecb_expect_true (!CCTX_EXPIRED (cctx)))
1536	1572	return cctx;
1537	1573
1538	1574	cctx_destroy (cctx);

1547	1583	assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->sptr));
1548	1584
1549	1585	/* free another cctx if overlimit */
1550		if (expect_false (cctx_idle >= cctx_max_idle))
	1586	if (ecb_expect_false (cctx_idle >= cctx_max_idle))
1551	1587	{
1552	1588	coro_cctx *first = cctx_first;
1553	1589	cctx_first = first->next;

1568	1604	{
1569	1605	/* TODO: throwing up here is considered harmful */
1570	1606
1571		if (expect_true (prev != next))
1572		{
1573		if (expect_false (!(prev->flags & (CF_RUNNING \| CF_NEW))))
	1607	if (ecb_expect_true (prev != next))
	1608	{
	1609	if (ecb_expect_false (!(prev->flags & (CF_RUNNING \| CF_NEW))))
1574	1610	croak ("Coro::State::transfer called with a blocked prev Coro::State, but can only transfer from running or new states,");
1575	1611
1576		if (expect_false (next->flags & (CF_RUNNING \| CF_DESTROYED \| CF_SUSPENDED)))
	1612	if (ecb_expect_false (next->flags & (CF_RUNNING \| CF_ZOMBIE \| CF_SUSPENDED)))
1577	1613	croak ("Coro::State::transfer called with running, destroyed or suspended next Coro::State, but can only transfer to inactive states,");
1578	1614
1579	1615	#if !PERL_VERSION_ATLEAST (5,10,0)
1580		if (expect_false (PL_lex_state != LEX_NOTPARSING))
	1616	if (ecb_expect_false (PL_lex_state != LEX_NOTPARSING))
1581	1617	croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");
1582	1618	#endif
1583	1619	}
1584	1620	}
1585	1621
1586	1622	/* always use the TRANSFER macro */
1587		static void NOINLINE /* noinline so we have a fixed stackframe */
	1623	static void ecb_noinline /* noinline so we have a fixed stackframe */
1588	1624	transfer (pTHX_ struct coro prev, struct coro next, int force_cctx)
1589	1625	{
1590	1626	dSTACKLEVEL;
1591	1627
1592	1628	/* sometimes transfer is only called to set idle_sp */
1593		if (expect_false (!prev))
	1629	if (ecb_expect_false (!prev))
1594	1630	{
1595	1631	cctx_current->idle_sp = STACKLEVEL;
1596	1632	assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
1597	1633	}
1598		else if (expect_true (prev != next))
	1634	else if (ecb_expect_true (prev != next))
1599	1635	{
1600	1636	coro_cctx *cctx_prev;
1601	1637
1602		if (expect_false (prev->flags & CF_NEW))
	1638	if (ecb_expect_false (prev->flags & CF_NEW))
1603	1639	{
1604	1640	/* create a new empty/source context */
1605	1641	prev->flags &= ~CF_NEW;

1612	1648	/* first get rid of the old state */
1613	1649	save_perl (aTHX_ prev);
1614	1650
1615		if (expect_false (next->flags & CF_NEW))
	1651	if (ecb_expect_false (next->flags & CF_NEW))
1616	1652	{
1617	1653	/* need to start coroutine */
1618	1654	next->flags &= ~CF_NEW;

1623	1659	load_perl (aTHX_ next);
1624	1660
1625	1661	/* possibly untie and reuse the cctx */
1626		if (expect_true (
	1662	if (ecb_expect_true (
1627	1663	cctx_current->idle_sp == STACKLEVEL
1628	1664	&& !(cctx_current->flags & CC_TRACE)
1629	1665	&& !force_cctx

1634	1670
1635	1671	/* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */
1636	1672	/* without this the next cctx_get might destroy the running cctx while still in use */
1637		if (expect_false (CCTX_EXPIRED (cctx_current)))
1638		if (expect_true (!next->cctx))
	1673	if (ecb_expect_false (CCTX_EXPIRED (cctx_current)))
	1674	if (ecb_expect_true (!next->cctx))
1639	1675	next->cctx = cctx_get (aTHX);
1640	1676
1641	1677	cctx_put (cctx_current);

1646	1682	++next->usecount;
1647	1683
1648	1684	cctx_prev = cctx_current;
1649		cctx_current = expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);
	1685	cctx_current = ecb_expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);
1650	1686
1651	1687	next->cctx = 0;
1652	1688
1653		if (expect_false (cctx_prev != cctx_current))
	1689	if (ecb_expect_false (cctx_prev != cctx_current))
1654	1690	{
1655	1691	cctx_prev->top_env = PL_top_env;
1656	1692	PL_top_env = cctx_current->top_env;

1666	1702
1667	1703	/ high level stuff ******************************************************/
1668	1704
1669		static int
	1705	/* this function is actually Coro, not Coro::State, but we call it from here */
	1706	/* because it is convenient - but it hasn't been declared yet for that reason */
	1707	static void
	1708	coro_call_on_destroy (pTHX_ struct coro *coro);
	1709
	1710	static void
1670	1711	coro_state_destroy (pTHX_ struct coro *coro)
1671	1712	{
1672		if (coro->flags & CF_DESTROYED)
1673		return 0;
1674
1675		if (coro->on_destroy && !PL_dirty)
1676		coro->on_destroy (aTHX_ coro);
1677
1678		coro->flags \|= CF_DESTROYED;
	1713	if (coro->flags & CF_ZOMBIE)
	1714	return;
	1715
	1716	slf_destroy (aTHX_ coro);
	1717
	1718	coro->flags \|= CF_ZOMBIE;
1679	1719
1680	1720	if (coro->flags & CF_READY)
1681	1721	{

1685	1725	}
1686	1726	else
1687	1727	coro->flags \|= CF_READY; /* make sure it is NOT put into the readyqueue */
	1728
	1729	if (coro->next) coro->next->prev = coro->prev;
	1730	if (coro->prev) coro->prev->next = coro->next;
	1731	if (coro == coro_first) coro_first = coro->next;
1688	1732
1689	1733	if (coro->mainstack
1690	1734	&& coro->mainstack != main_mainstack

1692	1736	&& !PL_dirty)
1693	1737	destroy_perl (aTHX_ coro);
1694	1738
1695		if (coro->next) coro->next->prev = coro->prev;
1696		if (coro->prev) coro->prev->next = coro->next;
1697		if (coro == coro_first) coro_first = coro->next;
1698
1699	1739	cctx_destroy (coro->cctx);
1700	1740	SvREFCNT_dec (coro->startcv);
1701	1741	SvREFCNT_dec (coro->args);
1702	1742	SvREFCNT_dec (coro->swap_sv);
1703	1743	SvREFCNT_dec (CORO_THROW);
1704	1744
1705		return 1;
	1745	coro_call_on_destroy (aTHX_ coro);
	1746
	1747	/* more destruction mayhem in coro_state_free */
1706	1748	}
1707	1749
1708	1750	static int

1711	1753	struct coro coro = (struct coro )mg->mg_ptr;
1712	1754	mg->mg_ptr = 0;
1713	1755
1714		coro->hv = 0;
1715
1716		if (--coro->refcnt < 0)
1717		{
1718		coro_state_destroy (aTHX_ coro);
1719		Safefree (coro);
1720		}
	1756	coro_state_destroy (aTHX_ coro);
	1757	SvREFCNT_dec (coro->on_destroy);
	1758	SvREFCNT_dec (coro->status);
	1759
	1760	Safefree (coro);
1721	1761
1722	1762	return 0;
1723	1763	}
1724	1764
1725		static int
	1765	static int ecb_cold
1726	1766	coro_state_dup (pTHX_ MAGIC mg, CLONE_PARAMS params)
1727	1767	{
1728		struct coro coro = (struct coro )mg->mg_ptr;
1729
1730		++coro->refcnt;
	1768	/* called when perl clones the current process the slow way (windows process emulation) */
	1769	/* WE SIMply nuke the pointers in the copy, causing perl to croak */
	1770	mg->mg_ptr = 0;
	1771	mg->mg_virtual = 0;
1731	1772
1732	1773	return 0;
1733	1774	}

1762	1803
1763	1804	/ Coro ******************************************************************/
1764	1805
1765		INLINE void
	1806	ecb_inline void
1766	1807	coro_enq (pTHX_ struct coro *coro)
1767	1808	{
1768	1809	struct coro **ready = coro_ready [coro->prio - CORO_PRIO_MIN];

1774	1815	ready [1] = coro;
1775	1816	}
1776	1817
1777		INLINE struct coro *
	1818	ecb_inline struct coro *
1778	1819	coro_deq (pTHX)
1779	1820	{
1780	1821	int prio;

1837	1878	}
1838	1879
1839	1880	/* expects to own a reference to next->hv */
1840		INLINE void
	1881	ecb_inline void
1841	1882	prepare_schedule_to (pTHX_ struct coro_transfer_args ta, struct coro next)
1842	1883	{
1843	1884	SV *prev_sv = SvRV (coro_current);

1860	1901	{
1861	1902	struct coro *next = coro_deq (aTHX);
1862	1903
1863		if (expect_true (next))
	1904	if (ecb_expect_true (next))
1864	1905	{
1865	1906	/* cannot transfer to destroyed coros, skip and look for next */
1866		if (expect_false (next->flags & (CF_DESTROYED \| CF_SUSPENDED)))
	1907	if (ecb_expect_false (next->flags & (CF_ZOMBIE \| CF_SUSPENDED)))
1867	1908	SvREFCNT_dec (next->hv); /* coro_nready has already been taken care of by destroy */
1868	1909	else
1869	1910	{

1906	1947	}
1907	1948	}
1908	1949
1909		INLINE void
	1950	ecb_inline void
1910	1951	prepare_cede (pTHX_ struct coro_transfer_args *ta)
1911	1952	{
1912	1953	api_ready (aTHX_ coro_current);
1913	1954	prepare_schedule (aTHX_ ta);
1914	1955	}
1915	1956
1916		INLINE void
	1957	ecb_inline void
1917	1958	prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)
1918	1959	{
1919	1960	SV *prev = SvRV (coro_current);

1953	1994
1954	1995	prepare_cede (aTHX_ &ta);
1955	1996
1956		if (expect_true (ta.prev != ta.next))
	1997	if (ecb_expect_true (ta.prev != ta.next))
1957	1998	{
1958	1999	TRANSFER (ta, 1);
1959	2000	return 1;

2006	2047	}
2007	2048
2008	2049	static void
	2050	coro_push_av (pTHX_ AV *av, I32 gimme_v)
	2051	{
	2052	if (AvFILLp (av) >= 0 && gimme_v != G_VOID)
	2053	{
	2054	dSP;
	2055
	2056	if (gimme_v == G_SCALAR)
	2057	XPUSHs (AvARRAY (av)[AvFILLp (av)]);
	2058	else
	2059	{
	2060	int i;
	2061	EXTEND (SP, AvFILLp (av) + 1);
	2062
	2063	for (i = 0; i <= AvFILLp (av); ++i)
	2064	PUSHs (AvARRAY (av)[i]);
	2065	}
	2066
	2067	PUTBACK;
	2068	}
	2069	}
	2070
	2071	static void
	2072	coro_push_on_destroy (pTHX_ struct coro coro, SV cb)
	2073	{
	2074	if (!coro->on_destroy)
	2075	coro->on_destroy = newAV ();
	2076
	2077	av_push (coro->on_destroy, cb);
	2078	}
	2079
	2080	static void
	2081	slf_destroy_join (pTHX_ struct CoroSLF *frame)
	2082	{
	2083	SvREFCNT_dec ((SV )((struct coro )frame->data)->hv);
	2084	}
	2085
	2086	static int
	2087	slf_check_join (pTHX_ struct CoroSLF *frame)
	2088	{
	2089	struct coro coro = (struct coro )frame->data;
	2090
	2091	if (!coro->status)
	2092	return 1;
	2093
	2094	frame->destroy = 0;
	2095
	2096	coro_push_av (aTHX_ coro->status, GIMME_V);
	2097
	2098	SvREFCNT_dec ((SV *)coro->hv);
	2099
	2100	return 0;
	2101	}
	2102
	2103	static void
	2104	slf_init_join (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
	2105	{
	2106	struct coro *coro = SvSTATE (items > 0 ? arg [0] : &PL_sv_undef);
	2107
	2108	if (items > 1)
	2109	croak ("join called with too many arguments");
	2110
	2111	if (coro->status)
	2112	frame->prepare = prepare_nop;
	2113	else
	2114	{
	2115	coro_push_on_destroy (aTHX_ coro, SvREFCNT_inc_NN (SvRV (coro_current)));
	2116	frame->prepare = prepare_schedule;
	2117	}
	2118
	2119	frame->check = slf_check_join;
	2120	frame->destroy = slf_destroy_join;
	2121	frame->data = (void *)coro;
	2122	SvREFCNT_inc (coro->hv);
	2123	}
	2124
	2125	static void
2009	2126	coro_call_on_destroy (pTHX_ struct coro *coro)
2010	2127	{
2011		SV **on_destroyp = hv_fetch (coro->hv, "_on_destroy", sizeof ("_on_destroy") - 1, 0);
2012		SV **statusp = hv_fetch (coro->hv, "_status", sizeof ("_status") - 1, 0);
2013
2014		if (on_destroyp)
2015		{
2016		AV on_destroy = (AV )SvRV (*on_destroyp);
2017
2018		while (AvFILLp (on_destroy) >= 0)
	2128	AV *od = coro->on_destroy;
	2129
	2130	if (!od)
	2131	return;
	2132
	2133	while (AvFILLp (od) >= 0)
	2134	{
	2135	SV *cb = sv_2mortal (av_pop (od));
	2136
	2137	/* coro hv's (and only hv's at the moment) are supported as well */
	2138	if (SvSTATEhv_p (aTHX_ cb))
	2139	api_ready (aTHX_ cb);
	2140	else
2019	2141	{
2020	2142	dSP; /* don't disturb outer sp */
2021		SV *cb = av_pop (on_destroy);
2022
2023	2143	PUSHMARK (SP);
2024	2144
2025		if (statusp)
	2145	if (coro->status)
2026	2146	{
2027		int i;
2028		AV status = (AV )SvRV (*statusp);
2029		EXTEND (SP, AvFILLp (status) + 1);
2030
2031		for (i = 0; i <= AvFILLp (status); ++i)
2032		PUSHs (AvARRAY (status)[i]);
	2147	PUTBACK;
	2148	coro_push_av (aTHX_ coro->status, G_ARRAY);
	2149	SPAGAIN;
2033	2150	}
2034	2151
2035	2152	PUTBACK;
2036		call_sv (sv_2mortal (cb), G_VOID \| G_DISCARD);
	2153	call_sv (cb, G_VOID \| G_DISCARD);
2037	2154	}
2038	2155	}
2039	2156	}
2040	2157
2041	2158	static void
2042		slf_init_terminate (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
2043		{
2044		int i;
2045		HV hv = (HV )SvRV (coro_current);
2046		AV *av = newAV ();
	2159	coro_set_status (pTHX_ struct coro coro, SV *arg, int items)
	2160	{
	2161	AV *av;
	2162
	2163	if (coro->status)
	2164	{
	2165	av = coro->status;
	2166	av_clear (av);
	2167	}
	2168	else
	2169	av = coro->status = newAV ();
2047	2170
2048	2171	/* items are actually not so common, so optimise for this case */
2049	2172	if (items)
2050	2173	{
	2174	int i;
	2175
2051	2176	av_extend (av, items - 1);
2052	2177
2053	2178	for (i = 0; i < items; ++i)
2054	2179	av_push (av, SvREFCNT_inc_NN (arg [i]));
2055	2180	}
2056
2057		hv_store (hv, "_status", sizeof ("_status") - 1, newRV_noinc ((SV *)av), 0);
2058
2059		av_push (av_destroy, (SV )newRV_inc ((SV )hv)); /* RVinc for perl */
	2181	}
	2182
	2183	static void
	2184	slf_init_terminate_cancel_common (pTHX_ struct CoroSLF frame, HV coro_hv)
	2185	{
	2186	av_push (av_destroy, (SV )newRV_inc ((SV )coro_hv)); /* RVinc for perl */
2060	2187	api_ready (aTHX_ sv_manager);
2061	2188
2062	2189	frame->prepare = prepare_schedule;

2065	2192	/* as a minor optimisation, we could unwind all stacks here */
2066	2193	/* but that puts extra pressure on pp_slf, and is not worth much */
2067	2194	/coro_unwind_stacks (aTHX);/
	2195	}
	2196
	2197	static void
	2198	slf_init_terminate (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
	2199	{
	2200	HV coro_hv = (HV )SvRV (coro_current);
	2201
	2202	coro_set_status (aTHX_ SvSTATE ((SV *)coro_hv), arg, items);
	2203	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
	2204	}
	2205
	2206	static void
	2207	slf_init_cancel (pTHX_ struct CoroSLF frame, CV cv, SV **arg, int items)
	2208	{
	2209	HV *coro_hv;
	2210	struct coro *coro;
	2211
	2212	if (items <= 0)
	2213	croak ("Coro::cancel called without coro object,");
	2214
	2215	coro = SvSTATE (arg [0]);
	2216	coro_hv = coro->hv;
	2217
	2218	coro_set_status (aTHX_ coro, arg + 1, items - 1);
	2219
	2220	if (ecb_expect_false (coro->flags & CF_NOCANCEL))
	2221	{
	2222	/* coro currently busy cancelling something, so just notify it */
	2223	coro->slf_frame.data = (void *)coro;
	2224
	2225	frame->prepare = prepare_nop;
	2226	frame->check = slf_check_nop;
	2227	}
	2228	else if (coro_hv == (HV *)SvRV (coro_current))
	2229	{
	2230	/* cancelling the current coro is allowed, and equals terminate */
	2231	slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
	2232	}
	2233	else
	2234	{
	2235	struct coro *self = SvSTATE_current;
	2236
	2237	/* otherwise we cancel directly, purely for speed reasons
	2238	* unfortunately, this requires some magic trickery, as
	2239	* somebody else could cancel us, so we have to fight the cancellation.
	2240	* this is ugly, and hopefully fully worth the extra speed.
	2241	* besides, I can't get the slow-but-safe version working...
	2242	*/
	2243	slf_frame.data = 0;
	2244	self->flags \|= CF_NOCANCEL;
	2245	coro_state_destroy (aTHX_ coro);
	2246	self->flags &= ~CF_NOCANCEL;
	2247
	2248	if (slf_frame.data)
	2249	{
	2250	/* while we were busy we have been cancelled, so terminate */
	2251	slf_init_terminate_cancel_common (aTHX_ frame, self->hv);
	2252	}
	2253	else
	2254	{
	2255	frame->prepare = prepare_nop;
	2256	frame->check = slf_check_nop;
	2257	}
	2258	}
	2259	}
	2260
	2261	static int
	2262	slf_check_safe_cancel (pTHX_ struct CoroSLF *frame)
	2263	{
	2264	frame->prepare = 0;
	2265	coro_unwind_stacks (aTHX);
	2266
	2267	slf_init_terminate_cancel_common (aTHX_ frame, (HV *)SvRV (coro_current));
	2268
	2269	return 1;
	2270	}
	2271
	2272	static int
	2273	safe_cancel (pTHX_ struct coro coro, SV *arg, int items)
	2274	{
	2275	if (coro->cctx)
	2276	croak ("coro inside C callback, unable to cancel at this time, caught");
	2277
	2278	if (coro->flags & CF_NEW)
	2279	{
	2280	coro_set_status (aTHX_ coro, arg, items);
	2281	coro_state_destroy (aTHX_ coro);
	2282	}
	2283	else
	2284	{
	2285	if (!coro->slf_frame.prepare)
	2286	croak ("coro outside an SLF function, unable to cancel at this time, caught");
	2287
	2288	slf_destroy (aTHX_ coro);
	2289
	2290	coro_set_status (aTHX_ coro, arg, items);
	2291	coro->slf_frame.prepare = prepare_nop;
	2292	coro->slf_frame.check = slf_check_safe_cancel;
	2293
	2294	api_ready (aTHX_ (SV *)coro->hv);
	2295	}
	2296
	2297	return 1;
2068	2298	}
2069	2299
2070	2300	/*****************************************************************************/

2105	2335	HV hv = (HV )SvRV (coro_current);
2106	2336	struct coro coro = SvSTATE_hv ((SV )hv);
2107	2337
2108		if (expect_true (coro->saved_deffh))
	2338	if (ecb_expect_true (coro->saved_deffh))
2109	2339	{
2110	2340	/* subsequent iteration */
2111	2341	SvREFCNT_dec ((SV )PL_defoutgv); PL_defoutgv = (GV )coro->saved_deffh;

2114	2344	if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)
2115	2345	\|\| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
2116	2346	{
2117		coro->invoke_cb = SvREFCNT_inc_NN ((SV *)cv_coro_terminate);
2118		coro->invoke_av = newAV ();
2119
2120		frame->prepare = prepare_nop;
	2347	slf_init_terminate_cancel_common (aTHX_ frame, hv);
	2348	return;
2121	2349	}
2122	2350	else
2123	2351	{

2350	2578	{
2351	2579	frame->prepare = prepare_cede_notself;
2352	2580	frame->check = slf_check_nop;
	2581	}
	2582
	2583	/* "undo"/cancel a running slf call - used when cancelling a coro, mainly */
	2584	static void
	2585	slf_destroy (pTHX_ struct coro *coro)
	2586	{
	2587	/* this callback is reserved for slf functions needing to do cleanup */
	2588	if (coro->slf_frame.destroy && coro->slf_frame.prepare && !PL_dirty)
	2589	coro->slf_frame.destroy (aTHX_ &coro->slf_frame);
	2590
	2591	/*
	2592	* The on_destroy above most likely is from an SLF call.
	2593	* Since by definition the SLF call will not finish when we destroy
	2594	* the coro, we will have to force-finish it here, otherwise
	2595	* cleanup functions cannot call SLF functions.
	2596	*/
	2597	coro->slf_frame.prepare = 0;
2353	2598	}
2354	2599
2355	2600	/*

2366	2611	/* set up the slf frame, unless it has already been set-up */
2367	2612	/* the latter happens when a new coro has been started */
2368	2613	/* or when a new cctx was attached to an existing coroutine */
2369		if (expect_true (!slf_frame.prepare))
	2614	if (ecb_expect_true (!slf_frame.prepare))
2370	2615	{
2371	2616	/* first iteration */
2372	2617	dSP;

2417	2662	slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */
2418	2663
2419	2664	/* exception handling */
2420		if (expect_false (CORO_THROW))
	2665	if (ecb_expect_false (CORO_THROW))
2421	2666	{
2422	2667	SV *exception = sv_2mortal (CORO_THROW);
2423	2668

2428	2673
2429	2674	/* return value handling - mostly like entersub */
2430	2675	/* make sure we put something on the stack in scalar context */
2431		if (GIMME_V == G_SCALAR)
	2676	if (GIMME_V == G_SCALAR
	2677	&& ecb_expect_false (PL_stack_sp != PL_stack_base + checkmark + 1))
2432	2678	{
2433	2679	dSP;
2434	2680	SV **bot = PL_stack_base + checkmark;
2435	2681
2436	2682	if (sp == bot) /* too few, push undef */
2437	2683	bot [1] = &PL_sv_undef;
2438		else if (sp != bot + 1) /* too many, take last one */
	2684	else /* too many, take last one */
2439	2685	bot [1] = *sp;
2440	2686
2441	2687	SP = bot + 1;

2552	2798	NV next, every;
2553	2799	} PerlIOCede;
2554	2800
2555		static IV
	2801	static IV ecb_cold
2556	2802	PerlIOCede_pushed (pTHX_ PerlIO f, const char mode, SV arg, PerlIO_funcs tab)
2557	2803	{
2558	2804	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);

2563	2809	return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);
2564	2810	}
2565	2811
2566		static SV *
	2812	static SV * ecb_cold
2567	2813	PerlIOCede_getarg (pTHX_ PerlIO f, CLONE_PARAMS param, int flags)
2568	2814	{
2569	2815	PerlIOCede *self = PerlIOSelf (f, PerlIOCede);

2685	2931	}
2686	2932
2687	2933	static void
2688		coro_semaphore_on_destroy (pTHX_ struct coro *coro)
	2934	coro_semaphore_destroy (pTHX_ struct CoroSLF *frame)
2689	2935	{
2690	2936	/* call $sem->adjust (0) to possibly wake up some other waiters */
2691		coro_semaphore_adjust (aTHX_ (AV *)coro->slf_frame.data, 0);
	2937	coro_semaphore_adjust (aTHX_ (AV *)frame->data, 0);
2692	2938	}
2693	2939
2694	2940	static int

2696	2942	{
2697	2943	AV av = (AV )frame->data;
2698	2944	SV *count_sv = AvARRAY (av)[0];
	2945	SV *coro_hv = SvRV (coro_current);
2699	2946
2700	2947	/* if we are about to throw, don't actually acquire the lock, just throw */
2701	2948	if (CORO_THROW)
2702	2949	return 0;
2703	2950	else if (SvIVX (count_sv) > 0)
2704	2951	{
2705		SvSTATE_current->on_destroy = 0;
	2952	frame->destroy = 0;
2706	2953
2707	2954	if (acquire)
2708	2955	SvIVX (count_sv) = SvIVX (count_sv) - 1;

2717	2964	/* if we were woken up but can't down, we look through the whole */
2718	2965	/* waiters list and only add us if we aren't in there already */
2719	2966	/* this avoids some degenerate memory usage cases */
2720
2721		for (i = 1; i <= AvFILLp (av); ++i)
2722		if (AvARRAY (av)[i] == SvRV (coro_current))
	2967	for (i = AvFILLp (av); i > 0; --i) /* i > 0 is not an off-by-one bug */
	2968	if (AvARRAY (av)[i] == coro_hv)
2723	2969	return 1;
2724	2970
2725		av_push (av, SvREFCNT_inc (SvRV (coro_current)));
	2971	av_push (av, SvREFCNT_inc (coro_hv));
2726	2972	return 1;
2727	2973	}
2728	2974	}

2755	3001
2756	3002	frame->data = (void )sv_2mortal (SvREFCNT_inc ((SV )av));
2757	3003	frame->prepare = prepare_schedule;
2758
2759	3004	/* to avoid race conditions when a woken-up coro gets terminated */
2760	3005	/* we arrange for a temporary on_destroy that calls adjust (0) */
2761		SvSTATE_current->on_destroy = coro_semaphore_on_destroy;
	3006	frame->destroy = coro_semaphore_destroy;
2762	3007	}
2763	3008	}
2764	3009

2986	3231	static SV *prio_cv;
2987	3232	static SV *prio_sv;
2988	3233
2989		if (expect_false (!prio_cv))
	3234	if (ecb_expect_false (!prio_cv))
2990	3235	{
2991	3236	prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);
2992	3237	prio_sv = newSViv (0);

3102	3347	return coro_sv;
3103	3348	}
3104	3349
	3350	#ifndef __cplusplus
	3351	ecb_cold XS(boot_Coro__State);
	3352	#endif
	3353
	3354	#if CORO_JIT
	3355
	3356	static void ecb_noinline ecb_cold
	3357	pushav_4uv (pTHX_ UV a, UV b, UV c, UV d)
	3358	{
	3359	dSP;
	3360	AV *av = newAV ();
	3361
	3362	av_store (av, 3, newSVuv (d));
	3363	av_store (av, 2, newSVuv (c));
	3364	av_store (av, 1, newSVuv (b));
	3365	av_store (av, 0, newSVuv (a));
	3366
	3367	XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
	3368
	3369	PUTBACK;
	3370	}
	3371
	3372	static void ecb_noinline ecb_cold
	3373	jit_init (pTHX)
	3374	{
	3375	dSP;
	3376	SV load, save;
	3377	char *map_base;
	3378	char load_ptr, save_ptr;
	3379	STRLEN load_len, save_len, map_len;
	3380	int count;
	3381
	3382	eval_pv ("require 'Coro/jit-" CORO_JIT_TYPE ".pl'", 1);
	3383
	3384	PUSHMARK (SP);
	3385	#define VARx(name,expr,type) pushav_4uv (aTHX_ (UV)&(expr), sizeof (expr), offsetof (perl_slots, name), sizeof (type));
	3386	# include "state.h"
	3387	#undef VARx
	3388	count = call_pv ("Coro::State::_jit", G_ARRAY);
	3389	SPAGAIN;
	3390
	3391	save = POPs; save_ptr = SvPVbyte (save, save_len);
	3392	load = POPs; load_ptr = SvPVbyte (load, load_len);
	3393
	3394	map_len = load_len + save_len + 16;
	3395
	3396	map_base = mmap (0, map_len, PROT_READ \| PROT_WRITE \| PROT_EXEC, MAP_PRIVATE \| MAP_ANONYMOUS, -1, 0);
	3397
	3398	assert (("Coro: unable to mmap jit code page, cannot continue.", map_base != (char *)MAP_FAILED));
	3399
	3400	load_perl_slots = (load_save_perl_slots_type)map_base;
	3401	memcpy (map_base, load_ptr, load_len);
	3402
	3403	map_base += (load_len + 15) & ~15;
	3404
	3405	save_perl_slots = (load_save_perl_slots_type)map_base;
	3406	memcpy (map_base, save_ptr, save_len);
	3407
	3408	/* we are good citizens and try to make the page read-only, so the evil evil */
	3409	/* hackers might have it a bit more difficult */
	3410	mprotect (map_base, map_len, PROT_READ \| PROT_EXEC);
	3411
	3412	PUTBACK;
	3413	eval_pv ("undef &Coro::State::_jit", 1);
	3414	}
	3415
	3416	#endif
	3417
3105	3418	MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
3106	3419
3107	3420	PROTOTYPES: DISABLE

3114	3427	# endif
3115	3428	#endif
3116	3429	BOOT_PAGESIZE;
	3430
	3431	/* perl defines these to check for existance first, but why it doesn't */
	3432	/* just create them one at init time is not clear to me, except for */
	3433	/* programs trying to delete them, but... */
	3434	/* anyway, we declare this as invalid and make sure they are initialised here */
	3435	DEFSV;
	3436	ERRSV;
3117	3437
3118	3438	cctx_current = cctx_new_empty ();
3119	3439

3166	3486	time_init (aTHX);
3167	3487
3168	3488	assert (("PRIO_NORMAL must be 0", !CORO_PRIO_NORMAL));
	3489	#if CORO_JIT
	3490	PUTBACK;
	3491	jit_init (aTHX);
	3492	SPAGAIN;
	3493	#endif
3169	3494	}
3170	3495
3171	3496	SV *

3182	3507	PROTOTYPE: $$
3183	3508	CODE:
3184	3509	CORO_EXECUTE_SLF_XS (slf_init_transfer);
3185
3186		bool
3187		_destroy (SV *coro_sv)
3188		CODE:
3189		RETVAL = coro_state_destroy (aTHX_ SvSTATE (coro_sv));
3190		OUTPUT:
3191		RETVAL
3192	3510
3193	3511	void
3194	3512	_exit (int code)

3274	3592	if (coro->mainstack && ((coro->flags & CF_RUNNING) \|\| coro->slot))
3275	3593	{
3276	3594	struct coro *current = SvSTATE_current;
	3595	struct CoroSLF slf_save;
3277	3596
3278	3597	if (current != coro)
3279	3598	{
3280	3599	PUTBACK;
3281	3600	save_perl (aTHX_ current);
3282	3601	load_perl (aTHX_ coro);
	3602	/* the coro is most likely in an active SLF call.
	3603	* while not strictly required (the code we execute is
	3604	* not allowed to call any SLF functions), it's cleaner
	3605	* to reinitialise the slf_frame and restore it later.
	3606	* This might one day allow us to actually do SLF calls
	3607	* from code executed here.
	3608	*/
	3609	slf_save = slf_frame;
	3610	slf_frame.prepare = 0;
3283	3611	SPAGAIN;
3284	3612	}
3285	3613

3299	3627	if (current != coro)
3300	3628	{
3301	3629	PUTBACK;
	3630	slf_frame = slf_save;
3302	3631	save_perl (aTHX_ coro);
3303	3632	load_perl (aTHX_ current);
3304	3633	SPAGAIN;

3313	3642	is_ready = CF_READY
3314	3643	is_running = CF_RUNNING
3315	3644	is_new = CF_NEW
3316		is_destroyed = CF_DESTROYED
	3645	is_destroyed = CF_ZOMBIE
	3646	is_zombie = CF_ZOMBIE
3317	3647	is_suspended = CF_SUSPENDED
3318	3648	CODE:
3319	3649	RETVAL = boolSV (coro->flags & ix);

3394	3724	cancel (Coro::State self)
3395	3725	CODE:
3396	3726	coro_state_destroy (aTHX_ self);
3397		coro_call_on_destroy (aTHX_ self); /* actually only for Coro objects */
3398
3399	3727
3400	3728	SV *
3401	3729	enable_times (int enabled = enable_times)

3420	3748	{
3421	3749	struct coro *current = SvSTATE (coro_current);
3422	3750
3423		if (expect_false (current == self))
	3751	if (ecb_expect_false (current == self))
3424	3752	{
3425	3753	coro_times_update ();
3426	3754	coro_times_add (SvSTATE (coro_current));

3430	3758	PUSHs (sv_2mortal (newSVnv (self->t_real [0] + self->t_real [1] * 1e-9)));
3431	3759	PUSHs (sv_2mortal (newSVnv (self->t_cpu [0] + self->t_cpu [1] * 1e-9)));
3432	3760
3433		if (expect_false (current == self))
	3761	if (ecb_expect_false (current == self))
3434	3762	coro_times_sub (SvSTATE (coro_current));
3435	3763	}
3436	3764

3461	3789	sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
3462	3790	sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
3463	3791	cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);
3464		cv_coro_terminate = get_cv ( "Coro::terminate" , GV_ADD);
3465	3792	coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);
3466	3793	av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
3467	3794	av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);

3510	3837	RETVAL
3511	3838
3512	3839	void
	3840	_destroy (Coro::State coro)
	3841	CODE:
	3842	/* used by the manager thread */
	3843	coro_state_destroy (aTHX_ coro);
	3844
	3845	void
	3846	on_destroy (Coro::State coro, SV *cb)
	3847	CODE:
	3848	coro_push_on_destroy (aTHX_ coro, newSVsv (cb));
	3849
	3850	void
	3851	join (...)
	3852	CODE:
	3853	CORO_EXECUTE_SLF_XS (slf_init_join);
	3854
	3855	void
3513	3856	terminate (...)
3514	3857	CODE:
3515	3858	CORO_EXECUTE_SLF_XS (slf_init_terminate);
	3859
	3860	void
	3861	cancel (...)
	3862	CODE:
	3863	CORO_EXECUTE_SLF_XS (slf_init_cancel);
	3864
	3865	int
	3866	safe_cancel (Coro::State self, ...)
	3867	C_ARGS: aTHX_ self, &ST (1), items - 1
3516	3868
3517	3869	void
3518	3870	schedule (...)

3798	4150	MODULE = Coro::State PACKAGE = Coro::SemaphoreSet
3799	4151
3800	4152	void
3801		_may_delete (SV *sem, int count, int extra_refs)
	4153	_may_delete (SV *sem, int count, unsigned int extra_refs)
3802	4154	PPCODE:
3803	4155	{
3804	4156	AV av = (AV )SvRV (sem);

-1

Coro/Storable.pm less more

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

-1

Coro/Timer.pm less more

29	29	use Coro ();
30	30	use Coro::AnyEvent ();
31	31
32		our $VERSION = 5.372;
	32	our $VERSION = 6.0;
33	33	our @EXPORT_OK = qw(timeout sleep);
34	34
35	35	# compatibility with older programs

-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 = 5.372;
	43	our $VERSION = 6.0;
44	44
45	45	our $MAXPARALLEL = 16; # max. number of parallel jobs
46	46

+318

-0

Coro/ecb.h less more

	0	/*
	1	* libecb - http://software.schmorp.de/pkg/libecb
	2	*
	3	* Copyright (©) 2009-2011 Marc Alexander Lehmann <libecb@schmorp.de>
	4	* Copyright (©) 2011 Emanuele Giaquinta
	5	* All rights reserved.
	6	*
	7	* Redistribution and use in source and binary forms, with or without modifica-
	8	* tion, are permitted provided that the following conditions are met:
	9	*
	10	* 1. Redistributions of source code must retain the above copyright notice,
	11	* this list of conditions and the following disclaimer.
	12	*
	13	* 2. Redistributions in binary form must reproduce the above copyright
	14	* notice, this list of conditions and the following disclaimer in the
	15	* documentation and/or other materials provided with the distribution.
	16	*
	17	* THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
	18	* WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MER-
	19	* CHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
	20	* EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPE-
	21	* CIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
	22	* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
	23	* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
	24	* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTH-
	25	* ERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
	26	* OF THE POSSIBILITY OF SUCH DAMAGE.
	27	*/
	28
	29	#ifndef ECB_H
	30	#define ECB_H
	31
	32	#ifdef _WIN32
	33	typedef signed char int8_t;
	34	typedef unsigned char uint8_t;
	35	typedef signed short int16_t;
	36	typedef unsigned short uint16_t;
	37	typedef signed int int32_t;
	38	typedef unsigned int uint32_t;
	39	#if __GNUC__
	40	typedef signed long long int64_t;
	41	typedef unsigned long long uint64_t;
	42	#else /* _MSC_VER \|\| __BORLANDC__ */
	43	typedef signed __int64 int64_t;
	44	typedef unsigned __int64 uint64_t;
	45	#endif
	46	#else
	47	#include <inttypes.h>
	48	#endif
	49
	50	/* many compilers define _GNUC_ to some versions but then only implement
	51	* what their idiot authors think are the "more important" extensions,
	52	* causing enourmous grief in return for some better fake benchmark numbers.
	53	* or so.
	54	* we try to detect these and simply assume they are not gcc - if they have
	55	* an issue with that they should have done it right in the first place.
	56	*/
	57	#ifndef ECB_GCC_VERSION
	58	#if !defined(__GNUC_MINOR__) \|\| defined(__INTEL_COMPILER) \|\| defined(__SUNPRO_C) \|\| defined(__SUNPRO_CC) \|\| defined(__llvm__) \|\| defined(__clang__)
	59	#define ECB_GCC_VERSION(major,minor) 0
	60	#else
	61	#define ECB_GCC_VERSION(major,minor) (__GNUC__ > (major) \|\| (__GNUC__ == (major) && __GNUC_MINOR__ >= (minor)))
	62	#endif
	63	#endif
	64
	65	#define ECB_C99 (__STDC_VERSION__ >= 199901L)
	66
	67	#if __cplusplus
	68	#define ecb_inline static inline
	69	#elif ECB_GCC_VERSION(2,5)
	70	#define ecb_inline static __inline__
	71	#elif ECB_C99
	72	#define ecb_inline static inline
	73	#else
	74	#define ecb_inline static
	75	#endif
	76
	77	#if ECB_GCC_VERSION(3,3)
	78	#define ecb_restrict __restrict__
	79	#elif ECB_C99
	80	#define ecb_restrict restrict
	81	#else
	82	#define ecb_restrict
	83	#endif
	84
	85	typedef int ecb_bool;
	86
	87	#define ECB_CONCAT_(a, b) a ## b
	88	#define ECB_CONCAT(a, b) ECB_CONCAT_(a, b)
	89	#define ECB_STRINGIFY_(a) # a
	90	#define ECB_STRINGIFY(a) ECB_STRINGIFY_(a)
	91
	92	#define ecb_function_ ecb_inline
	93
	94	#if ECB_GCC_VERSION(3,1)
	95	#define ecb_attribute(attrlist) __attribute__(attrlist)
	96	#define ecb_is_constant(expr) __builtin_constant_p (expr)
	97	#define ecb_expect(expr,value) __builtin_expect ((expr),(value))
	98	#define ecb_prefetch(addr,rw,locality) __builtin_prefetch (addr, rw, locality)
	99	#else
	100	#define ecb_attribute(attrlist)
	101	#define ecb_is_constant(expr) 0
	102	#define ecb_expect(expr,value) (expr)
	103	#define ecb_prefetch(addr,rw,locality)
	104	#endif
	105
	106	/* no emulation for ecb_decltype */
	107	#if ECB_GCC_VERSION(4,5)
	108	#define ecb_decltype(x) __decltype(x)
	109	#elif ECB_GCC_VERSION(3,0)
	110	#define ecb_decltype(x) __typeof(x)
	111	#endif
	112
	113	#define ecb_noinline ecb_attribute ((__noinline__))
	114	#define ecb_noreturn ecb_attribute ((__noreturn__))
	115	#define ecb_unused ecb_attribute ((__unused__))
	116	#define ecb_const ecb_attribute ((__const__))
	117	#define ecb_pure ecb_attribute ((__pure__))
	118
	119	#if ECB_GCC_VERSION(4,3)
	120	#define ecb_artificial ecb_attribute ((__artificial__))
	121	#define ecb_hot ecb_attribute ((__hot__))
	122	#define ecb_cold ecb_attribute ((__cold__))
	123	#else
	124	#define ecb_artificial
	125	#define ecb_hot
	126	#define ecb_cold
	127	#endif
	128
	129	/* put around conditional expressions if you are very sure that the */
	130	/* expression is mostly true or mostly false. note that these return */
	131	/* booleans, not the expression. */
	132	#define ecb_expect_false(expr) ecb_expect (!!(expr), 0)
	133	#define ecb_expect_true(expr) ecb_expect (!!(expr), 1)
	134	/* for compatibility to the rest of the world */
	135	#define ecb_likely(expr) ecb_expect_true (expr)
	136	#define ecb_unlikely(expr) ecb_expect_false (expr)
	137
	138	/* count trailing zero bits and count # of one bits */
	139	#if ECB_GCC_VERSION(3,4)
	140	/* we assume int == 32 bit, long == 32 or 64 bit and long long == 64 bit */
	141	#define ecb_ld32(x) (__builtin_clz (x) ^ 31)
	142	#define ecb_ld64(x) (__builtin_clzll (x) ^ 63)
	143	#define ecb_ctz32(x) __builtin_ctz (x)
	144	#define ecb_ctz64(x) __builtin_ctzll (x)
	145	#define ecb_popcount32(x) __builtin_popcount (x)
	146	/* no popcountll */
	147	#else
	148	ecb_function_ int ecb_ctz32 (uint32_t x) ecb_const;
	149	ecb_function_ int
	150	ecb_ctz32 (uint32_t x)
	151	{
	152	int r = 0;
	153
	154	x &= ~x + 1; /* this isolates the lowest bit */
	155
	156	#if ECB_branchless_on_i386
	157	r += !!(x & 0xaaaaaaaa) << 0;
	158	r += !!(x & 0xcccccccc) << 1;
	159	r += !!(x & 0xf0f0f0f0) << 2;
	160	r += !!(x & 0xff00ff00) << 3;
	161	r += !!(x & 0xffff0000) << 4;
	162	#else
	163	if (x & 0xaaaaaaaa) r += 1;
	164	if (x & 0xcccccccc) r += 2;
	165	if (x & 0xf0f0f0f0) r += 4;
	166	if (x & 0xff00ff00) r += 8;
	167	if (x & 0xffff0000) r += 16;
	168	#endif
	169
	170	return r;
	171	}
	172
	173	ecb_function_ int ecb_ctz64 (uint64_t x) ecb_const;
	174	ecb_function_ int
	175	ecb_ctz64 (uint64_t x)
	176	{
	177	int shift = x & 0xffffffffU ? 0 : 32;
	178	return ecb_ctz32 (x >> shift) + shift;
	179	}
	180
	181	ecb_function_ int ecb_popcount32 (uint32_t x) ecb_const;
	182	ecb_function_ int
	183	ecb_popcount32 (uint32_t x)
	184	{
	185	x -= (x >> 1) & 0x55555555;
	186	x = ((x >> 2) & 0x33333333) + (x & 0x33333333);
	187	x = ((x >> 4) + x) & 0x0f0f0f0f;
	188	x *= 0x01010101;
	189
	190	return x >> 24;
	191	}
	192
	193	/* you have the choice beetween something with a table lookup, */
	194	/* something using lots of bit arithmetic and a simple loop */
	195	/* we went for the loop */
	196	ecb_function_ int ecb_ld32 (uint32_t x) ecb_const;
	197	ecb_function_ int ecb_ld32 (uint32_t x)
	198	{
	199	int r = 0;
	200
	201	if (x >> 16) { x >>= 16; r += 16; }
	202	if (x >> 8) { x >>= 8; r += 8; }
	203	if (x >> 4) { x >>= 4; r += 4; }
	204	if (x >> 2) { x >>= 2; r += 2; }
	205	if (x >> 1) { r += 1; }
	206
	207	return r;
	208	}
	209
	210	ecb_function_ int ecb_ld64 (uint64_t x) ecb_const;
	211	ecb_function_ int ecb_ld64 (uint64_t x)
	212	{
	213	int r = 0;
	214
	215	if (x >> 32) { x >>= 32; r += 32; }
	216
	217	return r + ecb_ld32 (x);
	218	}
	219	#endif
	220
	221	/* popcount64 is only available on 64 bit cpus as gcc builtin */
	222	/* so for this version we are lazy */
	223	ecb_function_ int ecb_popcount64 (uint64_t x) ecb_const;
	224	ecb_function_ int
	225	ecb_popcount64 (uint64_t x)
	226	{
	227	return ecb_popcount32 (x) + ecb_popcount32 (x >> 32);
	228	}
	229
	230	ecb_inline uint8_t ecb_rotl8 (uint8_t x, unsigned int count) ecb_const;
	231	ecb_inline uint8_t ecb_rotr8 (uint8_t x, unsigned int count) ecb_const;
	232	ecb_inline uint16_t ecb_rotl16 (uint16_t x, unsigned int count) ecb_const;
	233	ecb_inline uint16_t ecb_rotr16 (uint16_t x, unsigned int count) ecb_const;
	234	ecb_inline uint32_t ecb_rotl32 (uint32_t x, unsigned int count) ecb_const;
	235	ecb_inline uint32_t ecb_rotr32 (uint32_t x, unsigned int count) ecb_const;
	236	ecb_inline uint64_t ecb_rotl64 (uint64_t x, unsigned int count) ecb_const;
	237	ecb_inline uint64_t ecb_rotr64 (uint64_t x, unsigned int count) ecb_const;
	238
	239	ecb_inline uint8_t ecb_rotl8 (uint8_t x, unsigned int count) { return (x >> ( 8 - count)) \| (x << count); }
	240	ecb_inline uint8_t ecb_rotr8 (uint8_t x, unsigned int count) { return (x << ( 8 - count)) \| (x >> count); }
	241	ecb_inline uint16_t ecb_rotl16 (uint16_t x, unsigned int count) { return (x >> (16 - count)) \| (x << count); }
	242	ecb_inline uint16_t ecb_rotr16 (uint16_t x, unsigned int count) { return (x << (16 - count)) \| (x >> count); }
	243	ecb_inline uint32_t ecb_rotl32 (uint32_t x, unsigned int count) { return (x >> (32 - count)) \| (x << count); }
	244	ecb_inline uint32_t ecb_rotr32 (uint32_t x, unsigned int count) { return (x << (32 - count)) \| (x >> count); }
	245	ecb_inline uint64_t ecb_rotl64 (uint64_t x, unsigned int count) { return (x >> (64 - count)) \| (x << count); }
	246	ecb_inline uint64_t ecb_rotr64 (uint64_t x, unsigned int count) { return (x << (64 - count)) \| (x >> count); }
	247
	248	#if ECB_GCC_VERSION(4,3)
	249	#define ecb_bswap16(x) (__builtin_bswap32 (x) >> 16)
	250	#define ecb_bswap32(x) __builtin_bswap32 (x)
	251	#define ecb_bswap64(x) __builtin_bswap64 (x)
	252	#else
	253	ecb_function_ uint16_t ecb_bswap16 (uint16_t x) ecb_const;
	254	ecb_function_ uint16_t
	255	ecb_bswap16 (uint16_t x)
	256	{
	257	return ecb_rotl16 (x, 8);
	258	}
	259
	260	ecb_function_ uint32_t ecb_bswap32 (uint32_t x) ecb_const;
	261	ecb_function_ uint32_t
	262	ecb_bswap32 (uint32_t x)
	263	{
	264	return (((uint32_t)ecb_bswap16 (x)) << 16) \| ecb_bswap16 (x >> 16);
	265	}
	266
	267	ecb_function_ uint64_t ecb_bswap64 (uint64_t x) ecb_const;
	268	ecb_function_ uint64_t
	269	ecb_bswap64 (uint64_t x)
	270	{
	271	return (((uint64_t)ecb_bswap32 (x)) << 32) \| ecb_bswap32 (x >> 32);
	272	}
	273	#endif
	274
	275	#if ECB_GCC_VERSION(4,5)
	276	#define ecb_unreachable() __builtin_unreachable ()
	277	#else
	278	/* this seems to work fine, but gcc always emits a warning for it :/ */
	279	ecb_function_ void ecb_unreachable (void) ecb_noreturn;
	280	ecb_function_ void ecb_unreachable (void) { }
	281	#endif
	282
	283	/* try to tell the compiler that some condition is definitely true */
	284	#define ecb_assume(cond) do { if (!(cond)) ecb_unreachable (); } while (0)
	285
	286	ecb_function_ unsigned char ecb_byteorder_helper (void) ecb_const;
	287	ecb_function_ unsigned char
	288	ecb_byteorder_helper (void)
	289	{
	290	const uint32_t u = 0x11223344;
	291	return (unsigned char )&u;
	292	}
	293
	294	ecb_function_ ecb_bool ecb_big_endian (void) ecb_const;
	295	ecb_function_ ecb_bool ecb_big_endian (void) { return ecb_byteorder_helper () == 0x11; }
	296	ecb_function_ ecb_bool ecb_little_endian (void) ecb_const;
	297	ecb_function_ ecb_bool ecb_little_endian (void) { return ecb_byteorder_helper () == 0x44; }
	298
	299	#if ECB_GCC_VERSION(3,0) \|\| ECB_C99
	300	#define ecb_mod(m,n) ((m) % (n) + ((m) % (n) < 0 ? (n) : 0))
	301	#else
	302	#define ecb_mod(m,n) ((m) < 0 ? ((n) - 1 - ((-1 - (m)) % (n))) : ((m) % (n)))
	303	#endif
	304
	305	#if ecb_cplusplus_does_not_suck
	306	/* does not work for local types (http://www.open-std.org/jtc1/sc22/wg21/docs/papers/2008/n2657.htm) */
	307	template<typename T, int N>
	308	static inline int ecb_array_length (const T (&arr)[N])
	309	{
	310	return N;
	311	}
	312	#else
	313	#define ecb_array_length(name) (sizeof (name) / sizeof (name [0]))
	314	#endif
	315
	316	#endif
	317

+106

-0

Coro/jit-amd64-unix.pl less more

	0	#!/opt/bin/perl
	1
	2	{
	3	package Coro::State;
	4
	5	use common::sense;
	6
	7	my @insn;
	8
	9	$insn[0][1] = "\x0f\xb6"; # movzbl mem -> rax
	10	$insn[0][2] = "\x0f\xb7"; # movzwl mem -> rax
	11	$insn[0][4] = "\x8b"; # movl mem -> rax
	12	$insn[0][8] = "\x48\x8b"; # movq mem -> rax
	13	$insn[1][1] = "\x88"; # movb al -> mem
	14	$insn[1][2] = "\x66\x89"; # movw ax -> mem
	15	$insn[1][4] = "\x89"; # movl eax -> mem
	16	$insn[1][8] = "\x48\x89"; # movq rax -> mem
	17
	18	my $modrm_disp8 = 0x40;
	19	my $modrm_disp32 = 0x80;
	20	my $modrm_rsi = 0x06;
	21	my $modrm_rdi = 0x07;
	22
	23	my @vars;
	24
	25	my $mov_ind = sub {
	26	my ($size, $mod_rm, $store, $offset) = @_;
	27
	28	if ($offset < -128 \|\| $offset > 127) {
	29	$mod_rm \|= $modrm_disp32;
	30	$offset = pack "V", $offset;
	31	} elsif ($offset) {
	32	$mod_rm \|= $modrm_disp8;
	33	$offset = pack "c", $offset;
	34	} else {
	35	$offset = "";
	36	}
	37
	38	$insn[$store][$size] . (chr $mod_rm) . $offset
	39	};
	40
	41	my $gencopy = sub {
	42	my ($save) = shift;
	43
	44	# all perl variables must be within 32-bits of this address
	45	my $curbase = $vars[$#vars >> 1][0];
	46
	47	my $code = "\x48\xbe" . pack "Q", $curbase; # mov imm64, %rsi
	48
	49	my $curslot = 0;
	50
	51	for (@vars) {
	52	my ($addr, $asize, $slot, $ssize) = @$_;
	53
	54	my $slotofs = $slot - $curslot;
	55
	56	# the sort ensures that this condition and adjustment suffices
	57	if ($slotofs > 127) {
	58	my $adj = 256;
	59	$code .= "\x48\x81\xc7" . pack "i", $adj; # addq imm32, %rdi
	60	$curslot += $adj;
	61	$slotofs -= $adj;
	62	}
	63
	64	if ($save) {
	65	$code .= $mov_ind->($asize, $modrm_rsi, 0, $addr - $curbase);
	66	$code .= $mov_ind->($ssize, $modrm_rdi, 1, $slotofs);
	67	} else {
	68	$code .= $mov_ind->($ssize, $modrm_rdi, 0, $slotofs);
	69	$code .= $mov_ind->($asize, $modrm_rsi, 1, $addr - $curbase);
	70	}
	71	}
	72
	73	$code .= "\xc3"; # retq
	74
	75	$code
	76	};
	77
	78	sub _jit {
	79	@vars = @_;
	80
	81	# sort all variables into 256 byte blocks, biased by -128
	82	# so gencopy can += 256 occasionally. within those blocks,
	83	# sort by address so we can play further tricks.
	84	@vars = sort {
	85	(($a->[2] + 128) & ~255) <=> (($b->[2] + 128) & ~255)
	86	or $a->[0] <=> $b->[0]
	87	} @vars;
	88
	89	# we could combine adjacent vars, but this is not very common
	90
	91	$vars[-1][0] - $vars[0][0] <= 0x7fffffff
	92	or die "JIT failed, perl var spread >31 bit\n";
	93
	94	my $load = $gencopy->(0);
	95	my $save = $gencopy->(1);
	96
	97	#open my $fh, ">dat"; syswrite $fh, $save; system "objdump -b binary -m i386 -M x86-64 -D dat";
	98	#warn length $load;
	99	#warn length $save;
	100
	101	($load, $save)
	102	}
	103	}
	104
	105	1

+121

-0

Coro/jit-x86-unix.pl less more

	0	#!/opt/bin/perl
	1
	2	{
	3	package Coro::State;
	4
	5	use common::sense;
	6
	7	my @insn;
	8
	9	$insn[0][1] = "\x0f\xb6"; # movzbl mem -> rax
	10	$insn[0][2] = "\x0f\xb7"; # movzwl mem -> rax
	11	$insn[0][4] = "\x8b"; # movl mem -> rax
	12	$insn[1][1] = "\x88"; # movb al -> mem
	13	$insn[1][2] = "\x66\x89"; # movw eax -> mem
	14	$insn[1][4] = "\x89"; # movl rax -> mem
	15
	16	my $modrm_abs = 0x05;
	17	my $modrm_disp8 = 0x40;
	18	my $modrm_disp32 = 0x80;
	19	my $modrm_edx = 0x02;
	20
	21	my @vars;
	22
	23	my $mov = sub {
	24	my ($size, $mod_rm, $store, $offset) = @_;
	25
	26	if ($mod_rm == $modrm_abs) {
	27	$offset = pack "V", $offset;
	28	} else {
	29	if ($offset < -128 \|\| $offset > 127) {
	30	$mod_rm \|= $modrm_disp32;
	31	$offset = pack "V", $offset;
	32	} elsif ($offset) {
	33	$mod_rm \|= $modrm_disp8;
	34	$offset = pack "c", $offset;
	35	} else {
	36	$offset = "";
	37	}
	38	}
	39
	40	my $insn = $insn[$store][$size] . (chr $mod_rm) . $offset;
	41
	42	# some instructions have shorter sequences
	43
	44	$insn =~ s/^\x8b\x05/\xa1/;
	45	$insn =~ s/^\x88\x05/\xa2/;
	46	$insn =~ s/^\x66\x89\x05/\x66\xa3/;
	47	$insn =~ s/^\x89\x05/\xa3/;
	48
	49	$insn
	50	};
	51
	52	my $gencopy = sub {
	53	my ($save) = shift;
	54
	55	my $code = "\x8b\x54\x24\x04"; # mov 4(%esp),%edx
	56
	57	my $curslot = 0;
	58
	59	for (@vars) {
	60	my ($addr, $asize, $slot, $ssize) = @$_;
	61
	62	my $slotofs = $slot - $curslot;
	63
	64	# the sort ensures that this condition and adjustment suffices
	65	if ($slotofs > 127) {
	66	my $adj = 256;
	67	$code .= "\x81\xc2" . pack "V", $adj; # add imm32, %edi
	68	$curslot += $adj;
	69	$slotofs -= $adj;
	70	}
	71
	72	if ($save) {
	73	$code .= $mov->($asize, $modrm_abs, 0, $addr);
	74	$code .= $mov->($ssize, $modrm_edx, 1, $slotofs);
	75	} else {
	76	$code .= $mov->($ssize, $modrm_edx, 0, $slotofs);
	77	$code .= $mov->($asize, $modrm_abs, 1, $addr);
	78	}
	79	}
	80
	81	$code .= "\xc3"; # retl
	82
	83	$code
	84	};
	85
	86	sub _jit {
	87	@vars = @_;
	88
	89	# split 8-byte accesses into two 4-byte accesses
	90	# not needed even for 64 bit perls, but you never know
	91	for (@vars) {
	92	if ($_->[1] == 8) {
	93	die "Coro: FATAL - cannot handle size mismatch between 8 and $_->[3] byte slots.\n";
	94
	95	$_->[1] =
	96	$_->[3] = 4;
	97
	98	push @vars,
	99	[$_->[0] + 4, 4,
	100	$_->[1] + 4, 4];
	101	}
	102	}
	103
	104	# sort by slot offset, required by gencopy to work
	105	@vars = sort { $a->[2] <=> $b->[2] } @vars;
	106
	107	# we could combine adjacent vars, but this is not very common
	108
	109	my $load = $gencopy->(0);
	110	my $save = $gencopy->(1);
	111
	112	#open my $fh, ">dat"; syswrite $fh, $save; system "objdump -b binary -m i386 -D dat";
	113	#warn length $load;
	114	#warn length $save;
	115
	116	($load, $save)
	117	}
	118	}
	119
	120	1

+76

-44

Coro/libcoro/coro.c less more

0	0	/*
1		* Copyright (c) 2001-2009 Marc Alexander Lehmann <schmorp@schmorp.de>
	1	* Copyright (c) 2001-2011 Marc Alexander Lehmann <schmorp@schmorp.de>
2	2	*
3	3	* Redistribution and use in source and binary forms, with or without modifica-
4	4	* tion, are permitted provided that the following conditions are met:

87	87
88	88	coro_transfer (new_coro, create_coro);
89	89
	90	#if __linux && __amd64
	91	/* we blindly assume on any __linux with __amd64 we have a new enough gas with .cfi_undefined support */
	92	asm (".cfi_undefined rip");
	93	#endif
	94
90	95	func ((void *)arg);
91	96
92	97	/* the new coro returned. bad. just abort() for now */

111	116
112	117	# if CORO_ASM
113	118
	119	#if _WIN32
	120	#define CORO_WIN_TIB 1
	121	#endif
	122
114	123	asm (
115		".text\n"
116		".globl coro_transfer\n"
117		".type coro_transfer, @function\n"
	124	"\t.text\n"
	125	"\t.globl coro_transfer\n"
118	126	"coro_transfer:\n"
119	127	/* windows, of course, gives a shit on the amd64 ABI and uses different registers */
120	128	/* http://blogs.msdn.com/freik/archive/2005/03/17/398200.aspx */
121	129	#if __amd64
122		#define NUM_SAVED 6
123		"\tpush %rbp\n"
124		"\tpush %rbx\n"
125		"\tpush %r12\n"
126		"\tpush %r13\n"
127		"\tpush %r14\n"
128		"\tpush %r15\n"
129		#if CORO_WIN_TIB
130		"\tpush %gs:0x0\n"
131		"\tpush %gs:0x8\n"
132		"\tpush %gs:0xc\n"
	130	#ifdef WIN32
	131	/* TODO: xmm6..15 also would need to be saved. sigh. */
	132	#define NUM_SAVED 8
	133	"\tpushq %rsi\n"
	134	"\tpushq %rdi\n"
	135	"\tpushq %rbp\n"
	136	"\tpushq %rbx\n"
	137	"\tpushq %r12\n"
	138	"\tpushq %r13\n"
	139	"\tpushq %r14\n"
	140	"\tpushq %r15\n"
	141	#if CORO_WIN_TIB
	142	"\tpushq %fs:0x0\n"
	143	"\tpushq %fs:0x8\n"
	144	"\tpushq %fs:0xc\n"
	145	#endif
	146	"\tmovq %rsp, (%rcx)\n"
	147	"\tmovq (%rdx), %rsp\n"
	148	#if CORO_WIN_TIB
	149	"\tpopq %fs:0xc\n"
	150	"\tpopq %fs:0x8\n"
	151	"\tpopq %fs:0x0\n"
	152	#endif
	153	"\tpopq %r15\n"
	154	"\tpopq %r14\n"
	155	"\tpopq %r13\n"
	156	"\tpopq %r12\n"
	157	"\tpopq %rbx\n"
	158	"\tpopq %rbp\n"
	159	"\tpopq %rdi\n"
	160	"\tpopq %rsi\n"
	161	#else
	162	#define NUM_SAVED 6
	163	"\tpushq %rbp\n"
	164	"\tpushq %rbx\n"
	165	"\tpushq %r12\n"
	166	"\tpushq %r13\n"
	167	"\tpushq %r14\n"
	168	"\tpushq %r15\n"
	169	"\tmovq %rsp, (%rdi)\n"
	170	"\tmovq (%rsi), %rsp\n"
	171	"\tpopq %r15\n"
	172	"\tpopq %r14\n"
	173	"\tpopq %r13\n"
	174	"\tpopq %r12\n"
	175	"\tpopq %rbx\n"
	176	"\tpopq %rbp\n"
133	177	#endif
134		"\tmov %rsp, (%rdi)\n"
135		"\tmov (%rsi), %rsp\n"
136		#if CORO_WIN_TIB
137		"\tpop %gs:0xc\n"
138		"\tpop %gs:0x8\n"
139		"\tpop %gs:0x0\n"
140		#endif
141		"\tpop %r15\n"
142		"\tpop %r14\n"
143		"\tpop %r13\n"
144		"\tpop %r12\n"
145		"\tpop %rbx\n"
146		"\tpop %rbp\n"
147	178	#elif __i386
148	179	#define NUM_SAVED 4
149		"\tpush %ebp\n"
150		"\tpush %ebx\n"
151		"\tpush %esi\n"
152		"\tpush %edi\n"
	180	"\tpushl %ebp\n"
	181	"\tpushl %ebx\n"
	182	"\tpushl %esi\n"
	183	"\tpushl %edi\n"
153	184	#if CORO_WIN_TIB
154		"\tpush %fs:0\n"
155		"\tpush %fs:4\n"
156		"\tpush %fs:8\n"
	185	"\tpushl %fs:0\n"
	186	"\tpushl %fs:4\n"
	187	"\tpushl %fs:8\n"
157	188	#endif
158		"\tmov %esp, (%eax)\n"
159		"\tmov (%edx), %esp\n"
	189	"\tmovl %esp, (%eax)\n"
	190	"\tmovl (%edx), %esp\n"
160	191	#if CORO_WIN_TIB
161		"\tpop %fs:8\n"
162		"\tpop %fs:4\n"
163		"\tpop %fs:0\n"
	192	"\tpopl %fs:8\n"
	193	"\tpopl %fs:4\n"
	194	"\tpopl %fs:0\n"
164	195	#endif
165		"\tpop %edi\n"
166		"\tpop %esi\n"
167		"\tpop %ebx\n"
168		"\tpop %ebp\n"
	196	"\tpopl %edi\n"
	197	"\tpopl %esi\n"
	198	"\tpopl %ebx\n"
	199	"\tpopl %ebp\n"
169	200	#else
170	201	#error unsupported architecture
171	202	#endif

306	337	#endif
307	338
308	339	ctx->sp -= NUM_SAVED;
	340	memset (ctx->sp, 0, sizeof (ctx->sp) NUM_SAVED);
309	341
310	342	# elif CORO_UCONTEXT
311	343

-1

Coro/libcoro/coro.h less more

69	69	* 2008-11-19 define coro_*jmp symbols for easier porting.
70	70	* 2009-06-23 tentative win32-backend support for mingw32 (Yasuhiro Matsumoto).
71	71	* 2010-12-03 tentative support for uclibc (which lacks all sorts of things).
	72	* 2011-05-30 set initial callee-saved-registers to zero with CORO_ASM.
	73	* use .cfi_undefined rip on linux-amd64 for better backtraces.
	74	* 2011-06-08 maybe properly implement weird windows amd64 calling conventions.
72	75	*/
73	76
74	77	#ifndef CORO_H

203	206	&& !defined(CORO_SJLJ) && !defined(CORO_LINUX) \
204	207	&& !defined(CORO_IRIX) && !defined(CORO_ASM) \
205	208	&& !defined(CORO_PTHREAD)
206		# if defined(WINDOWS)
	209	# if defined(WINDOWS) \|\| defined(_WIN32)
207	210	# define CORO_LOSER 1 /* you don't win with windoze */
208	211	# elif defined(__linux) && (defined(__x86) \|\| defined (__amd64))
209	212	# define CORO_ASM 1

-1

Coro/schmorp.h less more

7	7	#include <signal.h>
8	8	#include <errno.h>
9	9
10		#if defined(WIN32 ) \|\| defined(_MINIX)
	10	#if defined(_WIN32) \|\| defined(_MINIX)
11	11	# define SCHMORP_H_PREFER_SELECT 1
12	12	#endif
13	13

+24

-13

Coro/state.h less more

0	0	/* list the interpreter variables that need to be saved/restored */
	1
	2	VARx(defsv, GvSV (PL_defgv), SV *)
	3	VARx(defav, GvAV (PL_defgv), AV *)
	4	VARx(errsv, GvSV (PL_errgv), SV *)
	5	VARx(irsgv, GvSV (irsgv), SV *)
	6	VARx(hinthv, GvHV (PL_hintgv), HV *)
	7
1	8	/* mostly copied from thrdvar.h */
2	9
3		VAR(defoutgv, GV ) / default FH for output */
4	10	VAR(stack_sp, SV *) / the main stack */
5	11	#ifdef OP_IN_REGISTER
6	12	VAR(opsave, OP ) / probably not necessary */

15	21	VAR(scopestack, I32 ) / scopes we've ENTERed */
16	22	VAR(scopestack_ix, I32)
17	23	VAR(scopestack_max,I32)
	24	#if HAS_SCOPESTACK_NAME
	25	VAR(scopestack_name,const char **)
	26	#endif
18	27
19	28	VAR(savestack, ANY ) / items that need to be restored
20	29	when LEAVEing scopes we've ENTERed */

36	45	VAR(retstack_max, I32)
37	46	#endif
38	47
39		VAR(tainted, bool) /* using variables controlled by $< */
40	48	VAR(curpm, PMOP ) / what to do \ interps in REs from */
41	49	VAR(rs, SV ) / input record separator $/ */
	50	VAR(defoutgv, GV ) / default FH for output */
42	51	VAR(curcop, COP *)
43
44		VAR(in_eval, int) /* trap "fatal" errors? */
45		VAR(localizing, int) /* are we processing a local() list? */
46	52
47	53	VAR(curstack, AV ) / THE STACK */
48	54	VAR(curstackinfo, PERL_SI ) / current stack + context */

53	59	VAR(sortcxix, I32) /* from pp_ctl.c */
54	60	#endif
55	61
	62	VAR(localizing, U8) /* are we processing a local() list? */
	63	VAR(in_eval, U8) /* trap "fatal" errors? */
	64	VAR(tainted, bool) /* using variables controlled by $< */
	65
	66	VAR(diehook, SV *)
	67	VAR(warnhook, SV *)
	68
	69	/* compcv is intrpvar, but seems to be thread-specific to me */
	70	/* but, well, I thoroughly misunderstand what thrdvar and intrpvar is. still. */
	71	VAR(compcv, CV ) / currently compiling subroutine */
	72
56	73	VAR(comppad, AV ) / storage for lexically scoped temporaries */
57	74	VAR(comppad_name, AV ) / variable names for "my" variables */
58	75	VAR(comppad_name_fill, I32) /* last "introduced" variable offset */
59	76	VAR(comppad_name_floor, I32) /* start of vars in innermost block */
60	77
61		/* compcv is intrpvar, but seems to be thread-specific to me */
62		/* but, well, I thoroughly misunderstand what thrdvar and intrpvar is. still. */
63		VAR(compcv, CV ) / currently compiling subroutine */
	78	VAR(runops, runops_proc_t) /* for tracing support */
64	79
65		VAR(diehook, SV *)
66		VAR(warnhook, SV *)
67		VAR(runops, runops_proc_t) /* for tracing support */
	80	VAR(hints, U32) /* pragma-tic compile-time flags */
68	81
69	82	#if PERL_VERSION_ATLEAST (5,10,0)
70	83	VAR(parser, yy_parser *)
71	84	#endif
72	85
73		VAR(hints, U32) /* pragma-tic compile-time flags */
74

+139

-72

Coro.pm less more

17	17	cede; # and again
18	18
19	19	# use locking
20		use Coro::Semaphore;
21	20	my $lock = new Coro::Semaphore;
22	21	my $locked;
23	22

91	90	This creates a new coro thread and puts it into the ready queue, meaning
92	91	it will run as soon as the CPU is free for it.
93	92
94		C<async> will return a coro object - you can store this for future
95		reference or ignore it, the thread itself will keep a reference to it's
96		thread object - threads are alive on their own.
	93	C<async> will return a Coro object - you can store this for future
	94	reference or ignore it - a thread that is running, ready to run or waiting
	95	for some event is alive on it's own.
97	96
98	97	Another way to create a thread is to call the C<new> constructor with a
99	98	code-reference:

132	131	instead), but it will give up the CPU regularly because it waits for
133	132	external events.
134	133
135		As long as a coro thread runs, it's coro object is available in the global
	134	As long as a coro thread runs, its Coro object is available in the global
136	135	variable C<$Coro::current>.
137	136
138	137	The low-level way to give up the CPU is to call the scheduler, which

197	196	Coro::terminate "return value 1", "return value 2";
198	197	};
199	198
200		And yet another way is to C<< ->cancel >> the coro thread from another
201		thread:
	199	And yet another way is to C<< ->cancel >> (or C<< ->safe_cancel >>) the
	200	coro thread from another thread:
202	201
203	202	my $coro = async {
204	203	exit 1;
205	204	};
206	205
207		$coro->cancel; # an also accept values for ->join to retrieve
	206	$coro->cancel; # also accepts values for ->join to retrieve
208	207
209	208	Cancellation I<can> be dangerous - it's a bit like calling C<exit> without
210	209	actually exiting, and might leave C libraries and XS modules in a weird
211	210	state. Unlike other thread implementations, however, Coro is exceptionally
212	211	safe with regards to cancellation, as perl will always be in a consistent
213		state.
	212	state, and for those cases where you want to do truly marvellous things
	213	with your coro while it is being cancelled - that is, make sure all
	214	cleanup code is executed from the thread being cancelled - there is even a
	215	C<< ->safe_cancel >> method.
214	216
215	217	So, cancelling a thread that runs in an XS event loop might not be the
216	218	best idea, but any other combination that deals with perl only (cancelling
217	219	when a thread is in a C<tie> method or an C<AUTOLOAD> for example) is
218	220	safe.
219	221
	222	Lastly, a coro thread object that isn't referenced is C<< ->cancel >>'ed
	223	automatically - just like other objects in Perl. This is not such a common
	224	case, however - a running thread is referencedy b C<$Coro::current>, a
	225	thread ready to run is referenced by the ready queue, a thread waiting
	226	on a lock or semaphore is referenced by being in some wait list and so
	227	on. But a thread that isn't in any of those queues gets cancelled:
	228
	229	async {
	230	schedule; # cede to other coros, don't go into the ready queue
	231	};
	232
	233	cede;
	234	# now the async above is destroyed, as it is not referenced by anything.
	235
220	236	=item 5. Cleanup
221	237
222	238	Threads will allocate various resources. Most but not all will be returned

249	265	};
250	266
251	267	The C<Guard::guard> function comes in handy for any custom cleanup you
252		might want to do:
	268	might want to do (but you cannot switch to other coroutines form those
	269	code blocks):
253	270
254	271	async {
255	272	my $window = new Gtk2::Window "toplevel";

272	289
273	290	=item 6. Viva La Zombie Muerte
274	291
275		Even after a thread has terminated and cleaned up it's resources, the coro
276		object still is there and stores the return values of the thread. Only in
277		this state will the coro object be "reference counted" in the normal perl
278		sense: the thread code keeps a reference to it when it is active, but not
279		after it has terminated.
280
281		The means the coro object gets freed automatically when the thread has
	292	Even after a thread has terminated and cleaned up its resources, the Coro
	293	object still is there and stores the return values of the thread.
	294
	295	The means the Coro object gets freed automatically when the thread has
282	296	terminated and cleaned up and there arenot other references.
283	297
284		If there are, the coro object will stay around, and you can call C<<
	298	If there are, the Coro object will stay around, and you can call C<<
285	299	->join >> as many times as you wish to retrieve the result values:
286	300
287	301	async {

329	343	our $main; # main coro
330	344	our $current; # current coro
331	345
332		our $VERSION = 5.372;
	346	our $VERSION = '6.0';
333	347
334	348	our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub rouse_cb rouse_wait);
335	349	our %EXPORT_TAGS = (

400	414
401	415	$manager = new Coro sub {
402	416	while () {
403		Coro::State::cancel shift @destroy
	417	_destroy shift @destroy
404	418	while @destroy;
405	419
406	420	&schedule;

544	558
545	559	=item terminate [arg...]
546	560
547		Terminates the current coro with the given status values (see L<cancel>).
	561	Terminates the current coro with the given status values (see
	562	L<cancel>). The values will not be copied, but referenced directly.
548	563
549	564	=item Coro::on_enter BLOCK, Coro::on_leave BLOCK
550	565

710	725	against spurious wakeups, and the one in the Coro family certainly do
711	726	that.
712	727
	728	=item $state->is_new
	729
	730	Returns true iff this Coro object is "new", i.e. has never been run
	731	yet. Those states basically consist of only the code reference to call and
	732	the arguments, but consumes very little other resources. New states will
	733	automatically get assigned a perl interpreter when they are transfered to.
	734
	735	=item $state->is_zombie
	736
	737	Returns true iff the Coro object has been cancelled, i.e.
	738	it's resources freed because they were C<cancel>'ed, C<terminate>'d,
	739	C<safe_cancel>'ed or simply went out of scope.
	740
	741	The name "zombie" stems from UNIX culture, where a process that has
	742	exited and only stores and exit status and no other resources is called a
	743	"zombie".
	744
713	745	=item $is_ready = $coro->is_ready
714	746
715	747	Returns true iff the Coro object is in the ready queue. Unless the Coro

728	760
729	761	=item $coro->cancel (arg...)
730	762
731		Terminates the given Coro and makes it return the given arguments as
732		status (default: the empty list). Never returns if the Coro is the
	763	Terminates the given Coro thread and makes it return the given arguments as
	764	status (default: an empty list). Never returns if the Coro is the
733	765	current Coro.
734	766
735		=cut
736
737		sub cancel {
738		my $self = shift;
739
740		if ($current == $self) {
741		terminate @_;
742		} else {
743		$self->{_status} = [@_];
744		Coro::State::cancel $self;
	767	This is a rather brutal way to free a coro, with some limitations - if
	768	the thread is inside a C callback that doesn't expect to be canceled,
	769	bad things can happen, or if the cancelled thread insists on running
	770	complicated cleanup handlers that rely on its thread context, things will
	771	not work.
	772
	773	Any cleanup code being run (e.g. from C<guard> blocks) will be run without
	774	a thread context, and is not allowed to switch to other threads. On the
	775	plus side, C<< ->cancel >> will always clean up the thread, no matter
	776	what. If your cleanup code is complex or you want to avoid cancelling a
	777	C-thread that doesn't know how to clean up itself, it can be better to C<<
	778	->throw >> an exception, or use C<< ->safe_cancel >>.
	779
	780	The arguments to C<< ->cancel >> are not copied, but instead will
	781	be referenced directly (e.g. if you pass C<$var> and after the call
	782	change that variable, then you might change the return values passed to
	783	e.g. C<join>, so don't do that).
	784
	785	The resources of the Coro are usually freed (or destructed) before this
	786	call returns, but this can be delayed for an indefinite amount of time, as
	787	in some cases the manager thread has to run first to actually destruct the
	788	Coro object.
	789
	790	=item $coro->safe_cancel ($arg...)
	791
	792	Works mostly like C<< ->cancel >>, but is inherently "safer", and
	793	consequently, can fail with an exception in cases the thread is not in a
	794	cancellable state.
	795
	796	This method works a bit like throwing an exception that cannot be caught
	797	- specifically, it will clean up the thread from within itself, so
	798	all cleanup handlers (e.g. C<guard> blocks) are run with full thread
	799	context and can block if they wish. The downside is that there is no
	800	guarantee that the thread can be cancelled when you call this method, and
	801	therefore, it might fail. It is also considerably slower than C<cancel> or
	802	C<terminate>.
	803
	804	A thread is in a safe-cancellable state if it either hasn't been run yet,
	805	or it has no C context attached and is inside an SLF function.
	806
	807	The latter two basically mean that the thread isn't currently inside a
	808	perl callback called from some C function (usually via some XS modules)
	809	and isn't currently executing inside some C function itself (via Coro's XS
	810	API).
	811
	812	This call returns true when it could cancel the thread, or croaks with an
	813	error otherwise (i.e. it either returns true or doesn't return at all).
	814
	815	Why the weird interface? Well, there are two common models on how and
	816	when to cancel things. In the first, you have the expectation that your
	817	coro thread can be cancelled when you want to cancel it - if the thread
	818	isn't cancellable, this would be a bug somewhere, so C<< ->safe_cancel >>
	819	croaks to notify of the bug.
	820
	821	In the second model you sometimes want to ask nicely to cancel a thread,
	822	but if it's not a good time, well, then don't cancel. This can be done
	823	relatively easy like this:
	824
	825	if (! eval { $coro->safe_cancel }) {
	826	warn "unable to cancel thread: $@";
745	827	}
746		}
	828
	829	However, what you never should do is first try to cancel "safely" and
	830	if that fails, cancel the "hard" way with C<< ->cancel >>. That makes
	831	no sense: either you rely on being able to execute cleanup code in your
	832	thread context, or you don't. If you do, then C<< ->safe_cancel >> is the
	833	only way, and if you don't, then C<< ->cancel >> is always faster and more
	834	direct.
747	835
748	836	=item $coro->schedule_to
749	837

772	860
773	861	Coro will check for the exception each time a schedule-like-function
774	862	returns, i.e. after each C<schedule>, C<cede>, C<< Coro::Semaphore->down
775		>>, C<< Coro::Handle->readable >> and so on. Most of these functions
776		detect this case and return early in case an exception is pending.
	863	>>, C<< Coro::Handle->readable >> and so on. Most of those functions (all
	864	that are part of Coro itself) detect this case and return early in case an
	865	exception is pending.
777	866
778	867	The exception object will be thrown "as is" with the specified scalar in
779	868	C<$@>, i.e. if it is a string, no line number or newline will be appended
780	869	(unlike with C<die>).
781	870
782		This can be used as a softer means than C<cancel> to ask a coro to
783		end itself, although there is no guarantee that the exception will lead to
784		termination, and if the exception isn't caught it might well end the whole
785		program.
	871	This can be used as a softer means than either C<cancel> or C<safe_cancel
	872	>to ask a coro to end itself, although there is no guarantee that the
	873	exception will lead to termination, and if the exception isn't caught it
	874	might well end the whole program.
786	875
787	876	You might also think of C<throw> as being the moral equivalent of
788	877	C<kill>ing a coro with a signal (in this case, a scalar).

791	880
792	881	Wait until the coro terminates and return any values given to the
793	882	C<terminate> or C<cancel> functions. C<join> can be called concurrently
794		from multiple coro, and all will be resumed and given the status
	883	from multiple threads, and all will be resumed and given the status
795	884	return once the C<$coro> terminates.
796	885
797		=cut
798
799		sub join {
800		my $self = shift;
801
802		unless ($self->{_status}) {
803		my $current = $current;
804
805		push @{$self->{_on_destroy}}, sub {
806		$current->ready;
807		undef $current;
808		};
809
810		&schedule while $current;
811		}
812
813		wantarray ? @{$self->{_status}} : $self->{_status}[0];
814		}
815
816	886	=item $coro->on_destroy (\&cb)
817	887
818	888	Registers a callback that is called when this coro thread gets destroyed,
819		but before it is joined. The callback gets passed the terminate arguments,
820		if any, and I<must not> die, under any circumstances.
821
822		There can be any number of C<on_destroy> callbacks per coro.
823
824		=cut
825
826		sub on_destroy {
827		my ($self, $cb) = @_;
828
829		push @{ $self->{_on_destroy} }, $cb;
830		}
	889	that is, after it's resources have been freed but before it is joined. The
	890	callback gets passed the terminate/cancel arguments, if any, and I<must
	891	not> die, under any circumstances.
	892
	893	There can be any number of C<on_destroy> callbacks per coro, and there is
	894	no way currently to remove a callback once added.
831	895
832	896	=item $oldprio = $coro->prio ($newprio)
833	897

1109	1173	the windows process emulation enabled under unix roughly halves perl
1110	1174	performance, even when not used.
1111	1175
	1176	Attempts to use threads created in another emulated process will crash
	1177	("cleanly", with a null pointer exception).
	1178
1112	1179	=item coro switching is not signal safe
1113	1180
1114	1181	You must not switch to another coro from within a signal handler (only

-1

EV/EV.pm less more

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

-1

Event/Event.pm less more

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

-0

MANIFEST less more

8	8	Coro.pm
9	9	Coro/Makefile.PL
10	10	Coro/typemap
	11	Coro/ecb.h
11	12	Coro/schmorp.h
12	13	Coro/State.pm
13	14	Coro/State.xs
14	15	Coro/clone.c
15	16	Coro/state.h
	17	Coro/jit-amd64-unix.pl
	18	Coro/jit-x86-unix.pl
16	19	Coro/Signal.pm
17	20	Coro/Semaphore.pm
18	21	Coro/SemaphoreSet.pm

60	63	t/17_rouse.t
61	64	t/18_winder.t
62	65	t/19_handle.t
	66	t/20_mutual_cancel.t
63	67
64	68	EV/Makefile.PL
65	69	EV/EV.pm

-1

META.json less more

10	10	},
11	11	"generated_by" : "ExtUtils::MakeMaker::JSONMETA version 7.000",
12	12	"distribution_type" : "module",
13		"version" : "5.372",
	13	"version" : "6.0",
14	14	"name" : "Coro",
15	15	"author" : [],
16	16	"license" : "unknown",

-3

Makefile.PL less more

35	35	print "\nEvent version $Event::VERSION found, building Event support.\n\n";
36	36	}
37	37	} else {
38		print "\n*** Event not found, not build Event support.\n\n";
	38	print "\n*** Event not found, not building Event support.\n\n";
39	39	}
40	40
41	41	if (eval { require EV }) {

43	43	print <<EOF
44	44
45	45	***
46		*** WARNING: Event version $EV::VERSION found, NOT building EV support.
	46	*** WARNING: EV version $EV::VERSION found, NOT building EV support.
47	47	***
48	48	*** This version is ABI-incompatible with Coro, please upgrade to at least 3.3.
49	49	***

55	55	print "\nEV version $EV::VERSION found, building EV support.\n\n";
56	56	}
57	57	} else {
58		print "\n*** EV not found, not build EV support.\n\n";
	58	print "\n*** EV not found, not building EV support.\n\n";
59	59	}
60	60
61	61	WriteMakefile(

107	107	'Coro.pm' => '$(INST_LIBDIR)/Coro.pm',
108	108
109	109	'Coro/State.pm' => '$(INST_LIBDIR)/Coro/State.pm',
	110	'Coro/jit-amd64-unix.pl' => '$(INST_LIBDIR)/Coro/jit-amd64-unix.pl',
	111	'Coro/jit-x86-unix.pl' => '$(INST_LIBDIR)/Coro/jit-x86-unix.pl',
110	112
111	113	'Coro/MakeMaker.pm' => '$(INST_LIBDIR)/Coro/MakeMaker.pm',
112	114	'Coro/CoroAPI.h' => '$(INST_LIBDIR)/Coro/CoroAPI.h',

+140

-34

README less more

15	15	cede; # and again
16	16
17	17	# use locking
18		use Coro::Semaphore;
19	18	my $lock = new Coro::Semaphore;
20	19	my $locked;
21	20

85	84	This creates a new coro thread and puts it into the ready queue,
86	85	meaning it will run as soon as the CPU is free for it.
87	86
88		"async" will return a coro object - you can store this for future
89		reference or ignore it, the thread itself will keep a reference to
90		it's thread object - threads are alive on their own.
	87	"async" will return a Coro object - you can store this for future
	88	reference or ignore it - a thread that is running, ready to run or
	89	waiting for some event is alive on it's own.
91	90
92	91	Another way to create a thread is to call the "new" constructor with
93	92	a code-reference:

124	123	a function instead), but it will give up the CPU regularly because
125	124	it waits for external events.
126	125
127		As long as a coro thread runs, it's coro object is available in the
	126	As long as a coro thread runs, its Coro object is available in the
128	127	global variable $Coro::current.
129	128
130	129	The low-level way to give up the CPU is to call the scheduler, which

188	187	Coro::terminate "return value 1", "return value 2";
189	188	};
190	189
191		And yet another way is to "->cancel" the coro thread from another
192		thread:
	190	And yet another way is to "->cancel" (or "->safe_cancel") the coro
	191	thread from another thread:
193	192
194	193	my $coro = async {
195	194	exit 1;
196	195	};
197	196
198		$coro->cancel; # an also accept values for ->join to retrieve
	197	$coro->cancel; # also accepts values for ->join to retrieve
199	198
200	199	Cancellation can be dangerous - it's a bit like calling "exit"
201	200	without actually exiting, and might leave C libraries and XS modules
202	201	in a weird state. Unlike other thread implementations, however, Coro
203	202	is exceptionally safe with regards to cancellation, as perl will
204		always be in a consistent state.
	203	always be in a consistent state, and for those cases where you want
	204	to do truly marvellous things with your coro while it is being
	205	cancelled - that is, make sure all cleanup code is executed from the
	206	thread being cancelled - there is even a "->safe_cancel" method.
205	207
206	208	So, cancelling a thread that runs in an XS event loop might not be
207	209	the best idea, but any other combination that deals with perl only
208	210	(cancelling when a thread is in a "tie" method or an "AUTOLOAD" for
209	211	example) is safe.
210	212
	213	Lastly, a coro thread object that isn't referenced is "->cancel"'ed
	214	automatically - just like other objects in Perl. This is not such a
	215	common case, however - a running thread is referencedy b
	216	$Coro::current, a thread ready to run is referenced by the ready
	217	queue, a thread waiting on a lock or semaphore is referenced by
	218	being in some wait list and so on. But a thread that isn't in any of
	219	those queues gets cancelled:
	220
	221	async {
	222	schedule; # cede to other coros, don't go into the ready queue
	223	};
	224
	225	cede;
	226	# now the async above is destroyed, as it is not referenced by anything.
	227
211	228	5. Cleanup
212	229	Threads will allocate various resources. Most but not all will be
213	230	returned when a thread terminates, during clean-up.

239	256	};
240	257
241	258	The "Guard::guard" function comes in handy for any custom cleanup
242		you might want to do:
	259	you might want to do (but you cannot switch to other coroutines form
	260	those code blocks):
243	261
244	262	async {
245	263	my $window = new Gtk2::Window "toplevel";

261	279	}
262	280
263	281	6. Viva La Zombie Muerte
264		Even after a thread has terminated and cleaned up it's resources,
265		the coro object still is there and stores the return values of the
266		thread. Only in this state will the coro object be "reference
267		counted" in the normal perl sense: the thread code keeps a reference
268		to it when it is active, but not after it has terminated.
269
270		The means the coro object gets freed automatically when the thread
	282	Even after a thread has terminated and cleaned up its resources, the
	283	Coro object still is there and stores the return values of the
	284	thread.
	285
	286	The means the Coro object gets freed automatically when the thread
271	287	has terminated and cleaned up and there arenot other references.
272	288
273		If there are, the coro object will stay around, and you can call
	289	If there are, the Coro object will stay around, and you can call
274	290	"->join" as many times as you wish to retrieve the result values:
275	291
276	292	async {

439	455
440	456	terminate [arg...]
441	457	Terminates the current coro with the given status values (see
442		cancel).
	458	cancel). The values will not be copied, but referenced directly.
443	459
444	460	Coro::on_enter BLOCK, Coro::on_leave BLOCK
445	461	These function install enter and leave winders in the current scope.

581	597	protect itself against spurious wakeups, and the one in the Coro
582	598	family certainly do that.
583	599
	600	$state->is_new
	601	Returns true iff this Coro object is "new", i.e. has never been run
	602	yet. Those states basically consist of only the code reference to
	603	call and the arguments, but consumes very little other resources.
	604	New states will automatically get assigned a perl interpreter when
	605	they are transfered to.
	606
	607	$state->is_zombie
	608	Returns true iff the Coro object has been cancelled, i.e. it's
	609	resources freed because they were "cancel"'ed, "terminate"'d,
	610	"safe_cancel"'ed or simply went out of scope.
	611
	612	The name "zombie" stems from UNIX culture, where a process that has
	613	exited and only stores and exit status and no other resources is
	614	called a "zombie".
	615
584	616	$is_ready = $coro->is_ready
585	617	Returns true iff the Coro object is in the ready queue. Unless the
586	618	Coro object gets destroyed, it will eventually be scheduled by the

596	628	Coros will not ever be scheduled.
597	629
598	630	$coro->cancel (arg...)
599		Terminates the given Coro and makes it return the given arguments as
600		status (default: the empty list). Never returns if the Coro is the
601		current Coro.
	631	Terminates the given Coro thread and makes it return the given
	632	arguments as status (default: an empty list). Never returns if the
	633	Coro is the current Coro.
	634
	635	This is a rather brutal way to free a coro, with some limitations -
	636	if the thread is inside a C callback that doesn't expect to be
	637	canceled, bad things can happen, or if the cancelled thread insists
	638	on running complicated cleanup handlers that rely on its thread
	639	context, things will not work.
	640
	641	Any cleanup code being run (e.g. from "guard" blocks) will be run
	642	without a thread context, and is not allowed to switch to other
	643	threads. On the plus side, "->cancel" will always clean up the
	644	thread, no matter what. If your cleanup code is complex or you want
	645	to avoid cancelling a C-thread that doesn't know how to clean up
	646	itself, it can be better to "->throw" an exception, or use
	647	"->safe_cancel".
	648
	649	The arguments to "->cancel" are not copied, but instead will be
	650	referenced directly (e.g. if you pass $var and after the call change
	651	that variable, then you might change the return values passed to
	652	e.g. "join", so don't do that).
	653
	654	The resources of the Coro are usually freed (or destructed) before
	655	this call returns, but this can be delayed for an indefinite amount
	656	of time, as in some cases the manager thread has to run first to
	657	actually destruct the Coro object.
	658
	659	$coro->safe_cancel ($arg...)
	660	Works mostly like "->cancel", but is inherently "safer", and
	661	consequently, can fail with an exception in cases the thread is not
	662	in a cancellable state.
	663
	664	This method works a bit like throwing an exception that cannot be
	665	caught - specifically, it will clean up the thread from within
	666	itself, so all cleanup handlers (e.g. "guard" blocks) are run with
	667	full thread context and can block if they wish. The downside is that
	668	there is no guarantee that the thread can be cancelled when you call
	669	this method, and therefore, it might fail. It is also considerably
	670	slower than "cancel" or "terminate".
	671
	672	A thread is in a safe-cancellable state if it either hasn't been run
	673	yet, or it has no C context attached and is inside an SLF function.
	674
	675	The latter two basically mean that the thread isn't currently inside
	676	a perl callback called from some C function (usually via some XS
	677	modules) and isn't currently executing inside some C function itself
	678	(via Coro's XS API).
	679
	680	This call returns true when it could cancel the thread, or croaks
	681	with an error otherwise (i.e. it either returns true or doesn't
	682	return at all).
	683
	684	Why the weird interface? Well, there are two common models on how
	685	and when to cancel things. In the first, you have the expectation
	686	that your coro thread can be cancelled when you want to cancel it -
	687	if the thread isn't cancellable, this would be a bug somewhere, so
	688	"->safe_cancel" croaks to notify of the bug.
	689
	690	In the second model you sometimes want to ask nicely to cancel a
	691	thread, but if it's not a good time, well, then don't cancel. This
	692	can be done relatively easy like this:
	693
	694	if (! eval { $coro->safe_cancel }) {
	695	warn "unable to cancel thread: $@";
	696	}
	697
	698	However, what you never should do is first try to cancel "safely"
	699	and if that fails, cancel the "hard" way with "->cancel". That makes
	700	no sense: either you rely on being able to execute cleanup code in
	701	your thread context, or you don't. If you do, then "->safe_cancel"
	702	is the only way, and if you don't, then "->cancel" is always faster
	703	and more direct.
602	704
603	705	$coro->schedule_to
604	706	Puts the current coro to sleep (like "Coro::schedule"), but instead

625	727	Coro will check for the exception each time a schedule-like-function
626	728	returns, i.e. after each "schedule", "cede",
627	729	"Coro::Semaphore->down", "Coro::Handle->readable" and so on. Most of
628		these functions detect this case and return early in case an
629		exception is pending.
	730	those functions (all that are part of Coro itself) detect this case
	731	and return early in case an exception is pending.
630	732
631	733	The exception object will be thrown "as is" with the specified
632	734	scalar in $@, i.e. if it is a string, no line number or newline will
633	735	be appended (unlike with "die").
634	736
635		This can be used as a softer means than "cancel" to ask a coro to
636		end itself, although there is no guarantee that the exception will
637		lead to termination, and if the exception isn't caught it might well
638		end the whole program.
	737	This can be used as a softer means than either "cancel" or
	738	"safe_cancel "to ask a coro to end itself, although there is no
	739	guarantee that the exception will lead to termination, and if the
	740	exception isn't caught it might well end the whole program.
639	741
640	742	You might also think of "throw" as being the moral equivalent of
641	743	"kill"ing a coro with a signal (in this case, a scalar).

643	745	$coro->join
644	746	Wait until the coro terminates and return any values given to the
645	747	"terminate" or "cancel" functions. "join" can be called concurrently
646		from multiple coro, and all will be resumed and given the status
	748	from multiple threads, and all will be resumed and given the status
647	749	return once the $coro terminates.
648	750
649	751	$coro->on_destroy (\&cb)
650	752	Registers a callback that is called when this coro thread gets
651		destroyed, but before it is joined. The callback gets passed the
652		terminate arguments, if any, and must not die, under any
653		circumstances.
654
655		There can be any number of "on_destroy" callbacks per coro.
	753	destroyed, that is, after it's resources have been freed but before
	754	it is joined. The callback gets passed the terminate/cancel
	755	arguments, if any, and must not die, under any circumstances.
	756
	757	There can be any number of "on_destroy" callbacks per coro, and
	758	there is no way currently to remove a callback once added.
656	759
657	760	$oldprio = $coro->prio ($newprio)
658	761	Sets (or gets, if the argument is missing) the priority of the coro

849	952	processes, as having the windows process emulation enabled under
850	953	unix roughly halves perl performance, even when not used.
851	954
	955	Attempts to use threads created in another emulated process will
	956	crash ("cleanly", with a null pointer exception).
	957
852	958	coro switching is not signal safe
853	959	You must not switch to another coro from within a signal handler
854	960	(only relevant with %SIG - most event libraries provide safe

+12

-13

eg/bench less more

26	26	};
27	27
28	28	cede;
29
30		$main = $Coro::main;
31	29
32	30	*transfer = \&Coro::State::transfer;
33	31

62	60	#$c0->save (0);
63	61	#$c1->save (-1);
64	62
65		transfer($main, $c0);
66		transfer($main, $c1);
67
68	63	#Coro::State::enable_times 1;
69	64	#use Coro::Debug; Coro::Debug::command "ps";#d#
70	65	#(async {
71		timethese 5000000, {
72		function => 'a(5); a(6)',
73		method => '$a->b(5); $a->b(6)',
74		cede => 'cede',
75		transfer0 => 'transfer($main, $c0)',
76		transfer1 => 'transfer($main, $c1)',
77		};
	66	$main = $Coro::current;
	67
	68	transfer($main, $c0);
	69	transfer($main, $c1);
	70
	71	timethese 5000000, {
	72	function => 'a(5); a(6)',
	73	method => '$a->b(5); $a->b(6)',
	74	cede => 'cede',
	75	transfer0 => 'transfer($main, $c0)',
	76	transfer1 => 'transfer($main, $c1)',
	77	};
78	78	#})->join;
79	79	#use Coro::Debug; Coro::Debug::command "ps";#d#
80	80
81	81
82

-3

t/08_join.t less more

11	11
12	12	$p2 = async {
13	13	print "ok 4\n";
14		();
	14	()
15	15	};
16	16
17	17	$p3 = async {
18	18	print "ok 5\n";
19		(0,1,2);
	19	(0,1,2)
20	20	};
21	21
22	22	print "ok 2\n";

24	24	print 0 == ($p3->join)[0] ? "ok " : "not ok ", "7\n";
25	25	print 1 == ($p3->join)[1] ? "ok " : "not ok ", "8\n";
26	26	print 2 == ($p3->join)[2] ? "ok " : "not ok ", "9\n";
27		print 5 == $p1->join ? "ok " : "not ok ", "10\n";
	27	print 5 == $p1->join ? "ok " : "not ok ", "10\n";
28	28

+46

-0

t/20_mutual_cancel.t less more

	0	$\|=1;
	1	print "1..10\n";
	2
	3	# when two coros cancel each other mutually,
	4	# the slf function currently being executed needs to
	5	# be cleaned up, otherwise the next slf call in the cleanup code
	6	# will simply resume the previous call.
	7	# in addition, mutual cancellation must be specially handled
	8	# as currently, we sometimes cancel coros from another coro
	9	# which must not be interrupted (see slf_init_cancel).
	10
	11	use Coro;
	12
	13	print "ok 1\n";
	14
	15	my ($a, $b);
	16
	17	sub xyz::DESTROY {
	18	print "ok 7\n";
	19	$b->cancel;
	20	print "ok 8\n";
	21	}
	22
	23	$b = async {
	24	print "ok 3\n";
	25	cede;
	26	print "ok 6\n";
	27	$a->cancel;
	28	print "not ok 7\n";
	29	};
	30
	31	$a = async {
	32	print "ok 4\n";
	33	my $x = bless \my $dummy, "xyz";
	34	cede;
	35	print "not ok 5\n";
	36	};
	37
	38	print "ok 2\n";
	39	cede;
	40	print "ok 5\n";
	41	cede;
	42	print "ok 9\n";
	43	cede;
	44	print "ok 10\n";
	45