Coro
view release on metacpan or search on metacpan
This module is licensed under the same terms as perl itself.
Please note that Coro/libcoro comes with its own license.
Revision history for Perl extension Coro.
TODO: should explore PerlIO::coroaio (perl leaks like hell).
TODO: channel->maxsize(newsize)?
TODO: __GCC_HAVE_DWARF2_CFI_ASM
TODO: swap_sv, maybe add scope_swap_sv?
TODO: croak when async_pool tries to run canceled thread?
6.514 Thu Aug 31 18:25:31 CEST 2017
- safe_cancel no longer croaks when called on already-destroyed
thread, but instead "just works".
6.513 Sat Jul 15 01:18:51 CEST 2017
6.5 Wed Jun 22 22:23:50 CEST 2016
- swap_sv swapping order was not symmetrical, causing
wrong swaps when swap_sv was used multiple times on the
same sv in the same thread.
- swap_sv calls can now be undone by calling it again
with the same variables.
- swap_sv calls will now be undone in async_pool threads.
- split Coro::Semaphore::up/adjust into separate xs functions
for better error reporting, at slight codesize increase.
- (libcoro) arm assembly support, please test and report.
- adjust to PL_savestack changes in perl 5.24 (adapted from
the debian patch, which unfortunately gets it wrong).
6.49 Sat Oct 17 01:40:12 CEST 2015
- throwing an exception to a thread waiting in
Coro::Handle using Coro::EV did not stop the watchers,
causing the next call to fail (testcase by Martin Pritchard).
- bump minimum perl version to 5.10.
6.48 Sun Oct 4 19:03:51 CEST 2015
6.32 Tue Nov 5 15:35:35 CET 2013
- use a new algorithm to derive padlists for perl 5.18. The old
one could lead to 0-pointer accesses inside perl (reported
by Darin McBride).
6.31 Thu May 9 07:39:48 CEST 2013
- Coro::AIO requests would crash if the thread was ready'd
while the request was ongoing.
6.29 Wed May 8 02:55:18 CEST 2013
- when an on_destroy handler destructs the coro currently being
destructed a perl scalar could be accessed after being freed,
likely causing a crash.
6.28 Wed Mar 6 06:58:02 CET 2013
- clean remnants of existing __DIE__ and __WARN__ handlers so
they lose their magic and will not cause segfaults later
(testcase by Andrey Sagulin).
- improved Coro::State documentation a bit.
- Coro::Debug::command now flushes the output.
- add hack detection code for x32 abi, because the braindead slugs
- use sizeof (void *) as multiplication factor for stack sizes,
to accomodate the totally braindamaged microsoft 64 bit "os".
- changed verifier host from win2k-ap510-32 to win7-sp516-32/64.
activeperl 5.16 crashes when PerlIO_define_layer is called due
to some bug in the perl dll, strawberry perl at least passes
the testsuite.
- implement Coro::Handle->peeraddr/host/port, for slightly
improved compatibility with LWP.
- implement 5.17 compatibility by almost blindly applying a
good-looking patch by Father Chrysostomos.
- move stack management functions into libcoro 3.
- libcoro version 3 "released".
- support magic values as timed_io_once args.
- recommend AnyEvent 7+ or EV 4+, also require EV
version 4 or newer for Coro::EV.
6.10 Tue Oct 9 01:14:27 CEST 2012
- updated ecb.h, it had a typo that caused it to not compile on many
big endian systems (reported by many people).
- disable memory fences in ecb.h to improve portability.
6.09 Sat Oct 6 23:25:02 CEST 2012
in memory areas that are farther than 2gb apart, which the jit couldn't
handle and barfed. now it's just a bit slower on gentoo and similar
systems.
6.01 Sun Jul 3 12:31:14 CEST 2011
- workarounds are good, but the test for whether pthreads are used
was not good. this one should be better.
- check differently whether gcc generates cfi instructions itself.
6.0 Wed Jun 29 19:43:35 CEST 2011
- INCOMPATIBLE CHANGE: unreferenced coro objects will now be
destroyed and cleaned up automatically (e.g. async { schedule }).
- implement a JIT compiler for part of the thread switch code,
which gives a 50% speed improvement on threaded perls, and
about 4% on non-threaded perls (so threaded perls now finally
reach about half the speed of non-threaded perls).
- slightly modernise Coro::Intro, add section about rouse functions.
- avoid DEFSV and ERRSV, giving another 10% improvement
in thread switching.
- Coro::State->is_destroyed is now called is_zombie.
- implement a Coro->safe_cancel method that might fail, but
cancels in a "safer" way if it succeeds.
- add preliminary support for DEBUGGING perls.
- get rid of two hash-accesses when initialising a new Coro - this
speeds up coro creation by almost a factor of two.
- croak when a coro that is being cancelled tries to block
(e.g. while executing a guard block), instead of crashing or
deadlocking.
- use a more robust and also faster method to identify Coro::State
objects - speeds up everything a bit.
- implement Coro->cancel in XS for a 20% speed improvement, and to
be able to implement mutual cancellation.
- speed up context switches by a percent or two by more efficiently
allocating context stack entries.
- implement Coro->join and Coro->on_destroy in XS for a speedup and
a reduction in memory use.
- cancelling a coro while it itself is cancelling another coro is
now supported and working, instead of triggering an assertion.
- be a bit more crash-resistant when calling (buggy) on_destroy
callbacks (best effort).
- move on_destroy into the slf_frame, to allow extension slf
functions to have destructors.
- get rid if coro refcounting - simply crash in other interpreter
threads by nulling the pointers on clone.
- simplify warn/die hook handling when loading Coro - the convoluted
logic seems to be no longer neccessary.
- use libecb instead of our own home-grown gcc hacks.
- document alternatives to Coro::LWP. Please use them :)
- work around another mindless idiotic NEEDLESS bug in openbsd/mirbsds
sigaltstack. Really. wine suffers from it, erlang suffers from it,
and it's known since at least 2006.
5.372 Wed Feb 23 06:14:30 CET 2011
working pthreads, but still broken ucontext/sigaltstack.
- openbsd 4.8 finally got their act together, Coro works out of the box
with asm, setjmp and pthreads (no change, just informational).
5.24 Sat Oct 23 11:27:12 CEST 2010
- port to the EV 4.0 API.
- work around bugs in mingw32, making strawberry perl work
out of the box.
- correctly modify Coro::AIO function prototypes
so that they reflect the "no optional parameters" rule.
- "ported" libcoro to C++.
5.23 Mon May 17 18:50:42 CEST 2010
- be more resistant to ordering changes when initialising
Coro::AnyEvent, Coro::EV and Coro::Event (reported by Matthias
Waldorf).
- document that perl 5.12 deliberately removed support for cloning.
5.22 Wed Apr 14 03:55:35 CEST 2010
- correctly return udnef on errors in Coro::Handle::read/write
(testcase by Marc Mims).
- convert Coro::Util into a "perl compatibility wrapper" - the functions
are less useful now, but are drop-in replacements for existing
functions, listing better alternatives in the documentation. This also
fixes a bug in Coro::LWP which naively substituted Socket::inet_aton
with Coro::Util::inet_aton.
- do not override $Coro::idle unconditionally in Coro.pm, as other
modules could have provided their own idle coro already
(for exmaple, Coro::AnyEvent).
- fix Coro::Util::gethost* functions.
- Coro::Timer corretcly exports it's symbols (reported by Hideki Yamamura).
5.21 Wed Dec 16 07:19:51 CET 2009
- automatically load Coro::AnyEvent when AnyEvent and Coro are used
together.
- add some examples on how to combine other event loops with Coro in
Coro::AnyEvent, and how to run it (and not to block). Seems to be
the most common source of confusion.
- export rouse_cb and rouse_wait by default now.
- fix various prototype mismatches in Coro::AnyEvent and Coro::Handle.
- new method $state->swap_sv.
- added section on "windows process emulation" to the manpage,
after a not-so-fruitful (nor-friendly) "discussion" with chip
salzenberg (discussion implies arguments, but his only arguments
were ad-hominems, one wonders why he started it in the first
place). I hope this explains it well enough for him to understand,
and maybe well enough for others to understand.
- use common::sense everywhere now.
- idle callbacks are no longer supported, use idle coros instead.
- print a thread listing when a deadlock is detected.
5.17 Sat Aug 22 23:09:31 CEST 2009
- work around a bug in the perl debugger causing crashes
when running under the debugger by marking _pool_handler as nodebug.
- speed up Coro::async considerably.
- try some hacks to get netbsd to work "more often" - their broken
setjmp/longjmp, ucontext *and* phtreads are really hard on Coro.
- convert Coro to AE 5.0 API.
5.16 Tue Jul 21 01:44:37 CEST 2009
- Coro::AnyEvent failed to hook into the event loop
when no threads had been readied between detecting
the event loop and actually running it.
- considerably speed up Coro::Select by taking avdantage
of AnyEvent > 4.8 and some other optimisations.
- implement paragraph readline mode in Coro::Handle
(based on patches by Zsbán Ambrus).
- replace WSAEINPROGRESS by WSAEWOULDBLOCK (reported
and analyzed by Yasuhiro MATSUMOTO).
- clarified libcoro license and copyright.
- someone stole my EXTRA_META!!!
- implement Coro::Select::patch_pp_sselect and it's brother,
for hardcode select overriding.
5.151 Mon Jul 6 05:41:57 CEST 2009
- backport to windows process emulation code again (patch by
Yasuhiro MATSUMOTO).
- slightly update Coro::MakeMaker.
5.15 Tue Jun 30 10:28:06 CEST 2009
- deprecate Coro::Socket, document how to get ipv6 support via
AnyEvent::Socket instead.
- implement signal->wait ($cb) interface, similar to semaphores.
- work around SvOK not supporting getmagic, so we have to getmagic
to test for undef :/ (reported by Matthias Waldorf).
- load Coro::AnyEvent in all modules using AnyEvent.
- work around perl corrupting our internal data structures,
reported by Tokuhiro Matsuno.
- enable per-coroutine real and cpu time gathering
(Coro::State::enable_times).
5.14 Wed Jun 24 01:37:48 CEST 2009
- provide explicit functions to "cede" to the event loop in Coro::AnyEvent,
as this seems to have been a difficult concept (poll, sleep, idle,
idle_upto).
- add Coro::AnyEvent::readable/writable functions.
- clarify Coro::EV/Event/AnyEvent manpages.
- free per-thread global scalars in the thread calling ->cancel, to
avoid crashes when $_, $@ etc., are magical but some of those
spurious warnings.
- fix a lot of bugs in Coro::SemaphoreSet.
- Coro::SemaphoreSet will less often create a semaphore needlessly.
- add Coro::SemaphoreSet::count and wait methods.
- take advantage of the new Guard module.
- deprecate Coro::guard.
- try to fix the dreaded 01_unblock tests once more. I hate it when
testsuites need more fixing than the code they are supposed to test.
- croak in more cases when a required callback isn't resolvable.
- fix some minor issues in Coro::State->call/eval.
- use current coroutine context instead of a temporary one
when temporarily switching to another coroutine.
- do not call C-level on_destroy handlers during global destruction,
to avoid needless segfaults.
5.12 Sun Dec 7 13:30:38 CET 2008
- add default config for MirOS, which seems to be a bug-to-bug
compatible fork of openbsd ("world domination by releasing
openbsd cvs before the openbsd folks do it" or so :).
- free_padlist did destroy the names pad, not good, but didn't
seem to bother perl - this could fix issues such as eval ""
inside a function called from multiple coroutines.
- use a different method to detect destruction time.
- be more careful when freeing padlists just before global
destruction.
- fixed and expanded the call/cc example.
- renamed _terminate to _coro_run.
- new method Coro::Channel->shutdown.
- try pthreads on openbsd <4.4 (broken sigaltstack, will
pthreads fare better?).
- be less picky about destroying "a" running coroutine.
5.11 Tue Nov 25 21:49:05 CET 2008
- DEBUGGING in 5.10.0 is a mess: it constantly flags perfectly
working code with failed assertions, introducing more bugs than
it fixes, requiring elaborate workarounds :(
5.1 Mon Nov 24 08:54:59 CET 2008
- wrote a small introductory tutorial - Coro::Intro.
- convert Coro::Timer, Coro::Select and Coro::Util to rouse API.
- Coro::Select did errornously dup the file descriptors
and didn't work with all AnyEvent backends.
- Coro::Select wasn't imported correctly form Coro::LWP, causing blocking
LWP data transfers.
- disassociate c contexts from coro objects - this is agruably more
correct, but mostly allows sharing of cctxs between coro and state
objects, for added memory savings and speed increases.
- bumped $Coro::POOL_RSS up to 32kb by default.
- no longer set the optype to OP_CUSTOM, as B::* understandably
doesn't like this very much (and we *are* a type of entersub).
- implement state cloning, just to prove that call/cc can be done.
- automatically load Coro::AnyEvent in Coro::Handle.
- wrap ->cancel calls in eval inside Coro::Handle as EV watchers
do not have this method (and don't need it either).
- speed up generic anyevent methods in Coro::Handle by using rouse
callbacks.
- allow coroutines in $Coro::IDLE, speeding up Coro::AnyEvent and
others. It also makes the debugger happier, as you can trace
through the idle threads now.
- add comppad_name* and hints ($^H, %^H) to per-thread variables.
- eg/event was pretty broken.
- better 5.8.6 compatibility.
5.0 Thu Nov 20 10:35:05 CET 2008
- NEW ARCHITECTURE: use the latest 4.x version if you experience
stability issues.
- bump API version to 7 - all dependents must be recompiled.
- removed timed_* functions - they were not being used anyways
and should be replaced by a more generic mechanism -
and were annoying to support anyways :)
- removed SemaphoreSet's waiter method - use sem method instead.
- Coro::Semaphore->adjust didn't correctly wake up enough waiters.
- async_pool did free a scalar value twice
("Attempt to unreference...").
- fix a longstanding bug where calling terminate on a coro that
was waiting for a semaphore that was just becoming available
would cause a deadlock (semaphore would get into a state where
it was available but waiters were still blocked).
- calling throw on a coroutine that is waiting for a semaphore will
no longer make it acquire the semaphore (and thus leak a count).
- perl's process emulation is now not even theoretically supported
anymore.
- new functions Coro::rouse_cb and Coro::rouse_wait for easier
conversion of callback-style to blocking-style.
- new methods $coro->schedule_to and ->cede_to, to specifically
schedule or cede to a specific coroutine.
- new function Coro::Semaphore::wait.
- use named constants in Coro::Channel (Richard Hundt).
- directly patch the entersub opcode calling SLF functions (cede,
transfer and so on). this does speed up context switching, but
more importanly, it frees us from the hardcoded behaviour of
entersub, so we might actually be able to return something from
those functions and atcually create new ones.
- take advantage of __builtin_frame_address on gcc.
- expose THX in coroapi (not sure whether this was a wise decision,
as "threaded" perls are running at half speed anyways).
- implement execute_slf (schedule-like-function) interface that makes
it possible to implement schedule-like-functions in XS.
- use new SLF interface to massively speed up Coro::EV by roughly a
factor of two.
- used new SLF interface to massively speed up Coro::Semaphore by a
factor of three.
- used new SLF interface to speed up Coro::AIO by roughly a factor of
four and reduce its memory usage considerably.
- implement Coro::SemaphoreSet purely in terms of Coro::Semaphore,
for a nice speedup and vastly more correct behaviour. Also implement
a new method "sem" to get at the underlying semaphore object.
- implement Coro::Channel in terms of Coro::Semaphore, for a moderate
(in comparison) 20-40% speedup.
- used new SLF interface to reimplement Coro::Signal gaining
some unknown (because I was too lazy), but certain, speedup, and also
making signals reliable for the first time.
- used new SLF interface and other optimisations to speed up async_pool
by a factor of two. It also doesn't rely on perl's exception mechanism
to exit anymore. The overhead for terminating an async_pool, coro over
a normal async is now very small.
- sped up coroutine creation/destruction by 40%.
- forgot to include Coro/libcoro/README in the dist for all these years.
- work around a freebsd pthreads bug (manual testcancel is required as
pthread_cond_wait isn't a cancellation point on freebsd).
- use new rouse functions to speed up and simplify Coro::BDB.
- make "prefer perl native functions" work with threaded perls.
- condense Coro::Debug ps output, hint at v and w flags.
- (libcoro) lots of minor cleanups and portability improvements.
4.914 Wed Nov 19 12:54:18 CET 2008
- fix a disastrous bug in the readline optimisation
introduced in 4.801.
4.913 Sat Nov 15 07:58:28 CET 2008
- async_pool did free a scalar value twice
("Attempt to unreference...").
4.912 Thu Nov 13 18:31:23 CET 2008
- use much larger stacks on linux and perl < 5.8.8.
- Coro::Debug::new_unix_server did not unlink the socket
when destroyed.
4.911 Tue Nov 11 04:26:17 CET 2008
- "port" to threaded perls.
4.91 Mon Nov 10 05:36:38 CET 2008
- the ->throw exception object no longer leaks.
- creating a new cctx leaked a scopestack entry (memleak).
- new coroutines didn't get created with a zero flags field
(unknown impact).
- calling ->throw on a not-yet-started coroutine should now work
instead of being ignored.
- ->throw is now supported on Coro::State objects.
- clean up cctx creation code a bit.
- entersub is actually a UNOP, not a LOGOP (not a bugfix).
4.9 Sat Nov 8 17:45:27 CET 2008
- (libcoro) did not preserve rbp with CORO_ASM (we are getting there).
- (libcoro) no longer leak threads in the experimental pthread backend,
also speed it up considerably.
- (libcoro) do not rely on makecontext passing void *'s unscathed.
- fix compiletime dependencies on libcoro in the Makefile.
- cctx_count wasn't always updated properly.
- Coro::State::cctx_stacksize wasn't applied correctly.
- new function Coro::State::cctx_max_idle.
- the default max number of idle C contexts is now 4.
- (libcoro) try harder to get _setjmp/_longjmp.
- (libcoro) cleanup and extend the libcoro API to officially
allow the creation of empty source contexts.
- very experimental workaround for the totally broken netbsd platform.
- tried to hack around openbsd bugs.
4.804 Wed Nov 5 16:36:00 CET 2008
- Coro::Debug::new_unix_server would not create a non-blocking listening
socket, sometimes causing freezes.
- (libcoro) fix misaligned stack points for setjmp and assembly
methods, which can cause crashes on x86/x86_64 with a sufficiently
aggressive compiler.
- new function: Coro::Debug::new_tcp_server.
- move ->throw into the Coro class because it only works on coro objects.
4.803 Mon Nov 3 17:16:12 CET 2008
- (libcoro) use a global asm statement to become independent of gcc
otpimisations for CORO_ASM (thanks to pippijn for the idea).
- try to workaround yet another broken bsd, this time dragonfly.
4.802 Thu Oct 30 10:56:12 CET 2008
- support -fno-omit-frame-pointer on x86 with the assembly method.
- tune 01_unblock.t tests a bit.
4.801 Wed Oct 22 18:33:37 CEST 2008
- improve readline speed for very long "lines".
- backport to 5.8.8.
4.748 Sat Sep 27 14:03:19 CEST 2008
- implement, but do not document, PerlIO::cede(granularity).
- Coro::Storable forgot to wrap Storable::pstore.
- work around the multitude of leaks and memory corruption
bugs in PerlIO::via by using our own C-level perliol. As a side
effect, Coro::Storable is now much, much, much faster.
4.747 Tue Sep 23 01:59:41 CEST 2008
- fix a per-cv memleak (one empty array was leaked per
code reference).
- avoid a crash in coro->call|rss when the coroutine was already
destroyed (most noticably when using Coro::Debug::ps :)
- also protect *Storable::FILE.
- push up default storable granularity to 20ms.
4.746 Sun Sep 21 03:22:20 CEST 2008
- be more insistent on locking Storable against reentrancy
in Coro::Storable.
- move swap_def?v and throw to Coro::State, as documented.
4.745 Thu Jul 24 00:14:38 CEST 2008
- switch to "s" method on all bsd's by default, as their ucontext
stuff seems just too broken.
- fix a bug in Coro::Select.
4.74 Thu May 29 20:05:31 CEST 2008
- do not test Coro::LWP for lack of dependencies.
- do not test Coro::Select for lack of working perls.
4.73 Thu May 29 2008
- fix a bug in Coro::EV which would cause it to block despite
there being runnable coroutines.
- sprinkle "no warnings" freely over everything, also suppress
warnings for some other modules.
- fix typo in WSAEWOULDBLOCK.
4.72 Sun May 25 05:14:36 CEST 2008
- tweak META.yaml a bit, unfortunately, there is no documented way
to have optional dependencies with CPAN. doh :(
- avoid running some tests on windows because they would fail due to
perl bug (broken fork, broken pipes...).
- work around perl on windows bugs where perl returns undocumented
- fix a bug in Coro::AnyEvent ("Usage: Coro::AnyEvent::_schedule()").
- take advantage of async name resolution of AnyEvent::Util.
- work around brutal inet_aton override in Coro::LWP.
- take advantage of the readyhook in Coro::EV, for smoother
scheduling.
4.7 Sun May 11 00:32:19 CEST 2008
- completely reworked the Coro manpage.
- added Coro::AnyEvent, generic event loop integration.
- implement cancel, ready and kill commands in Coro::Debug.
- document find_coro in Coro::Debug.
- incompatible change: rename has_stack to has_cctx.
- Coro::AIO and Coro::BDB no longer force event model detection,
use AnyEvent::AIO and AnyEvent::BDB.
4.6 Sat Apr 26 10:05:14 CEST 2008
- INCOMPATIBLE CHANGE: sub/code attributes are no longer supported
by the Coro module. It was a mistake to have it in the first place.
- (experimental) support for activestate perl 5.10 (method "w").
- (experimental) support for strawberry perl (method "a").
- coro_sigelem_set did not return a value although it had to,
actual impact unknown.
4.51 Mon Apr 14 13:28:27 CEST 2008
- make it compile again on 5.8.
4.50 Thu Apr 10 09:43:17 CEST 2008
- I did it twice! (see 4.49).
4.49 Sun Apr 6 21:23:31 CEST 2008
- grr, instead of compiling the recent changes on 5.10 only they
were compiled on 5.8 only.
4.48 Sun Apr 6 20:36:46 CEST 2008
- allow coroutine switches during eval's under 5.10.x, as it seems
the parser is a per-interpreter option now, so this is safe
(this might fix the odd crashing bug).
- drop support for 5.9.x versions: they are dead, jim.
4.47 Sun Apr 6 00:37:52 CEST 2008
- force cctx allocation on API calls: we know we need to force one
and gcc actually manages to confuse our heuristic nowadays,
leading to crashes and worse.
- document force_cctx.
4.46 Fri Apr 4 22:05:43 CEST 2008
- upgrade libcoro, resulting in pthread-backend (which was only created
to fulfill the rules of the programming languages shootout).
4.45 Thu Mar 13 11:55:36 CET 2008
- fix a file leaking bug in eg/mhyttpd that would allow
downloading of any file (reported by oesi).
- fix deadlock bug in Coro::Channel (reported by Richard Hundt)
(also add testcase).
- support Broadcast option in Coro::Socket (patch by Richard Hundt,
apparently having loads of fun with that).
- implement $state->swap_defsv, ->swap_defav and document ->throw.
"Coro::State::transfer called while parsing" in many cases).
4.36 Sun Jan 13 10:53:56 CET 2008
- reset diehook when terminating from an async_pool as to not
trigger any __DIE__ handlers.
4.35 Sun Jan 13 04:14:13 CET 2008
- "bt" debug command now displays any exceptions
from longmess and also skips the innermost
stackframes, giving more useufl output.
- allow backtraces in coroutines blocked in Coro::EV,
at a <1% speed hit.
- handle localising of $SIG{__WARN__} and __DIE__
properly (with a proper amount of dirty hacking).
4.34 Sat Dec 22 17:49:53 CET 2007
- upgrade to EV version 2.0 API.
4.33 Mon Dec 17 08:36:12 CET 2007
- make Coro::AIO etc. loadable in the absence of EV.
4.22 Fri Nov 30 16:04:04 CET 2007
- really use optimised versions for Event and EV in Coro::Util
and Coro::Handle.
4.21 Sun Nov 25 10:48:59 CET 2007
- fix a spurious memory read.
- Coro::EV no longer keeps the eventloop "alive".
4.2 Fri Nov 9 20:47:05 CET 2007
- enable/disable tracing from a new coroutine, not a pooled one.
- fix a memleak in Coro::Event.
- removed killall call from fork_eval.
- made sure store_fd is already loaded so that fork_eval
does not have to parse autoload in each subprocess.
- only use assembly method if -O switch is in $Config{optimize}.
- add (optional) Coro::EV module, so far the best event loop module
directly supported by Coro.
- if the event model is EV, use EV::DNS to resolve
stuff in Coro::Util.
- don't get confused by multiple event notifications in Coro::Handle.
- initial support for EV (libevent interface).
- require Event and EV using configure_requires, to force their existance.
4.13 Wed Oct 24 07:26:45 CEST 2007
- add Coro::Storable::blocking_thaw.
- use a vastly more complicated technique to localise
$SIG{__WARN/DIE__} that also works on perls <= 5.8.8.
- use a coroutine for the idle callback Coro::Event,
instead of running Event in the current coroutine context.
This also catches recursive invocations.
- actually report fork errors in gethostbyname and inet_aton.
4.11 Thu Oct 11 02:40:24 CEST 2007
- port to threaded perls.
4.1 Thu Oct 11 02:38:16 CEST 2007
- incompatible change: $SIG{__DIE__} and $SIG{__WARN__} will now
be local to each coro (see Coro::State).
- incompatible change: for very deep reasons, cede and cede_notself
cannot return anything, so nothing will be returned.
- possibly bring back 5.10 compatibility (untested).
- work around stupid (and wrong) warning on 5.10 :(.
- overlay the saved state over the context stack. This saves
a few hundred bytes per coroutine on average and also
speeds up context switching a bit.
- further tune default stack sizes.
- (more) correctly calculate stack usage in coro_rss.
- Coro::Storable::blocking_* did not properly lock
resulting in races between coroutines.
- added Coro::Storable::guard.
- stopping to trace a coroutine could destroy the cctx of
an unrelated coroutine.
- explain the relationship between Perl and C coroutines in
more detail in Coro::State.
- Coro::Util::inet_aton did not short-circuit dotted quad forms,
causing a fork per resolve. This also affected Coro::Socket.
- switch to a separate stack in $coro->call/eval to avoid
invalidating pointers.
4.03 Sat Oct 6 21:24:00 CEST 2007
- added Coro::throw method.
- minor code cleanups.
4.02 Sat Oct 6 02:36:47 CEST 2007
- fix a very minor per-coroutine memleak (a single codereference).
- fixed a bug where the currently in-use c context would be freed
prematurely (can happen only when programs change the stacksize
or use tracing).
- tracing can no longer keep a coro alive after it terminated.
- do static branch prediction in the common path for gcc. gives
about 2-5% speed improvement here.
4.01 Fri Oct 5 22:10:49 CEST 2007
- instead of recreating *a* standard output handle we simply
use STDOUT, which is faster and hopefully more robust.
4.0 Fri Oct 5 12:56:00 CEST 2007
- incompatibly changed Coro::Storable::freeze.
- major new feature: added Coro::Debug, for interactive coroutine
debugging, tracing and much more.
- major bug fix: unbelievable, but true: $_, $/ and many other
"saved" variables actually weren't being saved. This has been fixed,
of course, while increasing performance while losing all the save
flags.
- save flags are gone, and all the api functions dealing with them.
- added Coro::Semaphore::adjust.
- added Coro::Util::fork_eval.
- added Coro::Storable::{nfreeze,blocking_{freeze,nfreeze}}.
- added Coro::killall.
- reduce initial stack sizes to allow for "micro-coroutines".
- better async_pool resource management, moved parts of async_pool
handling to XS (major speed improvement).
- actually croak before modifying important data structures.
- refuse to transfer while compiling.
- possibly support eval EXPR better now.
- enable assembly per default on linux+bsd x86+amd64.
- all internal members were renamed _something for easier subclassing.
- many minor tweaks.
3.63 Wed May 16 14:10:06 CEST 2007
- implement handcoded assembly for x86/amd64 SVR ABI.
3.62 Fri Apr 27 21:36:06 CEST 2007
- upgrade libcoro (which might set unwind info correctly).
- change default on linux to setjmp/longjmp.
3.61 Thu Apr 19 12:36:18 CEST 2007
- Coro::Storable caused an endless loop when thawing invalid
pst's sometimes.
- use a Semaphore in Coro::Storable, as Storable doesn't
seem to be reentrant (although it is documented to
be threadsafe...).
- fix Coro::Signal to bring back the original unreliable
but stateful semantics.
- fixed a lot of typos in Coro.pm (patch submitted by David
Steinbrunner, which applied flawlessly).
3.6 Sat Apr 14 17:13:31 CEST 2007
- added some bugfixes to get eg/myhttpd working again.
- added Coro::Storable for often-cede'ing freeze/thaw.
- try to do a clean exit when a coroutine calls exit
(EXPERIMENTAL).
- got rid of indirect call through _coro_init.
- updated the partly antique examples in eg/ to
work again and be a bit less magic, too.
- fixed Coro::Signal semantics to work as documented again.
3.55 Sun Mar 25 01:20:47 CET 2007
- add SAVE_DEFFH to save the default filehandle and enable
it by default.
- finally move socket-operations from Coro::Socket to Coro::Handle
to be able to unblock foreign sockets.
- add Coro::State::save_also and guarded_save.
3.501 Wed Feb 28 12:44:07 CET 2007
- rename some global symbols as macosx from hell redefines
them without asking.
3.5 Tue Feb 13 20:22:53 CET 2007
- do AnyEvent model detection earlier, avoiding problems
caused by first using AnyEvent and later Coro::Event.
- implement and document Coro::Event event objects.
- fix a potential problem in Coro::Event causing crashes.
- initialise PL_comppad when creating a new coroutine,
avoids crashes on early coro destruction.
3.41 Mon Jan 22 19:19:49 CET 2007
- readline on Coro::Handle did not support undefined $/,
nor did it deliver partial lines on EOF or error.
- implement malloc fallback for stack allocation because
stupid broken idiotic OSX has a stupid broken
idiotic fits-the-whole-os mmap "implementation" and
my dick feels longer if Coro is portable even to
obsolete platforms.
3.4 Fri Jan 19 21:52:54 CET 2007
- remove t/09_timer.t, as it isn't really testing much
but was rather flaky in practise.
- async_pool coro would keep arguments and callback alive until
it was reused.
- cancellation of a coroutine could cause spurious idle calls
in cede_notself.
3.3 Sat Jan 6 03:45:00 CET 2007
- implement $coro->on_destroy.
- Coro::Event blocking semantics have been changed,
documented and - hopefully - improved.
- fix nice adding, not subtracting, from priority.
- fix ->prio and api_is_ready (patch by Mark Hinds).
- fixed an assert ("... == prev__cctx->idle_te")
that could errronously trigger.
- fix various large and small memleaks.
- use a (hopefully) more stable cancel implementation
that immediately frees the coroutine data.
- cede/cede_notself return a status now.
- added Coro::guard function.
- added a global coroutine pool for jobs (on my machine,
I can create and execute 48k simple coros/s with async,
and 128k coros with async_pool).
- Coro::AIO now uses the coroutine priority as io priority.
3.2 Fri Dec 22 05:07:09 CET 2006
- improve portability to slightly older perls.
- use cleaner coroutine destruction.
- simplify configuration for users.
- optionally (unrecommended) prefer perl functions over
their coro replacements.
3.11 Tue Dec 5 13:11:24 CET 2006
- fixed some bogus assert's, but as perl.h disables assert even
without NDEBUG (thank you very much), not too many people should
notice (that did include myself). Andreas König noticed, though :)
- do not save/restore PL_sortcxix on >= 5.9.x, it doesn't seem to have
it. Also noticed by Andreas König :)
- save/restore tainted status.
- verified to pass the testsuite on my 5.9.5.
3.1 Mon Dec 4 23:03:40 CET 2006
- INCOMPATIBLE CHANGE: $/ is now per-coroutine (but slow).
- incompatible change: transfer flags are now per-state.
- give a better error message on deadlock.
- document Coro::nready.
- enhanced testsuite.
3.01 Sun Dec 3 23:47:42 CET 2006
- forgot to include Coro::Timer.
3.0 Sun Dec 3 22:57:25 CET 2006
- the "FINALLY COMPLETELY STABLE" release (coming soon:
the "FAMOUS LAST WORDS" release).
- implement a new stack sharing algorithm, which uses a stack
pool (size currently hardcoded).
- make stack sharing mandatory (it no longer uses a heuristic).
- eval/die no longer cause weird problems under heavy use.
- Coro::Event could cause livelocks if it was used but
no Coro::Event watchers were used.
- Coro::Event now uses asynccheck as prepare does not
check for changed watchers.
- Coro::Event allows multiple waiting coros and will wake up one
per event.
- Coro::Event should be cleaner and more efficient now.
- new utility function Coro::unblock_sub.
- document the sad fact that Event is no longer reentrant.
- putting a coroutine into the ready queue twice could under
some circumstances lead to stack corruption.
- minor incompatibility: subclassing Coro::State is supported
directly now without going through a _coro_state member.
- state/coro switching is much faster now.
- very minor optimisations and code/documentation cleanup.
- avoid problems due to compiler inlining.
- removed timers from Coro::Timer -> use AnyEvent instead.
- replaced Coro::idle coroutine by (cleaner) idle handler.
- updated to newest libcoro.
- implement enhanced support for valgrind.
- implement is_ready and return value for ready.
- removed Coro::Cont, it was a misnomer (it's generators),
and it was somewhat annoying to get it right. Will come back
if somebody asks for it :)
- many ->wait methods and Coro::Event could return
spuriously without the event having happened.
2.5 Tue Nov 7 12:22:33 CET 2006
- made Coro::Util, Coro::Select, Coro::Handle and Coro::Socket
use AnyEvent, moved them to Coro/.
- added Coro::LWP which contains all the uglyness required to
make LWP non-blocking.
- should work with perl 5.9.x now (Andreas König made me do it).
- fixed another bug in Coro::Select when the timeout was undef.
- reuse PL_start_env for all coros, saves some memory per coroutine.
- manage PL_top_env differently, hopefully to avoid panic: top_env.
- timeout argument was not properly used in Coro::Socket.
- allow limited forms of subclassing in Coro::Handle/Coro::Socket.
- emulate undocumented(!) functionality of IO::Socket required
by LWP(!!).
- updated eg/lwp to work with newer lwp's.
- remove "FATAL: uncaught exception" prefix. Coroutines that die
kill the whole process, just as exceptions in the main "coroutine"
did already.
2.1 Wed Nov 1 23:01:13 CET 2006
- fix a long-standing bug in Coro::Select where select with
zero timeout would instead change the current default filehandle.
- use a simpler and hopefully more robust way to clone padlists
(uses less memory and a perl function instead of our own).
- coro can now create a stack guard area on many architectures.
- Coro::AIO properly reexports additional functions from IO::AIO.
- updated libcoro with a workaround for OS X,
pach and testing by Michael Schwern.
2.0 Tue Oct 24 05:47:17 CEST 2006
- support additional aio requests in Coro::AIO.
1.9 (never properly released due to a glitch)
1.8 Thu Feb 2 00:59:06 CET 2006
- applied suggested patch by SAMV to avoid problems during stupid
mark & sweep gc run.
normally uses.
- make stacksize configurable for the ultimate debian experience.
1.51 Mon Dec 12 18:48:36 CET 2005
- remove debugging warn() accidentally left in Coro::Select.
1.5 Tue Nov 29 13:32:44 CET 2005
- use Coro::Event inside Coro::Select to avoid spurious deadlocks.
- fix Coro::Select 'select'.
- strict'ify some modules.
- libcoro errornously restored the SIGUSR2 handler to SIGUSR1.
- use XSLoader in selected modules.
- remove some 5.6 compatibility cruft.
1.4 Tue Sep 6 00:11:05 CEST 2005
- libcoro did not take into account the trampoline on amd64,
when 'l'inux method was used.
1.31 Tue Aug 30 23:31:33 CEST 2005
- some portability fixes/workarounds.
1.3 Sat Aug 20 03:08:56 CEST 2005
- no code changes. module seems to work fine.
- improve Coro::State docs, remove reference to nonexisting
Coro::State::flush method.
- no longer autodetect windows, present it as an option instead.
1.2 Mon May 16 02:00:55 CEST 2005
- included libcoro.c earlier in State.xs, might improve portability.
- use a faster and possibly more stable Coro::Cont implementation.
- accept x86_64 in addition to amd64 for optimized linux-amd64 support.
- fix bugs Coro::SemaphoreSet that could cause locks never to be freed.
- fix bugs in CoroAPI.h and document it in Coro::MakeMaker.
1.11 Thu Mar 3 18:00:52 CET 2005
- change of contact address.
1.1 Tue Feb 22 20:51:16 CET 2005
- support [l]inux method on amd64.
0.8 Wed Nov 5 19:38:40 CET 2003
- port to perl5.005_03, but only 5.8.x+ is supported!
- honor LocalAddr even without LocalPort in Coro::Socket.
0.7 Tue May 27 03:12:38 CEST 2003
- the version jump indicates some level of testing, not gobs
of new features.
- uh... I found the prompt function in ExtUtils::MakeMaker.
Highly correct stuff, that is...
- fixed(?) a bug with die's in coroutines causing "panic: top_env".
the fix is not well understood by the author, so beware :(.
0.652 Thu May 8 02:54:46 CEST 2003
- Applied patch by Slaven Rezic to set default to "s" on FreeBSD,
cause version 4 doesn't have ucontext.
- Benjamin Reed reported that setjmp works fine on darwin,
so preselect it.
0.651 Sat Mar 29 15:00:23 CET 2003
- fix a bug in Coro::Handle where some bytes could get lost
- Coro::Timer (independent of Event).
- new timed_wait functions for Coro::Signal, Semaphore, SemaphoreSet.
0.52 Tue Nov 6 21:36:18 CET 2001
- ported to cygwin (trivial).
patch by Gerrit P. Haase <gp@familiehaase.de>.
- small setjmp code fix by Sullivan.DanielJ@epamail.epa.gov.
0.51 Thu Nov 1 20:39:01 CET 2001
- terminate/cancel now work properly (otherwise termination
could cause a "next coroutine is not and contains not..."
error.
- added Coro::Socket::shutdown.
- Coro::Event::loop no is the same as Event::loop.
- implemented terminate with args + join.
0.5 Fri Sep 28 16:15:35 CEST 2001
- fixed "print" on a Coro::Handle. The print method worked.
- small tweaks (seem to reduce memory consumption a lot)
in various modules.
- splendid use of "no warnings" scattered throughout.
- added Coro::Handle::rbuf, fixed Coro::Handle::fh.
0.49 Sun Sep 16 02:42:45 CEST 2001
- changed some method calls to function calls for speed
inside Coro::Handle.
- make Coro::Handle use an array instead of a hash for
speed reasons.
- IRIX mystery solved: it's SGI's NT, after all: "standard, huh?".
sjlj and ucontext should now work.
- IRIX-specific port for libcoro.
- swapped order of accept results to match IO::Socket.
- changed getsock/peername to sock/peername to match IO::Socket.
- fixed a bug that caused segfault when returning to main task
under some circumstances.
- other bugfixes.
0.45 Sun Sep 2 02:54:01 CEST 2001
- new method Coro::Handle::timeout.
- corrected speling of set...name to get...name in Coro::Socket.
- Coro::Socket::accept now returns a Coro::Socket, not a Coro::Handle.
0.11 Tue Jul 24 22:49:21 CEST 2001
- added specialized hack for newer and older linux versions (fast).
- renamed Coro::Event::IO to Coro::Handle.
- new module Coro::Socket.
0.1 Tue Jul 24 01:47:53 CEST 2001
- release candidate 3. A rather new internal structure :(
- the great renaming: Damian Conway gave me a suitable replacement
for yield.
- added Coro/libcoro, a portable coroutine implementation for C
(not even perl-dependent!!!), which can be used by Coro::State.
- renamed SAVE_DEFSV (on xs-level only) to avoid symbol clash in
perl-5.6.
- new function Coro::Event::idle.
- the idle process is now overriden
by default in Coro::Event.
- Coro::Channel now enforces the size.
- canceling events now works in all cases.
- Coro state now include $_ and $@.
- yet another bug workaround that I do not really understand :(
- continuations have a saner syntax.
- no more memleaks.
0.07 Tue Jul 17 17:40:18 CEST 2001
- release candidate 1 ;)
- slightly nicer code.
- fixed a scheduling bug in Coro::Event.
0.06 Tue Jul 17 04:23:24 CEST 2001
- ok, I found the showstopper - the same sub must not be
re-entered in two different coroutines, otherwise => crash. I
see no easy solution to this problem, except by walking the call
chaing and saving/restoring the cv's, which is what I do now.
- memory leaks still latent, especially at thread termination.
- Coro::Event now works (haha).
0.05 Sun Jul 15 17:32:20 CEST 2001
- fixed a few issues in Coro::Event.
- I forgot to include Coro::Event in 0.04 :(:(:(
0.04 Sun Jul 15 05:24:59 CEST 2001
- @_ is now properly localized.
- Coro::State is now easier subclassable.
- Coro::Cont now coroutine-aware.
- Coro::Specific is a low-overhead module to create
coroutine-specific vars.
- Coro::Event provides a simple interface to Event.
0.03 Fri Jul 13 14:51:52 CEST 2001
- transfer() now implemented in XS (beware).
- new module Coro::Cont for really faked continuations.
- big internal architecture changes: Coro::State is now
really low-level and can thus be used to implement other
interesting things, While "Coro::" implements a process-like
model. Still crude and subject to change.
- $_ and $@ are no longer being localized.
use Coro;
async {
# some asynchronous thread of execution
print "2\n";
cede; # yield back to main
print "4\n";
};
print "1\n";
cede; # yield to coro
print "3\n";
cede; # and again
# use locking
my $lock = new Coro::Semaphore;
my $locked;
$lock->down;
$locked = 1;
$lock->up;
=head1 DESCRIPTION
For a tutorial-style introduction, please read the L<Coro::Intro>
manpage. This manpage mainly contains reference information.
This module collection manages continuations in general, most often in
the form of cooperative threads (also called coros, or simply "coro"
in the documentation). They are similar to kernel threads but don't (in
general) run in parallel at the same time even on SMP machines. The
specific flavor of thread offered by this module also guarantees you that
it will not switch between threads unless necessary, at easily-identified
points in your program, so locking and parallel access are rarely an
issue, making thread programming much safer and easier than using other
thread models.
Unlike the so-called "Perl threads" (which are not actually real threads
but only the windows process emulation (see section of same name for
more details) ported to UNIX, and as such act as processes), Coro
provides a full shared address space, which makes communication between
threads very easy. And coro threads are fast, too: disabling the Windows
process emulation code in your perl and using Coro can easily result in
a two to four times speed increase for your programs. A parallel matrix
multiplication benchmark (very communication-intensive) runs over 300
times faster on a single core than perls pseudo-threads on a quad core
using all four cores.
Coro achieves that by supporting multiple running interpreters that share
data, which is especially useful to code pseudo-parallel processes and
for event-based programming, such as multiple HTTP-GET requests running
concurrently. See L<Coro::AnyEvent> to learn more on how to integrate Coro
In this module, a thread is defined as "callchain + lexical variables +
some package variables + C stack), that is, a thread has its own callchain,
its own set of lexicals and its own set of perls most important global
variables (see L<Coro::State> for more configuration and background info).
See also the C<SEE ALSO> section at the end of this document - the Coro
module family is quite large.
=head1 CORO THREAD LIFE CYCLE
During the long and exciting (or not) life of a coro thread, it goes
through a number of states:
=over 4
=item 1. Creation
The first thing in the life of a coro thread is it's creation -
obviously. The typical way to create a thread is to call the C<async
BLOCK> function:
async {
# thread code goes here
};
You can also pass arguments, which are put in C<@_>:
async {
print $_[1]; # prints 2
} 1, 2, 3;
This creates a new coro thread and puts it into the ready queue, meaning
it will run as soon as the CPU is free for it.
C<async> will return a Coro object - you can store this for future
reference or ignore it - a thread that is running, ready to run or waiting
for some event is alive on it's own.
Another way to create a thread is to call the C<new> constructor with a
code-reference:
new Coro sub {
# thread code goes here
}, @optional_arguments;
This is quite similar to calling C<async>, but the important difference is
that the new thread is not put into the ready queue, so the thread will
not run until somebody puts it there. C<async> is, therefore, identical to
this sequence:
my $coro = new Coro sub {
# thread code goes here
};
$coro->ready;
return $coro;
=item 2. Startup
When a new coro thread is created, only a copy of the code reference
and the arguments are stored, no extra memory for stacks and so on is
allocated, keeping the coro thread in a low-memory state.
Only when it actually starts executing will all the resources be finally
allocated.
The optional arguments specified at coro creation are available in C<@_>,
similar to function calls.
=item 3. Running / Blocking
A lot can happen after the coro thread has started running. Quite usually,
it will not run to the end in one go (because you could use a function
instead), but it will give up the CPU regularly because it waits for
external events.
As long as a coro thread runs, its Coro object is available in the global
variable C<$Coro::current>.
The low-level way to give up the CPU is to call the scheduler, which
selects a new coro thread to run:
Coro::schedule;
Since running threads are not in the ready queue, calling the scheduler
without doing anything else will block the coro thread forever - you need
to arrange either for the coro to put woken up (readied) by some other
event or some other thread, or you can put it into the ready queue before
scheduling:
# this is exactly what Coro::cede does
$Coro::current->ready;
Coro::schedule;
All the higher-level synchronisation methods (Coro::Semaphore,
Coro::rouse_*...) are actually implemented via C<< ->ready >> and C<<
Coro::schedule >>.
While the coro thread is running it also might get assigned a C-level
thread, or the C-level thread might be unassigned from it, as the Coro
runtime wishes. A C-level thread needs to be assigned when your perl
thread calls into some C-level function and that function in turn calls
perl and perl then wants to switch coroutines. This happens most often
when you run an event loop and block in the callback, or when perl
itself calls some function such as C<AUTOLOAD> or methods via the C<tie>
mechanism.
=item 4. Termination
Many threads actually terminate after some time. There are a number of
ways to terminate a coro thread, the simplest is returning from the
top-level code reference:
async {
# after returning from here, the coro thread is terminated
};
async {
return if 0.5 < rand; # terminate a little earlier, maybe
print "got a chance to print this\n";
# or here
};
Any values returned from the coroutine can be recovered using C<< ->join
>>:
my $coro = async {
"hello, world\n" # return a string
};
my $hello_world = $coro->join;
print $hello_world;
Another way to terminate is to call C<< Coro::terminate >>, which at any
subroutine call nesting level:
async {
Coro::terminate "return value 1", "return value 2";
};
Yet another way is to C<< ->cancel >> (or C<< ->safe_cancel >>) the coro
thread from another thread:
my $coro = async {
exit 1;
};
$coro->cancel; # also accepts values for ->join to retrieve
Cancellation I<can> be dangerous - it's a bit like calling C<exit> without
actually exiting, and might leave C libraries and XS modules in a weird
state. Unlike other thread implementations, however, Coro is exceptionally
safe with regards to cancellation, as perl will always be in a consistent
state, and for those cases where you want to do truly marvellous things
with your coro while it is being cancelled - that is, make sure all
cleanup code is executed from the thread being cancelled - there is even a
C<< ->safe_cancel >> method.
So, cancelling a thread that runs in an XS event loop might not be the
best idea, but any other combination that deals with perl only (cancelling
when a thread is in a C<tie> method or an C<AUTOLOAD> for example) is
safe.
Last not least, a coro thread object that isn't referenced is C<<
->cancel >>'ed automatically - just like other objects in Perl. This
is not such a common case, however - a running thread is referencedy by
C<$Coro::current>, a thread ready to run is referenced by the ready queue,
a thread waiting on a lock or semaphore is referenced by being in some
wait list and so on. But a thread that isn't in any of those queues gets
cancelled:
async {
schedule; # cede to other coros, don't go into the ready queue
};
cede;
# now the async above is destroyed, as it is not referenced by anything.
A slightly embellished example might make it clearer:
async {
my $guard = Guard::guard { print "destroyed\n" };
schedule while 1;
my $sem = new Coro::Semaphore;
async {
my $lock_guard = $sem->guard;
# if we return, or die or get cancelled, here,
# then the semaphore will be "up"ed.
};
The C<Guard::guard> function comes in handy for any custom cleanup you
might want to do (but you cannot switch to other coroutines from those
code blocks):
async {
my $window = new Gtk2::Window "toplevel";
# The window will not be cleaned up automatically, even when $window
# gets freed, so use a guard to ensure it's destruction
# in case of an error:
my $window_guard = Guard::guard { $window->destroy };
# we are safe here
};
Last not least, C<local> can often be handy, too, e.g. when temporarily
replacing the coro thread description:
sub myfunction {
local $Coro::current->{desc} = "inside myfunction(@_)";
# if we return or die here, the description will be restored
}
=item 6. Viva La Zombie Muerte
Even after a thread has terminated and cleaned up its resources, the Coro
async {
print "hi\n";
1
};
# run the async above, and free everything before returning
# from Coro::cede:
Coro::cede;
{
my $coro = async {
print "hi\n";
1
};
# run the async above, and clean up, but do not free the coro
# object:
Coro::cede;
# optionally retrieve the result values
my @results = $coro->join;
# now $coro goes out of scope, and presumably gets freed
};
=back
=cut
package Coro;
use common::sense;
use Carp ();
use Guard ();
use Coro::State;
use base qw(Coro::State Exporter);
our $idle; # idle handler
our $main; # main coro
our $current; # current coro
our $VERSION = 6.514;
our @EXPORT = qw(async async_pool cede schedule terminate current unblock_sub rouse_cb rouse_wait);
our %EXPORT_TAGS = (
prio => [qw(PRIO_MAX PRIO_HIGH PRIO_NORMAL PRIO_LOW PRIO_IDLE PRIO_MIN)],
);
our @EXPORT_OK = (@{$EXPORT_TAGS{prio}}, qw(nready));
=head1 GLOBAL VARIABLES
=over 4
=item $Coro::main
This variable stores the Coro object that represents the main
program. While you can C<ready> it and do most other things you can do to
coro, it is mainly useful to compare again C<$Coro::current>, to see
whether you are running in the main program or not.
=cut
# $main is now being initialised by Coro::State
=item $Coro::current
The Coro object representing the current coro (the last
coro that the Coro scheduler switched to). The initial value is
C<$Coro::main> (of course).
This variable is B<strictly> I<read-only>. You can take copies of the
value stored in it and use it as any other Coro object, but you must
not otherwise modify the variable itself.
=cut
sub current() { $current } # [DEPRECATED]
pretty low-level functionality.
This variable stores a Coro object that is put into the ready queue when
there are no other ready threads (without invoking any ready hooks).
The default implementation dies with "FATAL: deadlock detected.", followed
by a thread listing, because the program has no other way to continue.
This hook is overwritten by modules such as C<Coro::EV> and
C<Coro::AnyEvent> to wait on an external event that hopefully wakes up a
coro so the scheduler can run it.
See L<Coro::EV> or L<Coro::AnyEvent> for examples of using this technique.
=cut
# ||= because other modules could have provided their own by now
$idle ||= new Coro sub {
require Coro::Debug;
die "FATAL: deadlock detected.\n"
. Coro::Debug::ps_listing ();
};
# this coro is necessary because a coro
# cannot destroy itself.
our @destroy;
our $manager;
$manager = new Coro sub {
while () {
_destroy shift @destroy
while @destroy;
&schedule;
}
};
$manager->{desc} = "[coro manager]";
$manager->prio (PRIO_MAX);
=back
=head1 SIMPLE CORO CREATION
=over 4
=item async { ... } [@args...]
Create a new coro and return its Coro object (usually
unused). The coro will be put into the ready queue, so
it will start running automatically on the next scheduler run.
The first argument is a codeblock/closure that should be executed in the
coro. When it returns argument returns the coro is automatically
terminated.
The remaining arguments are passed as arguments to the closure.
See the C<Coro::State::new> constructor for info about the coro
environment in which coro are executed.
Calling C<exit> in a coro will do the same as calling exit outside
the coro. Likewise, when the coro dies, the program will exit,
just as it would in the main program.
If you do not want that, you can provide a default C<die> handler, or
simply avoid dieing (by use of C<eval>).
Example: Create a new coro that just prints its arguments.
async {
print "@_\n";
} 1,2,3,4;
=item async_pool { ... } [@args...]
Similar to C<async>, but uses a coro pool, so you should not call
terminate or join on it (although you are allowed to), and you get a
coro that might have executed other code already (which can be good
or bad :).
On the plus side, this function is about twice as fast as creating (and
destroying) a completely new coro, so if you need a lot of generic
coros in quick successsion, use C<async_pool>, not C<async>.
The code block is executed in an C<eval> context and a warning will be
issued in case of an exception instead of terminating the program, as
C<async> does. As the coro is being reused, stuff like C<on_destroy>
will not work in the expected way, unless you call terminate or cancel,
which somehow defeats the purpose of pooling (but is fine in the
exceptional case).
The priority will be reset to C<0> after each run, all C<swap_sv> calls
will be undone, tracing will be disabled, the description will be reset
and the default output filehandle gets restored, so you can change all
these. Otherwise the coro will be re-used "as-is": most notably if you
change other per-coro global stuff such as C<$/> you I<must needs> revert
that change, which is most simply done by using local as in: C<< local $/
>>.
The idle pool size is limited to C<8> idle coros (this can be
adjusted by changing $Coro::POOL_SIZE), but there can be as many non-idle
coros as required.
If you are concerned about pooled coros growing a lot because a
single C<async_pool> used a lot of stackspace you can e.g. C<async_pool
{ terminate }> once per second or so to slowly replenish the pool. In
addition to that, when the stacks used by a handler grows larger than 32kb
(adjustable via $Coro::POOL_RSS) it will also be destroyed.
=cut
our $POOL_SIZE = 8;
our $POOL_RSS = 32 * 1024;
our @async_pool;
warn $@ if $@;
}
}
=back
=head1 STATIC METHODS
Static methods are actually functions that implicitly operate on the
current coro.
=over 4
=item schedule
Calls the scheduler. The scheduler will find the next coro that is
to be run from the ready queue and switches to it. The next coro
to be run is simply the one with the highest priority that is longest
in its ready queue. If there is no coro ready, it will call the
C<$Coro::idle> hook.
Please note that the current coro will I<not> be put into the ready
queue, so calling this function usually means you will never be called
again unless something else (e.g. an event handler) calls C<< ->ready >>,
thus waking you up.
This makes C<schedule> I<the> generic method to use to block the current
coro and wait for events: first you remember the current coro in
a variable, then arrange for some callback of yours to call C<< ->ready
>> on that once some event happens, and last you call C<schedule> to put
yourself to sleep. Note that a lot of things can wake your coro up,
so you need to check whether the event indeed happened, e.g. by storing the
status in a variable.
See B<HOW TO WAIT FOR A CALLBACK>, below, for some ways to wait for callbacks.
=item cede
"Cede" to other coros. This function puts the current coro into
the ready queue and calls C<schedule>, which has the effect of giving
up the current "timeslice" to other coros of the same or higher
priority. Once your coro gets its turn again it will automatically be
resumed.
This function is often called C<yield> in other languages.
=item Coro::cede_notself
Works like cede, but is not exported by default and will cede to I<any>
coro, regardless of priority. This is useful sometimes to ensure
progress is made.
=item terminate [arg...]
Terminates the current coro with the given status values (see
L<cancel>). The values will not be copied, but referenced directly.
=item Coro::on_enter BLOCK, Coro::on_leave BLOCK
These function install enter and leave winders in the current scope. The
enter block will be executed when on_enter is called and whenever the
current coro is re-entered by the scheduler, while the leave block is
executed whenever the current coro is blocked by the scheduler, and
also when the containing scope is exited (by whatever means, be it exit,
die, last etc.).
I<Neither invoking the scheduler, nor exceptions, are allowed within those
BLOCKs>. That means: do not even think about calling C<die> without an
eval, and do not even think of entering the scheduler in any way.
Since both BLOCKs are tied to the current scope, they will automatically
be removed when the current scope exits.
These functions implement the same concept as C<dynamic-wind> in scheme
does, and are useful when you want to localise some resource to a specific
coro.
They slow down thread switching considerably for coros that use them
(about 40% for a BLOCK with a single assignment, so thread switching is
still reasonably fast if the handlers are fast).
These functions are best understood by an example: The following function
will change the current timezone to "Antarctica/South_Pole", which
requires a call to C<tzset>, but by using C<on_enter> and C<on_leave>,
which remember/change the current timezone and restore the previous
value, respectively, the timezone is only changed for the coro that
installed those handlers.
use POSIX qw(tzset);
async {
my $old_tz; # store outside TZ value here
Coro::on_enter {
$old_tz = $ENV{TZ}; # remember the old value
$ENV{TZ} = "Antarctica/South_Pole";
tzset; # enable new value
};
Coro::on_leave {
$ENV{TZ} = $old_tz;
tzset; # restore old value
};
# at this place, the timezone is Antarctica/South_Pole,
# without disturbing the TZ of any other coro.
};
This can be used to localise about any resource (locale, uid, current
working directory etc.) to a block, despite the existence of other
coros.
Another interesting example implements time-sliced multitasking using
interval timers (this could obviously be optimised, but does the job):
# "timeslice" the given block
sub timeslice(&) {
use Time::HiRes ();
Coro::on_enter {
# on entering the thread, we set an VTALRM handler to cede
timeslice {
# The following is an endless loop that would normally
# monopolise the process. Since it runs in a timesliced
# environment, it will regularly cede to other threads.
while () { }
};
=item killall
Kills/terminates/cancels all coros except the currently running one.
Note that while this will try to free some of the main interpreter
resources if the calling coro isn't the main coro, but one
cannot free all of them, so if a coro that is not the main coro
calls this function, there will be some one-time resource leak.
=cut
sub killall {
for (Coro::State::list) {
$_->cancel
if $_ != $current && UNIVERSAL::isa $_, "Coro";
}
}
=back
=head1 CORO OBJECT METHODS
These are the methods you can call on coro objects (or to create
them).
=over 4
=item new Coro \&sub [, @args...]
Create a new coro and return it. When the sub returns, the coro
automatically terminates as if C<terminate> with the returned values were
called. To make the coro run you must first put it into the ready
queue by calling the ready method.
See C<async> and C<Coro::State::new> for additional info about the
coro environment.
=cut
sub _coro_run {
terminate &{+shift};
}
=item $success = $coro->ready
Put the given coro into the end of its ready queue (there is one
queue for each priority) and return true. If the coro is already in
the ready queue, do nothing and return false.
This ensures that the scheduler will resume this coro automatically
once all the coro of higher priority and all coro of the same
priority that were put into the ready queue earlier have been resumed.
=item $coro->suspend
Suspends the specified coro. A suspended coro works just like any other
coro, except that the scheduler will not select a suspended coro for
execution.
Suspending a coro can be useful when you want to keep the coro from
running, but you don't want to destroy it, or when you want to temporarily
freeze a coro (e.g. for debugging) to resume it later.
A scenario for the former would be to suspend all (other) coros after a
fork and keep them alive, so their destructors aren't called, but new
coros can be created.
=item $coro->resume
If the specified coro was suspended, it will be resumed. Note that when
the coro was in the ready queue when it was suspended, it might have been
unreadied by the scheduler, so an activation might have been lost.
To avoid this, it is best to put a suspended coro into the ready queue
unconditionally, as every synchronisation mechanism must protect itself
against spurious wakeups, and the one in the Coro family certainly do
that.
=item $state->is_new
Returns true iff this Coro object is "new", i.e. has never been run
yet. Those states basically consist of only the code reference to call and
the arguments, but consumes very little other resources. New states will
automatically get assigned a perl interpreter when they are transferred to.
=item $state->is_zombie
Returns true iff the Coro object has been cancelled, i.e.
it's resources freed because they were C<cancel>'ed, C<terminate>'d,
C<safe_cancel>'ed or simply went out of scope.
The name "zombie" stems from UNIX culture, where a process that has
exited and only stores and exit status and no other resources is called a
"zombie".
=item $is_ready = $coro->is_ready
Returns true iff the Coro object is in the ready queue. Unless the Coro
object gets destroyed, it will eventually be scheduled by the scheduler.
=item $is_running = $coro->is_running
Returns true iff the Coro object is currently running. Only one Coro object
can ever be in the running state (but it currently is possible to have
multiple running Coro::States).
=item $is_suspended = $coro->is_suspended
Returns true iff this Coro object has been suspended. Suspended Coros will
not ever be scheduled.
=item $coro->cancel ($arg...)
Terminate the given Coro thread and make it return the given arguments as
status (default: an empty list). Never returns if the Coro is the
current Coro.
This is a rather brutal way to free a coro, with some limitations - if
the thread is inside a C callback that doesn't expect to be canceled,
bad things can happen, or if the cancelled thread insists on running
complicated cleanup handlers that rely on its thread context, things will
not work.
Any cleanup code being run (e.g. from C<guard> blocks, destructors and so
on) will be run without a thread context, and is not allowed to switch
to other threads. A common mistake is to call C<< ->cancel >> from a
destructor called by die'ing inside the thread to be cancelled for
example.
The arguments to C<< ->cancel >> are not copied, but instead will
be referenced directly (e.g. if you pass C<$var> and after the call
change that variable, then you might change the return values passed to
e.g. C<join>, so don't do that).
The resources of the Coro are usually freed (or destructed) before this
call returns, but this can be delayed for an indefinite amount of time, as
in some cases the manager thread has to run first to actually destruct the
Coro object.
=item $coro->safe_cancel ($arg...)
Works mostly like C<< ->cancel >>, but is inherently "safer", and
consequently, can fail with an exception in cases the thread is not in a
cancellable state. Essentially, C<< ->safe_cancel >> is a C<< ->cancel >>
with extra checks before canceling.
It works a bit like throwing an exception that cannot be caught -
specifically, it will clean up the thread from within itself, so all
cleanup handlers (e.g. C<guard> blocks) are run with full thread
context and can block if they wish. The downside is that there is no
The last state basically means that the thread isn't currently inside a
perl callback called from some C function (usually via some XS modules)
and isn't currently executing inside some C function itself (via Coro's XS
API).
This call returns true when it could cancel the thread, or croaks with an
error otherwise (i.e. it either returns true or doesn't return at all).
Why the weird interface? Well, there are two common models on how and
when to cancel things. In the first, you have the expectation that your
coro thread can be cancelled when you want to cancel it - if the thread
isn't cancellable, this would be a bug somewhere, so C<< ->safe_cancel >>
croaks to notify of the bug.
In the second model you sometimes want to ask nicely to cancel a thread,
but if it's not a good time, well, then don't cancel. This can be done
relatively easy like this:
if (! eval { $coro->safe_cancel }) {
warn "unable to cancel thread: $@";
}
However, what you never should do is first try to cancel "safely" and
if that fails, cancel the "hard" way with C<< ->cancel >>. That makes
no sense: either you rely on being able to execute cleanup code in your
thread context, or you don't. If you do, then C<< ->safe_cancel >> is the
only way, and if you don't, then C<< ->cancel >> is always faster and more
direct.
=item $coro->schedule_to
Puts the current coro to sleep (like C<Coro::schedule>), but instead
of continuing with the next coro from the ready queue, always switch to
the given coro object (regardless of priority etc.). The readyness
state of that coro isn't changed.
This is an advanced method for special cases - I'd love to hear about any
uses for this one.
=item $coro->cede_to
Like C<schedule_to>, but puts the current coro into the ready
queue. This has the effect of temporarily switching to the given
coro, and continuing some time later.
This is an advanced method for special cases - I'd love to hear about any
uses for this one.
=item $coro->throw ([$scalar])
If C<$throw> is specified and defined, it will be thrown as an exception
inside the coro at the next convenient point in time. Otherwise
clears the exception object.
Coro will check for the exception each time a schedule-like-function
returns, i.e. after each C<schedule>, C<cede>, C<< Coro::Semaphore->down
>>, C<< Coro::Handle->readable >> and so on. Most of those functions (all
that are part of Coro itself) detect this case and return early in case an
exception is pending.
The exception object will be thrown "as is" with the specified scalar in
C<$@>, i.e. if it is a string, no line number or newline will be appended
(unlike with C<die>).
This can be used as a softer means than either C<cancel> or C<safe_cancel
>to ask a coro to end itself, although there is no guarantee that the
exception will lead to termination, and if the exception isn't caught it
might well end the whole program.
You might also think of C<throw> as being the moral equivalent of
C<kill>ing a coro with a signal (in this case, a scalar).
=item $coro->join
Wait until the coro terminates and return any values given to the
C<terminate> or C<cancel> functions. C<join> can be called concurrently
from multiple threads, and all will be resumed and given the status
return once the C<$coro> terminates.
=item $coro->on_destroy (\&cb)
Registers a callback that is called when this coro thread gets destroyed,
that is, after it's resources have been freed but before it is joined. The
callback gets passed the terminate/cancel arguments, if any, and I<must
not> die, under any circumstances.
There can be any number of C<on_destroy> callbacks per coro, and there is
currently no way to remove a callback once added.
=item $oldprio = $coro->prio ($newprio)
Sets (or gets, if the argument is missing) the priority of the
coro thread. Higher priority coro get run before lower priority
coros. Priorities are small signed integers (currently -4 .. +3),
that you can refer to using PRIO_xxx constants (use the import tag :prio
to get then):
PRIO_MAX > PRIO_HIGH > PRIO_NORMAL > PRIO_LOW > PRIO_IDLE > PRIO_MIN
3 > 1 > 0 > -1 > -3 > -4
# set priority to HIGH
current->prio (PRIO_HIGH);
The idle coro thread ($Coro::idle) always has a lower priority than any
existing coro.
Changing the priority of the current coro will take effect immediately,
but changing the priority of a coro in the ready queue (but not running)
will only take effect after the next schedule (of that coro). This is a
bug that will be fixed in some future version.
=item $newprio = $coro->nice ($change)
Similar to C<prio>, but subtract the given value from the priority (i.e.
higher values mean lower priority, just as in UNIX's nice command).
=item $olddesc = $coro->desc ($newdesc)
Sets (or gets in case the argument is missing) the description for this
coro thread. This is just a free-form string you can associate with a
coro.
This method simply sets the C<< $coro->{desc} >> member to the given
string. You can modify this member directly if you wish, and in fact, this
is often preferred to indicate major processing states that can then be
seen for example in a L<Coro::Debug> session:
sub my_long_function {
local $Coro::current->{desc} = "now in my_long_function";
...
$Coro::current->{desc} = "my_long_function: phase 1";
...
$Coro::current->{desc} = "my_long_function: phase 2";
}
=back
=head1 GLOBAL FUNCTIONS
=over 4
=item Coro::nready
Returns the number of coro that are currently in the ready state,
i.e. that can be switched to by calling C<schedule> directory or
indirectly. The value C<0> means that the only runnable coro is the
currently running one, so C<cede> would have no effect, and C<schedule>
would cause a deadlock unless there is an idle handler that wakes up some
coro.
=item my $guard = Coro::guard { ... }
This function still exists, but is deprecated. Please use the
C<Guard::guard> function instead.
=cut
BEGIN { *guard = \&Guard::guard }
=item unblock_sub { ... }
This utility function takes a BLOCK or code reference and "unblocks" it,
returning a new coderef. Unblocking means that calling the new coderef
will return immediately without blocking, returning nothing, while the
original code ref will be called (with parameters) from within another
coro.
The reason this function exists is that many event libraries (such as
the venerable L<Event|Event> module) are not thread-safe (a weaker form
of reentrancy). This means you must not block within event callbacks,
otherwise you might suffer from crashes or worse. The only event library
currently known that is safe to use without C<unblock_sub> is L<EV> (but
you might still run into deadlocks if all event loops are blocked).
Coro will try to catch you when you block in the event loop
("FATAL: $Coro::idle blocked itself"), but this is just best effort and
only works when you do not run your own event loop.
This function allows your callbacks to block by executing them in another
coro where it is safe to block. One example where blocking is handy
is when you use the L<Coro::AIO|Coro::AIO> functions to save results to
disk, for example.
In short: simply use C<unblock_sub { ... }> instead of C<sub { ... }> when
creating event callbacks that want to block.
If your handler does not plan to block (e.g. simply sends a message to
another coro, or puts some other coro into the ready queue), there is
no reason to use C<unblock_sub>.
Note that you also need to use C<unblock_sub> for any other callbacks that
are indirectly executed by any C-based event loop. For example, when you
use a module that uses L<AnyEvent> (and you use L<Coro::AnyEvent>) and it
provides callbacks that are the result of some event callback, then you
must not block either, or use C<unblock_sub>.
=cut
our @unblock_queue;
# we create a special coro because we want to cede,
# to reduce pressure on the coro pool (because most callbacks
# return immediately and can be reused) and because we cannot cede
# inside an event callback.
our $unblock_scheduler = new Coro sub {
while () {
while (my $cb = pop @unblock_queue) {
&async_pool (@$cb);
# for short-lived callbacks, this reduces pressure on the coro pool
# as the chance is very high that the async_poll coro will be back
# in the idle state when cede returns
cede;
}
schedule; # sleep well
}
};
$unblock_scheduler->{desc} = "[unblock_sub scheduler]";
sub unblock_sub(&) {
my $cb = shift;
sub {
unshift @unblock_queue, [$cb, @_];
$unblock_scheduler->ready;
}
}
=item $cb = rouse_cb
Create and return a "rouse callback". That's a code reference that,
when called, will remember a copy of its arguments and notify the owner
coro of the callback.
See the next function.
=item @args = rouse_wait [$cb]
Wait for the specified rouse callback (or the last one that was created in
this coro).
As soon as the callback is invoked (or when the callback was invoked
before C<rouse_wait>), it will return the arguments originally passed to
the rouse callback. In scalar context, that means you get the I<last>
argument, just as if C<rouse_wait> had a C<return ($a1, $a2, $a3...)>
statement at the end.
See the section B<HOW TO WAIT FOR A CALLBACK> for an actual usage example.
=back
if $old;
goto &{"Coro::$module\::new"};
};
}
1;
=head1 HOW TO WAIT FOR A CALLBACK
It is very common for a coro to wait for some callback to be
called. This occurs naturally when you use coro in an otherwise
event-based program, or when you use event-based libraries.
These typically register a callback for some event, and call that callback
when the event occurred. In a coro, however, you typically want to
just wait for the event, simplyifying things.
For example C<< AnyEvent->child >> registers a callback to be called when
a specific child has exited:
my $child_watcher = AnyEvent->child (pid => $pid, cb => sub { ... });
But from within a coro, you often just want to write this:
my $status = wait_for_child $pid;
Coro offers two functions specifically designed to make this easy,
C<rouse_cb> and C<rouse_wait>.
The first function, C<rouse_cb>, generates and returns a callback that,
when invoked, will save its arguments and notify the coro that
created the callback.
The second function, C<rouse_wait>, waits for the callback to be called
(by calling C<schedule> to go to sleep) and returns the arguments
originally passed to the callback.
Using these functions, it becomes easy to write the C<wait_for_child>
function mentioned above:
sub wait_for_child($) {
my ($rpid, $rstatus) = rouse_wait;
$rstatus
}
In the case where C<rouse_cb> and C<rouse_wait> are not flexible enough,
you can roll your own, using C<schedule> and C<ready>:
sub wait_for_child($) {
my ($pid) = @_;
# store the current coro in $current,
# and provide result variables for the closure passed to ->child
my $current = $Coro::current;
my ($done, $rstatus);
# pass a closure to ->child
my $watcher = AnyEvent->child (pid => $pid, cb => sub {
$rstatus = $_[1]; # remember rstatus
$done = 1; # mark $rstatus as valid
$current->ready; # wake up the waiting thread
});
=head1 BUGS/LIMITATIONS
=over 4
=item fork with pthread backend
When Coro is compiled using the pthread backend (which isn't recommended
but required on many BSDs as their libcs are completely broken), then
coro will not survive a fork. There is no known workaround except to
fix your libc and use a saner backend.
=item perl process emulation ("threads")
This module is not perl-pseudo-thread-safe. You should only ever use this
module from the first thread (this requirement might be removed in the
future to allow per-thread schedulers, but Coro::State does not yet allow
this). I recommend disabling thread support and using processes, as having
the windows process emulation enabled under unix roughly halves perl
performance, even when not used.
Attempts to use threads created in another emulated process will crash
("cleanly", with a null pointer exception).
=item coro switching is not signal safe
You must not switch to another coro from within a signal handler (only
relevant with %SIG - most event libraries provide safe signals), I<unless>
you are sure you are not interrupting a Coro function.
That means you I<MUST NOT> call any function that might "block" the
current coro - C<cede>, C<schedule> C<< Coro::Semaphore->down >> or
anything that calls those. Everything else, including calling C<ready>,
works.
=back
=head1 WINDOWS PROCESS EMULATION
A great many people seem to be confused about ithreads (for example, Chip
Salzenberg called me unintelligent, incapable, stupid and gullible,
Coro/AIO.pm view on Meta::CPAN
=head1 NAME
Coro::AIO - truly asynchronous file and directory I/O
=head1 SYNOPSIS
use Coro::AIO;
# can now use any of the aio requests your IO::AIO module supports.
# read 1MB of /etc/passwd, without blocking other coroutines
my $fh = aio_open "/etc/passwd", O_RDONLY, 0
or die "/etc/passwd: $!";
aio_read $fh, 0, 1_000_000, my $buf, 0
or die "aio_read: $!";
aio_close $fh;
=head1 DESCRIPTION
This module is an L<AnyEvent> user, you need to make sure that you use and
run a supported event loop.
Coro/AIO.pm view on Meta::CPAN
The API is exactly the same as that of the corresponding IO::AIO
routines, except that you have to specify I<all> arguments, even the
ones optional in IO::AIO, I<except> the callback argument. Instead of
calling a callback, the routines return the values normally passed to the
callback. Everything else, including C<$!> and perls stat cache, are set
as expected after these functions return.
You can mix calls to C<IO::AIO> functions with calls to this module. You
I<must not>, however, call these routines from within IO::AIO callbacks,
as this causes a deadlock. Start a coro inside the callback instead.
This module also loads L<AnyEvent::AIO> to integrate into the event loop
in use, so please refer to its (and L<AnyEvent>'s) documentation on how it
selects an appropriate event module.
All other functions exported by default by IO::AIO (e.g. C<aioreq_pri>)
will be exported by default by Coro::AIO, too.
Functions that can be optionally imported from IO::AIO can be imported
from Coro::AIO or can be called directly, e.g. C<Coro::AIO::nreqs>.
You cannot specify priorities with C<aioreq_pri> if your coroutine has a
non-zero priority, as this module overwrites the request priority with the
current coroutine priority in that case.
For your convenience, here are the changed function signatures for most
of the requests, for documentation of these functions please have a look
at L<IO::AIO|the IO::AIO manual>. Note that requests added by newer
versions of L<IO::AIO> will be automatically wrapped as well.
=over 4
=cut
Coro/AnyEvent.pm view on Meta::CPAN
When one naively starts to use threads in Perl, one will quickly run
into the problem that threads which block on a syscall (sleeping,
reading from a socket etc.) will block all threads.
If one then uses an event loop, the problem is that the event loop has
no knowledge of threads and will not run them before it polls for new
events, again blocking the whole process.
This module integrates threads into any event loop supported by
AnyEvent, combining event-based programming with coroutine-based
programming in a natural way.
As of Coro 5.21 and newer, this module gets loaded automatically when
AnyEvent initialises itself and Coro is used in the same process, thus
there is no need to load it manually if you just want your threads to
coexist with AnyEvent.
If you want to use any functions from this module, you of course still
need to C<use Coro::AnyEvent>, just as with other perl modules.
Coro/AnyEvent.pm view on Meta::CPAN
while () {
$_poll->();
Coro::schedule if Coro::nready;
}
};
$IDLE->{desc} = "[AnyEvent idle process]";
$Coro::idle = $IDLE;
# call the readyhook, in case coroutines were already readied
_activity;
}
# augment condvars
unshift @AnyEvent::CondVar::ISA, "Coro::AnyEvent::CondVar";
};
=item Coro::AnyEvent::poll
This call will block the current thread until the event loop has polled
Coro/AnyEvent.pm view on Meta::CPAN
}
sub writable($;$) {
my $cb = Coro::rouse_cb;
my $w = AE::io $_[0], 1, sub { $cb->(1) };
my $t = defined $_[1] && AE::timer $_[1], 0, sub { $cb->(0) };
Coro::rouse_wait
}
sub Coro::AnyEvent::CondVar::send {
(delete $_[0]{_ae_coro})->ready if $_[0]{_ae_coro};
&AnyEvent::CondVar::Base::send;
};
sub Coro::AnyEvent::CondVar::recv {
until ($_[0]{_ae_sent}) {
local $_[0]{_ae_coro} = $Coro::current;
Coro::schedule;
}
&AnyEvent::CondVar::Base::recv;
};
1;
=back
Coro/AnyEvent.pm view on Meta::CPAN
In addition to hooking into C<ready>, this module will also provide a
C<$Coro::idle> handler that runs the event loop. It is best not to take
advantage of this too often, as this is rather inefficient, but it should
work perfectly fine.
=item * provide overrides for AnyEvent's condvars
This module installs overrides for AnyEvent's condvars. That is, when
the module is loaded it will provide its own condition variables. This
makes them coroutine-safe, i.e. you can safely block on them from within a
coroutine.
=item * lead to data corruption or worse
As C<unblock_sub> cannot be used by this module (as it is the module
that implements it, basically), you must not call into the event
loop recursively from any coroutine. This is not usually a difficult
restriction to live with, just use condvars, C<unblock_sub> or other means
of inter-coroutine-communications.
If you use a module that supports AnyEvent (or uses the same event
loop as AnyEvent, making it implicitly compatible), and it offers
callbacks of any kind, then you must not block in them, either (or use
e.g. C<unblock_sub>), see the description of C<unblock_sub> in the
L<Coro> module.
This also means that you should load the module as early as possible,
as only condvars created after this module has been loaded will work
correctly.
Coro/BDB.pm view on Meta::CPAN
# can now use any of the bdb requests
=head1 DESCRIPTION
This module is an L<AnyEvent> user, you need to make sure that you use and
run a supported event loop.
This module implements a thin wrapper around the L<BDB> module: Each BDB
request that could block and doesn't get passed a callback will normally
block all coroutines. after loading this module, this will no longer be
the case (it provides a suitable sync prepare callback).
It will also register an AnyEvent watcher as soon as AnyEvent chooses an
event loop.
The AnyEvent watcher can be disabled by executing C<undef
$Coro::BDB::WATCHER>. Please notify the author of when and why you think
this was necessary.
This module does not export anything (unlike L<Coro::AIO>), as BDB already
supports leaving out the callback. (Unfortunately, it ties a C context
to each coroutine executing such a callback, so in the future, it might
export more efficient wrappers).
=over 4
=cut
package Coro::BDB;
use common::sense;
Coro/Channel.pm view on Meta::CPAN
print $q1->get;
die unless $q1->size;
=head1 DESCRIPTION
A Coro::Channel is the equivalent of a unix pipe (and similar to amiga
message ports): you can put things into it on one end and read things out
of it from the other end. If the capacity of the Channel is maxed out
writers will block. Both ends of a Channel can be read/written from by as
many coroutines as you want concurrently.
You don't have to load C<Coro::Channel> manually, it will be loaded
automatically when you C<use Coro> and call the C<new> constructor.
=over 4
=cut
package Coro::Channel;
Coro/Channel.pm view on Meta::CPAN
Return the number of elements waiting to be consumed. Please note that:
if ($q->size) {
my $data = $q->get;
...
}
is I<not> a race condition but instead works just fine. Note that the
number of elements that wait can be larger than C<$maxsize>, as it
includes any coroutines waiting to put data into the channel (but not any
shutdown condition).
This means that the number returned is I<precisely> the number of calls
to C<get> that will succeed instantly and return some data. Calling
C<shutdown> has no effect on this number.
=cut
sub size {
scalar @{$_[0][DATA]}
Coro/CoroAPI.h view on Meta::CPAN
#include "perl.h"
#include "XSUB.h"
#ifndef pTHX_
# define pTHX_
# define aTHX_
# define pTHX
# define aTHX
#endif
/* C-level coroutine struct, opaque, not used much */
struct coro;
/* used for schedule-like-function prepares */
struct coro_transfer_args
{
struct coro *prev, *next;
};
/* this is the per-perl-coro slf frame info */
/* it is treated like other "global" interpreter data */
/* and unfortunately is copied around, so keep it small */
struct CoroSLF
{
void (*prepare) (pTHX_ struct coro_transfer_args *ta); /* 0 means not yet initialised */
int (*check) (pTHX_ struct CoroSLF *frame);
void *data; /* for use by prepare/check/destroy */
void (*destroy) (pTHX_ struct CoroSLF *frame);
};
/* needs to fill in the *frame */
typedef void (*coro_slf_cb) (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items);
/* called on enter/leave */
typedef void (*coro_enterleave_hook) (pTHX_ void *arg);
/* private structure, always use the provided macros below */
struct CoroAPI
{
/* private */
I32 ver;
I32 rev;
#define CORO_API_VERSION 7 /* reorder CoroSLF on change */
#define CORO_API_REVISION 2
/* Coro */
int nready;
SV *current;
SV *except;
void (*readyhook) (void);
void (*schedule) (pTHX);
void (*schedule_to) (pTHX_ SV *coro_sv);
int (*cede) (pTHX);
int (*cede_notself) (pTHX);
int (*ready) (pTHX_ SV *coro_sv);
int (*is_ready) (pTHX_ SV *coro_sv);
/* Coro::State */
void (*transfer) (pTHX_ SV *prev_sv, SV *next_sv); /* Coro::State */
/* SLF */
struct coro *(*sv_state) (pTHX_ SV *coro_sv);
void (*execute_slf) (pTHX_ CV *cv, coro_slf_cb init_cb, I32 ax);
/* public */
/* for use as CoroSLF.prepare */
void (*prepare_nop) (pTHX_ struct coro_transfer_args *ta);
void (*prepare_schedule) (pTHX_ struct coro_transfer_args *ta);
void (*prepare_cede) (pTHX_ struct coro_transfer_args *ta);
void (*prepare_cede_notself) (pTHX_ struct coro_transfer_args *ta);
/* private */
void (*enterleave_hook)(pTHX_ SV *coro_sv, coro_enterleave_hook enter, void *enter_arg, coro_enterleave_hook leave, void *leave_arg);
void (*enterleave_unhook)(pTHX_ SV *coro_sv, coro_enterleave_hook enter, coro_enterleave_hook leave);
void (*enterleave_scope_hook)(pTHX_ coro_enterleave_hook enter, void *enter_arg, coro_enterleave_hook leave, void *leave_arg); /* XS caller must LEAVE/ENTER */
};
static struct CoroAPI *GCoroAPI;
/* public API macros */
#define CORO_TRANSFER(prev,next) GCoroAPI->transfer (aTHX_ (prev), (next))
#define CORO_SV_STATE(coro) GCoroAPI->sv_state (aTHX_ (coro))
#define CORO_EXECUTE_SLF(cv,init,ax) GCoroAPI->execute_slf (aTHX_ (cv), (init), (ax))
#define CORO_EXECUTE_SLF_XS(init) CORO_EXECUTE_SLF (cv, (init), ax)
#define CORO_SCHEDULE GCoroAPI->schedule (aTHX)
#define CORO_CEDE GCoroAPI->cede (aTHX)
#define CORO_CEDE_NOTSELF GCoroAPI->cede_notself (aTHX)
#define CORO_READY(coro) GCoroAPI->ready (aTHX_ coro)
#define CORO_IS_READY(coro) GCoroAPI->is_ready (coro)
#define CORO_NREADY (GCoroAPI->nready)
#define CORO_THROW (GCoroAPI->except)
#define CORO_CURRENT SvRV (GCoroAPI->current)
#define CORO_READYHOOK (GCoroAPI->readyhook)
#define CORO_ENTERLEAVE_HOOK(coro,enter,enter_arg,leave,leave_arg) GCoroAPI->enterleave_hook (aTHX_ coro, enter, enter_arg, leave, leave_arg)
#define CORO_ENTERLEAVE_UNHOOK(coro,enter,leave) GCoroAPI->enterleave_hook (aTHX_ coro, enter , leave )
#define CORO_ENTERLEAVE_SCOPE_HOOK(enter,enter_arg,leave,leave_arg) GCoroAPI->enterleave_scope_hook (aTHX_ enter, enter_arg, leave, leave_arg)
#define I_CORO_API(YourName) \
STMT_START { \
SV *sv = perl_get_sv ("Coro::API", 0); \
if (!sv) croak ("Coro::API not found"); \
GCoroAPI = (struct CoroAPI*) SvIV (sv); \
if (GCoroAPI->ver != CORO_API_VERSION \
|| GCoroAPI->rev < CORO_API_REVISION) \
croak ("Coro::API version mismatch (%d.%d vs. %d.%d) -- please recompile %s", \
Coro/Debug.pm view on Meta::CPAN
This module provides some debugging facilities. Most will, if not handled
carefully, severely compromise the security of your program, so use it
only for debugging (or take other precautions).
It mainly implements a very primitive debugger that is very easy to
integrate in your program:
our $server = new_unix_server Coro::Debug "/tmp/somepath";
# see new_unix_server, below, for more info
It lets you list running coroutines:
state (rUnning, Ready, New or neither)
|cctx allocated
|| resident set size (octets)
|| | scheduled this many times
> ps || | |
PID SC RSS USES Description Where
14572344 UC 62k 128k [main::] [dm-support.ext:47]
14620056 -- 2260 13 [coro manager] [Coro.pm:358]
14620128 -- 2260 166 [unblock_sub scheduler] [Coro.pm:358]
17764008 N- 152 0 [EV idle process] -
13990784 -- 2596 10k timeslot manager [cf.pm:454]
81424176 -- 18k 4758 [async pool idle] [Coro.pm:257]
23513336 -- 2624 1 follow handler [follow.ext:52]
40548312 -- 15k 5597 player scheduler [player-scheduler.ext:13]
29138032 -- 2548 431 music scheduler [player-env.ext:77]
43449808 -- 2260 3493 worldmap updater [item-worldmap.ext:115]
33352488 -- 19k 2845 [async pool idle] [Coro.pm:257]
81530072 -- 13k 43k map scheduler [map-scheduler.ext:65]
30751144 -- 15k 2204 [async pool idle] [Coro.pm:257]
Lets you do backtraces on about any coroutine:
> bt 18334288
coroutine is at /opt/cf/ext/player-env.ext line 77
eval {...} called at /opt/cf/ext/player-env.ext line 77
ext::player_env::__ANON__ called at -e line 0
Coro::_run_coro called at -e line 0
Or lets you eval perl code:
> 5+7
12
Or lets you eval perl code within other coroutines:
> eval 18334288 caller(1); $DB::args[0]->method
1
It can also trace subroutine entry/exits for most coroutines (those not
having recursed into a C function), resulting in output similar to:
> loglevel 5
> trace 94652688
2007-09-27Z20:30:25.1368 (5) [94652688] enter Socket::sockaddr_in with (8481,\x{7f}\x{00}\x{00}\x{01})
2007-09-27Z20:30:25.1369 (5) [94652688] leave Socket::sockaddr_in returning (\x{02}\x{00}...)
2007-09-27Z20:30:25.1370 (5) [94652688] enter Net::FCP::Util::touc with (client_get)
2007-09-27Z20:30:25.1371 (5) [94652688] leave Net::FCP::Util::touc returning (ClientGet)
2007-09-27Z20:30:25.1372 (5) [94652688] enter AnyEvent::Impl::Event::io with (AnyEvent,fh,GLOB(0x9256250),poll,w,cb,CODE(0x8c963a0))
2007-09-27Z20:30:25.1373 (5) [94652688] enter Event::Watcher::__ANON__ with (Event,poll,w,fd,GLOB(0x9256250),cb,CODE(0x8c963a0))
Coro/Debug.pm view on Meta::CPAN
use Coro::State ();
use Coro::AnyEvent ();
use Coro::Timer ();
our $VERSION = 6.514;
our %log;
our $SESLOGLEVEL = exists $ENV{PERL_CORO_DEFAULT_LOGLEVEL} ? $ENV{PERL_CORO_DEFAULT_LOGLEVEL} : -1;
our $ERRLOGLEVEL = exists $ENV{PERL_CORO_STDERR_LOGLEVEL} ? $ENV{PERL_CORO_STDERR_LOGLEVEL} : -1;
sub find_coro {
my ($pid) = @_;
if (my ($coro) = grep $_ == $pid, Coro::State::list) {
$coro
} else {
print "$pid: no such coroutine\n";
undef
}
}
sub format_msg($$) {
my ($time, $micro) = Coro::Util::gettimeofday;
my ($sec, $min, $hour, $day, $mon, $year) = gmtime $time;
my $date = sprintf "%04d-%02d-%02dZ%02d:%02d:%02d.%04d",
$year + 1900, $mon + 1, $day, $hour, $min, $sec, $micro / 100;
sprintf "%s (%d) %s", $date, $_[0], $_[1]
Coro/Debug.pm view on Meta::CPAN
Log a debug message of the given severity level (0 is highest, higher is
less important) to all interested parties.
=item stderr_loglevel $level
Set the loglevel for logging to stderr (defaults to the value of the
environment variable PERL_CORO_STDERR_LOGLEVEL, or -1 if missing).
=item session_loglevel $level
Set the default loglevel for new coro debug sessions (defaults to the
value of the environment variable PERL_CORO_DEFAULT_LOGLEVEL, or -1 if
missing).
=cut
sub log($$) {
my ($level, $msg) = @_;
$msg =~ s/\s*$/\n/;
$_->($level, $msg) for values %log;
printf STDERR format_msg $level, $msg if $level <= $ERRLOGLEVEL;
}
sub session_loglevel($) {
$SESLOGLEVEL = shift;
}
sub stderr_loglevel($) {
$ERRLOGLEVEL = shift;
}
=item trace $coro, $loglevel
Enables tracing the given coroutine at the given loglevel. If loglevel is
omitted, use 5. If coro is omitted, trace the current coroutine. Tracing
incurs a very high runtime overhead.
It is not uncommon to enable tracing on oneself by simply calling
C<Coro::Debug::trace>.
A message will be logged at the given loglevel if it is not possible to
enable tracing.
=item untrace $coro
Disables tracing on the given coroutine.
=cut
sub trace {
my ($coro, $loglevel) = @_;
$coro ||= $Coro::current;
$loglevel = 5 unless defined $loglevel;
(Coro::async {
if (eval { Coro::State::trace $coro, Coro::State::CC_TRACE | Coro::State::CC_TRACE_SUB; 1 }) {
Coro::Debug::log $loglevel, sprintf "[%d] tracing enabled", $coro + 0;
$coro->{_trace_line_cb} = sub {
Coro::Debug::log $loglevel, sprintf "[%d] at %s:%d\n", $Coro::current+0, @_;
};
$coro->{_trace_sub_cb} = sub {
Coro::Debug::log $loglevel, sprintf "[%d] %s %s %s\n",
$Coro::current+0,
$_[0] ? "enter" : "leave",
$_[1],
$_[2] ? ($_[0] ? "with (" : "returning (") . (
join ",",
map {
my $x = ref $_ ? overload::StrVal $_ : $_;
(substr $x, 40) = "..." if 40 + 3 < length $x;
$x =~ s/([^\x20-\x5b\x5d-\x7e])/sprintf "\\x{%02x}", ord $1/ge;
$x
} @{$_[2]}
) . ")" : "";
};
undef $coro; # the subs keep a reference which we do not want them to do
} else {
Coro::Debug::log $loglevel, sprintf "[%d] unable to enable tracing: %s", $Coro::current + 0, $@;
}
})->prio (Coro::PRIO_MAX);
Coro::cede;
}
sub untrace {
my ($coro) = @_;
$coro ||= $Coro::current;
(Coro::async {
Coro::State::trace $coro, 0;
delete $coro->{_trace_sub_cb};
delete $coro->{_trace_line_cb};
})->prio (Coro::PRIO_MAX);
Coro::cede;
}
sub ps_listing {
my $times = Coro::State::enable_times;
my $flags = $1;
my $verbose = $flags =~ /v/;
my $desc_format = $flags =~ /w/ ? "%-24s" : "%-24.24s";
my $tim0_format = $times ? " %9s %8s " : " ";
my $tim1_format = $times ? " %9.3f %8.3f " : " ";
my $buf = sprintf "%20s %s%s %4s %4s$tim0_format$desc_format %s\n",
"PID", "S", "C", "RSS", "USES",
$times ? ("t_real", "t_cpu") : (),
"Description", "Where";
for my $coro (reverse Coro::State::list) {
my @bt;
Coro::State::call ($coro, sub {
# we try to find *the* definite frame that gives most useful info
# by skipping Coro frames and pseudo-frames.
for my $frame (1..10) {
my @frame = caller $frame;
@bt = @frame if $frame[2];
last unless $bt[0] =~ /^Coro/;
}
});
$bt[1] =~ s/^.*[\/\\]// if @bt && !$verbose;
$buf .= sprintf "%20s %s%s %4s %4s$tim1_format$desc_format %s\n",
$coro+0,
$coro->is_new ? "N" : $coro->is_running ? "U" : $coro->is_ready ? "R" : "-",
$coro->is_traced ? "T" : $coro->has_cctx ? "C" : "-",
format_num4 $coro->rss,
format_num4 $coro->usecount,
$times ? $coro->times : (),
$coro->debug_desc,
(@bt ? sprintf "[%s:%d]", $bt[1], $bt[2] : "-");
}
$buf
}
=item command $string
Execute a debugger command, sending any output to STDOUT. Used by
C<session>, below.
Coro/Debug.pm view on Meta::CPAN
sub command($) {
my ($cmd) = @_;
$cmd =~ s/\s+$//;
if ($cmd =~ /^ps (?:\s* (\S+))? $/x) {
print ps_listing;
} elsif ($cmd =~ /^bt\s+(\d+)$/) {
if (my $coro = find_coro $1) {
my $bt;
Coro::State::call ($coro, sub {
local $Carp::CarpLevel = 2;
$bt = eval { Carp::longmess "coroutine is" } || "$@";
});
if ($bt) {
print $bt;
} else {
print "$1: unable to get backtrace\n";
}
}
} elsif ($cmd =~ /^(?:e|eval)\s+(\d+)\s+(.*)$/) {
if (my $coro = find_coro $1) {
my $cmd = eval "sub { $2 }";
my @res;
Coro::State::call ($coro, sub { @res = eval { &$cmd } });
print $@ ? $@ : (join " ", @res, "\n");
}
} elsif ($cmd =~ /^(?:tr|trace)\s+(\d+)$/) {
if (my $coro = find_coro $1) {
trace $coro;
}
} elsif ($cmd =~ /^(?:ut|untrace)\s+(\d+)$/) {
if (my $coro = find_coro $1) {
untrace $coro;
}
} elsif ($cmd =~ /^cancel\s+(\d+)$/) {
if (my $coro = find_coro $1) {
$coro->cancel;
}
} elsif ($cmd =~ /^ready\s+(\d+)$/) {
if (my $coro = find_coro $1) {
$coro->ready;
}
} elsif ($cmd =~ /^kill\s+(\d+)(?:\s+(.*))?$/) {
my $reason = defined $2 ? $2 : "killed";
if (my $coro = find_coro $1) {
$coro->throw ($reason);
}
} elsif ($cmd =~ /^enable_times(\s+\S.*)?\s*$/) {
my $enable = defined $1 ? 1*eval $1 : !Coro::State::enable_times;
Coro::State::enable_times $enable;
print "per-thread real and process time gathering ", $enable ? "enabled" : "disabled", ".\n";
} elsif ($cmd =~ /^help$/) {
print <<EOF;
ps [w|v] show the list of all coroutines (wide, verbose)
bt <pid> show a full backtrace of coroutine <pid>
eval <pid> <perl> evaluate <perl> expression in context of <pid>
trace <pid> enable tracing for this coroutine
untrace <pid> disable tracing for this coroutine
kill <pid> <reason> throws the given <reason> string in <pid>
cancel <pid> cancels this coroutine
ready <pid> force <pid> into the ready queue
enable_times <enable> enable or disable time profiling in ps
<anything else> evaluate as perl and print results
<anything else> & same as above, but evaluate asynchronously
you can use (find_coro <pid>) in perl expressions
to find the coro with the given pid, e.g.
(find_coro 9768720)->ready
EOF
} elsif ($cmd =~ /^(.*)&$/) {
my $cmd = $1;
my $sub = eval "sub { $cmd }";
my $fh = select;
Coro::async_pool {
$Coro::current->{desc} = $cmd;
my $t = Coro::Util::time;
my @res = eval { &$sub };
Coro/Debug.pm view on Meta::CPAN
$fh = Coro::Handle::unblock $fh;
my $old_fh = select $fh;
my $guard = guard { select $old_fh };
my $loglevel = $SESLOGLEVEL;
local $log{$Coro::current} = sub {
return unless $_[0] <= $loglevel;
print $fh "\015", (format_msg $_[0], $_[1]), "> ";
};
print "coro debug session. use help for more info\n\n";
while ((print "> "), defined (my $cmd = $fh->readline ("\012"))) {
if ($cmd =~ /^exit\s*$/) {
print "bye.\n";
last;
} elsif ($cmd =~ /^(?:ll|loglevel)\s*(\d+)?\s*/) {
$loglevel = defined $1 ? $1 : -1;
} elsif ($cmd =~ /^(?:w|watch)\s*([0-9.]*)\s+(.*)/) {
Coro/Debug.pm view on Meta::CPAN
runs C<session> on any connection. Normal unix permission checks and umask
applies, so you can protect your socket by puttint it into a protected
directory.
The C<socat> utility is an excellent way to connect to this socket:
socat readline /path/to/socket
Socat also offers history support:
socat readline:history=/tmp/hist.corodebug /path/to/socket
The server accepts connections until it is destroyed, so you must keep
the return value around as long as you want the server to stay available.
=cut
sub new_unix_server {
my ($class, $path) = @_;
unlink $path;
Coro/Handle.pm view on Meta::CPAN
=head1 SYNOPSIS
use Coro::Handle;
=head1 DESCRIPTION
This module is an L<AnyEvent> user, you need to make sure that you use and
run a supported event loop.
This module implements IO-handles in a coroutine-compatible way, that is,
other coroutines can run while reads or writes block on the handle.
It does so by using L<AnyEvent|AnyEvent> to wait for readable/writable
data, allowing other coroutines to run while one coroutine waits for I/O.
Coro::Handle does NOT inherit from IO::Handle but uses tied objects.
If at all possible, you should I<always> prefer method calls on the handle object over invoking
tied methods, i.e.:
$fh->print ($str); # NOT print $fh $str;
my $line = $fh->readline; # NOT my $line = <$fh>;
The reason is that perl recurses within the interpreter when invoking tie
magic, forcing the (temporary) allocation of a (big) stack. If you have
lots of socket connections and they happen to wait in e.g. <$fh>, then
they would all have a costly C coroutine associated with them.
=over 4
=cut
package Coro::Handle;
use common::sense;
use Carp ();
Coro/Handle.pm view on Meta::CPAN
tie *$self, 'Coro::Handle::FH', fh => $fh, @_;
bless \$self, ref $class ? ref $class : $class
}
=item $fh = unblock $fh
This is a convenience function that just calls C<new_from_fh> on the
given filehandle. Use it to replace a normal perl filehandle by a
non-(coroutine-)blocking equivalent.
=cut
sub unblock($) {
new_from_fh Coro::Handle $_[0]
}
=item $fh->writable, $fh->readable
Wait until the filehandle is readable or writable (and return true) or
until an error condition happens (and return false).
=cut
sub readable { Coro::Handle::FH::readable (tied *${$_[0]}) }
sub writable { Coro::Handle::FH::writable (tied *${$_[0]}) }
=item $fh->readline ([$terminator])
Similar to the builtin of the same name, but allows you to specify the
input record separator in a coroutine-safe manner (i.e. not using a global
variable). Paragraph mode is not supported, use "\n\n" to achieve the same
effect.
=cut
sub readline { tied(*${+shift})->READLINE (@_) }
=item $fh->autoflush ([...])
Always returns true, arguments are being ignored (exists for compatibility
Coro/Handle.pm view on Meta::CPAN
sub _writable_anyevent {
my $cb = Coro::rouse_cb;
my $w = AE::io $_[0][0], 1, sub { $cb->(1) };
my $t = (defined $_[0][2]) && AE::timer $_[0][2], 0, sub { $cb->(0) };
Coro::rouse_wait
}
sub _readable_coro {
($_[0][5] ||= "Coro::Event"->io (
fd => $_[0][0],
desc => "fh $_[0][1] read watcher",
timeout => $_[0][2],
poll => &Event::Watcher::R + &Event::Watcher::E + &Event::Watcher::T,
))->next->[4] & &Event::Watcher::R
}
sub _writable_coro {
($_[0][6] ||= "Coro::Event"->io (
fd => $_[0][0],
desc => "fh $_[0][1] write watcher",
timeout => $_[0][2],
poll => &Event::Watcher::W + &Event::Watcher::E + &Event::Watcher::T,
))->next->[4] & &Event::Watcher::W
}
#sub _readable_ev {
# &EV::READ == Coro::EV::timed_io_once (fileno $_[0][0], &EV::READ , $_[0][2])
Coro/Handle.pm view on Meta::CPAN
#
#sub _writable_ev {
# &EV::WRITE == Coro::EV::timed_io_once (fileno $_[0][0], &EV::WRITE, $_[0][2])
#}
# decide on event model at runtime
for my $rw (qw(readable writable)) {
*$rw = sub {
AnyEvent::detect;
if ($AnyEvent::MODEL eq "AnyEvent::Impl::Event" and eval { require Coro::Event }) {
*$rw = \&{"_$rw\_coro"};
*cleanup = sub {
eval {
$_[0][5]->cancel if $_[0][5];
$_[0][6]->cancel if $_[0][6];
};
@{$_[0]} = ();
};
} elsif ($AnyEvent::MODEL eq "AnyEvent::Impl::EV" and eval { require Coro::EV }) {
*$rw = \&{"Coro::EV::_$rw\_ev"};
Coro/Intro.pod view on Meta::CPAN
Coro started as a simple module that implemented a specific form of
first class continuations called Coroutines. These basically allow you
to capture the current point execution and jump to another point, while
allowing you to return at any time, as kind of non-local jump, not unlike
C's C<setjmp>/C<longjmp>. This is nowadays known as a L<Coro::State>.
One natural application for these is to include a scheduler, resulting in
cooperative threads, which is the main use case for Coro today. Still,
much of the documentation and custom refers to these threads as
"coroutines" or often just "coros".
A thread is very much like a stripped-down perl interpreter, or a
process: Unlike a full interpreter process, a thread doesn't have its own
variable or code namespaces - everything is shared. That means that when
one thread modifies a variable (or any value, e.g. through a reference),
then other threads immediately see this change when they look at the same
variable or location.
Cooperative means that these threads must cooperate with each other, when
it comes to CPU usage - only one thread ever has the CPU, and if another
Coro/Intro.pod view on Meta::CPAN
schedule;
Now, when you run it, one of two things happen: Either the C<async> thread
wakes up the main thread again, in which case the program silently exits,
or it doesn't, in which case you get something like this:
FATAL: deadlock detected.
PID SC RSS USES Description Where
31976480 -C 19k 0 [main::] [program:9]
32223768 UC 12k 1 [Coro.pm:691]
32225088 -- 2068 1 [coro manager] [Coro.pm:691]
32225184 N- 216 0 [unblock_sub scheduler] -
Why is that? Well, when the C<async> thread runs into the end of its
block, it will be terminated (via a call to C<Coro::terminate>) and the
scheduler is called again. Since the C<async> thread hasn't woken up the
main thread, and there aren't any other threads, there is nothing to wake
up, and the program cannot continue. Since there I<are> threads that
I<could> be running (main) but none are I<ready> to do so, Coro signals a
I<deadlock> - no progress is possible. Usually you also get a listing of
all threads, which might help you track down the problem.
Coro/Intro.pod view on Meta::CPAN
$lock->up; # unlock it
}
No matter how many threads call C<costly_function>, only one will run
the body of it, all others will wait in the C<down> call. If you want to
limit the number of concurrent executions to five, you could create the
semaphore with an initial count of C<5>.
Why does the comment mention an "operation the blocks"? Again, that's
because coro's threads are cooperative: unless C<costly_function>
willingly gives up the CPU, other threads of control will simply not
run. This makes locking superfluous in cases where the function itself
never gives up the CPU, but when dealing with the outside world, this is
rare.
Now consider what happens when the code C<die>s after executing C<down>,
but before C<up>. This will leave the semaphore in a locked state, which
often isn't what you want - imagine the caller expecting a failure and
wrapping the call into an C<eval {}>.
Coro/Intro.pod view on Meta::CPAN
=item $SIG{__DIE__} and $SIG{__WARN__}
If these weren't per-thread, then common constructs such as:
eval {
local $SIG{__DIE__} = sub { ... };
...
};
Would not allow coroutine switching. Since exception-handling is
per-thread, those variables should be per-thread as well.
=item Lots of other esoteric stuff
For example, C<$^H> is per-thread. Most of the additional per-thread state
is not directly visible to Perl, but required to make the interpreter
work. You won't normally notice these.
=back
Coro/Intro.pod view on Meta::CPAN
use Coro::Debug;
Coro::Debug::command "ps";
Remember the example with the two channels and a worker thread that
squared numbers? Running "ps" just after C<< $calculate->get >> outputs
something similar to this:
PID SC RSS USES Description Where
8917312 -C 22k 0 [main::] [introscript:20]
8964448 N- 152 0 [coro manager] -
8964520 N- 152 0 [unblock_sub scheduler] -
8591752 UC 152 1 [introscript:12]
11546944 N- 152 0 [EV idle process] -
Interesting - there is more going on in the background than one would
expect. Ignoring the extra threads, the main thread has pid
C<8917312>, and the one started by C<async> has pid C<8591752>.
The latter is also the only thread that doesn't have a description,
simply because we haven't set one. Setting one is easy, just put it into
Coro/Intro.pod view on Meta::CPAN
for (
(async { finger "abc", "cornell.edu" }),
(async { finger "sebbo", "world.std.com" }),
(async { finger "trouble", "noc.dfn.de" }),
) {
$_->join; # wait for the result
}
There are a few new things here. First of all, there is
L<Coro::Socket>. This module works much the same way as
L<IO::Socket::INET>, except that it is coroutine-aware. This means that
L<IO::Socket::INET>, when waiting for the network, will block the whole
process - that means all threads, which is clearly undesirable.
On the other hand, L<Coro::Socket> knows how to give up the CPU to other
threads when it waits for the network, which makes parallel execution
possible.
The other new thing is the C<join> method: All we want to do in this
example is start three C<async> threads and only exit when they have
done their job. This could be done using a counting semaphore, but it is
Coro/Intro.pod view on Meta::CPAN
If you are experienced in event-based programming, you will see that the
above program doesn't quite follow the normal pattern, where you start
some work, and then run the event loop (e.v. C<EV::loop>).
In fact, nontrivial programs follow this pattern even with Coro, so a Coro
program that uses EV usually looks like this:
use EV;
use Coro;
# start coroutines or event watchers
EV::loop; # and loop
And in fact, for debugging, you often do something like this:
use EV;
use Coro::Debug;
my $shell = new_unix_server Coro::Debug "/tmp/myshell";
EV::loop; # and loop
This runs your program, but also an interactive shell on the unix domain
socket in F</tmp/myshell>. You can use the F<socat> program to access it:
# socat readline /tmp/myshell
coro debug session. use help for more info
> ps
PID SC RSS USES Description Where
136672312 RC 19k 177k [main::] [myprog:28]
136710424 -- 1268 48 [coro manager] [Coro.pm:349]
> help
ps [w|v] show the list of all coroutines (wide, verbose)
bt <pid> show a full backtrace of coroutine <pid>
eval <pid> <perl> evaluate <perl> expression in context of <pid>
trace <pid> enable tracing for this coroutine
untrace <pid> disable tracing for this coroutine
kill <pid> <reason> throws the given <reason> string in <pid>
cancel <pid> cancels this coroutine
ready <pid> force <pid> into the ready queue
<anything else> evaluate as perl and print results
<anything else> & same as above, but evaluate asynchronously
you can use (find_coro <pid>) in perl expressions
to find the coro with the given pid, e.g.
(find_coro 9768720)->ready
loglevel <int> enable logging for messages of level <int> and lower
exit end this session
Microsft victims can of course use the even less secure C<new_tcp_server>
constructor.
=head2 The Real World - File I/O
Disk I/O, while often much faster than the network, nevertheless can take
Coro/Intro.pod view on Meta::CPAN
=head1 Other Modules
This introduction only mentions a few methods and modules, Coro has many
other functions (see the L<Coro> manpage) and modules (documented in the
C<SEE ALSO> section of the L<Coro> manpage).
Noteworthy modules are L<Coro::LWP> (for parallel LWP requests, but see
L<AnyEvent::HTTP> for a better HTTP-only alternative), L<Coro::BDB>, for
when you need an asynchronous database, L<Coro::Handle>, when you need
to use any file handle in a coroutine (popular to access C<STDIN> and
C<STDOUT>) and L<Coro::EV>, the optimised interface to L<EV> (which gets
used automatically by L<Coro::AnyEvent>).
There are a number of Coro-related moduels that might be useful for your problem
(see L<http://search.cpan.org/search?query=Coro&mode=module>). And since Coro
integrates so well into AnyEvent, it's often easy to adapt existing AnyEvent modules
(see L<http://search.cpan.org/search?query=AnyEvent&mode=module>).
=head1 AUTHOR
Coro/LWP.pm view on Meta::CPAN
users, requires Coro.
=back
=head1 DESCRIPTION
This module is an L<AnyEvent> user, you need to make sure that you use and
run a supported event loop.
This module tries to make L<LWP|LWP> non-blocking with respect to other
coroutines as much as possible, and with whatever means it takes.
LWP really tries very hard to be blocking (and relies on a lot of
undocumented functionality in IO::Socket), so this module had to be very
invasive and must be loaded very early to take the proper effect.
Note that the module L<AnyEvent::HTTP> might offer an alternative to the
full L<LWP> that is designed to be non-blocking.
Here is what it currently does (future versions of LWP might require
different tricks):
Coro/LWP.pm view on Meta::CPAN
who-knows-what.
Impact: everybody else uses this (slower) version of select, too. It should be quite
compatible to perls builtin select, though.
=item It overwrites Socket::inet_aton with Coro::Util::inet_aton.
This is necessary because LWP might (and does) try to resolve hostnames
this way.
Impact: some code might not expect coroutine semantics, for example, when
you fork you might prefer the blocking variant because other coroutines
shouldn't actually run.
=item It replaces the base class of Net::HTTP, Net::FTP, Net::NNTP.
This is necessary because LWP does not always use select to see whether
a filehandle can be read/written without blocking, so the base class
C<IO::Socket::INET> needs to be replaced by C<Coro::Socket>.
Impact: Coro::Socket is not at all compatible to IO::Socket::INET. While
it duplicates some undocumented functionality required by LWP, it does not
Coro/MakeMaker.pm view on Meta::CPAN
package Coro::MakeMaker;
use common::sense;
use Config;
use base 'Exporter';
our $installsitearch;
our $VERSION = 6.514;
our @EXPORT_OK = qw(&coro_args $installsitearch);
my %opt;
for my $opt (split /:+/, $ENV{PERL_MM_OPT}) {
my ($k,$v) = split /=/, $opt;
$opt{$k} = $v;
}
my $extra = $Config{sitearch};
$extra =~ s/$Config{prefix}/$opt{PREFIX}/ if
exists $opt{PREFIX};
for my $d ($extra, @INC) {
if (-e "$d/Coro/CoroAPI.h") {
$installsitearch = $d;
last;
}
}
sub coro_args {
my %arg = @_;
$arg{INC} .= " -I$installsitearch/Coro";
%arg;
}
1;
__END__
=head1 NAME
Coro::MakeMaker - MakeMaker glue for the XS-level Coro API
=head1 SYNOPSIS
This allows you to control coroutines from C/XS.
=head1 DESCRIPTION
For optimal performance, hook into Coro at the C-level. You'll need to
make changes to your C<Makefile.PL> and add code to your C<xs> / C<c>
file(s).
=head1 WARNING
When you hook in at the C-level you can get a I<huge> performance gain,
but you also reduce the chances that your code will work unmodified with
newer versions of C<perl> or C<Coro>. This may or may not be a problem.
Just be aware, and set your expectations accordingly.
=head1 HOW TO
=head2 Makefile.PL
use Coro::MakeMaker qw(coro_args);
# ... set up %args ...
WriteMakefile (coro_args (%args));
=head2 XS
#include "CoroAPI.h"
BOOT:
I_CORO_API ("YourModule");
=head2 API
Coro/MakeMaker.pm view on Meta::CPAN
the distribution, and check the examples in F<EV/> and F<Event/*>, or
as a more real-world example, the Deliantra game server (which uses
Coro::MakeMaker).
You can also drop me a mail if you run into any trouble.
#define CORO_TRANSFER(prev,next) /* transfer from prev to next */
#define CORO_SCHEDULE /* like Coro::schedule */
#define CORO_CEDE /* like Coro::cede */
#define CORO_CEDE_NOTSELF /* like Coro::cede_notself */
#define CORO_READY(coro) /* like $coro->ready */
#define CORO_IS_READY(coro) /* like $coro->is_ready */
#define CORO_NREADY /* # of procs in ready queue */
#define CORO_CURRENT /* returns $Coro::current */
#define CORO_THROW /* exception pending? */
#define CORO_READYHOOK /* hook for event libs, see Coro::EV */
/* C-level coroutine struct, opaque, not used much */
struct coro;
/* used for schedule-like-function prepares */
struct coro_transfer_args
{
struct coro *prev, *next;
};
/* this is the per-perl-coro slf frame info */
struct CoroSLF
{
void (*prepare) (pTHX_ struct coro_transfer_args *ta); /* 0 means not yet initialised */
int (*check) (pTHX_ struct CoroSLF *frame);
void *data; /* for use by prepare/check/destroy */
void (*destroy) (pTHX_ struct CoroSLF *frame);
};
/* needs to fill in the *frame */
typedef void (*coro_slf_cb) (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items);
#define CORO_SV_STATE(coro) /* returns the internal struct coro * */
#define CORO_EXECUTE_SLF(cv,init,ax) /* execute a schedule-like function */
#define CORO_EXECUTE_SLF_XS(init) /* SLF in XS, see e.g. Coro::EV */
/* called on enter/leave */
typedef void (*coro_enterleave_hook) (pTHX_ void *arg);
#define CORO_ENTERLEAVE_HOOK(coro,enter,enter_arg,leave,leave_arg) /* install an XS-level enter/leave hook */
#define CORO_ENTERLEAVE_UNHOOK(coro,enter,leave) /* remove an XS-level enter/leave hook */
#define CORO_ENTERLEAVE_SCOPE_HOOK(enter,enter_arg,leave,leave_arg) /* install an XS-level enter/leave hook for the corrent scope */
=head1 AUTHOR/SUPPORT/CONTACT
Marc A. Lehmann <schmorp@schmorp.de>
http://software.schmorp.de/pkg/Coro.html
=cut
Coro/Makefile.PL view on Meta::CPAN
$iface = "u";
} else {
$iface = "s";
}
print <<EOF;
*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
Coro can use a number of methods to implement coroutines at the C
level. The default chosen is based on your current confguration and is
correct in most cases, but you still can chose between these alternatives:
u The unix 'ucontext.h' functions are relatively new and not implemented
or well-tested in older unices. They allow very fast coroutine creation
and reasonably fast switching. They are, however, usually slower than
the other alternatives due to an extra syscall done by swapcontext. And
while nominally most portable (it's the only POSIX-standardised
interface for coroutines), ucontext functions are, as usual, broken on
most/all BSDs.
s If the ucontext functions are not working or you don't want
to use them for other reasons you can try a workaround using
setjmp/longjmp/sigaltstack (also standard unix functions). Coroutine
creation is rather slow, but switching is very fast (often much faster
than with the ucontext functions). Unfortunately, glibc-2.1 and
below don't even feature a working sigaltstack. You cannot use this
implementation if some other code uses SIGUSR2 or you plan to create
coroutines from an alternative signal stack, as both are being used for
coroutine creation.
a Handcoded assembly. This is the fastest and most compatible method,
with the least side effects, if it works, that is. It has been tested
on GNU/Linux x86 and x86_64 systems and should work on all x86/x86_64
systems using the SVR ELF ABI (it is also reported to be working on
Strawberry Perl for Windows using MinGW). This is the recommended
method on supported platforms. When it doesn't work, use another
method, such as (s)etjmp/longjmp.
l GNU/Linux. Very old GNU/Linux systems (glibc-2.1 and below) need
Coro/Makefile.PL view on Meta::CPAN
Perl), although, as there is no standard on how to do this under
windows, different environments might work differently. Doh.
f Microsoft Windows. Try this on Microsoft Windows if w fails. It is slower
and uses a lot more memory, but should be working all the time.
p Use pthread API. Try to avoid this option, it was only created to
make a point about the programming language shootout. It is unlikely
to work with perls that have windows process emulation enabled ("perl
threads"). It is also likely the slowest method of implementing
coroutines. It might work fine as a last resort, however, as the
pthread API is slightly better tested than ucontext functions for
example. Of course, not on BSDs, who usually have very broken pthread
implementations.
Coro tries hard to come up with a suitable default for most systems,
so pressing return at the prompt usually does the right thing. If you
experience problems (e.g. make test fails) then you should experiment with
this setting.
EOF
Coro/Makefile.PL view on Meta::CPAN
Per-context stack size factor: Depending on your settings, Coro tries to
share the C stacks is creates as much as possible, but sometimes it needs
to allocate a new one. This setting controls the maximum size that gets
allocated, and should not be set too high, as memory and address space
still is wasted even if it's not fully used. The value entered will be
multiplied by sizeof(void *), which is usually 4 on 32-bit systems, and 8
on 64-bit systems.
A setting of 16384 (the default) therefore corresponds to a 64k..128k
stack, which usually is ample space (you might even want to try 8192 or
lower if your program creates many coroutines).
On systems supporting mmap and dynamic memory management, the actual
memory usually gets allocated on demand, but with many large stacks you
can still run out of address space on your typical 32 bit platform (not to
forget the pagetables).
Some perls (mostly threaded ones and perl compiled under linux 2.6) and
some programs (inefficient regexes can use a lot of stack space) may
need much, much more: If Coro segfaults with weird backtraces (e.g. in a
function prologue) or in t/10_bugs.t, you might want to increase this to
Coro/Makefile.PL view on Meta::CPAN
Coro can use (or even trick) some perl functions into doing what it needs
instead of relying on (some) of its own functions. This might increase
chances that it compiles and works, but it could just as well result in
memory leaks, crashes or silent data corruption. It certainly does result
in slightly slower speed and higher memory consumption, though, so YOU
SHOULD ENABLE THIS OPTION ONLY AS A LAST RESORT.
EOF
my $use_internals = prompt ("Prefer perl functions over coro functions (y/n)?", "n");
$DEFINE .= " -DCORO_PREFER_PERL_FUNCTIONS=1" if $use_internals =~ /[yY]/;
print <<EOF;
*** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** *** ***
Coro can use a simple JIT compiler to compile a part of the thread switch
function at runtime. On perls with windows process emulation (most!),
this results in a 50% speed improvement. On sane perls, the gain is much
less, usually around 5%. If you enable this option, then the JIT will
Coro/Makefile.PL view on Meta::CPAN
EOF
WriteMakefile(
NAME => "Coro::State",
VERSION_FROM => "State.pm",
DEFINE => $DEFINE,
LIBS => @LIBS,
DIR => [],
depend => {
"State.c" => "state.h clone.c ecb.h libcoro/coro.h libcoro/coro.c",
},
);
sub conftest {
my $type = shift;
print "\nTrying to detect stack growth direction (for $type)\n";
print "You might see some warnings, this should not concern you.\n\n";
system "$Config{cc} $Config{ccflags} -D$type libcoro/conftest.c";
my $res = qx<./a.out>;
$res =~ s/\s+$//;
my ($sp, $ss) = split /,/, $res;
print "\n\n*****************************************************************************\n";
print "If the testsuite fails PLEASE provide the following information\n";
print "to Marc Lehmann <schmorp\@schmorp.de>: operating system name, version,\n";
print "architecture name and this string '$sp|$ss'. Thanks a lot!\n";#d#
print "*****************************************************************************\n\n";
Coro/RWLock.pm view on Meta::CPAN
# or:
$lck->wrlock; # acquire write lock
$lck->tryrdlock; # try a readlock
$lck->trywrlock; # try a write lock
=head1 DESCRIPTION
This module implements reader/write locks. A read can be acquired for
read by many coroutines in parallel as long as no writer has locked it
(shared access). A single write lock can be acquired when no readers
exist. RWLocks basically allow many concurrent readers (without writers)
OR a single writer (but no readers).
You don't have to load C<Coro::RWLock> manually, it will be loaded
automatically when you C<use Coro> and call the C<new> constructor.
=over 4
=cut
Coro/Select.pm view on Meta::CPAN
=head1 NAME
Coro::Select - a (slow but coro-aware) replacement for CORE::select
=head1 SYNOPSIS
use Coro::Select; # replace select globally (be careful, see below)
use Core::Select 'select'; # only in this module
use Coro::Select (); # use Coro::Select::select
=head1 DESCRIPTION
This module tries to create a fully working replacement for perl's
Coro/Socket.pm view on Meta::CPAN
(IO::Socket::UNIX->new
Local => "/tmp/socket",
Type => SOCK_STREAM,
);
=head1 DESCRIPTION
This module is an L<AnyEvent> user, you need to make sure that you use and
run a supported event loop.
This module implements socket-handles in a coroutine-compatible way,
that is, other coroutines can run while reads or writes block on the
handle. See L<Coro::Handle>, especially the note about prefering method
calls.
=head1 IPV6 WARNING
This module was written to imitate the L<IO::Socket::INET> API, and derive
from it. Since IO::Socket::INET does not support IPv6, this module does
neither.
Therefore it is not recommended to use Coro::Socket in new code. Instead,
Coro/Specific.pm view on Meta::CPAN
=head1 NAME
Coro::Specific - manage coroutine-specific variables.
=head1 SYNOPSIS
use Coro::Specific;
my $ref = new Coro::Specific;
$$ref = 5;
print $$ref;
=head1 DESCRIPTION
This module can be used to create variables (or better: references to
them) that are specific to the currently executing coroutine. This module
does not automatically load the Coro module (so the overhead will be small
when no coroutines are used).
A much faster method is to store extra keys into C<%$Coro::current>
- all you have to do is to make sure that the key is unique (e.g. by
prefixing it with your module name). You can even store data there before
loading the L<Coro> module - when Coro is loaded, the keys stored in
C<%$Coro::current> are automatically attached to the coro thread executing
the main program.
You don't have to load C<Coro::Specific> manually, it will be loaded
automatically when you C<use Coro> and call the C<new> constructor.
=over 4
=cut
package Coro::Specific;
use common::sense;
our $VERSION = 6.514;
=item new
Create a new coroutine-specific scalar and return a reference to it. The
scalar is guaranteed to be "undef". Once such a scalar has been allocated
you cannot deallocate it (yet), so allocate only when you must.
=cut
my $idx;
sub new {
my $var;
tie $var, Coro::Specific::;
Coro/Specific.pm view on Meta::CPAN
#sub DESTROY {
# push @idx, $$_[0];
#}
1;
=back
=head1 BUGS
The actual coroutine specific values do not automatically get destroyed
when the Coro::Specific object gets destroyed.
=head1 AUTHOR/SUPPORT/CONTACT
Marc A. Lehmann <schmorp@schmorp.de>
http://software.schmorp.de/pkg/Coro.html
=cut
Coro/State.pm view on Meta::CPAN
=head1 NAME
Coro::State - first class continuations
=head1 SYNOPSIS
use Coro::State;
$new = new Coro::State sub {
print "in coro (called with @_), switching back\n";
$new->transfer ($main);
print "in coro again, switching back\n";
$new->transfer ($main);
}, 5;
$main = new Coro::State;
print "in main, switching to coro\n";
$main->transfer ($new);
print "back in main, switch to coro again\n";
$main->transfer ($new);
print "back in main\n";
=head1 DESCRIPTION
This module implements coro objects. Coros, similar to threads and
continuations, allow you to run more than one "thread of execution" in
parallel. Unlike so-called "kernel" threads, there is no parallelism
and only voluntary switching is used so locking problems are greatly
reduced. The latter is called "cooperative" threading as opposed to
"preemptive" threading.
This can be used to implement non-local jumps, exception handling,
continuation objects and more.
This module provides only low-level functionality useful to build other
abstractions, such as threads, generators or coroutines. See L<Coro>
and related modules for a higher level threads abstraction including a
scheduler.
=head2 MODEL
Coro::State implements two different thread models: Perl and C. The C
threads (called cctx's) are basically simplified perl interpreters
running/interpreting the Perl threads. A single interpreter can run any
number of Perl threads, so usually there are very few C threads.
Coro/State.pm view on Meta::CPAN
=item $Coro::State::WARNHOOK
Similar to above die hook, but augments C<$SIG{__WARN__}>.
=back
=head2 Coro::State METHODS
=over 4
=item $coro = new Coro::State [$coderef[, @args...]]
Create a new Coro::State thread object and return it. The first
C<transfer> call to this thread will start execution at the given
coderef, with the given arguments.
Note that the arguments will not be copied. Instead, as with normal
function calls, the thread receives passed arguments by reference, so
make sure you don't change them in unexpected ways.
Returning from such a thread is I<NOT> supported. Neither is calling
Coro/State.pm view on Meta::CPAN
=item $state->eval ($string)
Like C<call>, but eval's the string. Dangerous.
=item $state->swap_defsv
=item $state->swap_defav
Swap the current C<$_> (swap_defsv) or C<@_> (swap_defav) with the
equivalent in the saved state of C<$state>. This can be used to give the
coro a defined content for C<@_> and C<$_> before transfer'ing to it.
=item $state->swap_sv (\$sv, \$swap_sv)
This (very advanced) function can be used to make I<any> variable local to
a thread.
It works by swapping the contents of C<$sv> and C<$swap_sv> each time the
thread is entered and left again, i.e. it is similar to:
$tmp = $sv; $sv = $swap_sv; $swap_sv = $tmp;
Coro/State.pm view on Meta::CPAN
not like, so don't do it.
Lastly, the C<$swap_sv> itself will be used, not a copy, so make sure you
give each thread it's own C<$swap_sv> instance.
It is, however, quite safe to swap some normal variable with
another. For example, L<PApp::SQL> stores the default database handle in
C<$PApp::SQL::DBH>. To make this a per-thread variable, use this:
my $private_dbh = ...;
$coro->swap_sv (\$PApp::SQL::DBH, \$private_dbh);
This results in C<$PApp::SQL::DBH> having the value of C<$private_dbh>
while it executes, and whatever other value it had when it doesn't
execute.
You can also swap hashes and other values:
my %private_hash;
$coro->swap_sv (\%some_hash, \%private_hash);
To undo an earlier C<swap_sv> call you must call C<swap_sv> with exactly
the same two variables in the same order (the references can be different,
it's the variables that they point to that count). For example, the
following sequence will remove the swap of C<$x> and C<$y>, while keeping
the swap of C<$x> and C<$z>:
$coro->swap_sv (\$x, \$y);
$coro->swap_sv (\$x, \$z);
$coro->swap_sv (\$x, \$y);
=item $bytes = $state->rss
Returns the memory allocated by the coro (which includes static
structures, various perl stacks but NOT local variables, arguments or any
C context data). This is a rough indication of how much memory it might
use.
=item ($real, $cpu) = $state->times
Returns the real time and cpu times spent in the given C<$state>. See
C<Coro::State::enable_times> for more info.
=item $state->trace ($flags)
Internal function to control tracing. I just mention this so you can stay
away from abusing it.
=back
=head3 METHODS FOR C CONTEXTS
Most coros only consist of some Perl data structures - transferring to a
coro just reconfigures the interpreter to continue somewhere else.
However. this is not always possible: For example, when Perl calls a C/XS function
(such as an event loop), and C then invokes a Perl callback, reconfiguring
the interpreter is not enough. Coro::State detects these cases automatically, and
attaches a C-level thread to each such Coro::State object, for as long as necessary.
The C-level thread structure is called "C context" (or cctxt for short),
and can be quite big, which is why Coro::State only creates them as needed
and can run many Coro::State's on a single cctxt.
Coro/State.pm view on Meta::CPAN
Forces the allocation of a private cctxt for the currently executing
Coro::State even though it would not normally ned one. Apart from
benchmarking or testing Coro itself, there is little point in doing so,
however.
=item $ncctx = Coro::State::cctx_count
Returns the number of C contexts allocated. If this number is very high
(more than a dozen) it might be beneficial to identify points of C-level
recursion (Perl calls C/XS, which calls Perl again which switches coros
- this forces an allocation of a C context) in your code and moving this
into a separate coro.
=item $nidle = Coro::State::cctx_idle
Returns the number of allocated but idle (currently unused and free for
reuse) C contexts.
=item $old = Coro::State::cctx_max_idle [$new_count]
Coro caches C contexts that are not in use currently, as creating them
from scratch has some overhead.
Coro/State.pm view on Meta::CPAN
=item $old = Coro::State::cctx_stacksize [$new_stacksize]
Returns the current C stack size and optionally sets the new I<minimum>
stack size to C<$new_stacksize> (in units of pointer sizes, i.e. typically
4 on 32 bit and 8 on 64 bit hosts). Existing stacks will not be changed,
but Coro will try to replace smaller stacks as soon as possible. Any
Coro::State that starts to use a stack after this call is guaranteed this
minimum stack size.
Please note that coros will only need to use a C-level stack if the
interpreter recurses or calls a function in a module that calls back into
the interpreter, so use of this feature is usually never needed.
=back
=head2 FUNCTIONS
=over 4
=item @states = Coro::State::list
Coro/State.pm view on Meta::CPAN
=item $clone = $state->clone
This exciting method takes a Coro::State object and clones it, i.e., it
creates a copy. This makes it possible to restore a state more than once,
and even return to states that have returned or have been terminated.
Since its only known purpose is for intellectual self-gratification, and
because it is a difficult piece of code, it is not enabled by default, and
not supported.
Here are a few little-known facts: First, coros *are* full/true/real
continuations. Secondly Coro::State objects (without clone) *are* first
class continuations. Thirdly, nobody has ever found a use for the full
power of call/cc that isn't better (faster, easier, more efficiently)
implemented differently, and nobody has yet found a useful control
construct that can't be implemented without it already, just much faster
and with fewer resources. And lastly, Scheme's call/cc doesn't support
using call/cc to implement threads.
Among the games you can play with this is implementing a scheme-like
call-with-current-continuation, as the following code does (well, with
Coro/State.pm view on Meta::CPAN
};
If you find this confusing, then you already understand the coolness of
call/cc: It can turn anything into spaghetti code real fast.
Besides, call/cc is much less useful in a Perl-like dynamic language (with
references, and its scoping rules) then in, say, scheme.
Now, the known limitations of C<clone>:
It probably only works on perl 5.10; it cannot clone a coro inside
the substition operator (but windows perl can't fork from there either)
and some other contexts, and C<abort ()> is the preferred mechanism to
signal errors. It cannot clone a state that has a c context attached
(implementing clone on the C level is too hard for me to even try),
which rules out calling call/cc from the main coro. It cannot
clone a context that hasn't even been started yet. It doesn't work with
C<-DDEBUGGING> (but what does). It probably also leaks, and sometimes
triggers a few assertions inside Coro. Most of these limitations *are*
fixable with some effort, but that's pointless just to make a point that
it could be done.
The current implementation could without doubt be optimised to be a
constant-time operation by doing lazy stack copying, if somebody were
insane enough to invest the time.
Coro/State.pm view on Meta::CPAN
# used by Coro::Debug only atm.
sub debug_desc {
$_[0]{desc}
}
# for very deep reasons, we must initialise $Coro::main here.
{
package Coro;
our $main; # main coro
our $current; # current coro
$main = Coro::new Coro::;
$main->{desc} = "[main::]";
# maybe some other module used Coro::Specific before...
$main->{_specific} = $current->{_specific}
if $current;
_set_current $main;
Coro/State.xs view on Meta::CPAN
/* this works around a bug in mingw32 providing a non-working setjmp */
#define USE_NO_MINGW_SETJMP_TWO_ARGS
#define NDEBUG 1 /* perl usually disables NDEBUG later */
#include "libcoro/coro.c"
#define PERL_NO_GET_CONTEXT
#define PERL_EXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "perliol.h"
#include "schmorp.h"
Coro/State.xs view on Meta::CPAN
# define dSTACKLEVEL int stacklevel_dummy
# define STACKLEVEL __builtin_frame_address (0)
#else
# define dSTACKLEVEL volatile void *stacklevel
# define STACKLEVEL ((void *)&stacklevel)
#endif
#define IN_DESTRUCT PL_dirty
#include "CoroAPI.h"
#define GCoroAPI (&coroapi) /* very sneaky */
#ifdef USE_ITHREADS
# if CORO_PTHREAD
static void *coro_thx;
# endif
#endif
#ifdef __linux
# include <time.h> /* for timespec */
# include <syscall.h> /* for SYS_* */
# ifdef SYS_clock_gettime
# define coro_clock_gettime(id, ts) syscall (SYS_clock_gettime, (id), (ts))
# define CORO_CLOCK_MONOTONIC 1
# define CORO_CLOCK_THREAD_CPUTIME_ID 3
# endif
#endif
/* one off bugfix for perl 5.22 */
#if PERL_VERSION_ATLEAST(5,22,0) && !PERL_VERSION_ATLEAST(5,24,0)
# undef PadlistNAMES
# define PadlistNAMES(pl) *((PADNAMELIST **)PadlistARRAY (pl))
#endif
Coro/State.xs view on Meta::CPAN
# undef NDEBUG
# include <assert.h>
#endif
static double (*nvtime)(); /* so why doesn't it take void? */
static void (*u2time)(pTHX_ UV ret[2]);
/* we hijack an hopefully unused CV flag for our purposes */
#define CVf_SLF 0x4000
static OP *pp_slf (pTHX);
static void slf_destroy (pTHX_ struct coro *coro);
static U32 cctx_gen;
static size_t cctx_stacksize = CORO_STACKSIZE;
static struct CoroAPI coroapi;
static AV *main_mainstack; /* used to differentiate between $main and others */
static JMPENV *main_top_env;
static HV *coro_state_stash, *coro_stash;
static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */
static AV *av_destroy; /* destruction queue */
static SV *sv_manager; /* the manager coro */
static SV *sv_idle; /* $Coro::idle */
static GV *irsgv; /* $/ */
static GV *stdoutgv; /* *STDOUT */
static SV *rv_diehook;
static SV *rv_warnhook;
/* async_pool helper stuff */
static SV *sv_pool_rss;
static SV *sv_pool_size;
static SV *sv_async_pool_idle; /* description string */
static AV *av_async_pool; /* idle pool */
static SV *sv_Coro; /* class string */
static CV *cv_pool_handler;
/* Coro::AnyEvent */
static SV *sv_activity;
/* enable processtime/realtime profiling */
static char enable_times;
typedef U32 coro_ts[2];
static coro_ts time_real, time_cpu;
static char times_valid;
static struct coro_cctx *cctx_first;
static int cctx_count, cctx_idle;
enum
{
CC_MAPPED = 0x01,
CC_NOREUSE = 0x02, /* throw this away after tracing */
CC_TRACE = 0x04,
CC_TRACE_SUB = 0x08, /* trace sub calls */
CC_TRACE_LINE = 0x10, /* trace each statement */
CC_TRACE_ALL = CC_TRACE_SUB | CC_TRACE_LINE,
};
/* this is a structure representing a c-level coroutine */
typedef struct coro_cctx
{
struct coro_cctx *next;
/* the stack */
struct coro_stack stack;
/* cpu state */
void *idle_sp; /* sp of top-level transfer/schedule/cede call */
#ifndef NDEBUG
JMPENV *idle_te; /* same as idle_sp, but for top_env */
#endif
JMPENV *top_env;
coro_context cctx;
U32 gen;
#if CORO_USE_VALGRIND
int valgrind_id;
#endif
unsigned char flags;
} coro_cctx;
static coro_cctx *cctx_current; /* the currently running cctx */
/*****************************************************************************/
static MGVTBL coro_state_vtbl;
enum
{
CF_RUNNING = 0x0001, /* coroutine is running */
CF_READY = 0x0002, /* coroutine is ready */
CF_NEW = 0x0004, /* has never been switched to */
CF_ZOMBIE = 0x0008, /* coroutine data has been freed */
CF_SUSPENDED = 0x0010, /* coroutine can't be scheduled */
CF_NOCANCEL = 0x0020, /* cannot cancel, set slf_frame.data to 1 (hackish) */
};
/* the structure where most of the perl state is stored, overlaid on the cxstack */
typedef struct
{
#define VARx(name,expr,type) type name;
#include "state.h"
} perl_slots;
/* how many context stack entries do we need for perl_slots */
#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))
/* this is a structure representing a perl-level coroutine */
struct coro
{
/* the C coroutine allocated to this perl coroutine, if any */
coro_cctx *cctx;
/* ready queue */
struct coro *next_ready;
/* state data */
struct CoroSLF slf_frame; /* saved slf frame */
AV *mainstack;
perl_slots *slot; /* basically the saved sp */
CV *startcv; /* the CV to execute */
AV *args; /* data associated with this coroutine (initial args) */
int flags; /* CF_ flags */
HV *hv; /* the perl hash associated with this coro, if any */
/* statistics */
int usecount; /* number of transfers to this coro */
/* coro process data */
int prio;
SV *except; /* exception to be thrown */
SV *rouse_cb; /* last rouse callback */
AV *on_destroy; /* callbacks or coros to notify on destroy */
AV *status; /* the exit status list */
/* async_pool */
SV *saved_deffh;
SV *invoke_cb;
AV *invoke_av;
/* on_enter/on_leave */
AV *on_enter; AV *on_enter_xs;
AV *on_leave; AV *on_leave_xs;
/* swap_sv */
AV *swap_sv;
/* times */
coro_ts t_cpu, t_real;
/* linked list */
struct coro *next, *prev;
};
typedef struct coro *Coro__State;
typedef struct coro *Coro__State_or_hashref;
/* the following variables are effectively part of the perl context */
/* and get copied between struct coro and these variables */
/* the main reason we don't support windows process emulation */
static struct CoroSLF slf_frame; /* the current slf frame */
/** Coro ********************************************************************/
#define CORO_PRIO_MAX 3
#define CORO_PRIO_HIGH 1
#define CORO_PRIO_NORMAL 0
#define CORO_PRIO_LOW -1
#define CORO_PRIO_IDLE -3
#define CORO_PRIO_MIN -4
/* for Coro.pm */
static SV *coro_current;
static SV *coro_readyhook;
static struct coro *coro_ready [CORO_PRIO_MAX - CORO_PRIO_MIN + 1][2]; /* head|tail */
static CV *cv_coro_run;
static struct coro *coro_first;
#define coro_nready coroapi.nready
/** JIT *********************************************************************/
#if CORO_JIT
/* APPLE doesn't have mmap though */
#define CORO_JIT_UNIXY (__linux || __FreeBSD__ || __OpenBSD__ || __NetBSD__ || __solaris || __APPLE__)
#ifndef CORO_JIT_TYPE
#if ECB_AMD64 && CORO_JIT_UNIXY
#define CORO_JIT_TYPE "amd64-unix"
#elif __i386 && CORO_JIT_UNIXY
Coro/State.xs view on Meta::CPAN
#undef CORO_JIT
#endif
#if CORO_JIT
typedef void (*load_save_perl_slots_type)(perl_slots *);
static load_save_perl_slots_type load_perl_slots, save_perl_slots;
#endif
/** Coro::Select ************************************************************/
static OP *(*coro_old_pp_sselect) (pTHX);
static SV *coro_select_select;
/* horrible hack, but if it works... */
static OP *
coro_pp_sselect (pTHX)
{
dSP;
PUSHMARK (SP - 4); /* fake argument list */
XPUSHs (coro_select_select);
PUTBACK;
/* entersub is an UNOP, select a LISTOP... keep your fingers crossed */
PL_op->op_flags |= OPf_STACKED;
PL_op->op_private = 0;
return PL_ppaddr [OP_ENTERSUB](aTHX);
}
/** time stuff **************************************************************/
#ifdef HAS_GETTIMEOFDAY
ecb_inline void
coro_u2time (pTHX_ UV ret[2])
{
struct timeval tv;
gettimeofday (&tv, 0);
ret [0] = tv.tv_sec;
ret [1] = tv.tv_usec;
}
ecb_inline double
coro_nvtime (void)
{
struct timeval tv;
gettimeofday (&tv, 0);
return tv.tv_sec + tv.tv_usec * 1e-6;
}
ecb_inline void
time_init (pTHX)
{
nvtime = coro_nvtime;
u2time = coro_u2time;
}
#else
ecb_inline void
time_init (pTHX)
{
SV **svp;
require_pv ("Time/HiRes.pm");
Coro/State.xs view on Meta::CPAN
svp = hv_fetch (PL_modglobal, "Time::U2time", 12, 0);
u2time = INT2PTR (void (*)(pTHX_ UV ret[2]), SvIV (*svp));
}
#endif
/** lowlevel stuff **********************************************************/
static SV * ecb_noinline
coro_get_sv (pTHX_ const char *name, int create)
{
#if PERL_VERSION_ATLEAST (5,10,0)
/* silence stupid and wrong 5.10 warning that I am unable to switch off */
get_sv (name, create);
#endif
return get_sv (name, create);
}
static AV * ecb_noinline
coro_get_av (pTHX_ const char *name, int create)
{
#if PERL_VERSION_ATLEAST (5,10,0)
/* silence stupid and wrong 5.10 warning that I am unable to switch off */
get_av (name, create);
#endif
return get_av (name, create);
}
static HV * ecb_noinline
coro_get_hv (pTHX_ const char *name, int create)
{
#if PERL_VERSION_ATLEAST (5,10,0)
/* silence stupid and wrong 5.10 warning that I am unable to switch off */
get_hv (name, create);
#endif
return get_hv (name, create);
}
ecb_inline void
coro_times_update (void)
{
#ifdef coro_clock_gettime
struct timespec ts;
ts.tv_sec = ts.tv_nsec = 0;
coro_clock_gettime (CORO_CLOCK_THREAD_CPUTIME_ID, &ts);
time_cpu [0] = ts.tv_sec; time_cpu [1] = ts.tv_nsec;
ts.tv_sec = ts.tv_nsec = 0;
coro_clock_gettime (CORO_CLOCK_MONOTONIC, &ts);
time_real [0] = ts.tv_sec; time_real [1] = ts.tv_nsec;
#else
dTHX;
UV tv[2];
u2time (aTHX_ tv);
time_real [0] = tv [0];
time_real [1] = tv [1] * 1000;
#endif
}
ecb_inline void
coro_times_add (struct coro *c)
{
c->t_real [1] += time_real [1];
if (c->t_real [1] > 1000000000) { c->t_real [1] -= 1000000000; ++c->t_real [0]; }
c->t_real [0] += time_real [0];
c->t_cpu [1] += time_cpu [1];
if (c->t_cpu [1] > 1000000000) { c->t_cpu [1] -= 1000000000; ++c->t_cpu [0]; }
c->t_cpu [0] += time_cpu [0];
}
ecb_inline void
coro_times_sub (struct coro *c)
{
if (c->t_real [1] < time_real [1]) { c->t_real [1] += 1000000000; --c->t_real [0]; }
c->t_real [1] -= time_real [1];
c->t_real [0] -= time_real [0];
if (c->t_cpu [1] < time_cpu [1]) { c->t_cpu [1] += 1000000000; --c->t_cpu [0]; }
c->t_cpu [1] -= time_cpu [1];
c->t_cpu [0] -= time_cpu [0];
}
Coro/State.xs view on Meta::CPAN
#define CORO_MAGIC(sv, type) \
(ecb_expect_true (SvMAGIC (sv)) \
? CORO_MAGIC_NN (sv, type) \
: 0)
#define CORO_MAGIC_cv(cv) CORO_MAGIC (((SV *)(cv)), CORO_MAGIC_type_cv)
#define CORO_MAGIC_state(sv) CORO_MAGIC_NN (((SV *)(sv)), CORO_MAGIC_type_state)
ecb_inline MAGIC *
SvSTATEhv_p (pTHX_ SV *coro)
{
MAGIC *mg;
if (ecb_expect_true (
SvTYPE (coro) == SVt_PVHV
&& (mg = CORO_MAGIC_state (coro))
&& mg->mg_virtual == &coro_state_vtbl
))
return mg;
return 0;
}
ecb_inline struct coro *
SvSTATE_ (pTHX_ SV *coro_sv)
{
MAGIC *mg;
if (SvROK (coro_sv))
coro_sv = SvRV (coro_sv);
mg = SvSTATEhv_p (aTHX_ coro_sv);
if (!mg)
croak ("Coro::State object required");
return (struct coro *)mg->mg_ptr;
}
#define SvSTATE(sv) SvSTATE_ (aTHX_ (sv))
/* faster than SvSTATE, but expects a coroutine hv */
#define SvSTATE_hv(hv) ((struct coro *)CORO_MAGIC_NN ((SV *)hv, CORO_MAGIC_type_state)->mg_ptr)
#define SvSTATE_current SvSTATE_hv (SvRV (coro_current))
/*****************************************************************************/
/* padlist management and caching */
ecb_inline PADLIST *
coro_derive_padlist (pTHX_ CV *cv)
{
PADLIST *padlist = CvPADLIST (cv);
PADLIST *newpadlist;
PADNAMELIST *padnames;
PAD *newpad;
PADOFFSET off = PadlistMAX (padlist) + 1;
#if NEWPADAPI
/* if we had the original CvDEPTH, we might be able to steal the CvDEPTH+1 entry instead */
Coro/State.xs view on Meta::CPAN
Safefree (padlist);
#else
AvFILLp (padlist) = -1;
AvREAL_off (padlist);
SvREFCNT_dec ((SV*)padlist);
#endif
}
}
static int
coro_cv_free (pTHX_ SV *sv, MAGIC *mg)
{
PADLIST *padlist;
PADLIST **padlists = (PADLIST **)(mg->mg_ptr + sizeof(size_t));
size_t len = *(size_t *)mg->mg_ptr;
/* perl manages to free our internal AV and _then_ call us */
if (IN_DESTRUCT)
return 0;
while (len--)
free_padlist (aTHX_ padlists[len]);
return 0;
}
static MGVTBL coro_cv_vtbl = {
0, 0, 0, 0,
coro_cv_free
};
/* the next two functions merely cache the padlists */
ecb_inline void
get_padlist (pTHX_ CV *cv)
{
MAGIC *mg = CORO_MAGIC_cv (cv);
size_t *lenp;
if (ecb_expect_true (mg && *(lenp = (size_t *)mg->mg_ptr)))
Coro/State.xs view on Meta::CPAN
else
{
#if CORO_PREFER_PERL_FUNCTIONS
/* this is probably cleaner? but also slower! */
/* in practise, it seems to be less stable */
CV *cp = Perl_cv_clone (aTHX_ cv);
CvPADLIST (cv) = CvPADLIST (cp);
CvPADLIST (cp) = 0;
SvREFCNT_dec (cp);
#else
CvPADLIST (cv) = coro_derive_padlist (aTHX_ cv);
#endif
}
}
ecb_inline void
put_padlist (pTHX_ CV *cv)
{
MAGIC *mg = CORO_MAGIC_cv (cv);
if (ecb_expect_false (!mg))
{
mg = sv_magicext ((SV *)cv, 0, CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
Newz (0, mg->mg_ptr ,sizeof (size_t) + sizeof (PADLIST *), char);
mg->mg_len = 1; /* so mg_free frees mg_ptr */
}
else
Renew (mg->mg_ptr,
sizeof(size_t) + (*(size_t *)mg->mg_ptr + 1) * sizeof(PADLIST *),
char);
((PADLIST **)(mg->mg_ptr + sizeof (size_t))) [(*(size_t *)mg->mg_ptr)++] = CvPADLIST (cv);
}
Coro/State.xs view on Meta::CPAN
static void
swap_svs_leave (pTHX_ Coro__State c)
{
int i;
for (i = AvFILLp (c->swap_sv) - 1; i >= 0; i -= 2)
swap_sv (AvARRAY (c->swap_sv)[i], AvARRAY (c->swap_sv)[i + 1]);
}
#define SWAP_SVS_ENTER(coro) \
if (ecb_expect_false ((coro)->swap_sv)) \
swap_svs_enter (aTHX_ (coro))
#define SWAP_SVS_LEAVE(coro) \
if (ecb_expect_false ((coro)->swap_sv)) \
swap_svs_leave (aTHX_ (coro))
static void
on_enterleave_call (pTHX_ SV *cb);
static void
load_perl (pTHX_ Coro__State c)
{
perl_slots *slot = c->slot;
c->slot = 0;
Coro/State.xs view on Meta::CPAN
PUTBACK;
}
slf_frame = c->slf_frame;
CORO_THROW = c->except;
if (ecb_expect_false (enable_times))
{
if (ecb_expect_false (!times_valid))
coro_times_update ();
coro_times_sub (c);
}
if (ecb_expect_false (c->on_enter))
{
int i;
for (i = 0; i <= AvFILLp (c->on_enter); ++i)
on_enterleave_call (aTHX_ AvARRAY (c->on_enter)[i]);
}
if (ecb_expect_false (c->on_enter_xs))
{
int i;
for (i = 0; i <= AvFILLp (c->on_enter_xs); i += 2)
((coro_enterleave_hook)AvARRAY (c->on_enter_xs)[i]) (aTHX_ AvARRAY (c->on_enter_xs)[i + 1]);
}
SWAP_SVS_ENTER (c);
}
static void
save_perl (pTHX_ Coro__State c)
{
SWAP_SVS_LEAVE (c);
if (ecb_expect_false (c->on_leave_xs))
{
int i;
for (i = AvFILLp (c->on_leave_xs) - 1; i >= 0; i -= 2)
((coro_enterleave_hook)AvARRAY (c->on_leave_xs)[i]) (aTHX_ AvARRAY (c->on_leave_xs)[i + 1]);
}
if (ecb_expect_false (c->on_leave))
{
int i;
for (i = AvFILLp (c->on_leave); i >= 0; --i)
on_enterleave_call (aTHX_ AvARRAY (c->on_leave)[i]);
}
times_valid = 0;
if (ecb_expect_false (enable_times))
{
coro_times_update (); times_valid = 1;
coro_times_add (c);
}
c->except = CORO_THROW;
c->slf_frame = slf_frame;
{
dSP;
I32 cxix = cxstack_ix;
PERL_CONTEXT *ccstk = cxstack;
PERL_SI *top_si = PL_curstackinfo;
Coro/State.xs view on Meta::CPAN
#else
#define VARx(name,expr,type) slot->name = expr;
#include "state.h"
#endif
}
}
/*
* allocate various perl stacks. This is almost an exact copy
* of perl.c:init_stacks, except that it uses less memory
* on the (sometimes correct) assumption that coroutines do
* not usually need a lot of stackspace.
*/
#if CORO_PREFER_PERL_FUNCTIONS
# define coro_init_stacks(thx) init_stacks ()
#else
static void
coro_init_stacks (pTHX)
{
PL_curstackinfo = new_stackinfo(32, 4 + SLOT_COUNT); /* 3 is minimum due to perl rounding down in scope.c:GROW() */
PL_curstackinfo->si_type = PERLSI_MAIN;
PL_curstack = PL_curstackinfo->si_stack;
PL_mainstack = PL_curstack; /* remember in case we switch stacks */
PL_stack_base = AvARRAY(PL_curstack);
PL_stack_sp = PL_stack_base;
PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
Coro/State.xs view on Meta::CPAN
PL_retstack_ix = 0;
PL_retstack_max = 4;
#endif
}
#endif
/*
* destroy the stacks, the callchain etc...
*/
static void
coro_destruct_stacks (pTHX)
{
while (PL_curstackinfo->si_next)
PL_curstackinfo = PL_curstackinfo->si_next;
while (PL_curstackinfo)
{
PERL_SI *p = PL_curstackinfo->si_prev;
if (!IN_DESTRUCT)
SvREFCNT_dec (PL_curstackinfo->si_stack);
Coro/State.xs view on Meta::CPAN
#define CORO_RSS \
rss += sizeof (SYM (curstackinfo)); \
rss += (SYM (curstackinfo->si_cxmax) + 1) * sizeof (PERL_CONTEXT); \
rss += sizeof (SV) + sizeof (struct xpvav) + (1 + AvMAX (SYM (curstack))) * sizeof (SV *); \
rss += SYM (tmps_max) * sizeof (SV *); \
rss += (SYM (markstack_max) - SYM (markstack_ptr)) * sizeof (I32); \
rss += SYM (scopestack_max) * sizeof (I32); \
rss += SYM (savestack_max) * sizeof (ANY);
static size_t
coro_rss (pTHX_ struct coro *coro)
{
size_t rss = sizeof (*coro);
if (coro->mainstack)
{
if (coro->flags & CF_RUNNING)
{
#define SYM(sym) PL_ ## sym
CORO_RSS;
#undef SYM
}
else
{
#define SYM(sym) coro->slot->sym
CORO_RSS;
#undef SYM
}
}
return rss;
}
/** provide custom get/set/clear methods for %SIG elements ******************/
/* apparently < 5.8.8 */
#ifndef MgPV_nolen_const
#define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \
SvPV_nolen((SV*)((mg)->mg_ptr)) : \
(const char*)(mg)->mg_ptr)
#endif
/* this will be a patched copy of PL_vtbl_sigelem */
static MGVTBL coro_sigelem_vtbl;
static int ecb_cold
coro_sig_copy (pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *name, I32 namlen)
{
char *key = SvPV_nolen ((SV *)name);
/* do what mg_copy normally does */
sv_magic (nsv, mg->mg_obj, PERL_MAGIC_sigelem, name, namlen);
assert (mg_find (nsv, PERL_MAGIC_sigelem)->mg_virtual == &PL_vtbl_sigelem);
/* patch sigelem vtbl, but only for __WARN__ and __DIE__ */
if (*key == '_'
&& (strEQ (key, "__DIE__")
|| strEQ (key, "__WARN__")))
mg_find (nsv, PERL_MAGIC_sigelem)->mg_virtual = &coro_sigelem_vtbl;
return 1;
}
/* perl does not have a %SIG vtbl, we provide one so we can override */
/* the magic vtbl for the __DIE__ and __WARN__ members */
static const MGVTBL coro_sig_vtbl = {
0, 0, 0, 0, 0,
coro_sig_copy
};
/*
* This overrides the default magic get method of %SIG elements.
* The original one doesn't provide for reading back of PL_diehook/PL_warnhook
* and instead of trying to save and restore the hash elements (extremely slow),
* we just provide our own readback here.
*/
static int ecb_cold
coro_sigelem_get (pTHX_ SV *sv, MAGIC *mg)
{
const char *s = MgPV_nolen_const (mg);
/* the key must be either __DIE__ or __WARN__ here */
SV **svp = s[2] == 'D' ? &PL_diehook : &PL_warnhook;
SV *ssv;
if (!*svp)
ssv = &PL_sv_undef;
else if (SvTYPE (*svp) == SVt_PVCV) /* perlio directly stores a CV in warnhook. ugh. */
ssv = sv_2mortal (newRV_inc (*svp));
else
ssv = *svp;
sv_setsv (sv, ssv);
return 0;
}
static int ecb_cold
coro_sigelem_clr (pTHX_ SV *sv, MAGIC *mg)
{
const char *s = MgPV_nolen_const (mg);
/* the key must be either __DIE__ or __WARN__ here */
SV **svp = s[2] == 'D' ? &PL_diehook : &PL_warnhook;
SV *old = *svp;
*svp = 0;
SvREFCNT_dec (old);
return 0;
}
static int ecb_cold
coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)
{
const char *s = MgPV_nolen_const (mg);
/* the key must be either __DIE__ or __WARN__ here */
SV **svp = s[2] == 'D' ? &PL_diehook : &PL_warnhook;
SV *old = *svp;
*svp = SvOK (sv) ? newSVsv (sv) : 0;
SvREFCNT_dec (old);
return 0;
}
static void
prepare_nop (pTHX_ struct coro_transfer_args *ta)
{
/* kind of mega-hacky, but works */
ta->next = ta->prev = (struct coro *)ta;
}
static int
slf_check_nop (pTHX_ struct CoroSLF *frame)
{
return 0;
}
static int
slf_check_repeat (pTHX_ struct CoroSLF *frame)
{
return 1;
}
/** coroutine stack handling ************************************************/
static UNOP init_perl_op;
ecb_noinline static void /* noinline to keep it out of the transfer fast path */
init_perl (pTHX_ struct coro *coro)
{
/*
* emulate part of the perl startup here.
*/
coro_init_stacks (aTHX);
PL_runops = RUNOPS_DEFAULT;
PL_curcop = &PL_compiling;
PL_in_eval = EVAL_NULL;
PL_comppad = 0;
PL_comppad_name = 0;
PL_comppad_name_fill = 0;
PL_comppad_name_floor = 0;
PL_curpm = 0;
PL_curpad = 0;
Coro/State.xs view on Meta::CPAN
#if PERL_VERSION_ATLEAST (5,10,0)
PL_parser = 0;
#endif
PL_hints = 0;
/* recreate the die/warn hooks */
PL_diehook = SvREFCNT_inc (rv_diehook);
PL_warnhook = SvREFCNT_inc (rv_warnhook);
GvSV (PL_defgv) = newSV (0);
GvAV (PL_defgv) = coro->args; coro->args = 0;
GvSV (PL_errgv) = newSV (0);
GvSV (irsgv) = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
GvHV (PL_hintgv) = newHV ();
#if PERL_VERSION_ATLEAST (5,10,0)
hv_magic (GvHV (PL_hintgv), 0, PERL_MAGIC_hints);
#endif
PL_rs = newSVsv (GvSV (irsgv));
PL_defoutgv = (GV *)SvREFCNT_inc_NN (stdoutgv);
{
dSP;
UNOP myop;
Zero (&myop, 1, UNOP);
myop.op_next = Nullop;
myop.op_type = OP_ENTERSUB;
myop.op_flags = OPf_WANT_VOID;
PUSHMARK (SP);
PUSHs ((SV *)coro->startcv);
PUTBACK;
PL_op = (OP *)&myop;
PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
}
/* this newly created coroutine might be run on an existing cctx which most
* likely was suspended in pp_slf, so we have to emulate entering pp_slf here.
*/
slf_frame.prepare = prepare_nop; /* provide a nop function for an eventual pp_slf */
slf_frame.check = slf_check_nop; /* signal pp_slf to not repeat */
slf_frame.destroy = 0;
/* and we have to provide the pp_slf op in any case, so pp_slf can skip it */
init_perl_op.op_next = PL_op;
init_perl_op.op_type = OP_ENTERSUB;
init_perl_op.op_ppaddr = pp_slf;
/* no flags etc. required, as an init function won't be called */
PL_op = (OP *)&init_perl_op;
/* copy throw, in case it was set before init_perl */
CORO_THROW = coro->except;
SWAP_SVS_ENTER (coro);
if (ecb_expect_false (enable_times))
{
coro_times_update ();
coro_times_sub (coro);
}
}
static void
coro_unwind_stacks (pTHX)
{
if (!IN_DESTRUCT)
{
/* restore all saved variables and stuff */
LEAVE_SCOPE (0);
assert (PL_tmps_floor == -1);
/* free all temporaries */
FREETMPS;
assert (PL_tmps_ix == -1);
/* unwind all extra stacks */
POPSTACK_TO (PL_mainstack);
/* unwind main stack */
dounwind (-1);
}
}
static void
destroy_perl (pTHX_ struct coro *coro)
{
SV *svf [9];
{
SV *old_current = SvRV (coro_current);
struct coro *current = SvSTATE (old_current);
assert (("FATAL: tried to destroy currently running coroutine", coro->mainstack != PL_mainstack));
save_perl (aTHX_ current);
/* this will cause transfer_check to croak on block*/
SvRV_set (coro_current, (SV *)coro->hv);
load_perl (aTHX_ coro);
/* restore swapped sv's */
SWAP_SVS_LEAVE (coro);
coro_unwind_stacks (aTHX);
coro_destruct_stacks (aTHX);
/* now save some sv's to be free'd later */
svf [0] = GvSV (PL_defgv);
svf [1] = (SV *)GvAV (PL_defgv);
svf [2] = GvSV (PL_errgv);
svf [3] = (SV *)PL_defoutgv;
svf [4] = PL_rs;
svf [5] = GvSV (irsgv);
svf [6] = (SV *)GvHV (PL_hintgv);
svf [7] = PL_diehook;
svf [8] = PL_warnhook;
assert (9 == sizeof (svf) / sizeof (*svf));
SvRV_set (coro_current, old_current);
load_perl (aTHX_ current);
}
{
unsigned int i;
for (i = 0; i < sizeof (svf) / sizeof (*svf); ++i)
SvREFCNT_dec (svf [i]);
SvREFCNT_dec (coro->saved_deffh);
SvREFCNT_dec (coro->rouse_cb);
SvREFCNT_dec (coro->invoke_cb);
SvREFCNT_dec (coro->invoke_av);
SvREFCNT_dec (coro->on_enter_xs);
SvREFCNT_dec (coro->on_leave_xs);
}
}
ecb_inline void
free_coro_mortal (pTHX)
{
if (ecb_expect_true (coro_mortal))
{
SvREFCNT_dec ((SV *)coro_mortal);
coro_mortal = 0;
}
}
static int
runops_trace (pTHX)
{
COP *oldcop = 0;
int oldcxix = -2;
while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX)))
Coro/State.xs view on Meta::CPAN
PL_runops = RUNOPS_DEFAULT;
ENTER;
SAVETMPS;
EXTEND (SP, 3);
PUSHMARK (SP);
PUSHs (&PL_sv_no);
PUSHs (fullname);
PUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
PUTBACK;
cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
SPAGAIN;
FREETMPS;
LEAVE;
PL_runops = runops_trace;
}
if (oldcop != PL_curcop)
{
oldcop = PL_curcop;
Coro/State.xs view on Meta::CPAN
PL_runops = RUNOPS_DEFAULT;
ENTER;
SAVETMPS;
EXTEND (SP, 3);
PUSHMARK (SP);
PUSHs (&PL_sv_yes);
PUSHs (fullname);
PUSHs (CxHASARGS (cx) ? sv_2mortal (newRV_inc (SUB_ARGARRAY)) : &PL_sv_undef);
PUTBACK;
cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
SPAGAIN;
FREETMPS;
LEAVE;
PL_runops = runops_trace;
}
oldcxix = cxstack_ix;
}
Coro/State.xs view on Meta::CPAN
PL_runops = RUNOPS_DEFAULT;
ENTER;
SAVETMPS;
EXTEND (SP, 3);
PL_runops = RUNOPS_DEFAULT;
PUSHMARK (SP);
PUSHs (sv_2mortal (newSVpv (OutCopFILE (oldcop), 0)));
PUSHs (sv_2mortal (newSViv (CopLINE (oldcop))));
PUTBACK;
cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_line_cb", sizeof ("_trace_line_cb") - 1, 0);
if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
SPAGAIN;
FREETMPS;
LEAVE;
PL_runops = runops_trace;
}
}
}
}
}
TAINT_NOT;
return 0;
}
static struct CoroSLF cctx_ssl_frame;
static void
slf_prepare_set_stacklevel (pTHX_ struct coro_transfer_args *ta)
{
ta->prev = 0;
}
static int
slf_check_set_stacklevel (pTHX_ struct CoroSLF *frame)
{
*frame = cctx_ssl_frame;
return frame->check (aTHX_ frame); /* execute the restored frame - there must be one */
Coro/State.xs view on Meta::CPAN
cctx_ssl_frame = slf_frame;
slf_frame.prepare = slf_prepare_set_stacklevel;
slf_frame.check = slf_check_set_stacklevel;
}
/* the tail of transfer: execute stuff we can only do after a transfer */
ecb_inline void
transfer_tail (pTHX)
{
free_coro_mortal (aTHX);
}
/* try to exit the same way perl's main function would do */
/* we do not bother resetting the environment or other things *7
/* that are not, uhm, essential */
/* this obviously also doesn't work when perl is embedded */
static void ecb_noinline ecb_cold
perlish_exit (pTHX)
{
int exitstatus = perl_destruct (PL_curinterp);
Coro/State.xs view on Meta::CPAN
}
/*
* this is a _very_ stripped down perl interpreter ;)
*/
static void
cctx_run (void *arg)
{
#ifdef USE_ITHREADS
# if CORO_PTHREAD
PERL_SET_CONTEXT (coro_thx);
# endif
#endif
{
dTHX;
/* normally we would need to skip the entersub here */
/* not doing so will re-execute it, which is exactly what we want */
/* PL_nop = PL_nop->op_next */
/* inject a fake subroutine call to cctx_init */
cctx_prepare (aTHX);
/* cctx_run is the alternative tail of transfer() */
transfer_tail (aTHX);
/* somebody or something will hit me for both perl_run and PL_restartop */
PL_restartop = PL_op;
perl_run (PL_curinterp);
/*
* Unfortunately, there is no way to get at the return values of the
* coro body here, as perl_run destroys these. Likewise, we cannot catch
* runtime errors here, as this is just a random interpreter, not a thread.
*/
/*
* pp_entersub in 5.24 no longer ENTERs, but perl_destruct
* requires PL_scopestack_ix, so do it here if required.
*/
if (!PL_scopestack_ix)
ENTER;
/*
* If perl-run returns we assume exit() was being called or the coro
* fell off the end, which seems to be the only valid (non-bug)
* reason for perl_run to return. We try to mimic whatever perl is normally
* doing in that case. YMMV.
*/
perlish_exit (aTHX);
}
}
static coro_cctx *
cctx_new (void)
{
coro_cctx *cctx;
++cctx_count;
New (0, cctx, 1, coro_cctx);
cctx->gen = cctx_gen;
cctx->flags = 0;
cctx->idle_sp = 0; /* can be accessed by transfer between cctx_run and set_stacklevel, on throw */
return cctx;
}
/* create a new cctx only suitable as source */
static coro_cctx *
cctx_new_empty (void)
{
coro_cctx *cctx = cctx_new ();
cctx->stack.sptr = 0;
coro_create (&cctx->cctx, 0, 0, 0, 0);
return cctx;
}
/* create a new cctx suitable as destination/running a perl interpreter */
static coro_cctx *
cctx_new_run (void)
{
coro_cctx *cctx = cctx_new ();
if (!coro_stack_alloc (&cctx->stack, cctx_stacksize))
{
perror ("FATAL: unable to allocate stack for coroutine, exiting.");
_exit (EXIT_FAILURE);
}
coro_create (&cctx->cctx, cctx_run, (void *)cctx, cctx->stack.sptr, cctx->stack.ssze);
return cctx;
}
static void
cctx_destroy (coro_cctx *cctx)
{
if (!cctx)
return;
assert (("FATAL: tried to destroy current cctx", cctx != cctx_current));
--cctx_count;
coro_destroy (&cctx->cctx);
coro_stack_free (&cctx->stack);
Safefree (cctx);
}
/* wether this cctx should be destructed */
#define CCTX_EXPIRED(cctx) ((cctx)->gen != cctx_gen || ((cctx)->flags & CC_NOREUSE))
static coro_cctx *
cctx_get (pTHX)
{
while (ecb_expect_true (cctx_first))
{
coro_cctx *cctx = cctx_first;
cctx_first = cctx->next;
--cctx_idle;
if (ecb_expect_true (!CCTX_EXPIRED (cctx)))
return cctx;
cctx_destroy (cctx);
}
return cctx_new_run ();
}
static void
cctx_put (coro_cctx *cctx)
{
assert (("FATAL: cctx_put called on non-initialised cctx in Coro (please report)", cctx->stack.sptr));
/* free another cctx if overlimit */
if (ecb_expect_false (cctx_idle >= cctx_max_idle))
{
coro_cctx *first = cctx_first;
cctx_first = first->next;
--cctx_idle;
cctx_destroy (first);
}
++cctx_idle;
cctx->next = cctx_first;
cctx_first = cctx;
}
/** coroutine switching *****************************************************/
static void
transfer_check (pTHX_ struct coro *prev, struct coro *next)
{
/* TODO: throwing up here is considered harmful */
if (ecb_expect_true (prev != next))
{
if (ecb_expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))
croak ("Coro::State::transfer called with a blocked prev Coro::State, but can only transfer from running or new states,");
if (ecb_expect_false (next->flags & (CF_RUNNING | CF_ZOMBIE | CF_SUSPENDED)))
croak ("Coro::State::transfer called with running, destroyed or suspended next Coro::State, but can only transfer to inactive states,");
#if !PERL_VERSION_ATLEAST (5,10,0)
if (ecb_expect_false (PL_lex_state != LEX_NOTPARSING))
croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version,");
#endif
}
}
/* always use the TRANSFER macro */
static void ecb_noinline /* noinline so we have a fixed stackframe */
transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
{
dSTACKLEVEL;
/* sometimes transfer is only called to set idle_sp */
if (ecb_expect_false (!prev))
{
cctx_current->idle_sp = STACKLEVEL;
assert (cctx_current->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
}
else if (ecb_expect_true (prev != next))
{
coro_cctx *cctx_prev;
if (ecb_expect_false (prev->flags & CF_NEW))
{
/* create a new empty/source context */
prev->flags &= ~CF_NEW;
prev->flags |= CF_RUNNING;
}
prev->flags &= ~CF_RUNNING;
next->flags |= CF_RUNNING;
/* first get rid of the old state */
save_perl (aTHX_ prev);
if (ecb_expect_false (next->flags & CF_NEW))
{
/* need to start coroutine */
next->flags &= ~CF_NEW;
/* setup coroutine call */
init_perl (aTHX_ next);
}
else
load_perl (aTHX_ next);
/* possibly untie and reuse the cctx */
if (ecb_expect_true (
cctx_current->idle_sp == STACKLEVEL
&& !(cctx_current->flags & CC_TRACE)
&& !force_cctx
Coro/State.xs view on Meta::CPAN
cctx_prev = cctx_current;
cctx_current = ecb_expect_false (next->cctx) ? next->cctx : cctx_get (aTHX);
next->cctx = 0;
if (ecb_expect_false (cctx_prev != cctx_current))
{
cctx_prev->top_env = PL_top_env;
PL_top_env = cctx_current->top_env;
coro_transfer (&cctx_prev->cctx, &cctx_current->cctx);
}
transfer_tail (aTHX);
}
}
#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))
#define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
/** high level stuff ********************************************************/
/* this function is actually Coro, not Coro::State, but we call it from here */
/* because it is convenient - but it hasn't been declared yet for that reason */
static void
coro_call_on_destroy (pTHX_ struct coro *coro);
static void
coro_state_destroy (pTHX_ struct coro *coro)
{
if (coro->flags & CF_ZOMBIE)
return;
slf_destroy (aTHX_ coro);
coro->flags |= CF_ZOMBIE;
if (coro->flags & CF_READY)
{
/* reduce nready, as destroying a ready coro effectively unreadies it */
/* alternative: look through all ready queues and remove the coro */
--coro_nready;
}
else
coro->flags |= CF_READY; /* make sure it is NOT put into the readyqueue */
if (coro->next) coro->next->prev = coro->prev;
if (coro->prev) coro->prev->next = coro->next;
if (coro == coro_first) coro_first = coro->next;
if (coro->mainstack
&& coro->mainstack != main_mainstack
&& coro->slot
&& !PL_dirty)
destroy_perl (aTHX_ coro);
cctx_destroy (coro->cctx);
SvREFCNT_dec (coro->startcv);
SvREFCNT_dec (coro->args);
SvREFCNT_dec (coro->swap_sv);
SvREFCNT_dec (CORO_THROW);
coro_call_on_destroy (aTHX_ coro);
/* more destruction mayhem in coro_state_free */
}
static int
coro_state_free (pTHX_ SV *sv, MAGIC *mg)
{
struct coro *coro = (struct coro *)mg->mg_ptr;
mg->mg_ptr = 0;
coro_state_destroy (aTHX_ coro);
SvREFCNT_dec (coro->on_destroy);
SvREFCNT_dec (coro->status);
Safefree (coro);
return 0;
}
static int ecb_cold
coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
{
/* called when perl clones the current process the slow way (windows process emulation) */
/* WE SIMply nuke the pointers in the copy, causing perl to croak */
mg->mg_ptr = 0;
mg->mg_virtual = 0;
return 0;
}
static MGVTBL coro_state_vtbl = {
0, 0, 0, 0,
coro_state_free,
0,
#ifdef MGf_DUP
coro_state_dup,
#else
# define MGf_DUP 0
#endif
};
static void
prepare_transfer (pTHX_ struct coro_transfer_args *ta, SV *prev_sv, SV *next_sv)
{
ta->prev = SvSTATE (prev_sv);
ta->next = SvSTATE (next_sv);
TRANSFER_CHECK (*ta);
}
static void
api_transfer (pTHX_ SV *prev_sv, SV *next_sv)
{
struct coro_transfer_args ta;
prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
TRANSFER (ta, 1);
}
/** Coro ********************************************************************/
ecb_inline void
coro_enq (pTHX_ struct coro *coro)
{
struct coro **ready = coro_ready [coro->prio - CORO_PRIO_MIN];
SvREFCNT_inc_NN (coro->hv);
coro->next_ready = 0;
*(ready [0] ? &ready [1]->next_ready : &ready [0]) = coro;
ready [1] = coro;
}
ecb_inline struct coro *
coro_deq (pTHX)
{
int prio;
for (prio = CORO_PRIO_MAX - CORO_PRIO_MIN + 1; --prio >= 0; )
{
struct coro **ready = coro_ready [prio];
if (ready [0])
{
struct coro *coro = ready [0];
ready [0] = coro->next_ready;
return coro;
}
}
return 0;
}
static void
invoke_sv_ready_hook_helper (void)
{
dTHX;
dSP;
ENTER;
SAVETMPS;
PUSHMARK (SP);
PUTBACK;
call_sv (coro_readyhook, G_VOID | G_DISCARD);
FREETMPS;
LEAVE;
}
static int
api_ready (pTHX_ SV *coro_sv)
{
struct coro *coro = SvSTATE (coro_sv);
if (coro->flags & CF_READY)
return 0;
coro->flags |= CF_READY;
coro_enq (aTHX_ coro);
if (!coro_nready++)
if (coroapi.readyhook)
coroapi.readyhook ();
return 1;
}
static int
api_is_ready (pTHX_ SV *coro_sv)
{
return !!(SvSTATE (coro_sv)->flags & CF_READY);
}
/* expects to own a reference to next->hv */
ecb_inline void
prepare_schedule_to (pTHX_ struct coro_transfer_args *ta, struct coro *next)
{
SV *prev_sv = SvRV (coro_current);
ta->prev = SvSTATE_hv (prev_sv);
ta->next = next;
TRANSFER_CHECK (*ta);
SvRV_set (coro_current, (SV *)next->hv);
free_coro_mortal (aTHX);
coro_mortal = prev_sv;
}
static void
prepare_schedule (pTHX_ struct coro_transfer_args *ta)
{
for (;;)
{
struct coro *next = coro_deq (aTHX);
if (ecb_expect_true (next))
{
/* cannot transfer to destroyed coros, skip and look for next */
if (ecb_expect_false (next->flags & (CF_ZOMBIE | CF_SUSPENDED)))
SvREFCNT_dec (next->hv); /* coro_nready has already been taken care of by destroy */
else
{
next->flags &= ~CF_READY;
--coro_nready;
prepare_schedule_to (aTHX_ ta, next);
break;
}
}
else
{
/* nothing to schedule: call the idle handler */
if (SvROK (sv_idle)
&& SvOBJECT (SvRV (sv_idle)))
{
if (SvRV (sv_idle) == SvRV (coro_current))
{
require_pv ("Carp");
{
dSP;
ENTER;
SAVETMPS;
PUSHMARK (SP);
XPUSHs (sv_2mortal (newSVpv ("FATAL: $Coro::idle blocked itself - did you try to block inside an event loop callback? Caught", 0)));
PUTBACK;
call_pv ("Carp::confess", G_VOID | G_DISCARD);
FREETMPS;
LEAVE;
}
}
++coro_nready; /* hack so that api_ready doesn't invoke ready hook */
api_ready (aTHX_ SvRV (sv_idle));
--coro_nready;
}
else
{
/* TODO: deprecated, remove, cannot work reliably *//*D*/
dSP;
ENTER;
SAVETMPS;
PUSHMARK (SP);
Coro/State.xs view on Meta::CPAN
call_sv (sv_idle, G_VOID | G_DISCARD);
FREETMPS;
LEAVE;
}
}
}
}
ecb_inline void
prepare_cede (pTHX_ struct coro_transfer_args *ta)
{
api_ready (aTHX_ coro_current);
prepare_schedule (aTHX_ ta);
}
ecb_inline void
prepare_cede_notself (pTHX_ struct coro_transfer_args *ta)
{
SV *prev = SvRV (coro_current);
if (coro_nready)
{
prepare_schedule (aTHX_ ta);
api_ready (aTHX_ prev);
}
else
prepare_nop (aTHX_ ta);
}
static void
api_schedule (pTHX)
{
struct coro_transfer_args ta;
prepare_schedule (aTHX_ &ta);
TRANSFER (ta, 1);
}
static void
api_schedule_to (pTHX_ SV *coro_sv)
{
struct coro_transfer_args ta;
struct coro *next = SvSTATE (coro_sv);
SvREFCNT_inc_NN (coro_sv);
prepare_schedule_to (aTHX_ &ta, next);
}
static int
api_cede (pTHX)
{
struct coro_transfer_args ta;
prepare_cede (aTHX_ &ta);
if (ecb_expect_true (ta.prev != ta.next))
{
TRANSFER (ta, 1);
return 1;
}
else
return 0;
}
static int
api_cede_notself (pTHX)
{
if (coro_nready)
{
struct coro_transfer_args ta;
prepare_cede_notself (aTHX_ &ta);
TRANSFER (ta, 1);
return 1;
}
else
return 0;
}
static void
api_trace (pTHX_ SV *coro_sv, int flags)
{
struct coro *coro = SvSTATE (coro_sv);
if (coro->flags & CF_RUNNING)
croak ("cannot enable tracing on a running coroutine, caught");
if (flags & CC_TRACE)
{
if (!coro->cctx)
coro->cctx = cctx_new_run ();
else if (!(coro->cctx->flags & CC_TRACE))
croak ("cannot enable tracing on coroutine with custom stack, caught");
coro->cctx->flags |= CC_NOREUSE | (flags & (CC_TRACE | CC_TRACE_ALL));
}
else if (coro->cctx && coro->cctx->flags & CC_TRACE)
{
coro->cctx->flags &= ~(CC_TRACE | CC_TRACE_ALL);
if (coro->flags & CF_RUNNING)
PL_runops = RUNOPS_DEFAULT;
else
coro->slot->runops = RUNOPS_DEFAULT;
}
}
static void
coro_push_av (pTHX_ AV *av, I32 gimme_v)
{
if (AvFILLp (av) >= 0 && gimme_v != G_VOID)
{
dSP;
if (gimme_v == G_SCALAR)
XPUSHs (AvARRAY (av)[AvFILLp (av)]);
else
{
int i;
Coro/State.xs view on Meta::CPAN
for (i = 0; i <= AvFILLp (av); ++i)
PUSHs (AvARRAY (av)[i]);
}
PUTBACK;
}
}
static void
coro_push_on_destroy (pTHX_ struct coro *coro, SV *cb)
{
if (!coro->on_destroy)
coro->on_destroy = newAV ();
av_push (coro->on_destroy, cb);
}
static void
slf_destroy_join (pTHX_ struct CoroSLF *frame)
{
SvREFCNT_dec ((SV *)((struct coro *)frame->data)->hv);
}
static int
slf_check_join (pTHX_ struct CoroSLF *frame)
{
struct coro *coro = (struct coro *)frame->data;
if (!coro->status)
return 1;
frame->destroy = 0;
coro_push_av (aTHX_ coro->status, GIMME_V);
SvREFCNT_dec ((SV *)coro->hv);
return 0;
}
static void
slf_init_join (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
struct coro *coro = SvSTATE (items > 0 ? arg [0] : &PL_sv_undef);
if (items > 1)
croak ("join called with too many arguments");
if (coro->status)
frame->prepare = prepare_nop;
else
{
coro_push_on_destroy (aTHX_ coro, SvREFCNT_inc_NN (SvRV (coro_current)));
frame->prepare = prepare_schedule;
}
frame->check = slf_check_join;
frame->destroy = slf_destroy_join;
frame->data = (void *)coro;
SvREFCNT_inc (coro->hv);
}
static void
coro_call_on_destroy (pTHX_ struct coro *coro)
{
AV *od = coro->on_destroy;
if (!od)
return;
coro->on_destroy = 0;
sv_2mortal ((SV *)od);
while (AvFILLp (od) >= 0)
{
SV *cb = sv_2mortal (av_pop (od));
/* coro hv's (and only hv's at the moment) are supported as well */
if (SvSTATEhv_p (aTHX_ cb))
api_ready (aTHX_ cb);
else
{
dSP; /* don't disturb outer sp */
PUSHMARK (SP);
if (coro->status)
{
PUTBACK;
coro_push_av (aTHX_ coro->status, G_ARRAY);
SPAGAIN;
}
PUTBACK;
call_sv (cb, G_VOID | G_DISCARD);
}
}
}
static void
coro_set_status (pTHX_ struct coro *coro, SV **arg, int items)
{
AV *av;
if (coro->status)
{
av = coro->status;
av_clear (av);
}
else
av = coro->status = newAV ();
/* items are actually not so common, so optimise for this case */
if (items)
{
int i;
av_extend (av, items - 1);
for (i = 0; i < items; ++i)
av_push (av, SvREFCNT_inc_NN (arg [i]));
}
}
static void
slf_init_terminate_cancel_common (pTHX_ struct CoroSLF *frame, HV *coro_hv)
{
av_push (av_destroy, (SV *)newRV_inc ((SV *)coro_hv)); /* RVinc for perl */
api_ready (aTHX_ sv_manager);
frame->prepare = prepare_schedule;
frame->check = slf_check_repeat;
/* as a minor optimisation, we could unwind all stacks here */
/* but that puts extra pressure on pp_slf, and is not worth much */
/*coro_unwind_stacks (aTHX);*/
}
static void
slf_init_terminate (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
HV *coro_hv = (HV *)SvRV (coro_current);
coro_set_status (aTHX_ SvSTATE ((SV *)coro_hv), arg, items);
slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
}
static void
slf_init_cancel (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
HV *coro_hv;
struct coro *coro;
if (items <= 0)
croak ("Coro::cancel called without coro object,");
coro = SvSTATE (arg [0]);
coro_hv = coro->hv;
coro_set_status (aTHX_ coro, arg + 1, items - 1);
if (ecb_expect_false (coro->flags & CF_NOCANCEL))
{
/* coro currently busy cancelling something, so just notify it */
coro->slf_frame.data = (void *)coro;
frame->prepare = prepare_nop;
frame->check = slf_check_nop;
}
else if (coro_hv == (HV *)SvRV (coro_current))
{
/* cancelling the current coro is allowed, and equals terminate */
slf_init_terminate_cancel_common (aTHX_ frame, coro_hv);
}
else
{
struct coro *self = SvSTATE_current;
if (!self)
croak ("Coro::cancel called outside of thread content,");
/* otherwise we cancel directly, purely for speed reasons
* unfortunately, this requires some magic trickery, as
* somebody else could cancel us, so we have to fight the cancellation.
* this is ugly, and hopefully fully worth the extra speed.
* besides, I can't get the slow-but-safe version working...
*/
slf_frame.data = 0;
self->flags |= CF_NOCANCEL;
coro_state_destroy (aTHX_ coro);
self->flags &= ~CF_NOCANCEL;
if (slf_frame.data)
{
/* while we were busy we have been cancelled, so terminate */
slf_init_terminate_cancel_common (aTHX_ frame, self->hv);
}
else
{
frame->prepare = prepare_nop;
frame->check = slf_check_nop;
}
}
}
static int
slf_check_safe_cancel (pTHX_ struct CoroSLF *frame)
{
frame->prepare = 0;
coro_unwind_stacks (aTHX);
slf_init_terminate_cancel_common (aTHX_ frame, (HV *)SvRV (coro_current));
return 1;
}
static int
safe_cancel (pTHX_ struct coro *coro, SV **arg, int items)
{
if (coro->cctx)
croak ("coro inside C callback, unable to cancel at this time, caught");
if (coro->flags & (CF_NEW | CF_ZOMBIE))
{
coro_set_status (aTHX_ coro, arg, items);
coro_state_destroy (aTHX_ coro);
}
else
{
if (!coro->slf_frame.prepare)
croak ("coro outside an SLF function, unable to cancel at this time, caught");
slf_destroy (aTHX_ coro);
coro_set_status (aTHX_ coro, arg, items);
coro->slf_frame.prepare = prepare_nop;
coro->slf_frame.check = slf_check_safe_cancel;
api_ready (aTHX_ (SV *)coro->hv);
}
return 1;
}
/*****************************************************************************/
/* async pool handler */
static int
slf_check_pool_handler (pTHX_ struct CoroSLF *frame)
{
HV *hv = (HV *)SvRV (coro_current);
struct coro *coro = (struct coro *)frame->data;
if (!coro->invoke_cb)
return 1; /* loop till we have invoke */
else
{
hv_store (hv, "desc", sizeof ("desc") - 1,
newSVpvn ("[async_pool]", sizeof ("[async_pool]") - 1), 0);
coro->saved_deffh = SvREFCNT_inc_NN ((SV *)PL_defoutgv);
{
dSP;
XPUSHs (sv_2mortal (coro->invoke_cb)); coro->invoke_cb = 0;
PUTBACK;
}
SvREFCNT_dec (GvAV (PL_defgv));
GvAV (PL_defgv) = coro->invoke_av;
coro->invoke_av = 0;
return 0;
}
}
static void
slf_init_pool_handler (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
HV *hv = (HV *)SvRV (coro_current);
struct coro *coro = SvSTATE_hv ((SV *)hv);
if (ecb_expect_true (coro->saved_deffh))
{
/* subsequent iteration */
SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
coro->saved_deffh = 0;
if (coro_rss (aTHX_ coro) > SvUV (sv_pool_rss)
|| av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
{
slf_init_terminate_cancel_common (aTHX_ frame, hv);
return;
}
else
{
av_clear (GvAV (PL_defgv));
hv_store (hv, "desc", sizeof ("desc") - 1, SvREFCNT_inc_NN (sv_async_pool_idle), 0);
if (ecb_expect_false (coro->swap_sv))
{
SWAP_SVS_LEAVE (coro);
SvREFCNT_dec_NN (coro->swap_sv);
coro->swap_sv = 0;
}
coro->prio = 0;
if (ecb_expect_false (coro->cctx) && ecb_expect_false (coro->cctx->flags & CC_TRACE))
api_trace (aTHX_ coro_current, 0);
frame->prepare = prepare_schedule;
av_push (av_async_pool, SvREFCNT_inc (hv));
}
}
else
{
/* first iteration, simply fall through */
frame->prepare = prepare_nop;
}
frame->check = slf_check_pool_handler;
frame->data = (void *)coro;
}
/*****************************************************************************/
/* rouse callback */
#define CORO_MAGIC_type_rouse PERL_MAGIC_ext
static void
coro_rouse_callback (pTHX_ CV *cv)
{
dXSARGS;
SV *data = (SV *)S_GENSUB_ARG;
if (SvTYPE (SvRV (data)) != SVt_PVAV)
{
/* first call, set args */
SV *coro = SvRV (data);
AV *av = newAV ();
SvRV_set (data, (SV *)av);
/* better take a full copy of the arguments */
while (items--)
av_store (av, items, newSVsv (ST (items)));
api_ready (aTHX_ coro);
SvREFCNT_dec (coro);
}
XSRETURN_EMPTY;
}
static int
slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)
{
SV *data = (SV *)frame->data;
Coro/State.xs view on Meta::CPAN
static void
slf_init_rouse_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
SV *cb;
if (items)
cb = arg [0];
else
{
struct coro *coro = SvSTATE_current;
if (!coro->rouse_cb)
croak ("Coro::rouse_wait called without rouse callback, and no default rouse callback found either,");
cb = sv_2mortal (coro->rouse_cb);
coro->rouse_cb = 0;
}
if (!SvROK (cb)
|| SvTYPE (SvRV (cb)) != SVt_PVCV
|| CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)
croak ("Coro::rouse_wait called with illegal callback argument,");
{
CV *cv = (CV *)SvRV (cb); /* for S_GENSUB_ARG */
SV *data = (SV *)S_GENSUB_ARG;
frame->data = (void *)data;
frame->prepare = SvTYPE (SvRV (data)) == SVt_PVAV ? prepare_nop : prepare_schedule;
frame->check = slf_check_rouse_wait;
}
}
static SV *
coro_new_rouse_cb (pTHX)
{
HV *hv = (HV *)SvRV (coro_current);
struct coro *coro = SvSTATE_hv (hv);
SV *data = newRV_inc ((SV *)hv);
SV *cb = s_gensub (aTHX_ coro_rouse_callback, (void *)data);
sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0);
SvREFCNT_dec (data); /* magicext increases the refcount */
SvREFCNT_dec (coro->rouse_cb);
coro->rouse_cb = SvREFCNT_inc_NN (cb);
return cb;
}
/*****************************************************************************/
/* schedule-like-function opcode (SLF) */
static UNOP slf_restore; /* restore stack as entersub did, for first-re-run */
static const CV *slf_cv;
static SV **slf_argv;
Coro/State.xs view on Meta::CPAN
for (i = 0; i < slf_argc; ++i)
PUSHs (sv_2mortal (slf_argv [i]));
PUSHs ((SV *)CvGV (slf_cv));
RETURNOP (slf_restore.op_first);
}
static void
slf_prepare_transfer (pTHX_ struct coro_transfer_args *ta)
{
SV **arg = (SV **)slf_frame.data;
prepare_transfer (aTHX_ ta, arg [0], arg [1]);
}
static void
slf_init_transfer (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
if (items != 2)
Coro/State.xs view on Meta::CPAN
}
static void
slf_init_schedule (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
frame->prepare = prepare_schedule;
frame->check = slf_check_nop;
}
static void
slf_prepare_schedule_to (pTHX_ struct coro_transfer_args *ta)
{
struct coro *next = (struct coro *)slf_frame.data;
SvREFCNT_inc_NN (next->hv);
prepare_schedule_to (aTHX_ ta, next);
}
static void
slf_init_schedule_to (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
if (!items)
croak ("Coro::schedule_to expects a coroutine argument, caught");
frame->data = (void *)SvSTATE (arg [0]);
frame->prepare = slf_prepare_schedule_to;
frame->check = slf_check_nop;
}
static void
slf_init_cede_to (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
api_ready (aTHX_ SvRV (coro_current));
slf_init_schedule_to (aTHX_ frame, cv, arg, items);
}
static void
slf_init_cede (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
frame->prepare = prepare_cede;
frame->check = slf_check_nop;
}
static void
slf_init_cede_notself (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
frame->prepare = prepare_cede_notself;
frame->check = slf_check_nop;
}
/* "undo"/cancel a running slf call - used when cancelling a coro, mainly */
static void
slf_destroy (pTHX_ struct coro *coro)
{
struct CoroSLF frame = coro->slf_frame;
/*
* The on_destroy below most likely is from an SLF call.
* Since by definition the SLF call will not finish when we destroy
* the coro, we will have to force-finish it here, otherwise
* cleanup functions cannot call SLF functions.
*/
coro->slf_frame.prepare = 0;
/* this callback is reserved for slf functions needing to do cleanup */
if (frame.destroy && frame.prepare && !PL_dirty)
frame.destroy (aTHX_ &frame);
}
/*
* these not obviously related functions are all rolled into one
* function to increase chances that they all will call transfer with the same
* stack offset
* SLF stands for "schedule-like-function".
*/
static OP *
pp_slf (pTHX)
{
I32 checkmark; /* mark SP to see how many elements check has pushed */
/* set up the slf frame, unless it has already been set-up */
/* the latter happens when a new coro has been started */
/* or when a new cctx was attached to an existing coroutine */
if (ecb_expect_true (!slf_frame.prepare))
{
/* first iteration */
dSP;
SV **arg = PL_stack_base + TOPMARK + 1;
int items = SP - arg; /* args without function object */
SV *gv = *sp;
/* do a quick consistency check on the "function" object, and if it isn't */
/* for us, divert to the real entersub */
Coro/State.xs view on Meta::CPAN
if (!(PL_op->op_flags & OPf_STACKED))
{
/* ampersand-form of call, use @_ instead of stack */
AV *av = GvAV (PL_defgv);
arg = AvARRAY (av);
items = AvFILLp (av) + 1;
}
/* now call the init function, which needs to set up slf_frame */
((coro_slf_cb)CvXSUBANY (GvCV (gv)).any_ptr)
(aTHX_ &slf_frame, GvCV (gv), arg, items);
/* pop args */
SP = PL_stack_base + POPMARK;
PUTBACK;
}
/* now that we have a slf_frame, interpret it! */
/* we use a callback system not to make the code needlessly */
/* complicated, but so we can run multiple perl coros from one cctx */
do
{
struct coro_transfer_args ta;
slf_frame.prepare (aTHX_ &ta);
TRANSFER (ta, 0);
checkmark = PL_stack_sp - PL_stack_base;
}
while (slf_frame.check (aTHX_ &slf_frame));
slf_frame.prepare = 0; /* invalidate the frame, we are done processing it */
Coro/State.xs view on Meta::CPAN
SP = bot + 1;
PUTBACK;
}
return NORMAL;
}
static void
api_execute_slf (pTHX_ CV *cv, coro_slf_cb init_cb, I32 ax)
{
int i;
SV **arg = PL_stack_base + ax;
int items = PL_stack_sp - arg + 1;
assert (("FATAL: SLF call with illegal CV value", !CvANON (cv)));
if (PL_op->op_ppaddr != PL_ppaddr [OP_ENTERSUB]
&& PL_op->op_ppaddr != pp_slf)
croak ("FATAL: Coro SLF calls can only be made normally, not via goto or any other means, caught");
Coro/State.xs view on Meta::CPAN
PUSHMARK (SP);
PUTBACK;
call_sv (cb, G_VOID | G_DISCARD);
SPAGAIN;
POPSTACK;
}
static SV *
coro_avp_pop_and_free (pTHX_ AV **avp)
{
AV *av = *avp;
SV *res = av_pop (av);
if (AvFILLp (av) < 0)
{
*avp = 0;
SvREFCNT_dec (av);
}
return res;
}
static void
coro_pop_on_enter (pTHX_ void *coro)
{
SV *cb = coro_avp_pop_and_free (aTHX_ &((struct coro *)coro)->on_enter);
SvREFCNT_dec (cb);
}
static void
coro_pop_on_leave (pTHX_ void *coro)
{
SV *cb = coro_avp_pop_and_free (aTHX_ &((struct coro *)coro)->on_leave);
on_enterleave_call (aTHX_ sv_2mortal (cb));
}
static void
enterleave_hook_xs (pTHX_ struct coro *coro, AV **avp, coro_enterleave_hook hook, void *arg)
{
if (!hook)
return;
if (!*avp)
{
*avp = newAV ();
AvREAL_off (*avp);
}
av_push (*avp, (SV *)hook);
av_push (*avp, (SV *)arg);
}
static void
enterleave_unhook_xs (pTHX_ struct coro *coro, AV **avp, coro_enterleave_hook hook, int execute)
{
AV *av = *avp;
int i;
if (!av)
return;
for (i = AvFILLp (av) - 1; i >= 0; i -= 2)
if (AvARRAY (av)[i] == (SV *)hook)
{
Coro/State.xs view on Meta::CPAN
}
if (AvFILLp (av) >= 0)
{
*avp = 0;
SvREFCNT_dec_NN (av);
}
}
static void
api_enterleave_hook (pTHX_ SV *coro_sv, coro_enterleave_hook enter, void *enter_arg, coro_enterleave_hook leave, void *leave_arg)
{
struct coro *coro = SvSTATE (coro_sv);
if (SvSTATE_current == coro)
if (enter)
enter (aTHX_ enter_arg);
enterleave_hook_xs (aTHX_ coro, &coro->on_enter_xs, enter, enter_arg);
enterleave_hook_xs (aTHX_ coro, &coro->on_leave_xs, leave, leave_arg);
}
static void
api_enterleave_unhook (pTHX_ SV *coro_sv, coro_enterleave_hook enter, coro_enterleave_hook leave)
{
struct coro *coro = SvSTATE (coro_sv);
enterleave_unhook_xs (aTHX_ coro, &coro->on_enter_xs, enter, 0);
enterleave_unhook_xs (aTHX_ coro, &coro->on_leave_xs, leave, SvSTATE_current == coro);
}
static void
savedestructor_unhook_enter (pTHX_ coro_enterleave_hook enter)
{
struct coro *coro = SvSTATE_current;
enterleave_unhook_xs (aTHX_ coro, &coro->on_enter_xs, enter, 0);
}
static void
savedestructor_unhook_leave (pTHX_ coro_enterleave_hook leave)
{
struct coro *coro = SvSTATE_current;
enterleave_unhook_xs (aTHX_ coro, &coro->on_leave_xs, leave, 1);
}
static void
api_enterleave_scope_hook (pTHX_ coro_enterleave_hook enter, void *enter_arg, coro_enterleave_hook leave, void *leave_arg)
{
api_enterleave_hook (aTHX_ coro_current, enter, enter_arg, leave, leave_arg);
/* this ought to be much cheaper than malloc + a single destructor call */
if (enter) SAVEDESTRUCTOR_X (savedestructor_unhook_enter, enter);
if (leave) SAVEDESTRUCTOR_X (savedestructor_unhook_leave, leave);
}
/*****************************************************************************/
/* PerlIO::cede */
typedef struct
Coro/State.xs view on Meta::CPAN
PerlIOBuf_bufsiz,
PerlIOBuf_get_ptr,
PerlIOBuf_get_cnt,
PerlIOBuf_set_ptrcnt,
};
/*****************************************************************************/
/* Coro::Semaphore & Coro::Signal */
static SV *
coro_waitarray_new (pTHX_ int count)
{
/* a waitarray=semaphore contains a counter IV in $sem->[0] and any waiters after that */
AV *av = newAV ();
SV **ary;
/* unfortunately, building manually saves memory */
Newx (ary, 2, SV *);
AvALLOC (av) = ary;
#if PERL_VERSION_ATLEAST (5,10,0)
AvARRAY (av) = ary;
Coro/State.xs view on Meta::CPAN
AvMAX (av) = 1;
AvFILLp (av) = 0;
ary [0] = newSViv (count);
return newRV_noinc ((SV *)av);
}
/* semaphore */
static void
coro_semaphore_adjust (pTHX_ AV *av, IV adjust)
{
SV *count_sv = AvARRAY (av)[0];
IV count = SvIVX (count_sv);
count += adjust;
SvIVX (count_sv) = count;
/* now wake up as many waiters as are expected to lock */
while (count > 0 && AvFILLp (av) > 0)
{
Coro/State.xs view on Meta::CPAN
XPUSHs (sv_2mortal (newRV_inc ((SV *)av)));
PUTBACK;
call_sv (cb, G_VOID | G_DISCARD | G_EVAL | G_KEEPERR);
}
SvREFCNT_dec_NN (cb);
}
}
static void
coro_semaphore_destroy (pTHX_ struct CoroSLF *frame)
{
/* call $sem->adjust (0) to possibly wake up some other waiters */
coro_semaphore_adjust (aTHX_ (AV *)frame->data, 0);
}
static int
slf_check_semaphore_down_or_wait (pTHX_ struct CoroSLF *frame, int acquire)
{
AV *av = (AV *)frame->data;
SV *count_sv = AvARRAY (av)[0];
SV *coro_hv = SvRV (coro_current);
frame->destroy = 0;
/* if we are about to throw, don't actually acquire the lock, just throw */
if (ecb_expect_false (CORO_THROW))
{
/* we still might be responsible for the semaphore, so wake up others */
coro_semaphore_adjust (aTHX_ av, 0);
return 0;
}
else if (SvIVX (count_sv) > 0)
{
if (acquire)
SvIVX (count_sv) = SvIVX (count_sv) - 1;
else
coro_semaphore_adjust (aTHX_ av, 0);
return 0;
}
else
{
int i;
/* if we were woken up but can't down, we look through the whole */
/* waiters list and only add us if we aren't in there already */
/* this avoids some degenerate memory usage cases */
for (i = AvFILLp (av); i > 0; --i) /* i > 0 is not an off-by-one bug */
if (AvARRAY (av)[i] == coro_hv)
return 1;
av_push (av, SvREFCNT_inc (coro_hv));
return 1;
}
}
static int
slf_check_semaphore_down (pTHX_ struct CoroSLF *frame)
{
return slf_check_semaphore_down_or_wait (aTHX_ frame, 1);
}
Coro/State.xs view on Meta::CPAN
{
AV *av = (AV *)SvRV (arg [0]);
if (SvIVX (AvARRAY (av)[0]) > 0)
{
frame->data = (void *)av;
frame->prepare = prepare_nop;
}
else
{
av_push (av, SvREFCNT_inc (SvRV (coro_current)));
frame->data = (void *)sv_2mortal (SvREFCNT_inc ((SV *)av));
frame->prepare = prepare_schedule;
/* to avoid race conditions when a woken-up coro gets terminated */
/* we arrange for a temporary on_destroy that calls adjust (0) */
frame->destroy = coro_semaphore_destroy;
}
}
static void
slf_init_semaphore_down (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items);
frame->check = slf_check_semaphore_down;
}
Coro/State.xs view on Meta::CPAN
{
if (items >= 2)
{
/* callback form */
AV *av = (AV *)SvRV (arg [0]);
SV *cb_cv = s_get_cv_croak (arg [1]);
av_push (av, SvREFCNT_inc_NN (cb_cv));
if (SvIVX (AvARRAY (av)[0]) > 0)
coro_semaphore_adjust (aTHX_ av, 0);
frame->prepare = prepare_nop;
frame->check = slf_check_nop;
}
else
{
slf_init_semaphore_down_or_wait (aTHX_ frame, cv, arg, items);
frame->check = slf_check_semaphore_wait;
}
}
/* signal */
static void
coro_signal_wake (pTHX_ AV *av, int count)
{
SvIVX (AvARRAY (av)[0]) = 0;
/* now signal count waiters */
while (count > 0 && AvFILLp (av) > 0)
{
SV *cb;
/* swap first two elements so we can shift a waiter */
cb = AvARRAY (av)[0];
Coro/State.xs view on Meta::CPAN
slf_init_signal_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
AV *av = (AV *)SvRV (arg [0]);
if (items >= 2)
{
SV *cb_cv = s_get_cv_croak (arg [1]);
av_push (av, SvREFCNT_inc_NN (cb_cv));
if (SvIVX (AvARRAY (av)[0]))
coro_signal_wake (aTHX_ av, 1); /* must be the only waiter */
frame->prepare = prepare_nop;
frame->check = slf_check_nop;
}
else if (SvIVX (AvARRAY (av)[0]))
{
SvIVX (AvARRAY (av)[0]) = 0;
frame->prepare = prepare_nop;
frame->check = slf_check_nop;
}
else
{
SV *waiter = newSVsv (coro_current); /* owned by signal av */
av_push (av, waiter);
frame->data = (void *)sv_2mortal (SvREFCNT_inc_NN (waiter)); /* owned by process */
frame->prepare = prepare_schedule;
frame->check = slf_check_signal_wait;
}
}
/*****************************************************************************/
Coro/State.xs view on Meta::CPAN
/* helper storage struct */
struct io_state
{
int errorno;
I32 laststype; /* U16 in 5.10.0 */
int laststatval;
Stat_t statcache;
};
static void
coro_aio_callback (pTHX_ CV *cv)
{
dXSARGS;
AV *state = (AV *)S_GENSUB_ARG;
SV *coro = av_pop (state);
SV *data_sv = newSV (sizeof (struct io_state));
av_extend (state, items - 1);
sv_upgrade (data_sv, SVt_PV);
SvCUR_set (data_sv, sizeof (struct io_state));
SvPOK_only (data_sv);
{
struct io_state *data = (struct io_state *)SvPVX (data_sv);
Coro/State.xs view on Meta::CPAN
/* now build the result vector out of all the parameters and the data_sv */
{
int i;
for (i = 0; i < items; ++i)
av_push (state, SvREFCNT_inc_NN (ST (i)));
}
av_push (state, data_sv);
api_ready (aTHX_ coro);
SvREFCNT_dec_NN (coro);
SvREFCNT_dec_NN ((AV *)state);
}
static int
slf_check_aio_req (pTHX_ struct CoroSLF *frame)
{
AV *state = (AV *)frame->data;
/* if we are about to throw, return early */
/* this does not cancel the aio request, but at least */
Coro/State.xs view on Meta::CPAN
PUTBACK;
}
return 0;
}
static void
slf_init_aio_req (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
{
AV *state = (AV *)sv_2mortal ((SV *)newAV ());
SV *coro_hv = SvRV (coro_current);
struct coro *coro = SvSTATE_hv (coro_hv);
/* put our coroutine id on the state arg */
av_push (state, SvREFCNT_inc_NN (coro_hv));
/* first see whether we have a non-zero priority and set it as AIO prio */
if (coro->prio)
{
dSP;
static SV *prio_cv;
static SV *prio_sv;
if (ecb_expect_false (!prio_cv))
{
prio_cv = (SV *)get_cv ("IO::AIO::aioreq_pri", 0);
prio_sv = newSViv (0);
}
PUSHMARK (SP);
sv_setiv (prio_sv, coro->prio);
XPUSHs (prio_sv);
PUTBACK;
call_sv (prio_cv, G_VOID | G_DISCARD);
}
/* now call the original request */
{
dSP;
CV *req = (CV *)CORO_MAGIC_NN ((SV *)cv, CORO_MAGIC_type_aio)->mg_obj;
Coro/State.xs view on Meta::CPAN
PUSHMARK (SP);
/* first push all args to the stack */
EXTEND (SP, items + 1);
for (i = 0; i < items; ++i)
PUSHs (arg [i]);
/* now push the callback closure */
PUSHs (sv_2mortal (s_gensub (aTHX_ coro_aio_callback, (void *)SvREFCNT_inc_NN ((SV *)state))));
/* now call the AIO function - we assume our request is uncancelable */
PUTBACK;
call_sv ((SV *)req, G_VOID | G_DISCARD);
}
/* now that the request is going, we loop till we have a result */
frame->data = (void *)state;
frame->prepare = prepare_schedule;
frame->check = slf_check_aio_req;
}
static void
coro_aio_req_xs (pTHX_ CV *cv)
{
dXSARGS;
CORO_EXECUTE_SLF_XS (slf_init_aio_req);
XSRETURN_EMPTY;
}
/*****************************************************************************/
#if CORO_CLONE
# include "clone.c"
#endif
/*****************************************************************************/
static SV *
coro_new (pTHX_ HV *stash, SV **argv, int argc, int is_coro)
{
SV *coro_sv;
struct coro *coro;
MAGIC *mg;
HV *hv;
SV *cb;
int i;
if (argc > 0)
{
cb = s_get_cv_croak (argv [0]);
if (!is_coro)
{
if (CvISXSUB (cb))
croak ("Coro::State doesn't support XS functions as coroutine start, caught");
if (!CvROOT (cb))
croak ("Coro::State doesn't support autoloaded or undefined functions as coroutine start, caught");
}
}
Newz (0, coro, 1, struct coro);
coro->args = newAV ();
coro->flags = CF_NEW;
if (coro_first) coro_first->prev = coro;
coro->next = coro_first;
coro_first = coro;
coro->hv = hv = newHV ();
mg = sv_magicext ((SV *)hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)coro, 0);
mg->mg_flags |= MGf_DUP;
coro_sv = sv_bless (newRV_noinc ((SV *)hv), stash);
if (argc > 0)
{
av_extend (coro->args, argc + is_coro - 1);
if (is_coro)
{
av_push (coro->args, SvREFCNT_inc_NN ((SV *)cb));
cb = (SV *)cv_coro_run;
}
coro->startcv = (CV *)SvREFCNT_inc_NN ((SV *)cb);
for (i = 1; i < argc; i++)
av_push (coro->args, newSVsv (argv [i]));
}
return coro_sv;
}
#ifndef __cplusplus
ecb_cold XS(boot_Coro__State);
#endif
#if CORO_JIT
static void ecb_noinline ecb_cold
pushav_4uv (pTHX_ UV a, UV b, UV c, UV d)
Coro/State.xs view on Meta::CPAN
MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
PROTOTYPES: DISABLE
BOOT:
{
#define VARx(name,expr,type) if (sizeof (type) < sizeof (expr)) croak ("FATAL: Coro thread context slot '" # name "' too small for this version of perl.");
#include "state.h"
#ifdef USE_ITHREADS
# if CORO_PTHREAD
coro_thx = PERL_GET_CONTEXT;
# endif
#endif
/* perl defines these to check for existance first, but why it doesn't */
/* just create them one at init time is not clear to me, except for */
/* programs trying to delete them, but... */
/* anyway, we declare this as invalid and make sure they are initialised here */
DEFSV;
ERRSV;
cctx_current = cctx_new_empty ();
irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
{
/*
* we provide a vtbvl for %SIG magic that replaces PL_vtbl_sig
* by coro_sig_vtbl in hash values.
*/
MAGIC *mg = mg_find ((SV *)GvHV (gv_fetchpv ("SIG", GV_ADD | GV_NOTQUAL, SVt_PVHV)), PERL_MAGIC_sig);
/* this only works if perl doesn't have a vtbl for %SIG */
assert (!mg->mg_virtual);
/*
* The irony is that the perl API itself asserts that mg_virtual
* must be non-const, yet perl5porters insisted on marking their
* vtbls as read-only, just to thwart perl modules from patching
* them.
*/
mg->mg_virtual = (MGVTBL *)&coro_sig_vtbl;
mg->mg_flags |= MGf_COPY;
coro_sigelem_vtbl = PL_vtbl_sigelem;
coro_sigelem_vtbl.svt_get = coro_sigelem_get;
coro_sigelem_vtbl.svt_set = coro_sigelem_set;
coro_sigelem_vtbl.svt_clear = coro_sigelem_clr;
}
rv_diehook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
coro_state_stash = gv_stashpv ("Coro::State", TRUE);
newCONSTSUB (coro_state_stash, "CC_TRACE" , newSViv (CC_TRACE));
newCONSTSUB (coro_state_stash, "CC_TRACE_SUB" , newSViv (CC_TRACE_SUB));
newCONSTSUB (coro_state_stash, "CC_TRACE_LINE", newSViv (CC_TRACE_LINE));
newCONSTSUB (coro_state_stash, "CC_TRACE_ALL" , newSViv (CC_TRACE_ALL));
main_mainstack = PL_mainstack;
main_top_env = PL_top_env;
while (main_top_env->je_prev)
main_top_env = main_top_env->je_prev;
{
SV *slf = sv_2mortal (newSViv (PTR2IV (pp_slf)));
if (!PL_custom_op_names) PL_custom_op_names = newHV ();
hv_store_ent (PL_custom_op_names, slf, newSVpv ("coro_slf", 0), 0);
if (!PL_custom_op_descs) PL_custom_op_descs = newHV ();
hv_store_ent (PL_custom_op_descs, slf, newSVpv ("coro schedule like function", 0), 0);
}
coroapi.ver = CORO_API_VERSION;
coroapi.rev = CORO_API_REVISION;
coroapi.transfer = api_transfer;
coroapi.sv_state = SvSTATE_;
coroapi.execute_slf = api_execute_slf;
coroapi.prepare_nop = prepare_nop;
coroapi.prepare_schedule = prepare_schedule;
coroapi.prepare_cede = prepare_cede;
coroapi.prepare_cede_notself = prepare_cede_notself;
time_init (aTHX);
assert (("PRIO_NORMAL must be 0", !CORO_PRIO_NORMAL));
#if CORO_JIT
PUTBACK;
jit_init (aTHX);
SPAGAIN;
#endif
}
SV *
new (SV *klass, ...)
ALIAS:
Coro::new = 1
CODE:
RETVAL = coro_new (aTHX_ ix ? coro_stash : coro_state_stash, &ST (1), items - 1, ix);
OUTPUT:
RETVAL
void
transfer (...)
PROTOTYPE: $$
CODE:
CORO_EXECUTE_SLF_XS (slf_init_transfer);
SV *
clone (Coro::State coro)
CODE:
{
#if CORO_CLONE
struct coro *ncoro = coro_clone (aTHX_ coro);
MAGIC *mg;
/* TODO: too much duplication */
ncoro->hv = newHV ();
mg = sv_magicext ((SV *)ncoro->hv, 0, CORO_MAGIC_type_state, &coro_state_vtbl, (char *)ncoro, 0);
mg->mg_flags |= MGf_DUP;
RETVAL = sv_bless (newRV_noinc ((SV *)ncoro->hv), SvSTASH (coro->hv));
#else
croak ("Coro::State->clone has not been configured into this installation of Coro, realised");
#endif
}
OUTPUT:
RETVAL
int
cctx_stacksize (int new_stacksize = 0)
PROTOTYPE: ;$
Coro/State.xs view on Meta::CPAN
CODE:
RETVAL = cctx_idle;
OUTPUT:
RETVAL
void
list ()
PROTOTYPE:
PPCODE:
{
struct coro *coro;
for (coro = coro_first; coro; coro = coro->next)
if (coro->hv)
XPUSHs (sv_2mortal (newRV_inc ((SV *)coro->hv)));
}
void
call (Coro::State coro, SV *coderef)
ALIAS:
eval = 1
CODE:
{
if (coro->mainstack && ((coro->flags & CF_RUNNING) || coro->slot))
{
struct coro *current = SvSTATE_current;
struct CoroSLF slf_save;
if (current != coro)
{
PUTBACK;
save_perl (aTHX_ current);
load_perl (aTHX_ coro);
/* the coro is most likely in an active SLF call.
* while not strictly required (the code we execute is
* not allowed to call any SLF functions), it's cleaner
* to reinitialise the slf_frame and restore it later.
* This might one day allow us to actually do SLF calls
* from code executed here.
*/
slf_save = slf_frame;
slf_frame.prepare = 0;
SPAGAIN;
}
Coro/State.xs view on Meta::CPAN
PUTBACK;
if (ix)
eval_sv (coderef, 0);
else
call_sv (coderef, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
POPSTACK;
SPAGAIN;
if (current != coro)
{
PUTBACK;
slf_frame = slf_save;
save_perl (aTHX_ coro);
load_perl (aTHX_ current);
SPAGAIN;
}
}
}
SV *
is_ready (Coro::State coro)
PROTOTYPE: $
ALIAS:
is_ready = CF_READY
is_running = CF_RUNNING
is_new = CF_NEW
is_destroyed = CF_ZOMBIE
is_zombie = CF_ZOMBIE
is_suspended = CF_SUSPENDED
CODE:
RETVAL = boolSV (coro->flags & ix);
OUTPUT:
RETVAL
void
throw (SV *self, SV *exception = &PL_sv_undef)
PROTOTYPE: $;$
CODE:
{
struct coro *coro = SvSTATE (self);
struct coro *current = SvSTATE_current;
SV **exceptionp = coro == current ? &CORO_THROW : &coro->except;
SvREFCNT_dec (*exceptionp);
SvGETMAGIC (exception);
*exceptionp = SvOK (exception) ? newSVsv (exception) : 0;
api_ready (aTHX_ self);
}
void
api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)
PROTOTYPE: $;$
C_ARGS: aTHX_ coro, flags
SV *
has_cctx (Coro::State coro)
PROTOTYPE: $
CODE:
/* maybe manage the running flag differently */
RETVAL = boolSV (!!coro->cctx || (coro->flags & CF_RUNNING));
OUTPUT:
RETVAL
int
is_traced (Coro::State coro)
PROTOTYPE: $
CODE:
RETVAL = (coro->cctx ? coro->cctx->flags : 0) & CC_TRACE_ALL;
OUTPUT:
RETVAL
UV
rss (Coro::State coro)
PROTOTYPE: $
ALIAS:
usecount = 1
CODE:
switch (ix)
{
case 0: RETVAL = coro_rss (aTHX_ coro); break;
case 1: RETVAL = coro->usecount; break;
}
OUTPUT:
RETVAL
void
force_cctx ()
PROTOTYPE:
CODE:
cctx_current->idle_sp = 0;
void
swap_defsv (Coro::State self)
PROTOTYPE: $
ALIAS:
swap_defav = 1
CODE:
if (!self->slot)
croak ("cannot swap state with coroutine that has no saved state,");
else
{
SV **src = ix ? (SV **)&GvAV (PL_defgv) : &GvSV (PL_defgv);
SV **dst = ix ? (SV **)&self->slot->defav : (SV **)&self->slot->defsv;
SV *tmp = *src; *src = *dst; *dst = tmp;
}
void
cancel (Coro::State self)
CODE:
coro_state_destroy (aTHX_ self);
SV *
enable_times (int enabled = enable_times)
CODE:
{
RETVAL = boolSV (enable_times);
if (enabled != enable_times)
{
enable_times = enabled;
coro_times_update ();
(enabled ? coro_times_sub : coro_times_add)(SvSTATE (coro_current));
}
}
OUTPUT:
RETVAL
void
times (Coro::State self)
PPCODE:
{
struct coro *current = SvSTATE (coro_current);
if (ecb_expect_false (current == self))
{
coro_times_update ();
coro_times_add (SvSTATE (coro_current));
}
EXTEND (SP, 2);
PUSHs (sv_2mortal (newSVnv (self->t_real [0] + self->t_real [1] * 1e-9)));
PUSHs (sv_2mortal (newSVnv (self->t_cpu [0] + self->t_cpu [1] * 1e-9)));
if (ecb_expect_false (current == self))
coro_times_sub (SvSTATE (coro_current));
}
void
swap_sv (Coro::State coro, SV *sva, SV *svb)
CODE:
{
struct coro *current = SvSTATE_current;
AV *swap_sv;
int i;
sva = SvRV (sva);
svb = SvRV (svb);
if (current == coro)
SWAP_SVS_LEAVE (current);
if (!coro->swap_sv)
coro->swap_sv = newAV ();
swap_sv = coro->swap_sv;
for (i = AvFILLp (swap_sv) - 1; i >= 0; i -= 2)
{
SV *a = AvARRAY (swap_sv)[i ];
SV *b = AvARRAY (swap_sv)[i + 1];
if (a == sva && b == svb)
{
SvREFCNT_dec_NN (a);
SvREFCNT_dec_NN (b);
Coro/State.xs view on Meta::CPAN
goto removed;
}
}
av_push (swap_sv, SvREFCNT_inc_NN (sva));
av_push (swap_sv, SvREFCNT_inc_NN (svb));
removed:
if (current == coro)
SWAP_SVS_ENTER (current);
}
MODULE = Coro::State PACKAGE = Coro
BOOT:
{
if (SVt_LAST > 32)
croak ("Coro internal error: SVt_LAST > 32, swap_sv might need adjustment");
sv_pool_rss = coro_get_sv (aTHX_ "Coro::POOL_RSS" , TRUE);
sv_pool_size = coro_get_sv (aTHX_ "Coro::POOL_SIZE" , TRUE);
cv_coro_run = get_cv ( "Coro::_coro_run" , GV_ADD);
coro_current = coro_get_sv (aTHX_ "Coro::current" , FALSE); SvREADONLY_on (coro_current);
av_async_pool = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
av_destroy = coro_get_av (aTHX_ "Coro::destroy" , TRUE);
sv_manager = coro_get_sv (aTHX_ "Coro::manager" , TRUE);
sv_idle = coro_get_sv (aTHX_ "Coro::idle" , TRUE);
sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);
sv_Coro = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);
cv_pool_handler = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);
CvNODEBUG_on (get_cv ("Coro::_pool_handler", 0)); /* work around a debugger bug */
coro_stash = gv_stashpv ("Coro", TRUE);
newCONSTSUB (coro_stash, "PRIO_MAX", newSViv (CORO_PRIO_MAX));
newCONSTSUB (coro_stash, "PRIO_HIGH", newSViv (CORO_PRIO_HIGH));
newCONSTSUB (coro_stash, "PRIO_NORMAL", newSViv (CORO_PRIO_NORMAL));
newCONSTSUB (coro_stash, "PRIO_LOW", newSViv (CORO_PRIO_LOW));
newCONSTSUB (coro_stash, "PRIO_IDLE", newSViv (CORO_PRIO_IDLE));
newCONSTSUB (coro_stash, "PRIO_MIN", newSViv (CORO_PRIO_MIN));
{
SV *sv = coro_get_sv (aTHX_ "Coro::API", TRUE);
coroapi.schedule = api_schedule;
coroapi.schedule_to = api_schedule_to;
coroapi.cede = api_cede;
coroapi.cede_notself = api_cede_notself;
coroapi.ready = api_ready;
coroapi.is_ready = api_is_ready;
coroapi.nready = coro_nready;
coroapi.current = coro_current;
coroapi.enterleave_hook = api_enterleave_hook;
coroapi.enterleave_unhook = api_enterleave_unhook;
coroapi.enterleave_scope_hook = api_enterleave_scope_hook;
/*GCoroAPI = &coroapi;*/
sv_setiv (sv, PTR2IV (&coroapi));
SvREADONLY_on (sv);
}
}
SV *
async (...)
PROTOTYPE: &@
CODE:
RETVAL = coro_new (aTHX_ coro_stash, &ST (0), items, 1);
api_ready (aTHX_ RETVAL);
OUTPUT:
RETVAL
void
_destroy (Coro::State coro)
CODE:
/* used by the manager thread */
coro_state_destroy (aTHX_ coro);
void
on_destroy (Coro::State coro, SV *cb)
CODE:
coro_push_on_destroy (aTHX_ coro, newSVsv (cb));
void
join (...)
CODE:
CORO_EXECUTE_SLF_XS (slf_init_join);
void
terminate (...)
CODE:
CORO_EXECUTE_SLF_XS (slf_init_terminate);
Coro/State.xs view on Meta::CPAN
void
cede_notself (...)
CODE:
CORO_EXECUTE_SLF_XS (slf_init_cede_notself);
void
_set_current (SV *current)
PROTOTYPE: $
CODE:
SvREFCNT_dec_NN (SvRV (coro_current));
SvRV_set (coro_current, SvREFCNT_inc_NN (SvRV (current)));
void
_set_readyhook (SV *hook)
PROTOTYPE: $
CODE:
SvREFCNT_dec (coro_readyhook);
SvGETMAGIC (hook);
if (SvOK (hook))
{
coro_readyhook = newSVsv (hook);
CORO_READYHOOK = invoke_sv_ready_hook_helper;
}
else
{
coro_readyhook = 0;
CORO_READYHOOK = 0;
}
int
prio (Coro::State coro, int newprio = 0)
PROTOTYPE: $;$
ALIAS:
nice = 1
CODE:
{
RETVAL = coro->prio;
if (items > 1)
{
if (ix)
newprio = coro->prio - newprio;
if (newprio < CORO_PRIO_MIN) newprio = CORO_PRIO_MIN;
if (newprio > CORO_PRIO_MAX) newprio = CORO_PRIO_MAX;
coro->prio = newprio;
}
}
OUTPUT:
RETVAL
SV *
ready (SV *self)
PROTOTYPE: $
CODE:
RETVAL = boolSV (api_ready (aTHX_ self));
OUTPUT:
RETVAL
int
nready (...)
PROTOTYPE:
CODE:
RETVAL = coro_nready;
OUTPUT:
RETVAL
void
suspend (Coro::State self)
PROTOTYPE: $
CODE:
self->flags |= CF_SUSPENDED;
void
Coro/State.xs view on Meta::CPAN
AV *av = newAV ();
SV *cb = ST (0);
int i;
av_extend (av, items - 2);
for (i = 1; i < items; ++i)
av_push (av, SvREFCNT_inc_NN (ST (i)));
if ((SV *)hv == &PL_sv_undef)
{
SV *sv = coro_new (aTHX_ coro_stash, (SV **)&cv_pool_handler, 1, 1);
hv = (HV *)SvREFCNT_inc_NN (SvRV (sv));
SvREFCNT_dec_NN (sv);
}
{
struct coro *coro = SvSTATE_hv (hv);
assert (!coro->invoke_cb);
assert (!coro->invoke_av);
coro->invoke_cb = SvREFCNT_inc (cb);
coro->invoke_av = av;
}
api_ready (aTHX_ (SV *)hv);
if (GIMME_V != G_VOID)
XPUSHs (sv_2mortal (newRV_noinc ((SV *)hv)));
else
SvREFCNT_dec_NN (hv);
}
SV *
rouse_cb ()
PROTOTYPE:
CODE:
RETVAL = coro_new_rouse_cb (aTHX);
OUTPUT:
RETVAL
void
rouse_wait (...)
PROTOTYPE: ;$
PPCODE:
CORO_EXECUTE_SLF_XS (slf_init_rouse_wait);
void
on_enter (SV *block)
ALIAS:
on_leave = 1
PROTOTYPE: &
CODE:
{
struct coro *coro = SvSTATE_current;
AV **avp = ix ? &coro->on_leave : &coro->on_enter;
block = s_get_cv_croak (block);
if (!*avp)
*avp = newAV ();
av_push (*avp, SvREFCNT_inc (block));
if (!ix)
on_enterleave_call (aTHX_ block);
LEAVE; /* pp_entersub unfortunately forces an ENTER/LEAVE around XS calls */
SAVEDESTRUCTOR_X (ix ? coro_pop_on_leave : coro_pop_on_enter, (void *)coro);
ENTER; /* pp_entersub unfortunately forces an ENTER/LEAVE around XS calls */
}
MODULE = Coro::State PACKAGE = PerlIO::cede
BOOT:
PerlIO_define_layer (aTHX_ &PerlIO_cede);
Coro/State.xs view on Meta::CPAN
if (count)
{
SvGETMAGIC (count);
if (SvOK (count))
semcnt = SvIV (count);
}
RETVAL = sv_bless (
coro_waitarray_new (aTHX_ semcnt),
GvSTASH (CvGV (cv))
);
}
OUTPUT:
RETVAL
# helper for Coro::Channel and others
SV *
_alloc (int count)
CODE:
RETVAL = coro_waitarray_new (aTHX_ count);
OUTPUT:
RETVAL
SV *
count (SV *self)
CODE:
RETVAL = newSVsv (AvARRAY ((AV *)SvRV (self))[0]);
OUTPUT:
RETVAL
void
up (SV *self)
CODE:
coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), 1);
void
adjust (SV *self, int adjust)
CODE:
coro_semaphore_adjust (aTHX_ (AV *)SvRV (self), adjust);
void
down (...)
CODE:
CORO_EXECUTE_SLF_XS (slf_init_semaphore_down);
void
wait (...)
CODE:
CORO_EXECUTE_SLF_XS (slf_init_semaphore_wait);
Coro/State.xs view on Meta::CPAN
XSRETURN_NO;
}
MODULE = Coro::State PACKAGE = Coro::Signal
SV *
new (SV *klass)
CODE:
RETVAL = sv_bless (
coro_waitarray_new (aTHX_ 0),
GvSTASH (CvGV (cv))
);
OUTPUT:
RETVAL
void
wait (...)
CODE:
CORO_EXECUTE_SLF_XS (slf_init_signal_wait);
void
broadcast (SV *self)
CODE:
{
AV *av = (AV *)SvRV (self);
coro_signal_wake (aTHX_ av, AvFILLp (av));
}
void
send (SV *self)
CODE:
{
AV *av = (AV *)SvRV (self);
if (AvFILLp (av))
coro_signal_wake (aTHX_ av, 1);
else
SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */
}
IV
awaited (SV *self)
CODE:
RETVAL = AvFILLp ((AV *)SvRV (self)) + 1 - 1;
OUTPUT:
RETVAL
MODULE = Coro::State PACKAGE = Coro::AnyEvent
BOOT:
sv_activity = coro_get_sv (aTHX_ "Coro::AnyEvent::ACTIVITY", TRUE);
void
_schedule (...)
CODE:
{
static int incede;
api_cede_notself (aTHX);
++incede;
while (coro_nready >= incede && api_cede (aTHX))
;
sv_setsv (sv_activity, &PL_sv_undef);
if (coro_nready >= incede)
{
PUSHMARK (SP);
PUTBACK;
call_pv ("Coro::AnyEvent::_activity", G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
}
--incede;
}
MODULE = Coro::State PACKAGE = Coro::AIO
void
_register (char *target, char *proto, SV *req)
CODE:
{
SV *req_cv = s_get_cv_croak (req);
/* newXSproto doesn't return the CV on 5.8 */
CV *slf_cv = newXS (target, coro_aio_req_xs, __FILE__);
sv_setpv ((SV *)slf_cv, proto);
sv_magicext ((SV *)slf_cv, (SV *)req_cv, CORO_MAGIC_type_aio, 0, 0, 0);
}
MODULE = Coro::State PACKAGE = Coro::Select
void
patch_pp_sselect ()
CODE:
if (!coro_old_pp_sselect)
{
coro_select_select = (SV *)get_cv ("Coro::Select::select", 0);
coro_old_pp_sselect = PL_ppaddr [OP_SSELECT];
PL_ppaddr [OP_SSELECT] = coro_pp_sselect;
}
void
unpatch_pp_sselect ()
CODE:
if (coro_old_pp_sselect)
{
PL_ppaddr [OP_SSELECT] = coro_old_pp_sselect;
coro_old_pp_sselect = 0;
}
MODULE = Coro::State PACKAGE = Coro::Util
void
_exit (int code)
CODE:
_exit (code);
NV
Coro/Timer.pm view on Meta::CPAN
use Coro::AnyEvent ();
our $VERSION = 6.514;
our @EXPORT_OK = qw(timeout sleep);
# compatibility with older programs
*sleep = \&Coro::AnyEvent::sleep;
=item $flag = timeout $seconds
This function will wake up the current coroutine after $seconds seconds
and sets $flag to true (it is false initially). If $flag goes out
of scope earlier then nothing happens.
This is used by Coro itself to implement the C<timed_down>, C<timed_wait>
etc. primitives. It is used like this:
sub timed_wait {
my $timeout = Coro::Timer::timeout 60;
while (condition false) {
Coro/Util.pm view on Meta::CPAN
Coro::rouse_wait;
$jobs->up;
my @r = map { pack "H*", $_ } split /\0/, $buf;
wantarray ? @r : $r[0];
}
=item $ipn = Coro::Util::inet_aton $hostname || $ip
Works almost exactly like its C<Socket::inet_aton> counterpart, except
that it does not block other coroutines.
Does not handle multihomed hosts or IPv6 - consider using
C<AnyEvent::Socket::resolve_sockaddr> with the L<Coro> rouse functions
instead.
=cut
sub inet_aton {
AnyEvent::Socket::inet_aton $_[0], Coro::rouse_cb;
(grep length == 4, Coro::rouse_wait)[0]
Coro/clone.c view on Meta::CPAN
AV *nav = newAV ();
av_fill (nav, AvFILLp (av));
for (i = 0; i <= AvFILLp (av); ++i)
AvARRAY (nav)[i] = SvREFCNT_inc (AvARRAY (av)[i]);
return nav;
}
static struct coro *
coro_clone (pTHX_ struct coro *coro)
{
perl_slots *slot, *nslot;
struct coro *ncoro;
if (coro->flags & (CF_RUNNING | CF_NEW))
croak ("Coro::State::clone cannot clone new or running states, caught");
if (coro->cctx)
croak ("Coro::State::clone cannot clone a state running on a custom C context, caught");
/* TODO: maybe check slf_frame for prpeare_rransfer/check_nop? */
slot = coro->slot;
if (slot->curstackinfo->si_type != PERLSI_MAIN)
croak ("Coro::State::clone cannot clone a state running on a non-main stack, caught");
Newz (0, ncoro, 1, struct coro);
Newz (0, nslot, 1, perl_slots);
/* copy first, then fixup */
*ncoro = *coro;
*nslot = *slot;
ncoro->slot = nslot;
nslot->curstackinfo = new_stackinfo (slot->stack_max - slot->stack_sp + 1, slot->curstackinfo->si_cxmax);
nslot->curstackinfo->si_type = PERLSI_MAIN;
nslot->curstackinfo->si_cxix = slot->curstackinfo->si_cxix;
nslot->curstack = nslot->curstackinfo->si_stack;
ncoro->mainstack = nslot->curstack;
nslot->stack_base = AvARRAY (nslot->curstack);
nslot->stack_sp = nslot->stack_base + (slot->stack_sp - slot->stack_base);
nslot->stack_max = nslot->stack_base + AvMAX (nslot->curstack);
Copy (slot->stack_base, nslot->stack_base, slot->stack_sp - slot->stack_base + 1, SV *);
Copy (slot->curstackinfo->si_cxstack, nslot->curstackinfo->si_cxstack, nslot->curstackinfo->si_cxix + 1, PERL_CONTEXT);
New (50, nslot->tmps_stack, nslot->tmps_max, SV *);
Copy (slot->tmps_stack, nslot->tmps_stack, slot->tmps_ix + 1, SV *);
Coro/clone.c view on Meta::CPAN
SvREFCNT_inc (nslot->defav);
SvREFCNT_inc (nslot->errsv);
SvREFCNT_inc (nslot->irsgv);
SvREFCNT_inc (nslot->defoutgv);
SvREFCNT_inc (nslot->rs);
SvREFCNT_inc (nslot->compcv);
SvREFCNT_inc (nslot->diehook);
SvREFCNT_inc (nslot->warnhook);
SvREFCNT_inc (ncoro->startcv);
SvREFCNT_inc (ncoro->args);
SvREFCNT_inc (ncoro->except);
return ncoro;
}
Coro/libcoro/LICENSE view on Meta::CPAN
CHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPE-
CIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTH-
ERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
OF THE POSSIBILITY OF SUCH DAMAGE.
Alternatively, the following files carry an additional notice that
explicitly allows relicensing under the GPLv2: coro.c, coro.h.
Coro/libcoro/README view on Meta::CPAN
Configuration, documentation etc. is provided in the coro.h file. Please
note that the file conftest.c in this distribution is under the GPL. It is
not needed for proper operation of this library though, for that, coro.h
and coro.c suffice.
Marc Lehmann <schmorp@schmorp.de>
Coro/libcoro/coro.c view on Meta::CPAN
* by deleting the provisions above and replace them with the notice
* and other provisions required by the GPL. If you do not delete the
* provisions above, a recipient may use your version of this file under
* either the BSD or the GPL.
*
* This library is modelled strictly after Ralf S. Engelschalls article at
* http://www.gnu.org/software/pth/rse-pmt.ps. So most of the credit must
* go to Ralf S. Engelschall <rse@engelschall.com>.
*/
#include "coro.h"
#include <stddef.h>
#include <string.h>
/*****************************************************************************/
/* ucontext/setjmp/asm backends */
/*****************************************************************************/
#if CORO_UCONTEXT || CORO_SJLJ || CORO_LOSER || CORO_LINUX || CORO_IRIX || CORO_ASM
# if CORO_UCONTEXT
Coro/libcoro/coro.c view on Meta::CPAN
# endif
# include <stdlib.h>
# if CORO_SJLJ
# include <stdio.h>
# include <signal.h>
# include <unistd.h>
# endif
static coro_func coro_init_func;
static void *coro_init_arg;
static coro_context *new_coro, *create_coro;
static void
coro_init (void)
{
volatile coro_func func = coro_init_func;
volatile void *arg = coro_init_arg;
coro_transfer (new_coro, create_coro);
#if __GCC_HAVE_DWARF2_CFI_ASM && __amd64
/*asm (".cfi_startproc");*/
/*asm (".cfi_undefined rip");*/
#endif
func ((void *)arg);
#if __GCC_HAVE_DWARF2_CFI_ASM && __amd64
/*asm (".cfi_endproc");*/
#endif
/* the new coro returned. bad. just abort() for now */
abort ();
}
# if CORO_SJLJ
static volatile int trampoline_done;
/* trampoline signal handler */
static void
trampoline (int sig)
{
if (coro_setjmp (new_coro->env))
coro_init (); /* start it */
else
trampoline_done = 1;
}
# endif
# if CORO_ASM
#if __arm__ && \
(defined __ARM_ARCH_7__ || defined __ARM_ARCH_7A__ \
Coro/libcoro/coro.c view on Meta::CPAN
#define CORO_ARM 1
#endif
#if _WIN32 || __CYGWIN__
#define CORO_WIN_TIB 1
#endif
asm (
"\t.text\n"
#if _WIN32 || __CYGWIN__
"\t.globl _coro_transfer\n"
"_coro_transfer:\n"
#else
"\t.globl coro_transfer\n"
"coro_transfer:\n"
#endif
/* windows, of course, gives a shit on the amd64 ABI and uses different registers */
/* http://blogs.msdn.com/freik/archive/2005/03/17/398200.aspx */
#if __amd64
#if _WIN32 || __CYGWIN__
#define NUM_SAVED 29
"\tsubq $168, %rsp\t" /* one dummy qword to improve alignment */
"\tmovaps %xmm6, (%rsp)\n"
"\tmovaps %xmm7, 16(%rsp)\n"
Coro/libcoro/coro.c view on Meta::CPAN
#endif
#else
#error unsupported architecture
#endif
);
# endif
void
coro_create (coro_context *ctx, coro_func coro, void *arg, void *sptr, size_t ssize)
{
coro_context nctx;
# if CORO_SJLJ
stack_t ostk, nstk;
struct sigaction osa, nsa;
sigset_t nsig, osig;
# endif
if (!coro)
return;
coro_init_func = coro;
coro_init_arg = arg;
new_coro = ctx;
create_coro = &nctx;
# if CORO_SJLJ
/* we use SIGUSR2. first block it, then fiddle with it. */
sigemptyset (&nsig);
sigaddset (&nsig, SIGUSR2);
sigprocmask (SIG_BLOCK, &nsig, &osig);
nsa.sa_handler = trampoline;
sigemptyset (&nsa.sa_mask);
Coro/libcoro/coro.c view on Meta::CPAN
abort ();
if (~ostk.ss_flags & SS_DISABLE)
sigaltstack (&ostk, 0);
sigaction (SIGUSR2, &osa, 0);
sigprocmask (SIG_SETMASK, &osig, 0);
# elif CORO_LOSER
coro_setjmp (ctx->env);
#if __CYGWIN__ && __i386__
ctx->env[8] = (long) coro_init;
ctx->env[7] = (long) ((char *)sptr + ssize) - sizeof (long);
#elif __CYGWIN__ && __x86_64__
ctx->env[7] = (long) coro_init;
ctx->env[6] = (long) ((char *)sptr + ssize) - sizeof (long);
#elif defined __MINGW32__
ctx->env[5] = (long) coro_init;
ctx->env[4] = (long) ((char *)sptr + ssize) - sizeof (long);
#elif defined _M_IX86
((_JUMP_BUFFER *)&ctx->env)->Eip = (long) coro_init;
((_JUMP_BUFFER *)&ctx->env)->Esp = (long) STACK_ADJUST_PTR (sptr, ssize) - sizeof (long);
#elif defined _M_AMD64
((_JUMP_BUFFER *)&ctx->env)->Rip = (__int64) coro_init;
((_JUMP_BUFFER *)&ctx->env)->Rsp = (__int64) STACK_ADJUST_PTR (sptr, ssize) - sizeof (__int64);
#elif defined _M_IA64
((_JUMP_BUFFER *)&ctx->env)->StIIP = (__int64) coro_init;
((_JUMP_BUFFER *)&ctx->env)->IntSp = (__int64) STACK_ADJUST_PTR (sptr, ssize) - sizeof (__int64);
#else
#error "microsoft libc or architecture not supported"
#endif
# elif CORO_LINUX
coro_setjmp (ctx->env);
#if __GLIBC__ >= 2 && __GLIBC_MINOR__ >= 0 && defined (JB_PC) && defined (JB_SP)
ctx->env[0].__jmpbuf[JB_PC] = (long) coro_init;
ctx->env[0].__jmpbuf[JB_SP] = (long) STACK_ADJUST_PTR (sptr, ssize) - sizeof (long);
#elif __GLIBC__ >= 2 && __GLIBC_MINOR__ >= 0 && defined (__mc68000__)
ctx->env[0].__jmpbuf[0].__aregs[0] = (long int)coro_init;
ctx->env[0].__jmpbuf[0].__sp = (int *) ((char *)sptr + ssize) - sizeof (long);
#elif defined (__GNU_LIBRARY__) && defined (__i386__)
ctx->env[0].__jmpbuf[0].__pc = (char *) coro_init;
ctx->env[0].__jmpbuf[0].__sp = (void *) ((char *)sptr + ssize) - sizeof (long);
#elif defined (__GNU_LIBRARY__) && defined (__x86_64__)
ctx->env[0].__jmpbuf[JB_PC] = (long) coro_init;
ctx->env[0].__jmpbuf[0].__sp = (void *) ((char *)sptr + ssize) - sizeof (long);
#else
#error "linux libc or architecture not supported"
#endif
# elif CORO_IRIX
coro_setjmp (ctx->env, 0);
ctx->env[JB_PC] = (__uint64_t)coro_init;
ctx->env[JB_SP] = (__uint64_t)STACK_ADJUST_PTR (sptr, ssize) - sizeof (long);
# elif CORO_ASM
#if __i386__ || __x86_64__
ctx->sp = (void **)(ssize + (char *)sptr);
*--ctx->sp = (void *)abort; /* needed for alignment only */
*--ctx->sp = (void *)coro_init;
#if CORO_WIN_TIB
*--ctx->sp = 0; /* ExceptionList */
*--ctx->sp = (char *)sptr + ssize; /* StackBase */
*--ctx->sp = sptr; /* StackLimit */
#endif
#elif CORO_ARM
/* return address stored in lr register, don't push anything */
#else
#error unsupported architecture
#endif
ctx->sp -= NUM_SAVED;
memset (ctx->sp, 0, sizeof (*ctx->sp) * NUM_SAVED);
#if __i386__ || __x86_64__
/* done already */
#elif CORO_ARM
ctx->sp[0] = coro; /* r4 */
ctx->sp[1] = arg; /* r5 */
ctx->sp[8] = (char *)coro_init; /* lr */
#else
#error unsupported architecture
#endif
# elif CORO_UCONTEXT
getcontext (&(ctx->uc));
ctx->uc.uc_link = 0;
ctx->uc.uc_stack.ss_sp = sptr;
ctx->uc.uc_stack.ss_size = (size_t)ssize;
ctx->uc.uc_stack.ss_flags = 0;
makecontext (&(ctx->uc), (void (*)())coro_init, 0);
# endif
coro_transfer (create_coro, new_coro);
}
/*****************************************************************************/
/* pthread backend */
/*****************************************************************************/
#elif CORO_PTHREAD
/* this mutex will be locked by the running coroutine */
pthread_mutex_t coro_mutex = PTHREAD_MUTEX_INITIALIZER;
struct coro_init_args
{
coro_func func;
void *arg;
coro_context *self, *main;
};
static pthread_t null_tid;
/* I'd so love to cast pthread_mutex_unlock to void (*)(void *)... */
static void
mutex_unlock_wrapper (void *arg)
{
pthread_mutex_unlock ((pthread_mutex_t *)arg);
}
static void *
coro_init (void *args_)
{
struct coro_init_args *args = (struct coro_init_args *)args_;
coro_func func = args->func;
void *arg = args->arg;
pthread_mutex_lock (&coro_mutex);
/* we try to be good citizens and use deferred cancellation and cleanup handlers */
pthread_cleanup_push (mutex_unlock_wrapper, &coro_mutex);
coro_transfer (args->self, args->main);
func (arg);
pthread_cleanup_pop (1);
return 0;
}
void
coro_transfer (coro_context *prev, coro_context *next)
{
pthread_cond_signal (&next->cv);
pthread_cond_wait (&prev->cv, &coro_mutex);
#if __FreeBSD__ /* freebsd is of course broken and needs manual testcancel calls... yay... */
pthread_testcancel ();
#endif
}
void
coro_create (coro_context *ctx, coro_func coro, void *arg, void *sptr, size_t ssize)
{
static coro_context nctx;
static int once;
if (!once)
{
once = 1;
pthread_mutex_lock (&coro_mutex);
pthread_cond_init (&nctx.cv, 0);
null_tid = pthread_self ();
}
pthread_cond_init (&ctx->cv, 0);
if (coro)
{
pthread_attr_t attr;
struct coro_init_args args;
args.func = coro;
args.arg = arg;
args.self = ctx;
args.main = &nctx;
pthread_attr_init (&attr);
#if __UCLIBC__
/* exists, but is borked */
/*pthread_attr_setstacksize (&attr, (size_t)ssize);*/
#elif __CYGWIN__
/* POSIX, not here */
pthread_attr_setstacksize (&attr, (size_t)ssize);
#else
pthread_attr_setstack (&attr, sptr, (size_t)ssize);
#endif
pthread_attr_setscope (&attr, PTHREAD_SCOPE_PROCESS);
pthread_create (&ctx->id, &attr, coro_init, &args);
coro_transfer (args.main, args.self);
}
else
ctx->id = null_tid;
}
void
coro_destroy (coro_context *ctx)
{
if (!pthread_equal (ctx->id, null_tid))
{
pthread_cancel (ctx->id);
pthread_mutex_unlock (&coro_mutex);
pthread_join (ctx->id, 0);
pthread_mutex_lock (&coro_mutex);
}
pthread_cond_destroy (&ctx->cv);
}
/*****************************************************************************/
/* fiber backend */
/*****************************************************************************/
#elif CORO_FIBER
#define WIN32_LEAN_AND_MEAN
#if _WIN32_WINNT < 0x0400
#undef _WIN32_WINNT
#define _WIN32_WINNT 0x0400
#endif
#include <windows.h>
VOID CALLBACK
coro_init (PVOID arg)
{
coro_context *ctx = (coro_context *)arg;
ctx->coro (ctx->arg);
}
void
coro_transfer (coro_context *prev, coro_context *next)
{
if (!prev->fiber)
{
prev->fiber = GetCurrentFiber ();
if (prev->fiber == 0 || prev->fiber == (void *)0x1e00)
prev->fiber = ConvertThreadToFiber (0);
}
SwitchToFiber (next->fiber);
}
void
coro_create (coro_context *ctx, coro_func coro, void *arg, void *sptr, size_t ssize)
{
ctx->fiber = 0;
ctx->coro = coro;
ctx->arg = arg;
if (!coro)
return;
ctx->fiber = CreateFiber (ssize, coro_init, ctx);
}
void
coro_destroy (coro_context *ctx)
{
DeleteFiber (ctx->fiber);
}
#else
#error unsupported backend
#endif
/*****************************************************************************/
/* stack management */
Coro/libcoro/coro.c view on Meta::CPAN
#ifndef CORO_GUARDPAGES
# define CORO_GUARDPAGES 0
#endif
#if !PAGESIZE
#if !CORO_MMAP
#define PAGESIZE 4096
#else
static size_t
coro_pagesize (void)
{
static size_t pagesize;
if (!pagesize)
pagesize = sysconf (_SC_PAGESIZE);
return pagesize;
}
#define PAGESIZE coro_pagesize ()
#endif
#endif
int
coro_stack_alloc (struct coro_stack *stack, unsigned int size)
{
if (!size)
size = 256 * 1024;
stack->sptr = 0;
stack->ssze = ((size_t)size * sizeof (void *) + PAGESIZE - 1) / PAGESIZE * PAGESIZE;
#if CORO_FIBER
stack->sptr = (void *)stack;
Coro/libcoro/coro.c view on Meta::CPAN
stack->valgrind_id = VALGRIND_STACK_REGISTER ((char *)base, ((char *)base) + ssze - CORO_GUARDPAGES * PAGESIZE);
#endif
stack->sptr = base;
return 1;
#endif
}
void
coro_stack_free (struct coro_stack *stack)
{
#if CORO_FIBER
/* nop */
#else
#if CORO_USE_VALGRIND
VALGRIND_STACK_DEREGISTER (stack->valgrind_id);
#endif
#if CORO_MMAP
if (stack->sptr)
Coro/libcoro/coro.h view on Meta::CPAN
* version of this file under the BSD license, indicate your decision
* by deleting the provisions above and replace them with the notice
* and other provisions required by the GPL. If you do not delete the
* provisions above, a recipient may use your version of this file under
* either the BSD or the GPL.
*
* This library is modelled strictly after Ralf S. Engelschalls article at
* http://www.gnu.org/software/pth/rse-pmt.ps. So most of the credit must
* go to Ralf S. Engelschall <rse@engelschall.com>.
*
* This coroutine library is very much stripped down. You should either
* build your own process abstraction using it or - better - just use GNU
* Portable Threads, http://www.gnu.org/software/pth/.
*
*/
/*
* 2006-10-26 Include stddef.h on OS X to work around one of its bugs.
* Reported by Michael_G_Schwern.
* 2006-11-26 Use _setjmp instead of setjmp on GNU/Linux.
* 2007-04-27 Set unwind frame info if gcc 3+ and ELF is detected.
Coro/libcoro/coro.h view on Meta::CPAN
* 2007-05-02 Add assembly versions for x86 and amd64 (to avoid reliance
* on SIGUSR2 and sigaltstack in Crossfire).
* 2008-01-21 Disable CFI usage on anything but GNU/Linux.
* 2008-03-02 Switched to 2-clause BSD license with GPL exception.
* 2008-04-04 New (but highly unrecommended) pthreads backend.
* 2008-04-24 Reinstate CORO_LOSER (had wrong stack adjustments).
* 2008-10-30 Support assembly method on x86 with and without frame pointer.
* 2008-11-03 Use a global asm statement for CORO_ASM, idea by pippijn.
* 2008-11-05 Hopefully fix misaligned stacks with CORO_ASM/SETJMP.
* 2008-11-07 rbp wasn't saved in CORO_ASM on x86_64.
* introduce coro_destroy, which is a nop except for pthreads.
* speed up CORO_PTHREAD. Do no longer leak threads either.
* coro_create now allows one to create source coro_contexts.
* do not rely on makecontext passing a void * correctly.
* try harder to get _setjmp/_longjmp.
* major code cleanup/restructuring.
* 2008-11-10 the .cfi hacks are no longer needed.
* 2008-11-16 work around a freebsd pthread bug.
* 2008-11-19 define coro_*jmp symbols for easier porting.
* 2009-06-23 tentative win32-backend support for mingw32 (Yasuhiro Matsumoto).
* 2010-12-03 tentative support for uclibc (which lacks all sorts of things).
* 2011-05-30 set initial callee-saved-registers to zero with CORO_ASM.
* use .cfi_undefined rip on linux-amd64 for better backtraces.
* 2011-06-08 maybe properly implement weird windows amd64 calling conventions.
* 2011-07-03 rely on __GCC_HAVE_DWARF2_CFI_ASM for cfi detection.
* 2011-08-08 cygwin trashes stacks, use pthreads with double stack on cygwin.
* 2012-12-04 reduce misprediction penalty for x86/amd64 assembly switcher.
* 2012-12-05 experimental fiber backend (allocates stack twice).
* 2012-12-07 API version 3 - add coro_stack_alloc/coro_stack_free.
* 2012-12-21 valgrind stack registering was broken.
* 2015-12-05 experimental asm be for arm7, based on a patch by Nick Zavaritsky.
* use __name__ for predefined symbols, as in libecb.
* enable guard pages on arm, aarch64 and mips.
* 2016-08-27 try to disable _FORTIFY_SOURCE with CORO_SJLJ, as it
* breaks setjmp/longjmp. Also disable CORO_ASM for asm by default,
* as it was reported to crash.
* 2016-11-18 disable cfi_undefined again - backtraces might be worse, but
* compile compatibility is improved.
*/
#ifndef CORO_H
#define CORO_H
#if __cplusplus
extern "C" {
#endif
/*
* This library consists of only three files
* coro.h, coro.c and LICENSE (and optionally README)
*
* It implements what is known as coroutines, in a hopefully
* portable way.
*
* All compiletime symbols must be defined both when including coro.h
* (using libcoro) as well as when compiling coro.c (the implementation).
*
* You can manually specify which flavour you want. If you don't define
* any of these, libcoro tries to choose a safe and fast default:
*
* -DCORO_UCONTEXT
*
* This flavour uses SUSv2's get/set/swap/makecontext functions that
* unfortunately only some unices support, and is quite slow.
*
* -DCORO_SJLJ
*
* This flavour uses SUSv2's setjmp/longjmp and sigaltstack functions to
* do it's job. Coroutine creation is much slower than UCONTEXT, but
Coro/libcoro/coro.h view on Meta::CPAN
* Hand coded assembly, known to work only on a few architectures/ABI:
* GCC + arm7/x86/IA32/amd64/x86_64 + GNU/Linux and a few BSDs. Fastest
* choice, if it works.
*
* -DCORO_PTHREAD
*
* Use the pthread API. You have to provide <pthread.h> and -lpthread.
* This is likely the slowest backend, and it also does not support fork(),
* so avoid it at all costs.
*
* If you define neither of these symbols, coro.h will try to autodetect
* the best/safest model. To help with the autodetection, you should check
* (e.g. using autoconf) and define the following symbols: HAVE_UCONTEXT_H
* / HAVE_SETJMP_H / HAVE_SIGALTSTACK.
*/
/*
* Changes when the API changes incompatibly.
* This is ONLY the API version - there is no ABI compatibility between releases.
*
* Changes in API version 2:
* replaced bogus -DCORO_LOOSE with grammatically more correct -DCORO_LOSER
* Changes in API version 3:
* introduced stack management (CORO_STACKALLOC)
*/
#define CORO_VERSION 3
#include <stddef.h>
/*
* This is the type for the initialization function of a new coroutine.
*/
typedef void (*coro_func)(void *);
/*
* A coroutine state is saved in the following structure. Treat it as an
* opaque type. errno and sigmask might be saved, but don't rely on it,
* implement your own switching primitive if you need that.
*/
typedef struct coro_context coro_context;
/*
* This function creates a new coroutine. Apart from a pointer to an
* uninitialised coro_context, it expects a pointer to the entry function
* and the single pointer value that is given to it as argument.
*
* Allocating/deallocating the stack is your own responsibility.
*
* As a special case, if coro, arg, sptr and ssze are all zero,
* then an "empty" coro_context will be created that is suitable
* as an initial source for coro_transfer.
*
* This function is not reentrant, but putting a mutex around it
* will work.
*/
void coro_create (coro_context *ctx, /* an uninitialised coro_context */
coro_func coro, /* the coroutine code to be executed */
void *arg, /* a single pointer passed to the coro */
void *sptr, /* start of stack area */
size_t ssze); /* size of stack area in bytes */
/*
* The following prototype defines the coroutine switching function. It is
* sometimes implemented as a macro, so watch out.
*
* This function is thread-safe and reentrant.
*/
#if 0
void coro_transfer (coro_context *prev, coro_context *next);
#endif
/*
* The following prototype defines the coroutine destroy function. It
* is sometimes implemented as a macro, so watch out. It also serves no
* purpose unless you want to use the CORO_PTHREAD backend, where it is
* used to clean up the thread. You are responsible for freeing the stack
* and the context itself.
*
* This function is thread-safe and reentrant.
*/
#if 0
void coro_destroy (coro_context *ctx);
#endif
/*****************************************************************************/
/* optional stack management */
/*****************************************************************************/
/*
* You can disable all of the stack management functions by
* defining CORO_STACKALLOC to 0. Otherwise, they are enabled by default.
*
* If stack management is enabled, you can influence the implementation via these
* symbols:
*
* -DCORO_USE_VALGRIND
*
* If defined, then libcoro will include valgrind/valgrind.h and register
* and unregister stacks with valgrind.
*
* -DCORO_GUARDPAGES=n
*
* libcoro will try to use the specified number of guard pages to protect against
* stack overflow. If n is 0, then the feature will be disabled. If it isn't
* defined, then libcoro will choose a suitable default. If guardpages are not
* supported on the platform, then the feature will be silently disabled.
*/
#ifndef CORO_STACKALLOC
# define CORO_STACKALLOC 1
#endif
#if CORO_STACKALLOC
/*
* The only allowed operations on these struct members is to read the
* "sptr" and "ssze" members to pass it to coro_create, to read the "sptr"
* member to see if it is false, in which case the stack isn't allocated,
* and to set the "sptr" member to 0, to indicate to coro_stack_free to
* not actually do anything.
*/
struct coro_stack
{
void *sptr;
size_t ssze;
#if CORO_USE_VALGRIND
int valgrind_id;
#endif
};
/*
* Try to allocate a stack of at least the given size and return true if
* successful, or false otherwise.
*
* The size is *NOT* specified in bytes, but in units of sizeof (void *),
* i.e. the stack is typically 4(8) times larger on 32 bit(64 bit) platforms
* then the size passed in.
*
* If size is 0, then a "suitable" stack size is chosen (usually 1-2MB).
*/
int coro_stack_alloc (struct coro_stack *stack, unsigned int size);
/*
* Free the stack allocated by coro_stack_alloc again. It is safe to
* call this function on the coro_stack structure even if coro_stack_alloc
* failed.
*/
void coro_stack_free (struct coro_stack *stack);
#endif
/*
* That was it. No other user-serviceable parts below here.
*/
/*****************************************************************************/
#if !defined CORO_LOSER && !defined CORO_UCONTEXT \
Coro/libcoro/coro.h view on Meta::CPAN
error unknown or unsupported architecture
# endif
#endif
/*****************************************************************************/
#if CORO_UCONTEXT
# include <ucontext.h>
struct coro_context
{
ucontext_t uc;
};
# define coro_transfer(p,n) swapcontext (&((p)->uc), &((n)->uc))
# define coro_destroy(ctx) (void *)(ctx)
#elif CORO_SJLJ || CORO_LOSER || CORO_LINUX || CORO_IRIX
# if defined(CORO_LINUX) && !defined(_GNU_SOURCE)
# define _GNU_SOURCE /* for glibc */
# endif
/* try to disable well-meant but buggy checks in some libcs */
# ifdef _FORTIFY_SOURCE
# undef _FORTIFY_SOURCE
Coro/libcoro/coro.h view on Meta::CPAN
/* solaris is hopelessly borked, it expands _XOPEN_UNIX to nothing */
# if __sun
# undef _XOPEN_UNIX
# define _XOPEN_UNIX 1
# endif
# include <setjmp.h>
# if _XOPEN_UNIX > 0 || defined (_setjmp)
# define coro_jmp_buf jmp_buf
# define coro_setjmp(env) _setjmp (env)
# define coro_longjmp(env) _longjmp ((env), 1)
# elif CORO_LOSER
# define coro_jmp_buf jmp_buf
# define coro_setjmp(env) setjmp (env)
# define coro_longjmp(env) longjmp ((env), 1)
# else
# define coro_jmp_buf sigjmp_buf
# define coro_setjmp(env) sigsetjmp (env, 0)
# define coro_longjmp(env) siglongjmp ((env), 1)
# endif
struct coro_context
{
coro_jmp_buf env;
};
# define coro_transfer(p,n) do { if (!coro_setjmp ((p)->env)) coro_longjmp ((n)->env); } while (0)
# define coro_destroy(ctx) (void *)(ctx)
#elif CORO_ASM
struct coro_context
{
void **sp; /* must be at offset 0 */
};
#if __i386__ || __x86_64__
void __attribute__ ((__noinline__, __regparm__(2)))
#else
void __attribute__ ((__noinline__))
#endif
coro_transfer (coro_context *prev, coro_context *next);
# define coro_destroy(ctx) (void *)(ctx)
#elif CORO_PTHREAD
# include <pthread.h>
extern pthread_mutex_t coro_mutex;
struct coro_context
{
pthread_cond_t cv;
pthread_t id;
};
void coro_transfer (coro_context *prev, coro_context *next);
void coro_destroy (coro_context *ctx);
#elif CORO_FIBER
struct coro_context
{
void *fiber;
/* only used for initialisation */
coro_func coro;
void *arg;
};
void coro_transfer (coro_context *prev, coro_context *next);
void coro_destroy (coro_context *ctx);
#endif
#if __cplusplus
}
#endif
#endif
=head1 NAME
Coro::EV - do events the coro-way, with EV
=head1 SYNOPSIS
use Coro;
use Coro::EV;
EV::READ & Coro::EV::timed_io_once $fh, EV::READ, 60
or die "timeout\n";
EV::run;
That means that threads with the same or higher priority as the threads
running the main loop will inhibit event processing, while threads of
lower priority will get the CPU, but cannot completeley inhibit event
processing. Note that for that to work you actually have to run the EV
event loop in some thread.
=head1 RUNNING WITH OR WITHOUT A MAINLOOP
In general, you should always run EV::run, either in your main program,
or in a separate coroutine. If you don't do that and all coroutines
start waiting for some events, this module will run the event loop once,
but this is very inefficient and will also not make it possible to run
background threads.
To run the EV event loop in a separate thread, you can simply do this:
async { EV::run };
=head1 FUNCTIONS
&_loop_oneshot;
Coro::schedule if Coro::nready;
}
};
$IDLE->{desc} = "[EV idle thread]";
$Coro::idle = $IDLE;
=item $revents = Coro::EV::timed_io_once $fileno_or_fh, $events[, $timeout]
Blocks the coroutine until either the given event set has occurred on the
fd, or the timeout has been reached (if timeout is missing or C<undef>
then there will be no timeout). Returns the received flags.
Consider using C<Coro::AnyEvent::readable> and C<Coro::AnyEvent::writable>
instead, they work with any AnyEvent-supported eventloop.
=item Coro::EV::timer_once $after
Blocks the coroutine for at least C<$after> seconds.
Consider using C<Coro::AnyEvent::sleep> instead, which works with any
AnyEvent-supported eventloop.
=cut
1;
=back
if (inhibit)
return;
++incede;
CORO_CEDE_NOTSELF;
while (CORO_NREADY >= incede && CORO_CEDE)
;
/* if still ready, then we have lower-priority coroutines.
* poll anyways, but do not block.
*/
if (CORO_NREADY >= incede)
{
if (!ev_is_active (&idler))
ev_idle_start (EV_A, &idler);
}
else
{
if (ev_is_active (&idler))
);
}
/*****************************************************************************/
typedef struct
{
ev_io io;
ev_timer tw;
SV *data;
} coro_dir;
typedef struct
{
coro_dir r, w;
} coro_handle;
static int
handle_free (pTHX_ SV *sv, MAGIC *mg)
{
coro_handle *data = (coro_handle *)mg->mg_ptr;
mg->mg_ptr = 0;
ev_io_stop (EV_DEFAULT_UC, &data->r.io); ev_io_stop (EV_DEFAULT_UC, &data->w.io);
ev_timer_stop (EV_DEFAULT_UC, &data->r.tw); ev_timer_stop (EV_DEFAULT_UC, &data->w.tw);
return 0;
}
static MGVTBL handle_vtbl = { 0, 0, 0, 0, handle_free };
static void
handle_cb (coro_dir *dir, int success)
{
ev_io_stop (EV_DEFAULT_UC, &dir->io);
ev_timer_stop (EV_DEFAULT_UC, &dir->tw);
CORO_READY (dir->data);
sv_setiv (dir->data, success);
}
static void
handle_io_cb (EV_P_ ev_io *w, int revents)
{
handle_cb ((coro_dir *)(((char *)w) - offsetof (coro_dir, io)), 1);
}
static void
handle_timer_cb (EV_P_ ev_timer *w, int revents)
{
handle_cb ((coro_dir *)(((char *)w) - offsetof (coro_dir, tw)), 0);
}
static int
slf_check_rw (pTHX_ struct CoroSLF *frame)
{
coro_dir *dir = (coro_dir *)frame->data;
/* return early when an exception is pending */
if (CORO_THROW)
{
ev_io_stop (EV_DEFAULT_UC, &dir->io);
ev_timer_stop (EV_DEFAULT_UC, &dir->tw);
return 0;
}
PUTBACK;
return 0;
}
}
static void
slf_init_rw (pTHX_ struct CoroSLF *frame, SV *arg, int wr)
{
AV *handle = (AV *)SvRV (arg);
SV *data_sv = AvARRAY (handle)[5];
coro_handle *data;
coro_dir *dir;
assert (AvFILLp (handle) >= 7);
if (!SvOK (data_sv))
{
int fno = sv_fileno (AvARRAY (handle)[0]);
SvREFCNT_dec (data_sv);
data_sv = AvARRAY (handle)[5] = NEWSV (0, sizeof (coro_handle));
SvPOK_only (data_sv);
SvREADONLY_on (data_sv);
data = (coro_handle *)SvPVX (data_sv);
memset (data, 0, sizeof (coro_handle));
ev_io_init (&data->r.io, handle_io_cb, fno, EV_READ);
ev_io_init (&data->w.io, handle_io_cb, fno, EV_WRITE);
ev_init (&data->r.tw, handle_timer_cb);
ev_init (&data->w.tw, handle_timer_cb);
sv_magicext (data_sv, 0, PERL_MAGIC_ext, &handle_vtbl, (char *)data, 0);
}
else
data = (coro_handle *)SvPVX (data_sv);
dir = wr ? &data->w : &data->r;
if (ev_is_active (&dir->io) || ev_is_active (&dir->tw))
croak ("recursive invocation of readable_ev or writable_ev (concurrent Coro::Handle calls on same handle?), detected");
dir->data = sv_2mortal (newRV_inc (CORO_CURRENT));
{
SV *to = AvARRAY (handle)[2];
_set_readyhook ()
CODE:
CORO_READYHOOK = readyhook;
CORO_READYHOOK ();
void
_loop_oneshot ()
CODE:
{
/* inhibit the prepare watcher, as we know we are the only
* ready coroutine and we don't want it to start an idle watcher
* just because of the fallback idle coro being of lower priority.
*/
++inhibit;
/* same reasoning as above, make sure it is stopped */
if (ev_is_active (&idler))
ev_idle_stop (EV_DEFAULT_UC, &idler);
ev_run (EV_DEFAULT_UC, EVRUN_ONCE);
--inhibit;
}
Event/Event.pm view on Meta::CPAN
=head1 NAME
Coro::Event - do events the coro-way, with Event
=head1 SYNOPSIS
use Coro;
use Coro::Event;
sub keyboard : Coro {
my $w = Coro::Event->io(fd => \*STDIN, poll => 'r');
while() {
print "cmd> ";
Event/Event.pm view on Meta::CPAN
Best practise is to always use B<Coro::unblock_sub> for your callbacks.
=head1 SEMANTICS
Whenever Event blocks (e.g. in a call to C<one_event>, C<loop> etc.),
this module cede's to all other threads with the same or higher
priority. When any threads of lower priority are ready, it will not
block but run one of them and then check for events.
The effect is that coroutines with the same or higher priority than
the blocking coroutine will keep Event from checking for events, while
coroutines with lower priority are being run, but Event checks for new
events after every cede. Note that for this to work you actually need to
run the event loop in some thread.
=head1 FUNCTIONS
=over 4
=cut
package Coro::Event;
Event/Event.pm view on Meta::CPAN
method often, but it does save typing sometimes.
=cut
for my $flavour (qw(idle var timer io signal)) {
push @EXPORT, "do_$flavour";
my $new = \&{"Event::$flavour"};
my $class = "Coro::Event::$flavour";
my $type = $flavour eq "io" ? 1 : 0;
@{"${class}::ISA"} = (Coro::Event::, "Event::$flavour");
my $coronew = sub {
# how does one do method-call-by-name?
# my $w = $class->SUPER::$flavour(@_);
shift eq Coro::Event::
or croak "event constructor \"Coro::Event->$flavour\" must be called as a static method";
my $w = $new->($class,
desc => $flavour,
@_,
parked => 1,
);
_install_std_cb $w, $type;
# reblessing due to Event being broken
bless $w, $class
};
*{ $flavour } = $coronew;
*{"do_$flavour"} = sub {
unshift @_, Coro::Event::;
@_ = &$coronew;
&Coro::schedule while &_next;
$_[0]->cancel;
&_event
};
}
# do schedule in perl to avoid forcing a stack allocation.
# this is about 10% slower, though.
sub next($) {
&Coro::schedule while &_next;
Event/Event.pm view on Meta::CPAN
sub Coro::Event::Event::got { $_[0][4] }
=item sweep
Similar to Event::one_event and Event::sweep: The idle task is called once
(this has the effect of jumping back into the Event loop once to serve new
events).
The reason this function exists is that you sometimes want to serve events
while doing other work. Calling C<Coro::cede> does not work because
C<cede> implies that the current coroutine is runnable and does not call
into the Event dispatcher.
=cut
sub sweep {
Event::one_event 0; # for now
}
# very inefficient
our $IDLE = new Coro sub {
( run in 0.770 second using v1.01-cache-2.11-cpan-3cd7ad12f66 )