rxvt-unicode/src/iom_perl.h

typedef int IOM_CHAINED;

static SV *
iom_new_ref (HV *hv, const char *klass)
{
  return sv_bless (newRV ((SV *)hv), gv_stashpv (klass, 1));
}

/////////////////////////////////////////////////////////////////////////////

#define SvWATCHER(sv) (perl_watcher *)SvPTR (sv, IOM_CLASS "::watcher")

struct perl_watcher
{
  SV *cbsv;
  HV *self;

  perl_watcher ()
  : cbsv (0)
  {
  }

  ~perl_watcher ()
  {
    SvREFCNT_dec (cbsv);
  }

  void cb (SV *cb)
  {
    SvREFCNT_dec (cbsv);
    cbsv = newSVsv (cb);
  }

  void invoke (const char *type, SV *self, int arg = -1);
};

void
perl_watcher::invoke (const char *type, SV *self, int arg)
{
  dSP;

  ENTER;
  SAVETMPS;

  PUSHMARK (SP);

  XPUSHs (sv_2mortal (self));

  if (arg >= 0)
    XPUSHs (sv_2mortal (newSViv (arg)));

  PUTBACK;
  call_sv (cbsv, G_VOID | G_EVAL | G_DISCARD);
  SPAGAIN;

  PUTBACK;
  FREETMPS;
  LEAVE;

  if (SvTRUE (ERRSV))
    IOM_WARN ("%s callback evaluation error: %s", type, SvPV_nolen (ERRSV));
}

#define newSVtimer(timer) iom_new_ref ((timer)->self, IOM_CLASS "::timer")
#define SvTIMER(sv) (timer *)(perl_watcher *)SvPTR ((sv), IOM_CLASS "::timer")

struct timer : perl_watcher, ev::timer
{
  timer ()
  {
    set<timer, &timer::execute> (this);
  }

  void execute (ev::timer &w, int revents)
  {
    invoke (IOM_CLASS "::timer", newSVtimer (this));
  }
};

#define newSViow(iow) iom_new_ref ((iow)->self, IOM_CLASS "::iow")
#define SvIOW(sv) (iow *)(perl_watcher *)SvPTR ((sv), IOM_CLASS "::iow")

struct iow : perl_watcher, ev::io
{
  iow ()
  {
    set<iow, &iow::execute> (this);
  }

  void execute (ev::io &w, int revents)
  {
    invoke (IOM_CLASS "::iow", newSViow (this), revents);
  }
};

#define newSViw(iw) iom_new_ref ((iw)->self, IOM_CLASS "::iw")
#define SvIW(sv) (iw *)(perl_watcher *)SvPTR ((sv), IOM_CLASS "::iw")

struct iw : perl_watcher, ev::idle
{
  iw ()
  {
    set<iw, &iw::execute> (this);
  }

  void execute (ev::idle &w, int revents)
  {
    invoke (IOM_CLASS "::iw", newSViw (this));
  }
};

#define newSVpw(pw) iom_new_ref ((pw)->self, IOM_CLASS "::pw")
#define SvPW(sv) (pw *)(perl_watcher *)SvPTR ((sv), IOM_CLASS "::pw")

struct pw : perl_watcher, ev::child
{
  pw ()
  {
    set<pw, &pw::execute> (this);
  }

  void execute (ev::child &w, int revents)
  {
    invoke (IOM_CLASS "::pw", newSVpw (this), w.rstatus);
  }
};

