ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/EV/schmorp.h
Revision: 1.5
Committed: Fri Jul 17 14:49:33 2009 UTC (14 years, 10 months ago) by root
Content type: text/plain
Branch: MAIN
CVS Tags: rel-3_7
Changes since 1.4: +6 -1 lines
Log Message:
3.7

File Contents

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