--- Coro/Event/Event.xs 2001/08/17 01:45:39 1.3 +++ Coro/Event/Event.xs 2007/09/23 21:52:04 1.22 @@ -2,57 +2,73 @@ #include "perl.h" #include "XSUB.h" +#include #include #include "EventAPI.h" #include "../Coro/CoroAPI.h" -#define CD_CORO 0 +#define CD_WAIT 0 /* wait queue */ #define CD_TYPE 1 -#define CD_W 2 -#define CD_GOT 3 -#define CD_MAX 3 -/* no support for hits and prio so far. */ - -#define EV_CLASS "Coro::Event::Ev" - -static HV *ev_stash; -static pe_idle *scheduler; -static int do_schedule; - -#define NEED_SCHEDULE if (!do_schedule) \ - { \ - do_schedule = 1; \ - GEventAPI->now ((pe_watcher *)scheduler); \ - } +#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) +coro_std_cb (pe_event *pe) { - AV *av = (AV *)SvRV ((SV *)pe->ext_data); - IV type = SvIV (*av_fetch (av, CD_TYPE, 1)); - SV *cd_coro = *av_fetch (av, CD_CORO, 1); + AV *priv = (AV *)pe->ext_data; + IV type = SvIV (AvARRAY (priv)[CD_TYPE]); + AV *cd_wait; + SV *coro; - av_store (av, CD_W, SvREFCNT_inc (pe->up->mysv)); + SvIV_set (AvARRAY (priv)[CD_HITS], pe->hits); + SvIV_set (AvARRAY (priv)[CD_GOT], type ? ((pe_ioevent *)pe)->got : 0); - if (type == 1) - av_store (av, CD_GOT, newSViv (((pe_ioevent *)pe)->got)); + AvARRAY (priv)[CD_OK] = &PL_sv_yes; - GEventAPI->stop (pe->up, 0); + cd_wait = (AV *)AvARRAY(priv)[CD_WAIT]; - if (SvROK (cd_coro)) + coro = av_shift (cd_wait); + if (coro != &PL_sv_undef) { - CORO_READY (cd_coro); - NEED_SCHEDULE; + CORO_READY (coro); + SvREFCNT_dec (coro); } + + if (av_len (cd_wait) < 0) + GEventAPI->stop (pe->up, 0); } static void -scheduler_cb(pe_event *pe) +asynccheck_hook (void *data) { - while (CORO_NREADY) - CORO_CEDE; + /* this loops as long as we have _other_ coros with the same or higher priority */ + while (CORO_NREADY && CORO_CEDE) + ; +} - do_schedule = 0; +static double +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 @@ -61,64 +77,85 @@ BOOT: { - I_EVENT_API("Coro::Event"); - I_CORO_API ("Coro::Event"); + coro_event_event_stash = gv_stashpv ("Coro::Event::Event", TRUE); - ev_stash = gv_stashpv (EV_CLASS, TRUE); + I_EVENT_API ("Coro::Event"); + I_CORO_API ("Coro::Event"); - /* create a fake idle handler (we only ever call now) */ - scheduler = GEventAPI->new_idle (0, 0); - scheduler->base.callback = scheduler_cb; - scheduler->min_interval = newSVnv (0); - scheduler->max_interval = newSVnv (0); - GEventAPI->stop ((pe_watcher *)scheduler, 0); + GEventAPI->add_hook ("asynccheck", (void *)asynccheck_hook, 0); + GEventAPI->add_hook ("prepare", (void *)prepare_hook, 0); } void -_install_std_cb(self,type) - SV * self - int type +_install_std_cb (SV *self, int type) CODE: +{ pe_watcher *w = GEventAPI->sv_2watcher (self); - AV *priv = newAV (); - SV *rv; - av_extend (priv, CD_MAX); - av_store (priv, CD_TYPE, newSViv (type)); + if (w->callback) + croak ("Coro::Event watchers must not have a callback (see Coro::Event), caught"); - rv = sv_bless (newRV_noinc ((SV *)priv), ev_stash); + { + AV *priv = newAV (); - hv_store ((HV *)SvRV (self), - EV_CLASS, strlen (EV_CLASS), - rv, 0); + 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->ext_data = rv; - w->callback = coro_std_cb; + w->callback = coro_std_cb; + w->ext_data = priv; + + sv_magicext (SvRV (self), newRV_noinc ((SV *)priv), PERL_MAGIC_coro_event, 0, (char *)w, 0); + } +} void -_next0(self) - SV * self +_next (SV *self) CODE: +{ pe_watcher *w = GEventAPI->sv_2watcher (self); - AV *priv = (AV *)SvRV ((SV *)w->ext_data); + AV *priv = (AV *)w->ext_data; - GEventAPI->start (w, 1); + if (AvARRAY (priv)[CD_OK] == &PL_sv_yes) + { + AvARRAY (priv)[CD_OK] = &PL_sv_no; + XSRETURN_NO; /* got an event */ + } - if (SvROK (*av_fetch (priv, CD_CORO, 1))) - croak ("only one coroutine can wait for an event"); + av_push ((AV *)AvARRAY (priv)[CD_WAIT], SvREFCNT_inc (CORO_CURRENT)); - av_store (priv, CD_CORO, SvREFCNT_inc (CORO_CURRENT)); + if (!w->running) + GEventAPI->start (w, 1); -SV * -_next1(self) - SV * self - CODE: - pe_watcher *w = GEventAPI->sv_2watcher (self); - AV *priv = (AV *)SvRV ((SV *)w->ext_data); + XSRETURN_YES; /* schedule */ +} - av_store (priv, CD_CORO, &PL_sv_undef); +SV * +_event (SV *self) + CODE: +{ + if (GIMME_V == G_VOID) + XSRETURN_EMPTY; - RETVAL = SvREFCNT_inc ((SV *)w->ext_data); + { + pe_watcher *w = 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