Revision:	1.6
Committed:	Tue Dec 4 16:23:59 2007 UTC (16 years, 6 months ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	before_dynamic_fontidx, rel-9_10, rel-8_9, rel-8_8, dynamic_fontidx, rel-9_0, rel-9_09, rel-9_02, rel-9_01, rel-9_06, rel-9_07, rel-9_05
Changes since 1.5:	+4 -4 lines
Log Message:	switch to new callbakc mechanism. ugly syntax, very small watchers, smaller code on g++-4.3 at least
#	User	Rev	Content
1	root	1.2	typedef int IOM_CHAINED;
2
3	root	1.4	static SV *
4			iom_new_ref (HV hv, const char klass)
5			{
6			return sv_bless (newRV ((SV *)hv), gv_stashpv (klass, 1));
7			}
8
9	root	1.1	/////////////////////////////////////////////////////////////////////////////
10
11			#define SvWATCHER(sv) (perl_watcher *)SvPTR (sv, IOM_CLASS "::watcher")
12
13			struct perl_watcher
14			{
15			SV *cbsv;
16			HV *self;
17
18			perl_watcher ()
19			: cbsv (0)
20			{
21			}
22
23			~perl_watcher ()
24			{
25			SvREFCNT_dec (cbsv);
26			}
27
28			void cb (SV *cb)
29			{
30			SvREFCNT_dec (cbsv);
31			cbsv = newSVsv (cb);
32			}
33
34			void invoke (const char type, SV self, int arg = -1);
35			};
36
37			void
38			perl_watcher::invoke (const char type, SV self, int arg)
39			{
40			dSP;
41
42			ENTER;
43			SAVETMPS;
44
45			PUSHMARK (SP);
46
47			XPUSHs (sv_2mortal (self));
48
49			if (arg >= 0)
50			XPUSHs (sv_2mortal (newSViv (arg)));
51
52			PUTBACK;
53			call_sv (cbsv, G_VOID \| G_EVAL \| G_DISCARD);
54			SPAGAIN;
55
56			PUTBACK;
57			FREETMPS;
58			LEAVE;
59
60			if (SvTRUE (ERRSV))
61	root	1.3	IOM_WARN ("%s callback evaluation error: %s", type, SvPV_nolen (ERRSV));
62	root	1.1	}
63
64	root	1.4	#define newSVtimer(timer) iom_new_ref ((timer)->self, IOM_CLASS "::timer")
65	root	1.1	#define SvTIMER(sv) (timer )(perl_watcher )SvPTR ((sv), IOM_CLASS "::timer")
66
67	root	1.5	struct timer : perl_watcher, ev::timer
68	root	1.1	{
69			timer ()
70			{
71	root	1.6	set<timer, &timer::execute> (this);
72	root	1.1	}
73
74	root	1.5	void execute (ev::timer &w, int revents)
75	root	1.1	{
76			invoke (IOM_CLASS "::timer", newSVtimer (this));
77			}
78			};
79
80	root	1.4	#define newSViow(iow) iom_new_ref ((iow)->self, IOM_CLASS "::iow")
81	root	1.1	#define SvIOW(sv) (iow )(perl_watcher )SvPTR ((sv), IOM_CLASS "::iow")
82
83	root	1.5	struct iow : perl_watcher, ev::io
84	root	1.1	{
85			iow ()
86			{
87	root	1.6	set<iow, &iow::execute> (this);
88	root	1.1	}
89
90	root	1.5	void execute (ev::io &w, int revents)
91	root	1.1	{
92			invoke (IOM_CLASS "::iow", newSViow (this), revents);
93			}
94			};
95
96	root	1.4	#define newSViw(iw) iom_new_ref ((iw)->self, IOM_CLASS "::iw")
97	root	1.1	#define SvIW(sv) (iw )(perl_watcher )SvPTR ((sv), IOM_CLASS "::iw")
98
99	root	1.5	struct iw : perl_watcher, ev::idle
100	root	1.1	{
101			iw ()
102			{
103	root	1.6	set<iw, &iw::execute> (this);
104	root	1.1	}
105
106	root	1.5	void execute (ev::idle &w, int revents)
107	root	1.1	{
108			invoke (IOM_CLASS "::iw", newSViw (this));
109			}
110			};
111
112	root	1.4	#define newSVpw(pw) iom_new_ref ((pw)->self, IOM_CLASS "::pw")
113	root	1.1	#define SvPW(sv) (pw )(perl_watcher )SvPTR ((sv), IOM_CLASS "::pw")
114
115	root	1.5	struct pw : perl_watcher, ev::child
116	root	1.1	{
117			pw ()
118			{
119	root	1.6	set<pw, &pw::execute> (this);
120	root	1.1	}
121
122	root	1.5	void execute (ev::child &w, int revents)
123	root	1.1	{
124	root	1.5	invoke (IOM_CLASS "::pw", newSVpw (this), w.rstatus);
125	root	1.1	}
126			};
127