ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/EV/schmorp.h
Revision: 1.8
Committed: Wed Apr 14 00:17:22 2010 UTC (14 years, 1 month ago) by root
Content type: text/plain
Branch: MAIN
Changes since 1.7: +4 -2 lines
Log Message:
strict(er?) aliasing

File Contents

# 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