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 NV
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 = (pe_watcher *)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 = (void *)coro_std_cb;
          w->ext_data = priv;

          {
            SV *mob = newRV_noinc ((SV *)priv);
            sv_magicext (SvRV (self), mob, PERL_MAGIC_coro_event, 0, (char *)w, 0);
            SvREFCNT_dec (mob); /* sv_magicext increments the refcount */
          }
        }
}

void
_next (SV *self)
        CODE:
{
        pe_watcher *w = (pe_watcher *)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 = (pe_watcher *)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.28
Committed:	Sun Jun 21 17:02:49 2015 UTC (11 years, 3 months ago) by root
Branch:	MAIN
CVS Tags:	rel-6_5, rel-6_512, rel-6_513, rel-6_511, rel-6_514, rel-6_46, rel-6_45, rel-6_51, rel-6_52, rel-6_53, rel-6_54, rel-6_55, rel-6_56, rel-6_57, rel-6_47, rel-6_44, rel-6_49, rel-6_48, HEAD
Changes since 1.27:	+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.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	root	1.28	static NV
57	root	1.18	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.1	MODULE = Coro::Event PACKAGE = Coro::Event
75
76	root	1.3	PROTOTYPES: ENABLE
77
78	root	1.1	BOOT:
79			{
80	root	1.19	coro_event_event_stash = gv_stashpv ("Coro::Event::Event", TRUE);
81
82	root	1.9	I_EVENT_API ("Coro::Event");
83	root	1.26	I_CORO_API ("Coro::Event");
84	root	1.3
85	root	1.13	GEventAPI->add_hook ("asynccheck", (void *)asynccheck_hook, 0);
86	root	1.18	GEventAPI->add_hook ("prepare", (void *)prepare_hook, 0);
87	root	1.1	}
88	root	1.3
89			void
90	root	1.13	_install_std_cb (SV *self, int type)
91	root	1.3	CODE:
92	root	1.12	{
93	root	1.27	pe_watcher w = (pe_watcher )GEventAPI->sv_2watcher (self);
94	root	1.3
95	root	1.13	if (w->callback)
96			croak ("Coro::Event watchers must not have a callback (see Coro::Event), caught");
97
98	root	1.9	{
99			AV *priv = newAV ();
100
101	root	1.15	av_fill (priv, CD_MAX);
102	root	1.19	AvARRAY (priv)[CD_WAIT] = (SV )newAV (); / AV in AV _should_ not be exposed to perl */
103	root	1.13	AvARRAY (priv)[CD_TYPE] = newSViv (type);
104			AvARRAY (priv)[CD_OK ] = &PL_sv_no;
105			AvARRAY (priv)[CD_HITS] = newSViv (0);
106			AvARRAY (priv)[CD_GOT ] = newSViv (0);
107	root	1.9	SvREADONLY_on (priv);
108
109	root	1.27	w->callback = (void *)coro_std_cb;
110	root	1.9	w->ext_data = priv;
111
112	root	1.25	{
113			SV mob = newRV_noinc ((SV )priv);
114			sv_magicext (SvRV (self), mob, PERL_MAGIC_coro_event, 0, (char *)w, 0);
115			SvREFCNT_dec (mob); /* sv_magicext increments the refcount */
116			}
117	root	1.9	}
118	root	1.12	}
119	root	1.8
120	root	1.24	void
121			_next (SV *self)
122			CODE:
123			{
124	root	1.27	pe_watcher w = (pe_watcher )GEventAPI->sv_2watcher (self);
125	root	1.24	AV priv = (AV )w->ext_data;
126
127			if (AvARRAY (priv)[CD_OK] == &PL_sv_yes)
128			{
129			AvARRAY (priv)[CD_OK] = &PL_sv_no;
130			XSRETURN_NO; /* got an event */
131			}
132
133			av_push ((AV *)AvARRAY (priv)[CD_WAIT], SvREFCNT_inc (CORO_CURRENT));
134
135			if (!w->running)
136			GEventAPI->start (w, 1);
137
138			XSRETURN_YES; /* schedule */
139			}
140
141			SV *
142			_event (SV *self)
143			CODE:
144			{
145			if (GIMME_V == G_VOID)
146			XSRETURN_EMPTY;
147
148			{
149	root	1.27	pe_watcher w = (pe_watcher )GEventAPI->sv_2watcher (self);
150	root	1.24	AV priv = (AV )w->ext_data;
151
152			RETVAL = newRV_inc ((SV *)priv);
153
154			/* may need to bless it now */
155			if (!SvOBJECT (priv))
156			{
157			SvREADONLY_off ((SV *)priv);
158			sv_bless (RETVAL, coro_event_event_stash);
159			SvREADONLY_on ((SV *)priv);
160			}
161			}
162			}
163			OUTPUT:
164			RETVAL
165