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)
{
  /* ceding from C means allocating a stack, but we assume this is a rare case */
  while (CORO_NREADY)
    CORO_CEDE;
}

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

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.17
Committed:	Mon Dec 4 22:05:49 2006 UTC (17 years, 6 months ago) by root
Branch:	MAIN
CVS Tags:	rel-3_1, rel-3_2, rel-3_11
Changes since 1.16:	+1 -1 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.13	/* ceding from C means allocating a stack, but we assume this is a rare case */
47	root	1.3	while (CORO_NREADY)
48			CORO_CEDE;
49			}
50
51	root	1.1	MODULE = Coro::Event PACKAGE = Coro::Event
52
53	root	1.3	PROTOTYPES: ENABLE
54
55	root	1.1	BOOT:
56			{
57	root	1.9	I_EVENT_API ("Coro::Event");
58	root	1.1	I_CORO_API ("Coro::Event");
59	root	1.3
60	root	1.13	GEventAPI->add_hook ("asynccheck", (void *)asynccheck_hook, 0);
61	root	1.1	}
62	root	1.3
63			void
64	root	1.13	_install_std_cb (SV *self, int type)
65	root	1.3	CODE:
66	root	1.12	{
67	root	1.3	pe_watcher *w = GEventAPI->sv_2watcher (self);
68
69	root	1.13	if (w->callback)
70			croak ("Coro::Event watchers must not have a callback (see Coro::Event), caught");
71
72	root	1.9	{
73			AV *priv = newAV ();
74			SV rv = newRV_noinc ((SV )priv);
75
76	root	1.15	av_fill (priv, CD_MAX);
77	root	1.17	AvARRAY (priv)[CD_WAIT] = (SV )newAV (); / badbad */
78	root	1.13	AvARRAY (priv)[CD_TYPE] = newSViv (type);
79			AvARRAY (priv)[CD_OK ] = &PL_sv_no;
80			AvARRAY (priv)[CD_HITS] = newSViv (0);
81			AvARRAY (priv)[CD_GOT ] = newSViv (0);
82	root	1.9	SvREADONLY_on (priv);
83
84			w->callback = coro_std_cb;
85			w->ext_data = priv;
86
87	root	1.13	/* make sure Event does not use PERL_MAGIC_uvar, which */
88			/* we abuse for non-uvar purposes. */
89			sv_magicext (SvRV (self), rv, PERL_MAGIC_uvar, 0, 0, 0);
90	root	1.9	}
91	root	1.12	}
92	root	1.8
93	root	1.3	void
94	root	1.13	_next (SV *self)
95	root	1.3	CODE:
96	root	1.12	{
97	root	1.3	pe_watcher *w = GEventAPI->sv_2watcher (self);
98	root	1.6	AV priv = (AV )w->ext_data;
99	root	1.3
100	root	1.13	if (AvARRAY (priv)[CD_OK] == &PL_sv_yes)
101	root	1.4	{
102	root	1.13	AvARRAY (priv)[CD_OK] = &PL_sv_no;
103			XSRETURN_NO; /* got an event */
104	root	1.4	}
105	root	1.6
106	root	1.16	av_push ((AV *)AvARRAY (priv)[CD_WAIT], SvREFCNT_inc (CORO_CURRENT));
107
108	root	1.12	if (!w->running)
109	root	1.16	GEventAPI->start (w, 1);
110	root	1.12
111	root	1.13	XSRETURN_YES; /* schedule */
112	root	1.12	}
113	root	1.6
114	root	1.14	SV *
115			_event (SV *self)
116			CODE:
117			{
118			if (GIMME_V == G_VOID)
119			XSRETURN_EMPTY;
120
121			{
122			pe_watcher *w = GEventAPI->sv_2watcher (self);
123			AV priv = (AV )w->ext_data;
124
125			RETVAL = newRV_inc ((SV *)priv);
126			}
127			}
128			OUTPUT:
129			RETVAL
130