Coro-6.514/0000755000000000000000000000000013152034463011132 5ustar rootrootCoro-6.514/Event/0000755000000000000000000000000013152034463012213 5ustar rootrootCoro-6.514/Event/Makefile.PL0000644000000000000000000000053410523706122014164 0ustar rootrootuse ExtUtils::MakeMaker; use Event::MakeMaker; use 5.005; use Config; $|=1; WriteMakefile(Event::MakeMaker::event_args( NAME => "Coro::Event", VERSION_FROM => "Event.pm", DEFINE => $DEFINE, DIR => [], PM => { 'Event.pm' => '$(INST_LIBDIR)/Event.pm', }, )); Coro-6.514/Event/Event.pm0000644000000000000000000001247013152034454013636 0ustar rootroot=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> "; my $ev = $w->next; my $cmd = ; unloop unless $cmd ne ""; print "data> "; my $ev = $w->next; my $data = ; } } loop; # wait for input on stdin for one second Coro::Event::do_io (fd => \*STDIN, timeout => 1) & Event::Watcher::R or die "no input received"; # use a separate thread for event processing, if impossible in main: Coro::async { Event::loop }; =head1 DESCRIPTION This module enables you to create programs using the powerful Event model (and module), while retaining the linear style known from simple or threaded programs. This module provides a method and a function for every watcher type (I) (see L). The only difference between these and the watcher constructors from Event is that you do not specify a callback function - it will be managed by this module. Your application should just create all necessary threads and then call C. Please note that even programs or modules (such as L) that use "traditional" event-based/continuation style will run more efficient with this module then when using only Event. =head1 WARNING Please note that Event does not support multithreading. That means that you B block in an event callback. Again: In Event callbacks, you I call a Coro function that blocks the current thread. While this seems to work superficially, it will eventually cause memory corruption and often results in deadlocks. Best practise is to always use B for your callbacks. =head1 SEMANTICS Whenever Event blocks (e.g. in a call to C, C 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; use common::sense; use Carp; use Coro; use Event qw(loop unloop); # we are re-exporting this for historical reasons use XSLoader; use base Exporter::; our @EXPORT = qw(loop unloop sweep); BEGIN { our $VERSION = 6.514; local $^W = 0; # avoid redefine warning for Coro::ready; XSLoader::load __PACKAGE__, $VERSION; } =item $w = Coro::Event->flavour (args...) Create and return a watcher of the given type. Examples: my $reader = Coro::Event->io (fd => $filehandle, poll => 'r'); $reader->next; =cut =item $w->next Wait for and return the next event of the event queue of the watcher. The returned event objects support two methods only: C and C, both of which return integers: the number this watcher was hit for this event, and the mask of poll events received. =cut =item do_flavour args... Create a watcher of the given type and immediately call it's next method, returning the event. This is less efficient then calling the constructor once and the next 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 } sub Coro::Event::Event::hits { $_[0][3] } 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 does not work because C 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 { while () { Event::one_event; Coro::schedule if Coro::nready; } }; $IDLE->{desc} = "[Event idle thread]"; $Coro::idle = $IDLE; 1; =back =head1 AUTHOR/SUPPORT/CONTACT Marc A. Lehmann http://software.schmorp.de/pkg/Coro.html =cut Coro-6.514/Event/Event.xs0000644000000000000000000000770512535073246013667 0ustar rootroot#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #include #include "EventAPI.h" #include "../Coro/CoroAPI.h" #define CD_WAIT 0 /* wait queue */ #define CD_TYPE 1 #define CD_OK 2 #define CD_HITS 3 /* hardcoded in Coro::Event */ #define CD_GOT 4 /* hardcoded in Coro::Event, Coro::Handle */ #define CD_MAX 4 static HV *coro_event_event_stash; #define PERL_MAGIC_coro_event 0x18 /* to avoid clashes with e.g. event */ static void coro_std_cb (pe_event *pe) { AV *priv = (AV *)pe->ext_data; IV type = SvIV (AvARRAY (priv)[CD_TYPE]); AV *cd_wait; SV *coro; SvIV_set (AvARRAY (priv)[CD_HITS], pe->hits); SvIV_set (AvARRAY (priv)[CD_GOT], type ? ((pe_ioevent *)pe)->got : 0); AvARRAY (priv)[CD_OK] = &PL_sv_yes; cd_wait = (AV *)AvARRAY(priv)[CD_WAIT]; coro = av_shift (cd_wait); if (coro != &PL_sv_undef) { CORO_READY (coro); SvREFCNT_dec (coro); } if (av_len (cd_wait) < 0) GEventAPI->stop (pe->up, 0); } static void asynccheck_hook (void *data) { /* this loops as long as we have _other_ coros with the same or higher priority */ while (CORO_NREADY && CORO_CEDE) ; } static NV prepare_hook (void *data) { /* this yields once to another coro with any priority */ if (CORO_NREADY) { CORO_CEDE_NOTSELF; /* * timers might have changed, and Event fails to notice this * so we have to assume the worst. If Event didn't have that bug, * we would only need to do this if CORO_NREADY is != 0 now. */ return 0.; } else return 85197.73; /* this is as good as any value, but it factors badly with common values */ } MODULE = Coro::Event PACKAGE = Coro::Event PROTOTYPES: ENABLE BOOT: { coro_event_event_stash = gv_stashpv ("Coro::Event::Event", TRUE); I_EVENT_API ("Coro::Event"); I_CORO_API ("Coro::Event"); GEventAPI->add_hook ("asynccheck", (void *)asynccheck_hook, 0); GEventAPI->add_hook ("prepare", (void *)prepare_hook, 0); } void _install_std_cb (SV *self, int type) CODE: { pe_watcher *w = (pe_watcher *)GEventAPI->sv_2watcher (self); if (w->callback) croak ("Coro::Event watchers must not have a callback (see Coro::Event), caught"); { AV *priv = newAV (); av_fill (priv, CD_MAX); AvARRAY (priv)[CD_WAIT] = (SV *)newAV (); /* AV in AV _should_ not be exposed to perl */ AvARRAY (priv)[CD_TYPE] = newSViv (type); AvARRAY (priv)[CD_OK ] = &PL_sv_no; AvARRAY (priv)[CD_HITS] = newSViv (0); AvARRAY (priv)[CD_GOT ] = newSViv (0); SvREADONLY_on (priv); w->callback = (void *)coro_std_cb; w->ext_data = priv; { SV *mob = newRV_noinc ((SV *)priv); sv_magicext (SvRV (self), mob, PERL_MAGIC_coro_event, 0, (char *)w, 0); SvREFCNT_dec (mob); /* sv_magicext increments the refcount */ } } } void _next (SV *self) CODE: { pe_watcher *w = (pe_watcher *)GEventAPI->sv_2watcher (self); AV *priv = (AV *)w->ext_data; if (AvARRAY (priv)[CD_OK] == &PL_sv_yes) { AvARRAY (priv)[CD_OK] = &PL_sv_no; XSRETURN_NO; /* got an event */ } av_push ((AV *)AvARRAY (priv)[CD_WAIT], SvREFCNT_inc (CORO_CURRENT)); if (!w->running) GEventAPI->start (w, 1); XSRETURN_YES; /* schedule */ } SV * _event (SV *self) CODE: { if (GIMME_V == G_VOID) XSRETURN_EMPTY; { pe_watcher *w = (pe_watcher *)GEventAPI->sv_2watcher (self); AV *priv = (AV *)w->ext_data; RETVAL = newRV_inc ((SV *)priv); /* may need to bless it now */ if (!SvOBJECT (priv)) { SvREADONLY_off ((SV *)priv); sv_bless (RETVAL, coro_event_event_stash); SvREADONLY_on ((SV *)priv); } } } OUTPUT: RETVAL Coro-6.514/Event/t/0000755000000000000000000000000013152034463012456 5ustar rootrootCoro-6.514/Event/t/01_unblock.t0000644000000000000000000000156211231500457014601 0ustar rootrootBEGIN { if ($^O =~ /mswin32/i) { print < 0.001); print "ok 7\n"; print $w "13\n"; print "ok 8\n"; Coro::Event::do_timer (after => 0.1); # see EV/t/01* $w->print ("x" x (1024*1024*8)); print "ok 10\n"; $w->print ("x" x (1024*1024*8)); print $w "77\n"; close $w; }; print "ok 4\n"; cede; print "ok 6\n"; print <$r> == 13 ? "" : "not ", "ok 9\n"; $r->read (my $buf, 1024*1024*16); print "ok 11\n"; print <$r> == 77 ? "" : "not ", "ok 12\n"; Coro-6.514/Event/t/00_basic.t0000644000000000000000000000045110533710301014213 0ustar rootrootBEGIN { $| = 1; print "1..5\n"; } END {print "not ok 1\n" unless $loaded;} use Coro; use Coro::Event; $loaded = 1; print "ok 1\n"; async { print "ok 3\n"; $var = 7; print "ok 4\n"; }; print "ok 2\n"; do_var (var => \$var, poll => 'w'); print $var == 7 ? "ok 5\n" : "not ok 5\n"; Coro-6.514/t/0000755000000000000000000000000013152034463011375 5ustar rootrootCoro-6.514/t/16_signal.t0000644000000000000000000000243611220312366013345 0ustar rootroot$|=1; print "1..18\n"; no warnings; use Coro; use Coro::Signal; { my $sig = new Coro::Signal; $as1 = async { my $g = $sig->wait; print "ok 3\n"; }; $as2 = async { my $g = $sig->wait; print "ok 4\n"; }; cede; # put 1, 2 in wait q $as3 = async { my $g = $sig->wait; print "ok 2\n"; }; $as4 = async { my $g = $sig->wait; print "ok 6\n"; }; $as5 = async { my $g = $sig->wait; print "ok 9\n"; }; $sig->send; # ready 1 $sig->send; # ready 2 $sig->send; # remember print +(Coro::Semaphore::count $sig) == 1 ? "" : "not ", "ok 1\n"; cede; # execute 3 (already ready, no contention), 1, 2 print +(Coro::Semaphore::count $sig) == 0 ? "" : "not ", "ok 5\n"; $sig->send; cede; print +(Coro::Semaphore::count $sig) == 0 ? "" : "not ", "ok 7\n"; $sig->broadcast; print +(Coro::Semaphore::count $sig) == 0 ? "" : "not ", "ok 8\n"; cede; $sig->wait (sub { print "ok 12\n" }); print "ok 10\n"; print "ok 11\n"; $sig->send; print "ok 13\n"; cede; print "ok 14\n"; $sig->send; print "ok 15\n"; $sig->wait (sub { print "ok 16\n" }); print "ok 17\n"; print +(Coro::Semaphore::count $sig) == 0 ? "" : "not ", "ok 18\n"; } Coro-6.514/t/18_winder.t0000644000000000000000000000105611121473704013363 0ustar rootroot$|=1; print "1..17\n"; no warnings; use Coro; my @enter = (3, 8, 12, -1); my @leave = (6, 10, 14, -1); async { print "ok 2\n"; { Coro::on_enter { print "ok ", shift @enter, "\n"; }; print "ok 4\n"; Coro::on_leave { print "ok ", shift @leave, "\n"; }; print "ok 5\n"; cede; print "ok 9\n"; cede; print "ok 13\n"; } print "ok 15\n"; $cb = Coro::rouse_cb; print "ok 16\n"; }; print "ok 1\n"; cede; print "ok 7\n"; cede; print "ok 11\n"; cede; print "ok 17\n"; Coro-6.514/t/15_semaphore.t0000644000000000000000000000313612305255214014053 0ustar rootroot$|=1; print "1..6\n"; use Coro; use Coro::Semaphore; { my $sem = new Coro::Semaphore 2; my $rand = 0; sub xrand { $rand = ($rand * 121 + 2121) % 212121; $rand / 212120 } my $counter; $_->join for map { async { my $current = $Coro::current; for (1..100) { cede if 0.2 > xrand; Coro::async_pool { $current->ready } if 0.2 > xrand; $counter += $sem->count; my $guard = $sem->guard; cede; cede; cede; cede; } } } 1..15 ; print $counter == 998 ? "" : "not ", "ok 1 # $counter\n"; } # check terminate { my $sem = new Coro::Semaphore 0; $as1 = async { my $g = $sem->guard; print "not ok 2\n"; }; $as2 = async { my $g = $sem->guard; print "ok 2\n"; }; cede; $sem->up; # wake up as1 $as1->cancel; # destroy as1 before it could ->guard $as1->join; $as2->join; } # check throw { my $sem = new Coro::Semaphore 0; $as1 = async { my $g = eval { $sem->guard; }; print $@ ? "" : "not ", "ok 3\n"; }; $as2 = async { my $g = $sem->guard; print "ok 4\n"; }; cede; $sem->up; # wake up as1 $as1->throw (1); # destroy as1 before it could ->guard $as1->join; $as2->join; } # check wait { my $sem = new Coro::Semaphore 0; $as1 = async { $sem->wait; print "ok 5\n"; }; $as2 = async { my $g = $sem->guard; print "ok 6\n"; }; cede; $sem->up; # wake up as1 $as1->join; $as2->join; } Coro-6.514/t/04_rwlock.t0000644000000000000000000000124710531710372013370 0ustar rootroot$|=1; print "1..15\n"; use Coro; use Coro::RWLock; my $l = new Coro::RWLock; print "ok 1\n"; $l->rdlock; print (($l->tryrdlock ? "" : "not "), "ok 2\n"); print (($l->trywrlock ? "not " : ""), "ok 3\n"); $l->unlock; $l->unlock; print (($l->trywrlock ? "" : "not "), "ok 4\n"); print (($l->trywrlock ? "not " : ""), "ok 5\n"); print (($l->tryrdlock ? "not " : ""), "ok 6\n"); async { print "ok 8\n"; $l->wrlock; print "ok 10\n"; $l->unlock; $l->rdlock; print "ok 11\n"; cede; print "ok 14\n"; }; print "ok 7\n"; cede; cede; cede; cede; print "ok 9\n"; $l->unlock; cede; print "ok 12\n"; $l->rdlock; print "ok 13\n"; cede; cede; print "ok 15\n"; Coro-6.514/t/08_join.t0000644000000000000000000000074411671415525013043 0ustar rootroot$|=1; print "1..10\n"; use Coro; print "ok 1\n"; $p1 = async { print "ok 3\n"; terminate 5; }; $p2 = async { print "ok 4\n"; () }; $p3 = async { print "ok 5\n"; (0,1,2) }; print "ok 2\n"; print 0 == @{[$p2->join]} ? "ok " : "not ok ", "6\n"; print 0 == ($p3->join)[0] ? "ok " : "not ok ", "7\n"; print 1 == ($p3->join)[1] ? "ok " : "not ok ", "8\n"; print 2 == ($p3->join)[2] ? "ok " : "not ok ", "9\n"; print 5 == $p1->join ? "ok " : "not ok ", "10\n"; Coro-6.514/t/12_exit.t0000644000000000000000000000067611016132556013045 0ustar rootrootBEGIN { if ($^O =~ /mswin32/i) { print <autoflush(1); async { $W->print("one\ntwo\n\nthree\n\n\nfour\n\n\nfive\nsix\nseven"); $W->close; } my $p; while (defined(my $i = $R->readline($sep[$c]))) { $p .= $i . ":"; } $ex[$c] eq $p or print "not "; print "ok " . (1 + $c) . "\n"; } Coro-6.514/t/14_load.t0000644000000000000000000000067111020071374013003 0ustar rootrootBEGIN { $| = 1; print "1..17\n"; } my $idx; for my $module (qw( Coro::State Coro Coro::MakeMaker Coro::Signal Coro::Semaphore Coro::SemaphoreSet Coro::Channel Coro::Specific Coro::RWLock Coro::AnyEvent Coro::Timer Coro::Util Coro::Select Coro::Handle Coro::Socket Coro::Storable Coro::Debug )) { eval "use $module"; print $@ ? "not " : "", "ok ", ++$idx, " # $module ($@)\n"; } Coro-6.514/t/02_channel.t0000644000000000000000000000045411002441402013461 0ustar rootroot$|=1; print "1..19\n"; use Coro; use Coro::Channel; my $q = new Coro::Channel 1; async { # producer for (1..9) { print "ok ", $_*2, "\n"; $q->put($_); } }; print "ok 1\n"; cede; for (11..19) { my $x = $q->get; print $x == $_-10 ? "ok " : "not ok ", ($_-10)*2+1, "\n"; } Coro-6.514/t/11_deadlock.t0000644000000000000000000000117512115435171013634 0ustar rootrootBEGIN { if ($^O =~ /mswin32/i) { print <(); }; schedule; exit 3; }; waitpid $pid, 0; print 3 == $? >> 8 ? "not " : "", "ok 3\n"; my $coro = new Coro sub { print "ok 5\n"; Coro::Util::_exit 0; }; $Coro::idle = sub { $coro->ready; }; print "ok 4\n"; schedule; die; Coro-6.514/t/01_process.t0000644000000000000000000000154011563071420013536 0ustar rootroot$|=1; print "1..13\n"; use Coro; async { print "ok 2\n"; }; print "ok 1\n"; cede; print "ok 3\n"; my $c1 = async { print "ok 5\n"; cede; print "not ok 8\n";#d# }; print $c1->ready ? "not " : "", "ok 4\n"; cede; print "ok 6\n"; $c1->on_destroy (sub { print "ok 7\n"; }); $c1->cancel; print "ok 8\n"; cede; cede; print "ok 9\n"; { my $as1 = async { print "not ok 10\n"; }; my $as2 = async { print "ok 10\n"; $as1->cancel; }; $as2->cede_to; } { my $as1 = async { print "not ok 11\n"; }; my $as2 = async { print "ok 11\n"; $as1->cancel; cede; print "ok 12\n"; $Coro::main->ready; $Coro::main->throw ("exit"); }; local $SIG{__DIE__} = sub { print "ok 13\n"; exit if $@ eq "exit"; }; $as2->schedule_to; } print "not ok 12\n"; Coro-6.514/t/03_channel.t0000644000000000000000000000107310766043362013503 0ustar rootroot$|=1; print "1..10\n"; # adapted testcase by Richard Hundt use strict; use Coro; use Coro::Channel; my $c1 = new Coro::Channel 1; my $c2 = new Coro::Channel 1; async { print "ok 2\n"; print $c1->get eq "sig 1" ? "" : "not ", "ok 4\n"; $c2->put ('OK 1'); print "ok 7\n"; $c1->put ('last'); }; async { print "ok 3\n"; $c1->put('sig 1'); print "ok 5\n"; print $c2->get eq "OK 1" ? "" : "not ", "ok 6\n"; $Coro::main->ready; }; print "ok 1\n"; schedule; print "ok 8\n"; print $c1->get eq "last" ? "" : "not ", "ok 9\n"; print "ok 10\n"; Coro-6.514/t/05_specific.t0000644000000000000000000000124307330153465013660 0ustar rootroot$|=1; print "1..8\n"; use Coro::Specific; # first test without coro print "ok 1\n"; my $s1 = new Coro::Specific; my $s2 = new Coro::Specific; $$s1 = 5; $$s2 = $$s1+5; print (($$s2 == 10 ? "" : "not "), "ok 2\n"); print (($$s1 == $$s2-5 ? "" : "not "), "ok 3\n"); # now let coro inherit the first task require Coro; Coro::async(sub { print ((!defined $$s2 ? "" : "not "), "ok 5\n"); $$s1 = 6; $$s2 = $$s1 + 6; $$s2++; Coro::cede(); print (($$s2 == 13 ? "" : "not "), "ok 7\n"); }); print (($$s2 == 10 ? "" : "not "), "ok 4\n"); &Coro::cede; print (($$s2 == 10 ? "" : "not "), "ok 6\n"); &Coro::cede; print (($$s2 == 10 ? "" : "not "), "ok 8\n"); Coro-6.514/t/20_mutual_cancel.t0000644000000000000000000000145311556573660014717 0ustar rootroot$|=1; print "1..10\n"; # when two coros cancel each other mutually, # the slf function currently being executed needs to # be cleaned up, otherwise the next slf call in the cleanup code # will simply resume the previous call. # in addition, mutual cancellation must be specially handled # as currently, we sometimes cancel coros from another coro # which must not be interrupted (see slf_init_cancel). use Coro; print "ok 1\n"; my ($a, $b); sub xyz::DESTROY { print "ok 7\n"; $b->cancel; print "ok 8\n"; } $b = async { print "ok 3\n"; cede; print "ok 6\n"; $a->cancel; print "not ok 7\n"; }; $a = async { print "ok 4\n"; my $x = bless \my $dummy, "xyz"; cede; print "not ok 5\n"; }; print "ok 2\n"; cede; print "ok 5\n"; cede; print "ok 9\n"; cede; print "ok 10\n"; Coro-6.514/t/10_bugs.t0000644000000000000000000000052710700304275013023 0ustar rootroot$|=1; print "1..3\n"; # test for known buggy perls use Coro; print "ok 1\n"; # Debian allocates 0.25mb of local variables in Perl_magic_get, # normal is <<256 bytes. If your perl segfaults here, try getting a # newer one or increase the C context stack space to a few megs. async { print "ok 2\n"; $1 }->join; print "ok 3\n"; Coro-6.514/t/17_rouse.t0000644000000000000000000000036411110715230013217 0ustar rootroot$|=1; print "1..5\n"; no warnings; use Coro; my $cb; async { $cb = Coro::rouse_cb; print "ok 2\n"; print Coro::rouse_wait == 77 ? "" : "not", "ok 4\n"; }; print "ok 1\n"; cede; print "ok 3\n"; $cb->(13, 77); cede; print "ok 5\n"; Coro-6.514/t/00_basic.t0000644000000000000000000000137610700736505013153 0ustar rootrootBEGIN { $| = 1; print "1..9\n"; } END {print "not ok 1\n" unless $loaded;} use Coro::State; $loaded = 1; print "ok 1\n"; my $main = new Coro::State; my $proca = new Coro::State \&a; my $procb = new Coro::State \&b; sub a { print $/ eq "\n" ? "" : "not ", "ok 3\n"; $/ = 77; print "ok 4\n"; $proca->transfer ($main); print $/ == 77 ? "" : "not ", "ok 6\n"; $proca->transfer ($main); print "not ok 7\n"; die; } sub b { print $/ ne "\n" ? "not " : "", "ok 8\n"; $procb->transfer ($main); print "not ok 9\n"; die; } $/ = 55; print "ok 2\n"; $main->transfer ($proca); print $/ != 55 ? "not " : "ok 5\n"; $main->transfer ($proca); print $/ != 55 ? "not " : "ok 7\n"; $main->transfer ($procb); print $/ != 55 ? "not " : "ok 9\n"; Coro-6.514/t/07_eval.t0000644000000000000000000000106110703050532013007 0ustar rootroot$|=1; print "1..5\n"; use Coro; async { my $t = eval "2"; print "ok $t\n"; cede; # a panic: restartop in this test can be caused by perl 5.8.8 not # properly handling constant folding (change 29976/28148) # (fixed in 5.10, 5.8.9) # we don't want to scare users, so disable it. delete $SIG{__DIE__} if $] < 5.008009; print defined eval "1/0" ? "not ok" : "ok", " 4\n"; }; async { my $t = eval "3"; print "ok $t\n"; cede; print defined eval "die" ? "not ok" : "ok", " 5\n"; }; print "ok 1\n"; cede; cede; cede; cede; Coro-6.514/t/13_diewarn.t0000644000000000000000000000113210704467461013523 0ustar rootrootBEGIN { $| = 1; print "1..7\n"; } use Coro; use Coro::State; print "ok 1\n"; async { warn "-"; cede; warn "-"; local $SIG{__WARN__} = sub { print "ok 7\n" }; { local $SIG{__WARN__} = sub { print "ok 5\n" }; cede; warn "-"; } cede; warn "-"; cede; }; async { $Coro::State::WARNHOOK = sub { print "ok 3\n" }; local $SIG{__WARN__} = sub { print "ok 6\n" }; { local $SIG{__WARN__} = sub { print "ok 4\n" }; cede; warn "-"; } cede; warn "-"; }; $Coro::State::WARNHOOK = sub { print "ok 2\n" }; cede; cede; cede; cede; Coro-6.514/t/06_prio.t0000644000000000000000000000100210531710372013027 0ustar rootroot$|=1; print "1..10\n"; use Coro qw(:prio cede async current); print "ok 1\n"; use Carp; $SIG{__DIE__} = sub { Carp::cluck $@ };#d# (async { print "ok 2\n"; cede; cede; cede; print "ok 3\n" })->prio(10); (async { print "ok 4\n" })->prio(2); (async { print "ok 5\n" })->prio(PRIO_HIGH); (async { print "ok 6\n" }); (async { print "ok 7\n" })->prio(PRIO_LOW); (async { print "ok 8\n" })->prio(PRIO_IDLE); (async { print "ok 9\n"; cede; print "ok 11\n" })->prio(-500); current->prio(-100); cede; print "ok 10\n"; Coro-6.514/Coro/0000755000000000000000000000000013152034463012034 5ustar rootrootCoro-6.514/Coro/BDB.pm0000644000000000000000000000275513152034454012772 0ustar rootroot=head1 NAME Coro::BDB - truly asynchronous bdb access =head1 SYNOPSIS use Coro::BDB; use BDB; # can now use any of the bdb requests =head1 DESCRIPTION This module is an L user, you need to make sure that you use and run a supported event loop. This module implements a thin wrapper around the L 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. Please notify the author of when and why you think this was necessary. This module does not export anything (unlike L), 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; use BDB (); use AnyEvent::BDB (); use Coro (); use Coro::AnyEvent (); use base Exporter::; our $VERSION = 6.514; our $WATCHER; BDB::set_sync_prepare { my $cb = Coro::rouse_cb; ( sub { $cb->($!) }, sub { $! = Coro::rouse_wait }, ) }; =back =head1 SEE ALSO L of course. =head1 AUTHOR/SUPPORT/CONTACT Marc A. Lehmann http://software.schmorp.de/pkg/Coro.html =cut 1 Coro-6.514/Coro/LWP.pm0000644000000000000000000000766113152034454013046 0ustar rootroot=head1 NAME Coro::LWP - make LWP non-blocking - as much as possible =head1 SYNOPSIS use Coro::LWP; # afterwards LWP should not block =head1 ALTERNATIVES Over the years, a number of less-invasive alternatives have popped up, which you might find more acceptable than this rather invasive and fragile module. All of them only support HTTP (and sometimes HTTPS). =over 4 =item L Works fine without Coro. Requires using a very different API than LWP. Probably the best choice I you can do with a completely different event-based API. =item L Makes LWP use L. Does not make LWP event-based, but allows Coro threads to schedule unimpeded through its AnyEvent integration. Lets you use the LWP API normally. =item L Basically the same as above, distinction unclear. :) =item L A different user agent implementation, not completely transparent to users, requires Coro. =back =head1 DESCRIPTION This module is an L user, you need to make sure that you use and run a supported event loop. This module tries to make L 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 might offer an alternative to the full L that is designed to be non-blocking. Here is what it currently does (future versions of LWP might require different tricks): =over 4 =item It loads Coro::Select, overwriting the perl C built-in, using C watchers to do the job, so other threads can run in parallel to any select user. As many libraries that only have a blocking API do not use global variables and often use select (or IO::Select), this effectively makes most such libraries "somewhat" non-blocking w.r.t. other threads. This implementation works fastest when only very few bits are set in the fd set(s). To be effective globally, this module must be C'd before any other module that uses C globally might actually cause problems, as some C backends use C) is a difficult case: sometimes being global is preferable, sometimes per-thread is preferable. Since per-thread seems to be more common, it is per-thread. =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 Everything else is shared between all threads. For example, the globals C<$a> and C<$b> are shared. When does that matter? When using C, these variables become special, and therefore, switching threads when sorting might have surprising results. Other examples are the C<$!>, errno, C<$.>, the current input line number, C<$,>, C<$\>, C<$"> and many other special variables. While in some cases a good argument could be made for localising them to the thread, they are rarely used, and sometimes hard to localise. Future versions of Coro might include more per-thread state when it becomes a problem. =head2 Debugging Sometimes it can be useful to find out what each thread is doing (or which threads exist in the first place). The L module has (among other goodies), a function that allows you to print a "ps"-like listing - you have seen it in action earlier when Coro detected a deadlock. You use it like this: 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 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 C<< $Coro::current->{desc} >>: async { $Coro::current->{desc} = "cruncher"; ... }; This can be rather useful when debugging a program, or when using the interactive debug shell of L. =head1 The Real World - Event Loops Coro really wants to run in a program using some event loop. In fact, most real-world programs using Coro threads are written with a combination of event-based and thread-based techniques, as it is easy to get the best of both worlds with Coro. Coro integrates automatically into any event loop supported by L (see L for details), but can take special advantage of the L and L modules. Here is a simple finger client, using whatever event loop L comes up with: use Coro; use Coro::Socket; sub finger { my ($user, $host) = @_; my $fh = new Coro::Socket PeerHost => $host, PeerPort => "finger" or die "$user\@$host: $!"; print $fh "$user\n"; print "$user\@$host: $_" while <$fh>; print "$user\@$host: done\n"; } # now finger a few accounts 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. This module works much the same way as L, except that it is coroutine-aware. This means that L, when waiting for the network, will block the whole process - that means all threads, which is clearly undesirable. On the other hand, L 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 method: All we want to do in this example is start three C threads and only exit when they have done their job. This could be done using a counting semaphore, but it is much simpler to synchronously wait for them to C, which is exactly what the C method does. It doesn't matter that the three Cs will probably finish in a different order then the for loop Cs them - when the thread is still running, C simply waits. If the thread has already terminated, it will simply fetch its return status. 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). 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. You can use the F 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 show a full backtrace of coroutine eval evaluate expression in context of trace enable tracing for this coroutine untrace disable tracing for this coroutine kill throws the given string in cancel cancels this coroutine ready force into the ready queue evaluate as perl and print results & same as above, but evaluate asynchronously you can use (find_coro ) in perl expressions to find the coro with the given pid, e.g. (find_coro 9768720)->ready loglevel enable logging for messages of level and lower exit end this session Microsft victims can of course use the even less secure C constructor. =head2 The Real World - File I/O Disk I/O, while often much faster than the network, nevertheless can take quite a long time in which the CPU could do other things, if one would only be able to do something. Fortunately, the L module on CPAN allows you to move these I/O calls into the background, letting you do useful work in the foreground. It is event-/callback-based, but Coro has a nice wrapper around it, called L, which lets you use its functions naturally from within threads: use Fcntl; use Coro::AIO; my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600 or die "$filename~: $!"; aio_write $fh, 0, (length $data), $data, 0; aio_fsync $fh; aio_close $fh; aio_rename "$filename~", "$filename"; The above creates a new file, writes data into it, syncs the data to disk and atomically replaces a base file with a new copy. =head2 Inversion of control - rouse functions Last not least, me talk about inversion of control. The "control" refers to "who calls whom", who is in control of the program. In this program, the main program is in control and passes this to all functions it calls: use LWP; # pass control to get my $res = get "http://example.org/"; # control returned to us print $res; When switching to event-based programs, instead of "us calling them", "they call us" - this is the inversion of control form the title: use AnyEvent::HTTP; # do not pass control for long - http_get immediately returns http_get "http://example.org/", sub { print $_[0]; }; # we stay in control and can do other things Event based programming can be nice, but sometimes it's just easier to write down some processing in "linear" fashion, without callbacks. Coro provides some special functions to reduce typing: use AnyEvent::HTTP; # do not pass control for long - http_get immediately returns http_get "http://example.org/", Coro::rouse_cb; # we stay in control and can do other things... # ...such as wait for the result my ($res) = Coro::rouse_wait; C creates and returns a special callback. You can pass this callback to any function that would expect a callback. C waits (block the current thread) until the most recently created callback has been called, and returns whatever was passed to it. These two functions allow you to I invert the control from "callback based style" used by most event-based libraries to "blocking style", whenever you wish to. The pattern is simple: instead of... some_func ..., sub { my @res = @_; ... }; ... you write: some_func ..., Coro::rouse_cb; my @res = Coro::rouse_wait; ... Callback-based interfaces are plenty, and the rouse functions allow you to use them in an often more convenient way. =head1 Other Modules This introduction only mentions a few methods and modules, Coro has many other functions (see the L manpage) and modules (documented in the C section of the L manpage). Noteworthy modules are L (for parallel LWP requests, but see L for a better HTTP-only alternative), L, for when you need an asynchronous database, L, when you need to use any file handle in a coroutine (popular to access C and C) and L, the optimised interface to L (which gets used automatically by L). There are a number of Coro-related moduels that might be useful for your problem (see L). And since Coro integrates so well into AnyEvent, it's often easy to adapt existing AnyEvent modules (see L). =head1 AUTHOR Marc Lehmann http://home.schmorp.de/ Coro-6.514/Coro/Specific.pm0000644000000000000000000000344713152034454014127 0ustar rootroot=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 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 manually, it will be loaded automatically when you C and call the C 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::; \$var; } sub TIESCALAR { my $idx = $idx++; bless \$idx, $_[0]; } sub FETCH { $Coro::current->{_specific}[${$_[0]}]; } sub STORE { $Coro::current->{_specific}[${$_[0]}] = $_[1]; } #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 http://software.schmorp.de/pkg/Coro.html =cut Coro-6.514/Coro/SemaphoreSet.pm0000644000000000000000000001015013152034454014766 0ustar rootroot=head1 NAME Coro::SemaphoreSet - efficient set of counting semaphores =head1 SYNOPSIS use Coro; $sig = new Coro::SemaphoreSet [initial value]; $sig->down ("semaphoreid"); # wait for signal # ... some other "thread" $sig->up ("semaphoreid"); =head1 DESCRIPTION This module implements sets of counting semaphores (see L). It is nothing more than a hash with normal semaphores as members, but is more efficiently managed. This is useful if you want to allow parallel tasks to run in parallel but not on the same problem. Just use a SemaphoreSet and lock on the problem identifier. You don't have to load C manually, it will be loaded automatically when you C and call the C constructor. =over 4 =cut package Coro::SemaphoreSet; use common::sense; our $VERSION = 6.514; use Coro::Semaphore (); =item new [initial count] Creates a new semaphore set with the given initial lock count for each individual semaphore. See L. =cut sub new { bless [defined $_[1] ? $_[1] : 1], $_[0] } =item $semset->down ($id) Decrement the counter, therefore "locking" the named semaphore. This method waits until the semaphore is available if the counter is zero. =cut sub down { # Coro::Semaphore::down increases the refcount, which we check in _may_delete Coro::Semaphore::down ($_[0][1]{$_[1]} ||= Coro::Semaphore::_alloc $_[0][0]); } #ub timed_down { # require Coro::Timer; # my $timeout = Coro::Timer::timeout ($_[2]); # # while () { # my $sem = ($_[0][1]{$_[1]} ||= [$_[0][0]]); # # if ($sem->[0] > 0) { # --$sem->[0]; # return 1; # } # # if ($timeout) { # # ugly as hell. # for (0..$#{$sem->[1]}) { # if ($sem->[1][$_] == $Coro::current) { # splice @{$sem->[1]}, $_, 1; # return 0; # } # } # die; # } # # push @{$sem->[1]}, $Coro::current; # &Coro::schedule; # } # =item $semset->up ($id) Unlock the semaphore again. If the semaphore reaches the default count for this set and has no waiters, the space allocated for it will be freed. =cut sub up { my ($self, $id) = @_; my $sem = $self->[1]{$id} ||= Coro::Semaphore::_alloc $self->[0]; Coro::Semaphore::up $sem; delete $self->[1]{$id} if _may_delete $sem, $self->[0], 1; } =item $semset->try ($id) Try to C the semaphore. Returns true when this was possible, otherwise return false and leave the semaphore unchanged. =cut sub try { Coro::Semaphore::try ( $_[0][1]{$_[1]} ||= $_[0][0] > 0 ? Coro::Semaphore::_alloc $_[0][0] : return 0 ) } =item $semset->count ($id) Return the current semaphore count for the specified semaphore. =cut sub count { Coro::Semaphore::count ($_[0][1]{$_[1]} || return $_[0][0]); } =item $semset->waiters ($id) Returns the number (in scalar context) or list (in list context) of waiters waiting on the specified semaphore. =cut sub waiters { Coro::Semaphore::waiters ($_[0][1]{$_[1]} || return); } =item $semset->wait ($id) Same as Coro::Semaphore::wait on the specified semaphore. =cut sub wait { Coro::Semaphore::wait ($_[0][1]{$_[1]} || return); } =item $guard = $semset->guard ($id) This method calls C and then creates a guard object. When the guard object is destroyed it automatically calls C. =cut sub guard { &down; bless [@_], Coro::SemaphoreSet::guard:: } #ub timed_guard { # &timed_down # ? bless [$_[0], $_[1]], Coro::SemaphoreSet::guard:: # : (); # sub Coro::SemaphoreSet::guard::DESTROY { up @{$_[0]}; } =item $semaphore = $semset->sem ($id) This SemaphoreSet version is based on Coro::Semaphore's. This function creates (if necessary) the underlying Coro::Semaphore object and returns it. You may legally call any Coro::Semaphore method on it, but note that calling C<< $semset->up >> can invalidate the returned semaphore. =cut sub sem { bless +($_[0][1]{$_[1]} ||= Coro::Semaphore::_alloc $_[0][0]), Coro::Semaphore::; } 1; =back =head1 AUTHOR/SUPPORT/CONTACT Marc A. Lehmann http://software.schmorp.de/pkg/Coro.html =cut Coro-6.514/Coro/AnyEvent.pm0000644000000000000000000003242713152034454014133 0ustar rootroot=head1 NAME Coro::AnyEvent - integrate threads into AnyEvent =head1 SYNOPSIS use Coro; use AnyEvent; # using both Coro and AnyEvent will automatically load Coro::AnyEvent # or load it manually for its utility functions: use Coro::AnyEvent; Coro::AnyEvent::sleep 5; # block current thread for 5s Coro::AnyEvent::poll; # poll for new events once Coro::AnyEvent::idle; # block until process no longer busy Coro::AnyEvent::idle_upto 5; # same, but only up to 5 seconds Coro::AnyEvent::readable $fh, 60 or die "fh didn't become readable within 60 seconds\n"; =head1 DESCRIPTION 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, just as with other perl modules. Also, this module autodetects the event loop used (by relying on L) and will either automatically defer to the high-performance L or L modules, or will use a generic integration method that should work with any event loop supported by L. =head1 USAGE =head2 RUN AN EVENT LOOP - OR NOT? For performance reasons, it is recommended that the main program or something else run the event loop of the event model you use, i.e. use Gtk2; # <- the event model use AnyEvent; use Coro: # initialise stuff async { ... }; # now run mainloop of Gtk2 main Gtk2; You can move the event loop into a thread as well, although this tends to get confusing: use Gtk2; use AnyEvent; use Coro: async { main Gtk2 }; # do other things... while () { use Coro::AnyEvent; Coro::AnyEvent::sleep 1; print "ping...\n"; } You can also do nothing, in which case Coro::AnyEvent will invoke the event loop as needed, which is less efficient, but sometimes very convenient. What you I is to block inside an event loop callback. The reason is that most event loops are not reentrant and this can cause a deadlock at best and corrupt memory at worst. 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. To avoid this problem, start a new thread (e.g. with C) or use C to run blocking tasks. =head2 INVERSION OF CONTROL If you need to wait for a single event, the rouse functions will come in handy (see the Coro manpage for details): # wait for single SIGINT { my $int_w = AnyEvent->signal (signal => "INT", cb => Coro::rouse_cb); Coro::rouse_wait; } =head2 EVENT MODULES OTHER THAN ANYEVENT Keep in mind that, as shipped, Coro and Coro::AnyEvent only work with AnyEvent, and only when AnyEvent is actually used (i.e. initialised), so this will not work: # does not work: EV without AnyEvent is not recognised use EV; use Coro; EV::loop; And neither does this, unless you actually I AnyEvent for something: # does not work: AnyEvent must be initialised (e.g. by creating watchers) use EV; use AnyEvent; use Coro; EV::loop; This does work, however, because you create a watcher (condvars work, too), thus forcing AnyEvent to initialise itself: # does work: AnyEvent is actually used use EV; use AnyEvent; use Coro; my $timer = AE::timer 1, 1, sub { }; EV::loop; And if you want to use AnyEvent just to bridge between Coro and your event model of choice, you can simply force it to initialise itself, like this: # does work: AnyEvent is initialised manually use POE; use AnyEvent; use Coro; AnyEvent::detect; # force AnyEvent to integrate Coro into POE POE::Kernel->run; =head1 FUNCTIONS Coro::AnyEvent also offers a few functions that might be useful. =over 4 =cut package Coro::AnyEvent; use common::sense; use Coro; use AnyEvent (); our $VERSION = 6.514; ############################################################################# # idle handler our $IDLE; ############################################################################# # 0-timeout idle emulation watcher our $ACTIVITY; sub _activity { $ACTIVITY ||= AE::timer 0, 0, \&_schedule; } Coro::_set_readyhook (\&AnyEvent::detect); AnyEvent::post_detect { my $model = $AnyEvent::MODEL; if ($model eq "AnyEvent::Impl::EV" and eval { require Coro::EV }) { # provide faster versions of some functions Coro::EV::_set_readyhook (); eval ' *sleep = \&Coro::EV::timer_once; *poll = \&Coro::EV::_poll; *idle = sub() { my $w = EV::idle Coro::rouse_cb; Coro::rouse_wait; }; *idle_upto = sub($) { my $cb = Coro::rouse_cb; my $t = EV::timer $_[0], 0, $cb; my $w = EV::idle $cb; Coro::rouse_wait; }; *readable = sub($;$) { EV::READ & Coro::EV::timed_io_once $_[0], EV::READ , $_[1] }; *writable = sub($;$) { EV::WRITE & Coro::EV::timed_io_once $_[0], EV::WRITE, $_[1] }; '; die if $@; } elsif ($model eq "AnyEvent::Impl::Event" and eval { require Coro::Event }) { Coro::_set_readyhook undef; # let Coro::Event do its thing } else { # do the inefficient thing ourselves Coro::_set_readyhook \&_activity; $IDLE = new Coro sub { my $_poll = AnyEvent->can ("_poll") || AnyEvent->can ("one_event"); # AnyEvent < 6.0 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 for potential new events and instructs the event loop to poll for new events once, without blocking. Note that this call will not actually execute the poll, nor will it wait until there are some events, just block until the event loop has polled for new events, so other threads will have a chance to run. This is useful when you have a thread that does some computations, but you still want to poll for new events from time to time. Simply call C from time to time: my $long_calc = async { for (1..10000) { Coro::AnyEvent::poll; # do some stuff, make sure it takes at least 0.001s or so } } Although you should also consider C or C in such cases. =item Coro::AnyEvent::sleep $seconds This blocks the current thread for at least the given number of seconds. =item Coro::AnyEvent::idle This call is similar to C in that it will also poll for events. Unlike C, it will only resume the thread once there are no events to handle anymore, i.e. when the process is otherwise idle. This is good for background threads that shouldn't use CPU time when foreground jobs are ready to run. =item Coro::AnyEvent::idle_upto $seconds Like C, but with a maximum waiting time. If your process is busy handling events, calling C can mean that your thread will never be resumed. To avoid this, you can use C and specify a timeout, after which your thread will be resumed even if the process is completely busy. =item Coro::AnyEvent::readable $fh_or_fileno[, $timeout] =item Coro::AnyEvent::writable $fh_or_fileno[, $timeout] Blocks the current thread until the given file handle (or file descriptor) becomes readable (or writable), or the given timeout has elapsed, whichever happens first. No timeout counts as infinite timeout. Returns true when the file handle became ready, false when a timeout occurred. Note that these functions are quite inefficient as compared to using a single watcher (they recreate watchers on every invocation) or compared to using Coro::Handle. Note also that they only work for sources that have reasonable non-blocking behaviour (e.g. not files). Example: wait until STDIN becomes readable, then quit the program. use Coro::AnyEvent; print "press enter to quit...\n"; Coro::AnyEvent::readable *STDIN; exit 0; =cut sub poll() { my $w = AE::timer 0, 0, Coro::rouse_cb; Coro::rouse_wait; } sub sleep($) { my $w = AE::timer $_[0], 0, Coro::rouse_cb; Coro::rouse_wait; } sub idle() { my $w = AE::idle Coro::rouse_cb; Coro::rouse_wait; } sub idle_upto($) { my $cb = Coro::rouse_cb; my $t = AE::timer shift, 0, $cb; my $w = AE::idle $cb; Coro::rouse_wait; } sub readable($;$) { my $cb = Coro::rouse_cb; my $w = AE::io $_[0], 0, sub { $cb->(1) }; my $t = defined $_[1] && AE::timer $_[1], 0, sub { $cb->(0) }; Coro::rouse_wait } 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 =head1 IMPLEMENTATION DETAILS Unfortunately, few event loops (basically only L and L) support the kind of integration required for smooth operations well, and consequently, AnyEvent cannot completely offer the functionality required by this module, so we need to improvise. Here is what this module does when it has to work with other event loops: =over 4 =item * run ready threads before blocking the process Each time a thread is put into the ready queue (and there are no other threads in the ready queue), a timer with an C value of C<0> is registered with AnyEvent. This creates something similar to an I watcher, i.e. a watcher that keeps the event loop from blocking but still polls for new events. (Unfortunately, some badly designed event loops (e.g. Event::Lib) don't support a timeout of C<0> and will always block for a bit). The callback for that timer will C to other threads of the same or higher priority for as long as such threads exists. This has the effect of running all threads that have work to do until all threads block to wait for external events. If no threads of equal or higher priority are ready, it will cede to any thread, but only once. This has the effect of running lower-priority threads as well, but it will not keep higher priority threads from receiving new events. The priority used is simply the priority of the thread that runs the event loop, usually the main program, which usually has a priority of C<0>. Note that Coro::AnyEvent does I run an event loop for you, so unless the main program runs one, there will simply be no event loop to C to (event handling will still work, somewhat inefficiently, but any thread will have a higher priority than event handling in that case). =item * provide a suitable idle callback. In addition to hooking into C, 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 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 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), see the description of C in the L 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. =back =head1 SEE ALSO L, to see which event loops are supported, L and L for more efficient and more correct solutions (they will be used automatically if applicable). =head1 AUTHOR/SUPPORT/CONTACT Marc A. Lehmann http://software.schmorp.de/pkg/Coro.html =cut Coro-6.514/Coro/Handle.pm0000644000000000000000000003277513152034454013603 0ustar rootroot=head1 NAME Coro::Handle - non-blocking I/O with a blocking interface. =head1 SYNOPSIS use Coro::Handle; =head1 DESCRIPTION This module is an L 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 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 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 (); use Errno qw(EAGAIN EINTR EINPROGRESS); use AnyEvent::Util qw(WSAEWOULDBLOCK WSAEINPROGRESS); use AnyEvent::Socket (); use base 'Exporter'; our $VERSION = 6.514; our @EXPORT = qw(unblock); =item $fh = new_from_fh Coro::Handle $fhandle [, arg => value...] Create a new non-blocking io-handle using the given perl-filehandle. Returns C if no filehandle is given. The only other supported argument is "timeout", which sets a timeout for each operation. =cut sub new_from_fh { my $class = shift; my $fh = shift or return; my $self = do { local *Coro::Handle }; 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 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 only). Might change in the future. =cut sub autoflush { !0 } =item $fh->fileno, $fh->close, $fh->read, $fh->sysread, $fh->syswrite, $fh->print, $fh->printf Work like their function equivalents (except read, which works like sysread. You should not use the read function with Coro::Handle's, it will work but it's not efficient). =cut sub read { Coro::Handle::FH::READ (tied *${$_[0]}, $_[1], $_[2], $_[3]) } sub sysread { Coro::Handle::FH::READ (tied *${$_[0]}, $_[1], $_[2], $_[3]) } sub syswrite { Coro::Handle::FH::WRITE (tied *${$_[0]}, $_[1], $_[2], $_[3]) } sub print { Coro::Handle::FH::WRITE (tied *${+shift}, join "", @_) } sub printf { Coro::Handle::FH::PRINTF (tied *${+shift}, @_) } sub fileno { Coro::Handle::FH::FILENO (tied *${$_[0]}) } sub close { Coro::Handle::FH::CLOSE (tied *${$_[0]}) } sub blocking { !0 } # this handler always blocks the caller sub partial { my $obj = tied *${$_[0]}; my $retval = $obj->[8]; $obj->[8] = $_[1] if @_ > 1; $retval } =item connect, listen, bind, getsockopt, setsockopt, send, recv, peername, sockname, shutdown, peerport, peerhost Do the same thing as the perl builtins or IO::Socket methods (but return true on EINPROGRESS). Remember that these must be method calls. =cut sub connect { connect tied(*${$_[0]})->[0], $_[1] or $! == EINPROGRESS or $! == EAGAIN or $! == WSAEWOULDBLOCK } sub bind { bind tied(*${$_[0]})->[0], $_[1] } sub listen { listen tied(*${$_[0]})->[0], $_[1] } sub getsockopt { getsockopt tied(*${$_[0]})->[0], $_[1], $_[2] } sub setsockopt { setsockopt tied(*${$_[0]})->[0], $_[1], $_[2], $_[3] } sub send { send tied(*${$_[0]})->[0], $_[1], $_[2], @_ > 2 ? $_[3] : () } sub recv { recv tied(*${$_[0]})->[0], $_[1], $_[2], @_ > 2 ? $_[3] : () } sub sockname { getsockname tied(*${$_[0]})->[0] } sub peername { getpeername tied(*${$_[0]})->[0] } sub shutdown { shutdown tied(*${$_[0]})->[0], $_[1] } =item peeraddr, peerhost, peerport Return the peer host (as numericla IP address) and peer port (as integer). =cut sub peeraddr { (AnyEvent::Socket::unpack_sockaddr getpeername tied(*${$_[0]})->[0])[1] } sub peerport { (AnyEvent::Socket::unpack_sockaddr getpeername tied(*${$_[0]})->[0])[0] } sub peerhost { AnyEvent::Socket::format_address &peeraddr } =item ($fh, $peername) = $listen_fh->accept In scalar context, returns the newly accepted socket (or undef) and in list context return the ($fh, $peername) pair (or nothing). =cut sub accept { my ($peername, $fh); while () { $peername = accept $fh, tied(*${$_[0]})->[0] and return wantarray ? ($_[0]->new_from_fh($fh), $peername) : $_[0]->new_from_fh($fh); return if $! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK; $_[0]->readable or return; } } =item $fh->timeout ([...]) The optional argument sets the new timeout (in seconds) for this handle. Returns the current (new) value. C<0> is a valid timeout, use C to disable the timeout. =cut sub timeout { my $self = tied *${$_[0]}; if (@_ > 1) { $self->[2] = $_[1]; $self->[5]->timeout ($_[1]) if $self->[5]; $self->[6]->timeout ($_[1]) if $self->[6]; } $self->[2] } =item $fh->fh Returns the "real" (non-blocking) filehandle. Use this if you want to do operations on the file handle you cannot do using the Coro::Handle interface. =item $fh->rbuf Returns the current contents of the read buffer (this is an lvalue, so you can change the read buffer if you like). You can use this function to implement your own optimized reader when neither readline nor sysread are viable candidates, like this: # first get the _real_ non-blocking filehandle # and fetch a reference to the read buffer my $nb_fh = $fh->fh; my $buf = \$fh->rbuf; while () { # now use buffer contents, modifying # if necessary to reflect the removed data last if $$buf ne ""; # we have leftover data # read another buffer full of data $fh->readable or die "end of file"; sysread $nb_fh, $$buf, 8192; } =cut sub fh { (tied *${$_[0]})->[0]; } sub rbuf : lvalue { (tied *${$_[0]})->[3]; } sub DESTROY { # nop } our $AUTOLOAD; sub AUTOLOAD { my $self = tied *${$_[0]}; (my $func = $AUTOLOAD) =~ s/^(.*):://; my $forward = UNIVERSAL::can $self->[7], $func; $forward or die "Can't locate object method \"$func\" via package \"" . (ref $self) . "\""; goto &$forward; } package Coro::Handle::FH; use common::sense; use Carp 'croak'; use Errno qw(EAGAIN EINTR); use AnyEvent::Util qw(WSAEWOULDBLOCK); use Coro::AnyEvent; # formerly a hash, but we are speed-critical, so try # to be faster even if it hurts. # # 0 FH # 1 desc # 2 timeout # 3 rb # 4 wb # unused # 5 read watcher, if Coro::Event|EV used # 6 write watcher, if Coro::Event|EV used # 7 forward class # 8 blocking sub TIEHANDLE { my ($class, %arg) = @_; my $self = bless [], $class; $self->[0] = $arg{fh}; $self->[1] = $arg{desc}; $self->[2] = $arg{timeout}; $self->[3] = ""; $self->[4] = ""; $self->[5] = undef; # work around changes in 5.20, which requires initialisation $self->[6] = undef; # work around changes in 5.20, which requires initialisation $self->[7] = $arg{forward_class}; $self->[8] = $arg{partial}; AnyEvent::Util::fh_nonblocking $self->[0], 1; $self } sub cleanup { # gets overriden for Coro::Event @{$_[0]} = (); } sub OPEN { &cleanup; my $self = shift; my $r = @_ == 2 ? open $self->[0], $_[0], $_[1] : open $self->[0], $_[0], $_[1], $_[2]; if ($r) { fcntl $self->[0], &Fcntl::F_SETFL, &Fcntl::O_NONBLOCK or croak "fcntl(O_NONBLOCK): $!"; } $r } sub PRINT { WRITE (shift, join "", @_) } sub PRINTF { WRITE (shift, sprintf shift, @_) } sub GETC { my $buf; READ ($_[0], $buf, 1); $buf } sub BINMODE { binmode $_[0][0]; } sub TELL { Carp::croak "Coro::Handle's don't support tell()"; } sub SEEK { Carp::croak "Coro::Handle's don't support seek()"; } sub EOF { Carp::croak "Coro::Handle's don't support eof()"; } sub CLOSE { my $fh = $_[0][0]; &cleanup; close $fh } sub DESTROY { &cleanup; } sub FILENO { fileno $_[0][0] } # seems to be called for stringification (how weird), at least # when DumpValue::dumpValue is used to print this. sub FETCH { "$_[0]<$_[0][1]>" } sub _readable_anyevent { my $cb = Coro::rouse_cb; my $w = AE::io $_[0][0], 0, sub { $cb->(1) }; my $t = (defined $_[0][2]) && AE::timer $_[0][2], 0, sub { $cb->(0) }; Coro::rouse_wait } 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]) #} # #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"}; return &$rw; # Coro 5.0+ doesn't support goto &SLF, and this line is executed once only } else { *$rw = \&{"_$rw\_anyevent"}; } goto &$rw }; }; sub WRITE { my $len = defined $_[2] ? $_[2] : length $_[1]; my $ofs = $_[3]; my $res; while () { my $r = syswrite ($_[0][0], $_[1], $len, $ofs); if (defined $r) { $len -= $r; $ofs += $r; $res += $r; last unless $len; } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { last; } last unless &writable; } $res } sub READ { my $len = $_[2]; my $ofs = $_[3]; my $res; # first deplete the read buffer if (length $_[0][3]) { my $l = length $_[0][3]; if ($l <= $len) { substr ($_[1], $ofs) = $_[0][3]; $_[0][3] = ""; $len -= $l; $ofs += $l; $res += $l; return $res unless $len; } else { substr ($_[1], $ofs) = substr ($_[0][3], 0, $len); substr ($_[0][3], 0, $len) = ""; return $len; } } while() { my $r = sysread $_[0][0], $_[1], $len, $ofs; if (defined $r) { $len -= $r; $ofs += $r; $res += $r; last unless $len && $r; } elsif ($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) { last; } last if $_[0][8] || !&readable; } $res } sub READLINE { my $irs = @_ > 1 ? $_[1] : $/; my ($ofs, $len, $pos); my $bufsize = 1020; while () { if (length $irs) { $pos = index $_[0][3], $irs, $ofs < 0 ? 0 : $ofs; return substr $_[0][3], 0, $pos + length $irs, "" if $pos >= 0; $ofs = (length $_[0][3]) - (length $irs); } elsif (defined $irs) { $pos = index $_[0][3], "\n\n", $ofs < 1 ? 1 : $ofs; if ($pos >= 0) { my $res = substr $_[0][3], 0, $pos + 2, ""; $res =~ s/\A\n+//; return $res; } $ofs = (length $_[0][3]) - 1; } $len = $bufsize - length $_[0][3]; $len = $bufsize *= 2 if $len < $bufsize * 0.5; $len = sysread $_[0][0], $_[0][3], $len, length $_[0][3]; unless ($len) { if (defined $len) { # EOF return undef unless length $_[0][3]; $_[0][3] =~ s/\A\n+// if ! length $irs && defined $irs; return delete $_[0][3]; } elsif (($! != EAGAIN && $! != EINTR && $! != WSAEWOULDBLOCK) || !&readable) { return length $_[0][3] ? delete $_[0][3] : undef; } } } } 1; =back =head1 BUGS - Perl's IO-Handle model is THE bug. =head1 AUTHOR/SUPPORT/CONTACT Marc A. Lehmann http://software.schmorp.de/pkg/Coro.html =cut Coro-6.514/Coro/typemap0000644000000000000000000000011010531573124013426 0ustar rootrootCoro::State T_CORO_STATE INPUT T_CORO_STATE $var = SvSTATE ($arg); Coro-6.514/Coro/state.h0000644000000000000000000000641013132250236013322 0ustar rootroot/* used in state.h */ #ifndef VAR #define VAR(name,type) VARx(name, PL_ ## name, type) #endif /* list the interpreter variables that need to be saved/restored */ VARx(defsv, GvSV (PL_defgv), SV *) VARx(defav, GvAV (PL_defgv), AV *) VARx(errsv, GvSV (PL_errgv), SV *) VARx(irsgv, GvSV (irsgv), SV *) VARx(hinthv, GvHV (PL_hintgv), HV *) /* mostly copied from thrdvar.h */ VAR(stack_sp, SV **) /* the main stack */ #ifdef OP_IN_REGISTER VAR(opsave, OP *) /* probably not necessary */ #else VAR(op, OP *) /* currently executing op */ #endif VAR(curpad, SV **) /* active pad (lexicals+tmps) */ VAR(stack_base, SV **) VAR(stack_max, SV **) VAR(scopestack, I32 *) /* scopes we've ENTERed */ VAR(scopestack_ix, I32) VAR(scopestack_max,I32) #if HAS_SCOPESTACK_NAME VAR(scopestack_name,const char **) #endif VAR(savestack, ANY *) /* items that need to be restored when LEAVEing scopes we've ENTERed */ VAR(savestack_ix, I32) VAR(savestack_max, I32) VAR(tmps_stack, SV **) /* mortals we've made */ VAR(tmps_ix, SSize_t) VAR(tmps_floor, SSize_t) VAR(tmps_max, SSize_t) VAR(markstack, I32 *) /* stack_sp locations we're remembering */ VAR(markstack_ptr, I32 *) VAR(markstack_max, I32 *) #if !PERL_VERSION_ATLEAST (5,9,0) VAR(retstack, OP **) /* OPs we have postponed executing */ VAR(retstack_ix, I32) VAR(retstack_max, I32) #endif VAR(curpm, PMOP *) /* what to do \ interps in REs from */ VAR(rs, SV *) /* input record separator $/ */ VAR(defoutgv, GV *) /* default FH for output */ VAR(curcop, COP *) VAR(curstack, AV *) /* THE STACK */ VAR(curstackinfo, PERL_SI *) /* current stack + context */ VAR(sortcop, OP *) /* user defined sort routine */ VAR(sortstash, HV *) /* which is in some package or other */ #if !PERL_VERSION_ATLEAST (5,9,0) VAR(sortcxix, I32) /* from pp_ctl.c */ #endif #if PERL_VERSION_ATLEAST (5,9,0) VAR(localizing, U8) /* are we processing a local() list? */ VAR(in_eval, U8) /* trap "fatal" errors? */ #else VAR(localizing, U32) /* are we processing a local() list? */ VAR(in_eval, U32) /* trap "fatal" errors? */ #endif VAR(tainted, bool) /* using variables controlled by $< */ VAR(diehook, SV *) VAR(warnhook, SV *) /* compcv is intrpvar, but seems to be thread-specific to me */ /* but, well, I thoroughly misunderstand what thrdvar and intrpvar is. still. */ VAR(compcv, CV *) /* currently compiling subroutine */ VAR(comppad, AV *) /* storage for lexically scoped temporaries */ VAR(comppad_name, PADNAMELIST *) /* variable names for "my" variables */ VAR(comppad_name_fill, PADOFFSET) /* last "introduced" variable offset */ VAR(comppad_name_floor, PADOFFSET) /* start of vars in innermost block */ VAR(runops, runops_proc_t) /* for tracing support */ VAR(hints, U32) /* pragma-tic compile-time flags */ #if PERL_VERSION_ATLEAST (5,10,0) VAR(parser, yy_parser *) #endif #undef VAR #undef VARx Coro-6.514/Coro/CoroAPI.h0000644000000000000000000001110512544071772013447 0ustar rootroot#ifndef CORO_API_H #define CORO_API_H #include "EXTERN.h" #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", \ (int)GCoroAPI->ver, (int)GCoroAPI->rev, CORO_API_VERSION, CORO_API_REVISION, YourName); \ } STMT_END #endif Coro-6.514/eg/0000755000000000000000000000000013152034463011525 5ustar rootrootCoro-6.514/eg/lwp0000644000000000000000000000101611112456760012252 0ustar rootroot#!/usr/bin/perl use Coro::LWP; # should be use'd as early as possible use Coro; use Coro::AnyEvent; use LWP::Simple; $SIG{PIPE} = 'IGNORE'; my @pids; for (1..1) { push @pid, async { print "starting to fetch http://www.google.de/\n"; get "http://www.google.de/"; print "fetched http://www.google.de/\n"; }; push @pid, async { print "starting to fetch http://www.yahoo.com/\n"; get "http://www.yahoo.com/"; print "fetched http://www.yahoo.com/\n"; }; } $_->join for @pid; Coro-6.514/eg/prodcons30000644000000000000000000000115410523707622013366 0ustar rootroot#!/usr/bin/perl # the classical producer/consumer example, using a channel # one process produces items, sends a signal. # another process waits for that signal and # consumed the item. use Coro; use Coro::Channel; use Coro::Signal; my $work = new Coro::Channel 3; my $finished = new Coro::Signal; async { for my $i (0..9) { print "produced $i\n"; $work->put($i); } print "work done\n"; $finished->send; }; async { while () { my $i = $work->get; print "consumed $i\n"; } }; $finished->wait; print "producer finished\n"; cede while $work->size; print "job finished\n"; Coro-6.514/eg/prodcons10000644000000000000000000000115207324702657013372 0ustar rootroot#!/usr/bin/perl # the classical producer/consumer example. # one process produces items, send s a signal. # another process waits for that signal and # consumed the item. use Coro; use Coro::Signal; my $produced = new Coro::Signal; my $consumed = new Coro::Signal; my $finished = new Coro::Signal; async { for (0..9) { print "produced something\n"; $produced->send; $consumed->wait; } print "work done\n"; $finished->send; }; async { while () { $produced->wait; print "consuming something\n"; $consumed->send; } }; $finished->wait; print "job finished\n"; Coro-6.514/eg/dns0000644000000000000000000000047411112432006012226 0ustar rootroot#!/usr/bin/perl use Coro; use Coro::Util; use Coro::AnyEvent; use Socket; # do some asynchronous hostname resolution my @pid; for my $x (1..255) { push @pid, async { my $addr = "129.13.162.$x"; print "$addr => ",(scalar gethostbyaddr inet_aton($addr), AF_INET),"\n"; }; } $_->join for @pid; Coro-6.514/eg/bench0000644000000000000000000000326211671415525012540 0ustar rootroot#!/usr/bin/perl # ->resume is not exactly cheap (it saves/restores a LOT # of global variables), but shouldn't be slow. just to show # how fast it is, this little proggie compares a normal subroutine # call with two calls of transfer in a loop. use Coro; use Benchmark; sub a($) { } $a = bless {}, main::; sub b { my ($self) = shift; $self->{b} = shift if @_; $self->{b}; } $b = async { # do a little unrolling... while() { cede; cede; cede; cede; cede; cede; cede; cede; cede; cede; } }; cede; *transfer = \&Coro::State::transfer; sub doit0 { while() { # some unrolling here as well.. transfer($c0, $main); transfer($c0, $main); transfer($c0, $main); transfer($c0, $main); transfer($c0, $main); transfer($c0, $main); transfer($c0, $main); transfer($c0, $main); } } sub doit1 { while() { # some unrolling here as well.. transfer($c1, $main); transfer($c1, $main); transfer($c1, $main); transfer($c1, $main); transfer($c1, $main); transfer($c1, $main); transfer($c1, $main); transfer($c1, $main); } } $c0 = new Coro::State sub { doit0(1,2,3,4,5,6,7,8,9); }; $c1 = new Coro::State sub { doit1(1,2,3,4,5,6,7,8,9); }; #$c0->save (0); #$c1->save (-1); #Coro::State::enable_times 1; #use Coro::Debug; Coro::Debug::command "ps";#d# #(async { $main = $Coro::current; transfer($main, $c0); transfer($main, $c1); timethese 5000000, { function => 'a(5); a(6)', method => '$a->b(5); $a->b(6)', cede => 'cede', transfer0 => 'transfer($main, $c0)', transfer1 => 'transfer($main, $c1)', }; #})->join; #use Coro::Debug; Coro::Debug::command "ps";#d# Coro-6.514/eg/event0000644000000000000000000000230611112432006012557 0ustar rootroot#!/usr/bin/perl # this crap is an asynchronous finger client. it's rather idiotic ;) use Coro; use Coro::Socket; use Coro::Event; use AnyEvent; my $quit = AnyEvent->condvar; # this gets started everytime a user enters a finger command sub finger { my $user = shift; my $host = shift; my $fh = new Coro::Socket PeerHost => $host, PeerPort => "finger" or die "$user\@$host: $!"; print $fh "$user\n"; print "$user\@$host: $_" while <$fh>; print "$user\@$host: done\n"; } # display the time or garble the display, YMMV. async { my $w = Coro::Event->timer (interval => 0.001, hard => 1); use Time::HiRes qw(time); while () { $w->next; print "\e7\e[C\e[C\e[C\e[C\e[C\e[C\e[C\e[C