OpenCL/schmorp.h

#ifndef SCHMORP_PERL_H_
#define SCHMORP_PERL_H_

/* WARNING
 * This header file is a shared resource between many modules.
 * perl header files MUST already be included.
 */

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

#if defined(WIN32 ) || defined(_MINIX)
# define SCHMORP_H_PREFER_SELECT 1
#endif

#if !SCHMORP_H_PREFER_SELECT
# 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

/* use NV for 32 bit perls as it allows larger offsets */
#if IVSIZE >= 8
typedef IV VAL64;
# define SvVAL64(sv) SvIV (sv)
# define newSVval64(i64) newSViv (i64)
#else
typedef NV VAL64;
# define SvVAL64(sv) SvNV (sv)
# define newSVval64(i64) newSVnv (i64)
#endif

/* typemap for the above */
/*
VAL64           T_VAL64

INPUT

T_VAL64
        $var = ($type)SvVAL64 ($arg);

OUTPUT

T_VAL64
        $arg = newSVval64 ($var);
*/

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