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 4 /* hardcoded in Coro::Event */
#define CD_GOT  5 /* hardcoded in Coro::Event, Coro::Handle */
#define CD_MAX  5

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];
  if ((coro = av_shift (cd_wait)))
    {
      if (av_len (cd_wait) < 0)
        GEventAPI->stop (pe->up, 0);

      CORO_READY (coro);
      SvREFCNT_dec (coro);
    }
}

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:
{
        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 ();
          SV *rv = newRV_noinc ((SV *)priv);

          av_fill (priv, CD_MAX);
          AvARRAY (priv)[CD_WAIT] = (SV *)newAV (); /* badbad */
          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;

          /* make sure Event does not use PERL_MAGIC_uvar, which */
          /* we abuse for non-uvar purposes. */
          sv_magicext (SvRV (self), rv, PERL_MAGIC_uvar, 0, 0, 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);
        }
}
        OUTPUT:
        RETVAL

Revision:	1.18
Committed:	Fri Dec 29 11:37:49 2006 UTC (17 years, 6 months ago) by root
Branch:	MAIN
CVS Tags:	rel-3_41, rel-3_4, rel-3_3
Changes since 1.17:	+22 -3 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.14
15	root	1.6	#define CD_HITS 4 /* hardcoded in Coro::Event */
16			#define CD_GOT 5 /* hardcoded in Coro::Event, Coro::Handle */
17			#define CD_MAX 5
18	root	1.3
19			static void
20	root	1.13	coro_std_cb (pe_event *pe)
21	root	1.3	{
22	root	1.6	AV priv = (AV )pe->ext_data;
23	root	1.13	IV type = SvIV (AvARRAY (priv)[CD_TYPE]);
24	root	1.16	AV *cd_wait;
25			SV *coro;
26	root	1.6
27	root	1.13	SvIV_set (AvARRAY (priv)[CD_HITS], pe->hits);
28	root	1.16	SvIV_set (AvARRAY (priv)[CD_GOT], type ? ((pe_ioevent *)pe)->got : 0);
29	root	1.12
30	root	1.13	AvARRAY (priv)[CD_OK] = &PL_sv_yes;
31	root	1.12
32	root	1.16	cd_wait = (AV *)AvARRAY(priv)[CD_WAIT];
33			if ((coro = av_shift (cd_wait)))
34	root	1.3	{
35	root	1.16	if (av_len (cd_wait) < 0)
36			GEventAPI->stop (pe->up, 0);
37
38			CORO_READY (coro);
39			SvREFCNT_dec (coro);
40	root	1.3	}
41			}
42
43	root	1.13	static void
44			asynccheck_hook (void *data)
45	root	1.3	{
46	root	1.18	/* this loops as long as we have _other_ coros with the same or higher priority */
47			while (CORO_NREADY && CORO_CEDE)
48			;
49			}
50
51			static double
52			prepare_hook (void *data)
53			{
54			/* this yields once to another coro with any priority */
55			if (CORO_NREADY)
56			{
57			CORO_CEDE_NOTSELF;
58			/*
59			* timers might have changed, and Event fails to notice this
60			* so we have to assume the worst. If Event didn't have that bug,
61			* we would only need to do this if CORO_NREADY is != 0 now.
62			*/
63			return 0.;
64			}
65			else
66			return 85197.73; /* this is as good as any value, but it factors badly with common values */
67	root	1.3	}
68
69	root	1.1	MODULE = Coro::Event PACKAGE = Coro::Event
70
71	root	1.3	PROTOTYPES: ENABLE
72
73	root	1.1	BOOT:
74			{
75	root	1.9	I_EVENT_API ("Coro::Event");
76	root	1.1	I_CORO_API ("Coro::Event");
77	root	1.3
78	root	1.13	GEventAPI->add_hook ("asynccheck", (void *)asynccheck_hook, 0);
79	root	1.18	GEventAPI->add_hook ("prepare", (void *)prepare_hook, 0);
80	root	1.1	}
81	root	1.3
82			void
83	root	1.13	_install_std_cb (SV *self, int type)
84	root	1.3	CODE:
85	root	1.12	{
86	root	1.3	pe_watcher *w = GEventAPI->sv_2watcher (self);
87
88	root	1.13	if (w->callback)
89			croak ("Coro::Event watchers must not have a callback (see Coro::Event), caught");
90
91	root	1.9	{
92			AV *priv = newAV ();
93			SV rv = newRV_noinc ((SV )priv);
94
95	root	1.15	av_fill (priv, CD_MAX);
96	root	1.17	AvARRAY (priv)[CD_WAIT] = (SV )newAV (); / badbad */
97	root	1.13	AvARRAY (priv)[CD_TYPE] = newSViv (type);
98			AvARRAY (priv)[CD_OK ] = &PL_sv_no;
99			AvARRAY (priv)[CD_HITS] = newSViv (0);
100			AvARRAY (priv)[CD_GOT ] = newSViv (0);
101	root	1.9	SvREADONLY_on (priv);
102
103			w->callback = coro_std_cb;
104			w->ext_data = priv;
105
106	root	1.13	/* make sure Event does not use PERL_MAGIC_uvar, which */
107			/* we abuse for non-uvar purposes. */
108			sv_magicext (SvRV (self), rv, PERL_MAGIC_uvar, 0, 0, 0);
109	root	1.9	}
110	root	1.12	}
111	root	1.8
112	root	1.3	void
113	root	1.13	_next (SV *self)
114	root	1.3	CODE:
115	root	1.12	{
116	root	1.3	pe_watcher *w = GEventAPI->sv_2watcher (self);
117	root	1.6	AV priv = (AV )w->ext_data;
118	root	1.3
119	root	1.13	if (AvARRAY (priv)[CD_OK] == &PL_sv_yes)
120	root	1.4	{
121	root	1.13	AvARRAY (priv)[CD_OK] = &PL_sv_no;
122			XSRETURN_NO; /* got an event */
123	root	1.4	}
124	root	1.6
125	root	1.16	av_push ((AV *)AvARRAY (priv)[CD_WAIT], SvREFCNT_inc (CORO_CURRENT));
126
127	root	1.12	if (!w->running)
128	root	1.16	GEventAPI->start (w, 1);
129	root	1.12
130	root	1.13	XSRETURN_YES; /* schedule */
131	root	1.12	}
132	root	1.6
133	root	1.14	SV *
134			_event (SV *self)
135			CODE:
136			{
137			if (GIMME_V == G_VOID)
138			XSRETURN_EMPTY;
139
140			{
141			pe_watcher *w = GEventAPI->sv_2watcher (self);
142			AV priv = (AV )w->ext_data;
143
144			RETVAL = newRV_inc ((SV *)priv);
145			}
146			}
147			OUTPUT:
148			RETVAL
149