Async-Interrupt/schmorp.h

#ifndef SCHMORP_PERL_H_
#define SCHMORP_PERL_H_

/* WARNING
 * This header file is a shared resource between many modules.
 */

#include <signal.h>
#include <errno.h>

#ifndef _WIN32
# include <poll.h>
#endif

/* useful stuff, used by schmorp mostly */

#include "patchlevel.h"

#define PERL_VERSION_ATLEAST(a,b,c)                             \
  (PERL_REVISION > (a)                                          \
   || (PERL_REVISION == (a)                                     \
       && (PERL_VERSION > (b)                                   \
           || (PERL_VERSION == (b) && PERL_SUBVERSION >= (c)))))

#ifndef PERL_MAGIC_ext
# define PERL_MAGIC_ext '~'
#endif

#if !PERL_VERSION_ATLEAST (5,6,0)
# ifndef PL_ppaddr
#  define PL_ppaddr ppaddr
# endif
# ifndef call_sv
#  define call_sv perl_call_sv
# endif
# ifndef get_sv
#  define get_sv perl_get_sv
# endif
# ifndef get_cv
#  define get_cv perl_get_cv
# endif
# ifndef IS_PADGV
#  define IS_PADGV(v) 0
# endif
# ifndef IS_PADCONST
#  define IS_PADCONST(v) 0
# endif
#endif

/* 5.11 */
#ifndef CxHASARGS
# define CxHASARGS(cx) (cx)->blk_sub.hasargs
#endif

/* 5.10.0 */
#ifndef SvREFCNT_inc_NN
# define SvREFCNT_inc_NN(sv) SvREFCNT_inc (sv)
#endif

/* 5.8.8 */
#ifndef GV_NOTQUAL
# define GV_NOTQUAL 0
#endif
#ifndef newSV
# define newSV(l) NEWSV(0,l)
#endif
#ifndef CvISXSUB_on
# define CvISXSUB_on(cv) (void)cv
#endif
#ifndef CvISXSUB
# define CvISXSUB(cv) (CvXSUB (cv) ? TRUE : FALSE)
#endif
#ifndef Newx
# define Newx(ptr,nitems,type) New (0,ptr,nitems,type)
#endif

/* 5.8.7 */
#ifndef SvRV_set
# define SvRV_set(s,v) SvRV(s) = (v)
#endif

static int
s_signum (SV *sig)
{
#ifndef SIG_SIZE
  /* kudos to Slaven Rezic for the idea */
  static char sig_size [] = { SIG_NUM };
# define SIG_SIZE (sizeof (sig_size) + 1)
#endif
  dTHX;
  int signum;

  SvGETMAGIC (sig);

  for (signum = 1; signum < SIG_SIZE; ++signum)
    if (strEQ (SvPV_nolen (sig), PL_sig_name [signum]))
      return signum;

  signum = SvIV (sig);

  if (signum > 0 && signum < SIG_SIZE)
    return signum;

  return -1;
}

static int
s_signum_croak (SV *sig)
{
  int signum = s_signum (sig);

  if (signum < 0)
    {
      dTHX;
      croak ("%s: invalid signal name or number", SvPV_nolen (sig));
    }

  return signum;
}

static int
s_fileno (SV *fh, int wr)
{
  dTHX;
  SvGETMAGIC (fh);

  if (SvROK (fh))
    {
      fh = SvRV (fh);
      SvGETMAGIC (fh);
    }

  if (SvTYPE (fh) == SVt_PVGV)
    return PerlIO_fileno (wr ? IoOFP (sv_2io (fh)) : IoIFP (sv_2io (fh)));

  if (SvOK (fh) && (SvIV (fh) >= 0) && (SvIV (fh) < 0x7fffffffL))
    return SvIV (fh);

  return -1;
}

static int
s_fileno_croak (SV *fh, int wr)
{
  int fd = s_fileno (fh, wr);

  if (fd < 0)
    {
      dTHX;
      croak ("%s: illegal fh argument, either not an OS file or read/write mode mismatch", SvPV_nolen (fh));
    }

  return fd;
}

