Coro/Event/Event.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include <assert.h>
#include <string.h>

#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;

static int
coro_ev_free (pTHX_ SV *sv, MAGIC *mg)
{
  *(void **)mg->mg_ptr = 0;

  return 0;
}

#define PERL_MAGIC_coro_event 0x18 /* to avoid clashes with e.g. event */

static MGVTBL vtbl_coro_event = {0, 0, 0, 0, coro_ev_free};

static void
coro_std_cb (pe_event *pe)
{
  if (pe->up->ext_data)
    {
      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 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

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 = 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 = coro_std_cb;
          w->ext_data = priv;

          sv_magicext (SvRV (self), newRV_noinc ((SV *)priv), PERL_MAGIC_coro_event, &vtbl_coro_event, &w->ext_data, 0);
        }
}

void
_next (SV *self)
        CODE:
{
        pe_watcher *w = 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 = 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

Revision:	1.20
Committed:	Sat Sep 22 20:11:53 2007 UTC (16 years, 9 months ago) by root
Branch:	MAIN
Changes since 1.19:	+32 -19 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#include "EXTERN.h"
2			#include "perl.h"
3			#include "XSUB.h"
4
5	root	1.13	#include <assert.h>
6	root	1.3	#include <string.h>
7
8	root	1.2	#include "EventAPI.h"
9			#include "../Coro/CoroAPI.h"
10	root	1.1
11	root	1.16	#define CD_WAIT 0 /* wait queue */
12	root	1.3	#define CD_TYPE 1
13	root	1.4	#define CD_OK 2
14	root	1.19	#define CD_HITS 3 /* hardcoded in Coro::Event */
15			#define CD_GOT 4 /* hardcoded in Coro::Event, Coro::Handle */
16			#define CD_MAX 4
17	root	1.14
18	root	1.19	static HV *coro_event_event_stash;
19	root	1.3
20	root	1.20	static int
21			coro_ev_free (pTHX_ SV sv, MAGIC mg)
22			{
23			(void *)mg->mg_ptr = 0;
24
25			return 0;
26			}
27
28			#define PERL_MAGIC_coro_event 0x18 /* to avoid clashes with e.g. event */
29
30			static MGVTBL vtbl_coro_event = {0, 0, 0, 0, coro_ev_free};
31
32	root	1.3	static void
33	root	1.13	coro_std_cb (pe_event *pe)
34	root	1.3	{
35	root	1.20	if (pe->up->ext_data)
36			{
37			AV priv = (AV )pe->ext_data;
38			IV type = SvIV (AvARRAY (priv)[CD_TYPE]);
39			AV *cd_wait;
40			SV *coro;
41
42			SvIV_set (AvARRAY (priv)[CD_HITS], pe->hits);
43			SvIV_set (AvARRAY (priv)[CD_GOT], type ? ((pe_ioevent *)pe)->got : 0);
44	root	1.6
45	root	1.20	AvARRAY (priv)[CD_OK] = &PL_sv_yes;
46	root	1.12
47	root	1.20	cd_wait = (AV *)AvARRAY(priv)[CD_WAIT];
48	root	1.12
49	root	1.20	coro = av_shift (cd_wait);
50			if (coro != &PL_sv_undef)
51			{
52			CORO_READY (coro);
53			SvREFCNT_dec (coro);
54			}
55	root	1.19
56	root	1.20	if (av_len (cd_wait) < 0)
57			GEventAPI->stop (pe->up, 0);
58	root	1.3	}
59			}
60
61	root	1.13	static void
62			asynccheck_hook (void *data)
63	root	1.3	{
64	root	1.18	/* this loops as long as we have _other_ coros with the same or higher priority */
65			while (CORO_NREADY && CORO_CEDE)
66			;
67			}
68
69			static double
70			prepare_hook (void *data)
71			{
72			/* this yields once to another coro with any priority */
73			if (CORO_NREADY)
74			{
75			CORO_CEDE_NOTSELF;
76			/*
77			* timers might have changed, and Event fails to notice this
78			* so we have to assume the worst. If Event didn't have that bug,
79			* we would only need to do this if CORO_NREADY is != 0 now.
80			*/
81			return 0.;
82			}
83			else
84			return 85197.73; /* this is as good as any value, but it factors badly with common values */
85	root	1.3	}
86
87	root	1.1	MODULE = Coro::Event PACKAGE = Coro::Event
88
89	root	1.3	PROTOTYPES: ENABLE
90
91	root	1.1	BOOT:
92			{
93	root	1.19	coro_event_event_stash = gv_stashpv ("Coro::Event::Event", TRUE);
94
95	root	1.9	I_EVENT_API ("Coro::Event");
96	root	1.1	I_CORO_API ("Coro::Event");
97	root	1.3
98	root	1.13	GEventAPI->add_hook ("asynccheck", (void *)asynccheck_hook, 0);
99	root	1.18	GEventAPI->add_hook ("prepare", (void *)prepare_hook, 0);
100	root	1.1	}
101	root	1.3
102			void
103	root	1.13	_install_std_cb (SV *self, int type)
104	root	1.3	CODE:
105	root	1.12	{
106	root	1.3	pe_watcher *w = GEventAPI->sv_2watcher (self);
107
108	root	1.13	if (w->callback)
109			croak ("Coro::Event watchers must not have a callback (see Coro::Event), caught");
110
111	root	1.9	{
112			AV *priv = newAV ();
113
114	root	1.15	av_fill (priv, CD_MAX);
115	root	1.19	AvARRAY (priv)[CD_WAIT] = (SV )newAV (); / AV in AV _should_ not be exposed to perl */
116	root	1.13	AvARRAY (priv)[CD_TYPE] = newSViv (type);
117			AvARRAY (priv)[CD_OK ] = &PL_sv_no;
118			AvARRAY (priv)[CD_HITS] = newSViv (0);
119			AvARRAY (priv)[CD_GOT ] = newSViv (0);
120	root	1.9	SvREADONLY_on (priv);
121
122			w->callback = coro_std_cb;
123			w->ext_data = priv;
124
125	root	1.20	sv_magicext (SvRV (self), newRV_noinc ((SV *)priv), PERL_MAGIC_coro_event, &vtbl_coro_event, &w->ext_data, 0);
126	root	1.9	}
127	root	1.12	}
128	root	1.8
129	root	1.3	void
130	root	1.13	_next (SV *self)
131	root	1.3	CODE:
132	root	1.12	{
133	root	1.3	pe_watcher *w = GEventAPI->sv_2watcher (self);
134	root	1.6	AV priv = (AV )w->ext_data;
135	root	1.3
136	root	1.13	if (AvARRAY (priv)[CD_OK] == &PL_sv_yes)
137	root	1.4	{
138	root	1.13	AvARRAY (priv)[CD_OK] = &PL_sv_no;
139			XSRETURN_NO; /* got an event */
140	root	1.4	}
141	root	1.6
142	root	1.16	av_push ((AV *)AvARRAY (priv)[CD_WAIT], SvREFCNT_inc (CORO_CURRENT));
143
144	root	1.12	if (!w->running)
145	root	1.16	GEventAPI->start (w, 1);
146	root	1.12
147	root	1.13	XSRETURN_YES; /* schedule */
148	root	1.12	}
149	root	1.6
150	root	1.14	SV *
151			_event (SV *self)
152			CODE:
153			{
154			if (GIMME_V == G_VOID)
155			XSRETURN_EMPTY;
156
157			{
158			pe_watcher *w = GEventAPI->sv_2watcher (self);
159			AV priv = (AV )w->ext_data;
160
161			RETVAL = newRV_inc ((SV *)priv);
162	root	1.19
163			/* may need to bless it now */
164			if (!SvOBJECT (priv))
165			{
166			SvREADONLY_off ((SV *)priv);
167			sv_bless (RETVAL, coro_event_event_stash);
168			SvREADONLY_on ((SV *)priv);
169			}
170	root	1.14	}
171			}
172			OUTPUT:
173			RETVAL
174