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

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;

          /* make sure Event does not use PERL_MAGIC_uvar, which */
          /* we abuse for non-uvar purposes. */
          sv_magicext (SvRV (self), newRV_noinc ((SV *)priv), 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);

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