static SV *
s_get_cv (SV *cb_sv)
{
  dTHX;
  HV *st;
  GV *gvp;

  return (SV *)sv_2cv (cb_sv, &st, &gvp, 0);
}

static SV *
s_get_cv_croak (SV *cb_sv)
{
  SV *cv = s_get_cv (cb_sv);

  if (!cv)
    {
      dTHX;
      croak ("%s: callback must be a CODE reference or another callable object", SvPV_nolen (cb_sv));
    }

  return cv;
}

/*****************************************************************************/
/* gensub: simple closure generation utility */

#define S_GENSUB_ARG CvXSUBANY (cv).any_ptr

/* create a closure from XS, returns a code reference */
/* the arg can be accessed via GENSUB_ARG from the callback */
/* the callback must use dXSARGS/XSRETURN */
static SV *
s_gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
{
  CV *cv = (CV *)newSV (0);

  sv_upgrade ((SV *)cv, SVt_PVCV);

  CvANON_on (cv);
  CvISXSUB_on (cv);
  CvXSUB (cv) = xsub;
  S_GENSUB_ARG = arg;

  return newRV_noinc ((SV *)cv);
}

/*****************************************************************************/
/* portable pipe/socketpair */

#ifdef USE_SOCKETS_AS_HANDLES
# define S_TO_HANDLE(x) ((HANDLE)win32_get_osfhandle (x))
#else
# define S_TO_HANDLE(x) ((HANDLE)x)
#endif

#ifdef _WIN32
/* taken almost verbatim from libev's ev_win32.c */
/* oh, the humanity! */
static int
s_pipe (int filedes [2])
{
  dTHX;

  struct sockaddr_in addr = { 0 };
  int addr_size = sizeof (addr);
  struct sockaddr_in adr2;
  int adr2_size = sizeof (adr2);
  SOCKET listener;
  SOCKET sock [2] = { -1, -1 };

  if ((listener = socket (AF_INET, SOCK_STREAM, 0)) == INVALID_SOCKET) 
    return -1;

  addr.sin_family = AF_INET;
  addr.sin_addr.s_addr = htonl (INADDR_LOOPBACK);
  addr.sin_port = 0;

  if (bind (listener, (struct sockaddr *)&addr, addr_size))
    goto fail;

  if (getsockname (listener, (struct sockaddr *)&addr, &addr_size))
    goto fail;

  if (listen (listener, 1))
    goto fail;

  if ((sock [0] = socket (AF_INET, SOCK_STREAM, 0)) == INVALID_SOCKET) 
    goto fail;

  if (connect (sock [0], (struct sockaddr *)&addr, addr_size))
    goto fail;

  if ((sock [1] = accept (listener, 0, 0)) < 0)
    goto fail;

  /* windows vista returns fantasy port numbers for getpeername.
   * example for two interconnected tcp sockets:
   *
   * (Socket::unpack_sockaddr_in getsockname $sock0)[0] == 53364
   * (Socket::unpack_sockaddr_in getpeername $sock0)[0] == 53363
   * (Socket::unpack_sockaddr_in getsockname $sock1)[0] == 53363
   * (Socket::unpack_sockaddr_in getpeername $sock1)[0] == 53365
   *
   * wow! tridirectional sockets!
   *
   * this way of checking ports seems to work:
   */
  if (getpeername (sock [0], (struct sockaddr *)&addr, &addr_size))
    goto fail;

  if (getsockname (sock [1], (struct sockaddr *)&adr2, &adr2_size))
    goto fail;

  errno = WSAEINVAL;
  if (addr_size != adr2_size
      || addr.sin_addr.s_addr != adr2.sin_addr.s_addr /* just to be sure, I mean, it's windows */
      || addr.sin_port        != adr2.sin_port)
    goto fail;

  closesocket (listener);

#ifdef USE_SOCKETS_AS_HANDLES
  /* when select isn't winsocket, we also expect socket, connect, accept etc.
   * to work on fds */
  filedes [0] = sock [0];
  filedes [1] = sock [1];
#else
  filedes [0] = _open_osfhandle (sock [0], 0);
  filedes [1] = _open_osfhandle (sock [1], 0);
#endif

  return 0;

fail:
  closesocket (listener);

  if (sock [0] != INVALID_SOCKET) closesocket (sock [0]);
  if (sock [1] != INVALID_SOCKET) closesocket (sock [1]);

  return -1;
}

