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;

#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 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 */
}

static SV *
event_next (SV *watcher, int cancel, int wantev)
{
  pe_watcher *w = GEventAPI->sv_2watcher (watcher);
  AV *priv = (AV *)w->ext_data;

  if (AvARRAY (priv)[CD_OK] == &PL_sv_yes)
    {
      AvARRAY (priv)[CD_OK] = &PL_sv_no;

      if (cancel)
        GEventAPI->cancel (w);

      if (wantev)
        {
          SV *ev = newRV_inc ((SV *)priv);

          /* may need to bless it now */
          if (!SvOBJECT (priv))
            {
              SvREADONLY_off ((SV *)priv);
              sv_bless (ev, coro_event_event_stash);
              SvREADONLY_on ((SV *)priv);
            }

          return sv_2mortal (ev);
        }
      else
        return &PL_sv_undef;
    }

  av_push ((AV *)AvARRAY (priv)[CD_WAIT], SvREFCNT_inc (CORO_CURRENT));

  if (!w->running)
    GEventAPI->start (w, 1);

  return 0; /* schedule */
}

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

        GCoroAPI->coro_event_next = event_next;
}

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, 0, (char *)w, 0);
        }
}

Revision:	1.23
Committed:	Tue Oct 9 22:29:27 2007 UTC (16 years, 7 months ago) by root
Branch:	MAIN
Changes since 1.22:	+41 -46 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	#define PERL_MAGIC_coro_event 0x18 /* to avoid clashes with e.g. event */
21
22	root	1.3	static void
23	root	1.13	coro_std_cb (pe_event *pe)
24	root	1.3	{
25	root	1.21	AV priv = (AV )pe->ext_data;
26			IV type = SvIV (AvARRAY (priv)[CD_TYPE]);
27			AV *cd_wait;
28			SV *coro;
29	root	1.20
30	root	1.21	SvIV_set (AvARRAY (priv)[CD_HITS], pe->hits);
31			SvIV_set (AvARRAY (priv)[CD_GOT], type ? ((pe_ioevent *)pe)->got : 0);
32	root	1.6
33	root	1.21	AvARRAY (priv)[CD_OK] = &PL_sv_yes;
34	root	1.12
35	root	1.21	cd_wait = (AV *)AvARRAY(priv)[CD_WAIT];
36	root	1.12
37	root	1.21	coro = av_shift (cd_wait);
38			if (coro != &PL_sv_undef)
39			{
40			CORO_READY (coro);
41			SvREFCNT_dec (coro);
42			}
43	root	1.19
44	root	1.21	if (av_len (cd_wait) < 0)
45			GEventAPI->stop (pe->up, 0);
46	root	1.3	}
47
48	root	1.13	static void
49			asynccheck_hook (void *data)
50	root	1.3	{
51	root	1.18	/* this loops as long as we have _other_ coros with the same or higher priority */
52			while (CORO_NREADY && CORO_CEDE)
53			;
54			}
55
56			static double
57			prepare_hook (void *data)
58			{
59			/* this yields once to another coro with any priority */
60			if (CORO_NREADY)
61			{
62			CORO_CEDE_NOTSELF;
63			/*
64			* timers might have changed, and Event fails to notice this
65			* so we have to assume the worst. If Event didn't have that bug,
66			* we would only need to do this if CORO_NREADY is != 0 now.
67			*/
68			return 0.;
69			}
70			else
71			return 85197.73; /* this is as good as any value, but it factors badly with common values */
72	root	1.3	}
73
74	root	1.23	static SV *
75			event_next (SV *watcher, int cancel, int wantev)
76			{
77			pe_watcher *w = GEventAPI->sv_2watcher (watcher);
78			AV priv = (AV )w->ext_data;
79
80			if (AvARRAY (priv)[CD_OK] == &PL_sv_yes)
81			{
82			AvARRAY (priv)[CD_OK] = &PL_sv_no;
83
84			if (cancel)
85			GEventAPI->cancel (w);
86
87			if (wantev)
88			{
89			SV ev = newRV_inc ((SV )priv);
90
91			/* may need to bless it now */
92			if (!SvOBJECT (priv))
93			{
94			SvREADONLY_off ((SV *)priv);
95			sv_bless (ev, coro_event_event_stash);
96			SvREADONLY_on ((SV *)priv);
97			}
98
99			return sv_2mortal (ev);
100			}
101			else
102			return &PL_sv_undef;
103			}
104
105			av_push ((AV *)AvARRAY (priv)[CD_WAIT], SvREFCNT_inc (CORO_CURRENT));
106
107			if (!w->running)
108			GEventAPI->start (w, 1);
109
110			return 0; /* schedule */
111			}
112
113	root	1.1	MODULE = Coro::Event PACKAGE = Coro::Event
114
115	root	1.3	PROTOTYPES: ENABLE
116
117	root	1.1	BOOT:
118			{
119	root	1.19	coro_event_event_stash = gv_stashpv ("Coro::Event::Event", TRUE);
120
121	root	1.9	I_EVENT_API ("Coro::Event");
122	root	1.1	I_CORO_API ("Coro::Event");
123	root	1.3
124	root	1.13	GEventAPI->add_hook ("asynccheck", (void *)asynccheck_hook, 0);
125	root	1.18	GEventAPI->add_hook ("prepare", (void *)prepare_hook, 0);
126	root	1.23
127			GCoroAPI->coro_event_next = event_next;
128	root	1.1	}
129	root	1.3
130			void
131	root	1.13	_install_std_cb (SV *self, int type)
132	root	1.3	CODE:
133	root	1.12	{
134	root	1.3	pe_watcher *w = GEventAPI->sv_2watcher (self);
135
136	root	1.13	if (w->callback)
137			croak ("Coro::Event watchers must not have a callback (see Coro::Event), caught");
138
139	root	1.9	{
140			AV *priv = newAV ();
141
142	root	1.15	av_fill (priv, CD_MAX);
143	root	1.19	AvARRAY (priv)[CD_WAIT] = (SV )newAV (); / AV in AV _should_ not be exposed to perl */
144	root	1.13	AvARRAY (priv)[CD_TYPE] = newSViv (type);
145			AvARRAY (priv)[CD_OK ] = &PL_sv_no;
146			AvARRAY (priv)[CD_HITS] = newSViv (0);
147			AvARRAY (priv)[CD_GOT ] = newSViv (0);
148	root	1.9	SvREADONLY_on (priv);
149
150			w->callback = coro_std_cb;
151			w->ext_data = priv;
152
153	root	1.22	sv_magicext (SvRV (self), newRV_noinc ((SV )priv), PERL_MAGIC_coro_event, 0, (char )w, 0);
154	root	1.9	}
155	root	1.12	}
156	root	1.8