#define s_socketpair(domain,type,protocol,filedes) s_pipe (filedes)

static int
s_fd_blocking (int fd, int blocking)
{
  u_long nonblocking = !blocking;

  return ioctlsocket ((SOCKET)S_TO_HANDLE (fd), FIONBIO, &nonblocking);
}

#define s_fd_prepare(fd) s_fd_blocking (fd, 0)

#else

#define s_socketpair(domain,type,protocol,filedes) socketpair (domain, type, protocol, filedes)
#define s_pipe(filedes) pipe (filedes)

static int
s_fd_blocking (int fd, int blocking)
{
  return fcntl (fd, F_SETFL, blocking ? 0 : O_NONBLOCK);
}

static int
s_fd_prepare (int fd)
{
  return s_fd_blocking (fd, 0)
         || fcntl (fd, F_SETFD, FD_CLOEXEC);
}

#endif

#if __linux && (__GLIBC__ > 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 7))
/* our minimum requirement is glibc 2.7 which has the stub, but not the header */
# include <stdint.h>
# ifdef __cplusplus
extern "C" {
# endif
  int eventfd (unsigned int initval, int flags);
# ifdef __cplusplus
}
# endif
#else
# define eventfd(initval,flags) -1
#endif

typedef struct {
  int fd[2]; /* read, write fd, might be equal */
  int len; /* write length (1 pipe/socket, 8 eventfd) */
} s_epipe;

static int
s_epipe_new (s_epipe *epp)
{
  s_epipe ep;

  ep.fd [0] = ep.fd [1] = eventfd (0, 0);

  if (ep.fd [0] >= 0)
    {
      s_fd_prepare (ep.fd [0]);
      ep.len = 8;
    }
  else
    {
      if (s_pipe (ep.fd))
        return -1;

      if (s_fd_prepare (ep.fd [0])
          || s_fd_prepare (ep.fd [1]))
        {
           dTHX;

           close (ep.fd [0]);
           close (ep.fd [1]);
           return -1;
        }

      ep.len = 1;
    }

  *epp = ep;
  return 0;
}

static void
s_epipe_destroy (s_epipe *epp)
{
  dTHX;

  close (epp->fd [0]);

  if (epp->fd [1] != epp->fd [0])
    close (epp->fd [1]);

  epp->len = 0;
}

static void
s_epipe_signal (s_epipe *epp)
{
#ifdef _WIN32
  /* perl overrides send with a function that crashes in other threads.
   * unfortunately, it overrides it with an argument-less macro, so
   * there is no way to force usage of the real send function.
   * incompetent windows programmers - is this redundant?
   */
  DWORD dummy;
  WriteFile (S_TO_HANDLE (epp->fd [1]), (LPCVOID)&dummy, 1, &dummy, 0);
#else
  static uint64_t counter = 1;
  /* some modules accept fd's from outside, support eventfd here */
  if (write (epp->fd [1], &counter, epp->len) < 0
      && errno == EINVAL
      && epp->len != 8)
    write (epp->fd [1], &counter, (epp->len = 8));
#endif
}

static void
s_epipe_drain (s_epipe *epp)
{
  dTHX;
  char buf [9];

#ifdef _WIN32
  recv (epp->fd [0], buf, sizeof (buf), 0);
#else
  read (epp->fd [0], buf, sizeof (buf));
#endif
}

/* like new, but dups over old */
static int
s_epipe_renew (s_epipe *epp)
{
  dTHX;
  s_epipe epn;

  if (epp->fd [1] != epp->fd [0])
    close (epp->fd [1]);

  if (s_epipe_new (&epn))
    return -1;

  if (epp->len)
    {
      if (dup2 (epn.fd [0], epp->fd [0]) < 0)
        croak ("unable to dup over old event pipe"); /* should not croak */

      close (epn.fd [0]);

      if (epn.fd [0] == epn.fd [1])
        epn.fd [1] = epp->fd [0];

      epn.fd [0] = epp->fd [0];
    }

  *epp = epn;

  return 0;
}

#define s_epipe_fd(epp) ((epp)->fd [0])

static int
s_epipe_wait (s_epipe *epp)
{
  dTHX;
#ifdef _WIN32
  fd_set rfd;
  int fd = s_epipe_fd (epp);

  FD_ZERO (&rfd);
  FD_SET (fd, &rfd);

  return PerlSock_select (fd + 1, &rfd, 0, 0, 0);
#else
  /* poll is preferable on posix systems */
  struct pollfd pfd;

  pfd.fd = s_epipe_fd (epp);
  pfd.events = POLLIN;

  return poll (&pfd, 1, -1);
#endif
}

#endif

Revision:	1.8
Committed:	Wed Mar 31 00:47:11 2010 UTC (14 years, 8 months ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	rel-1_04, rel-1_05
Changes since 1.7:	+4 -2 lines
Log Message:	1.104
#	Content
1	#ifndef SCHMORP_PERL_H_
2	#define SCHMORP_PERL_H_
3
4	/* WARNING
5	* This header file is a shared resource between many modules.
6	*/
7
8	#include <signal.h>
9	#include <errno.h>
10
11	#ifndef _WIN32
12	# include <poll.h>
13	#endif
14
15	/* useful stuff, used by schmorp mostly */
16
17	#include "patchlevel.h"
18
19	#define PERL_VERSION_ATLEAST(a,b,c) \
20	(PERL_REVISION > (a) \
21	\|\| (PERL_REVISION == (a) \
22	&& (PERL_VERSION > (b) \
23	\|\| (PERL_VERSION == (b) && PERL_SUBVERSION >= (c)))))
24
25	#ifndef PERL_MAGIC_ext
26	# define PERL_MAGIC_ext '~'
27	#endif
28
29	#if !PERL_VERSION_ATLEAST (5,6,0)
30	# ifndef PL_ppaddr
31	# define PL_ppaddr ppaddr
32	# endif
33	# ifndef call_sv
34	# define call_sv perl_call_sv
35	# endif
36	# ifndef get_sv
37	# define get_sv perl_get_sv
38	# endif
39	# ifndef get_cv
40	# define get_cv perl_get_cv
41	# endif
42	# ifndef IS_PADGV
43	# define IS_PADGV(v) 0
44	# endif
45	# ifndef IS_PADCONST
46	# define IS_PADCONST(v) 0
47	# endif
48	#endif
49
50	/* 5.11 */
51	#ifndef CxHASARGS
52	# define CxHASARGS(cx) (cx)->blk_sub.hasargs
53	#endif
54
55	/* 5.10.0 */
56	#ifndef SvREFCNT_inc_NN
57	# define SvREFCNT_inc_NN(sv) SvREFCNT_inc (sv)
58	#endif
59
60	/* 5.8.8 */
61	#ifndef GV_NOTQUAL
62	# define GV_NOTQUAL 0
63	#endif
64	#ifndef newSV
65	# define newSV(l) NEWSV(0,l)
66	#endif
67	#ifndef CvISXSUB_on
68	# define CvISXSUB_on(cv) (void)cv
69	#endif
70	#ifndef CvISXSUB
71	# define CvISXSUB(cv) (CvXSUB (cv) ? TRUE : FALSE)
72	#endif
73	#ifndef Newx
74	# define Newx(ptr,nitems,type) New (0,ptr,nitems,type)
75	#endif
76
77	/* 5.8.7 */
78	#ifndef SvRV_set
79	# define SvRV_set(s,v) SvRV(s) = (v)
80	#endif
81
82	static int
83	s_signum (SV *sig)
84	{
85	#ifndef SIG_SIZE
86	/* kudos to Slaven Rezic for the idea */
87	static char sig_size [] = { SIG_NUM };
88	# define SIG_SIZE (sizeof (sig_size) + 1)
89	#endif
90	dTHX;
91	int signum;
92
93	SvGETMAGIC (sig);
94
95	for (signum = 1; signum < SIG_SIZE; ++signum)
96	if (strEQ (SvPV_nolen (sig), PL_sig_name [signum]))
97	return signum;
98
99	signum = SvIV (sig);
100
101	if (signum > 0 && signum < SIG_SIZE)
102	return signum;
103
104	return -1;
105	}
106
107	static int
108	s_signum_croak (SV *sig)
109	{
110	int signum = s_signum (sig);
111
112	if (signum < 0)
113	{
114	dTHX;
115	croak ("%s: invalid signal name or number", SvPV_nolen (sig));
116	}
117
118	return signum;
119	}
120
121	static int
122	s_fileno (SV *fh, int wr)
123	{
124	dTHX;
125	SvGETMAGIC (fh);
126
127	if (SvROK (fh))
128	{
129	fh = SvRV (fh);
130	SvGETMAGIC (fh);
131	}
132
133	if (SvTYPE (fh) == SVt_PVGV)
134	return PerlIO_fileno (wr ? IoOFP (sv_2io (fh)) : IoIFP (sv_2io (fh)));
135
136	if (SvOK (fh) && (SvIV (fh) >= 0) && (SvIV (fh) < 0x7fffffffL))
137	return SvIV (fh);
138
139	return -1;
140	}
141
142	static int
143	s_fileno_croak (SV *fh, int wr)
144	{
145	int fd = s_fileno (fh, wr);
146
147	if (fd < 0)
148	{
149	dTHX;
150	croak ("%s: illegal fh argument, either not an OS file or read/write mode mismatch", SvPV_nolen (fh));
151	}
152
153	return fd;
154	}
155
156	static SV *
157	s_get_cv (SV *cb_sv)
158	{
159	dTHX;
160	HV *st;
161	GV *gvp;
162
163	return (SV *)sv_2cv (cb_sv, &st, &gvp, 0);
164	}
165
166	static SV *
167	s_get_cv_croak (SV *cb_sv)
168	{
169	SV *cv = s_get_cv (cb_sv);
170
171	if (!cv)
172	{
173	dTHX;
174	croak ("%s: callback must be a CODE reference or another callable object", SvPV_nolen (cb_sv));
175	}
176
177	return cv;
178	}
179
180	/*****************************************************************************/
181	/* gensub: simple closure generation utility */
182
183	#define S_GENSUB_ARG CvXSUBANY (cv).any_ptr
184
185	/* create a closure from XS, returns a code reference */
186	/* the arg can be accessed via GENSUB_ARG from the callback */
187	/* the callback must use dXSARGS/XSRETURN */
188	static SV *
189	s_gensub (pTHX_ void (xsub)(pTHX_ CV ), void *arg)
190	{
191	CV cv = (CV )newSV (0);
192
193	sv_upgrade ((SV *)cv, SVt_PVCV);
194
195	CvANON_on (cv);
196	CvISXSUB_on (cv);
197	CvXSUB (cv) = xsub;
198	S_GENSUB_ARG = arg;
199
200	return newRV_noinc ((SV *)cv);
201	}
202
203	/*****************************************************************************/
204	/* portable pipe/socketpair */
205
206	#ifdef USE_SOCKETS_AS_HANDLES
207	# define S_TO_HANDLE(x) ((HANDLE)win32_get_osfhandle (x))
208	#else
209	# define S_TO_HANDLE(x) ((HANDLE)x)
210	#endif
211
212	#ifdef _WIN32
213	/* taken almost verbatim from libev's ev_win32.c */
214	/* oh, the humanity! */
215	static int
216	s_pipe (int filedes [2])
217	{
218	dTHX;
219
220	struct sockaddr_in addr = { 0 };
221	int addr_size = sizeof (addr);
222	struct sockaddr_in adr2;
223	int adr2_size = sizeof (adr2);
224	SOCKET listener;
225	SOCKET sock [2] = { -1, -1 };
226
227	if ((listener = socket (AF_INET, SOCK_STREAM, 0)) == INVALID_SOCKET)
228	return -1;
229
230	addr.sin_family = AF_INET;
231	addr.sin_addr.s_addr = htonl (INADDR_LOOPBACK);
232	addr.sin_port = 0;
233
234	if (bind (listener, (struct sockaddr *)&addr, addr_size))
235	goto fail;
236
237	if (getsockname (listener, (struct sockaddr *)&addr, &addr_size))
238	goto fail;
239
240	if (listen (listener, 1))
241	goto fail;
242
243	if ((sock [0] = socket (AF_INET, SOCK_STREAM, 0)) == INVALID_SOCKET)
244	goto fail;
245
246	if (connect (sock [0], (struct sockaddr *)&addr, addr_size))
247	goto fail;
248
249	if ((sock [1] = accept (listener, 0, 0)) < 0)
250	goto fail;
251
252	/* windows vista returns fantasy port numbers for getpeername.
253	* example for two interconnected tcp sockets:
254	*
255	* (Socket::unpack_sockaddr_in getsockname $sock0)[0] == 53364
256	* (Socket::unpack_sockaddr_in getpeername $sock0)[0] == 53363
257	* (Socket::unpack_sockaddr_in getsockname $sock1)[0] == 53363
258	* (Socket::unpack_sockaddr_in getpeername $sock1)[0] == 53365
259	*
260	* wow! tridirectional sockets!
261	*
262	* this way of checking ports seems to work:
263	*/
264	if (getpeername (sock [0], (struct sockaddr *)&addr, &addr_size))
265	goto fail;
266
267	if (getsockname (sock [1], (struct sockaddr *)&adr2, &adr2_size))
268	goto fail;
269
270	errno = WSAEINVAL;
271	if (addr_size != adr2_size
272	\|\| addr.sin_addr.s_addr != adr2.sin_addr.s_addr /* just to be sure, I mean, it's windows */
273	\|\| addr.sin_port != adr2.sin_port)
274	goto fail;
275
276	closesocket (listener);
277
278	#ifdef USE_SOCKETS_AS_HANDLES
279	/* when select isn't winsocket, we also expect socket, connect, accept etc.
280	* to work on fds */
281	filedes [0] = sock [0];
282	filedes [1] = sock [1];
283	#else
284	filedes [0] = _open_osfhandle (sock [0], 0);
285	filedes [1] = _open_osfhandle (sock [1], 0);
286	#endif
287
288	return 0;
289
290	fail:
291	closesocket (listener);
292
293	if (sock [0] != INVALID_SOCKET) closesocket (sock [0]);
294	if (sock [1] != INVALID_SOCKET) closesocket (sock [1]);
295
296	return -1;
297	}
298
299	#define s_socketpair(domain,type,protocol,filedes) s_pipe (filedes)
300
301	static int
302	s_fd_blocking (int fd, int blocking)
303	{
304	u_long nonblocking = !blocking;
305
306	return ioctlsocket ((SOCKET)S_TO_HANDLE (fd), FIONBIO, &nonblocking);
307	}
308
309	#define s_fd_prepare(fd) s_fd_blocking (fd, 0)
310
311	#else
312
313	#define s_socketpair(domain,type,protocol,filedes) socketpair (domain, type, protocol, filedes)
314	#define s_pipe(filedes) pipe (filedes)
315
316	static int
317	s_fd_blocking (int fd, int blocking)
318	{
319	return fcntl (fd, F_SETFL, blocking ? 0 : O_NONBLOCK);
320	}
321
322	static int
323	s_fd_prepare (int fd)
324	{
325	return s_fd_blocking (fd, 0)
326	\|\| fcntl (fd, F_SETFD, FD_CLOEXEC);
327	}
328
329	#endif
330
331	#if __linux && (__GLIBC__ > 2 \|\| (__GLIBC__ == 2 && __GLIBC_MINOR__ >= 7))
332	/* our minimum requirement is glibc 2.7 which has the stub, but not the header */
333	# include <stdint.h>
334	# ifdef __cplusplus
335	extern "C" {
336	# endif
337	int eventfd (unsigned int initval, int flags);
338	# ifdef __cplusplus
339	}
340	# endif
341	#else
342	# define eventfd(initval,flags) -1
343	#endif
344
345	typedef struct {
346	int fd[2]; /* read, write fd, might be equal */
347	int len; /* write length (1 pipe/socket, 8 eventfd) */
348	} s_epipe;
349
350	static int
351	s_epipe_new (s_epipe *epp)
352	{
353	s_epipe ep;
354
355	ep.fd [0] = ep.fd [1] = eventfd (0, 0);
356
357	if (ep.fd [0] >= 0)
358	{
359	s_fd_prepare (ep.fd [0]);
360	ep.len = 8;
361	}
362	else
363	{
364	if (s_pipe (ep.fd))
365	return -1;
366
367	if (s_fd_prepare (ep.fd [0])
368	\|\| s_fd_prepare (ep.fd [1]))
369	{
370	dTHX;
371
372	close (ep.fd [0]);
373	close (ep.fd [1]);
374	return -1;
375	}
376
377	ep.len = 1;
378	}
379
380	*epp = ep;
381	return 0;
382	}
383
384	static void
385	s_epipe_destroy (s_epipe *epp)
386	{
387	dTHX;
388
389	close (epp->fd [0]);
390
391	if (epp->fd [1] != epp->fd [0])
392	close (epp->fd [1]);
393
394	epp->len = 0;
395	}
396
397	static void
398	s_epipe_signal (s_epipe *epp)
399	{
400	#ifdef _WIN32
401	/* perl overrides send with a function that crashes in other threads.
402	* unfortunately, it overrides it with an argument-less macro, so
403	* there is no way to force usage of the real send function.
404	* incompetent windows programmers - is this redundant?
405	*/
406	DWORD dummy;
407	WriteFile (S_TO_HANDLE (epp->fd [1]), (LPCVOID)&dummy, 1, &dummy, 0);
408	#else
409	static uint64_t counter = 1;
410	/* some modules accept fd's from outside, support eventfd here */
411	if (write (epp->fd [1], &counter, epp->len) < 0
412	&& errno == EINVAL
413	&& epp->len != 8)
414	write (epp->fd [1], &counter, (epp->len = 8));
415	#endif
416	}
417
418	static void
419	s_epipe_drain (s_epipe *epp)
420	{
421	dTHX;
422	char buf [9];
423
424	#ifdef _WIN32
425	recv (epp->fd [0], buf, sizeof (buf), 0);
426	#else
427	read (epp->fd [0], buf, sizeof (buf));
428	#endif
429	}
430
431	/* like new, but dups over old */
432	static int
433	s_epipe_renew (s_epipe *epp)
434	{
435	dTHX;
436	s_epipe epn;
437
438	if (epp->fd [1] != epp->fd [0])
439	close (epp->fd [1]);
440
441	if (s_epipe_new (&epn))
442	return -1;
443
444	if (epp->len)
445	{
446	if (dup2 (epn.fd [0], epp->fd [0]) < 0)
447	croak ("unable to dup over old event pipe"); /* should not croak */
448
449	close (epn.fd [0]);
450
451	if (epn.fd [0] == epn.fd [1])
452	epn.fd [1] = epp->fd [0];
453
454	epn.fd [0] = epp->fd [0];
455	}
456
457	*epp = epn;
458
459	return 0;
460	}
461
462	#define s_epipe_fd(epp) ((epp)->fd [0])
463
464	static int
465	s_epipe_wait (s_epipe *epp)
466	{
467	dTHX;
468	#ifdef _WIN32
469	fd_set rfd;
470	int fd = s_epipe_fd (epp);
471
472	FD_ZERO (&rfd);
473	FD_SET (fd, &rfd);
474
475	return PerlSock_select (fd + 1, &rfd, 0, 0, 0);
476	#else
477	/* poll is preferable on posix systems */
478	struct pollfd pfd;
479
480	pfd.fd = s_epipe_fd (epp);
481	pfd.events = POLLIN;
482
483	return poll (&pfd, 1, -1);
484	#endif
485	}
486
487	#endif
488