This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [ID 19991026.001] perl segmentation fault report
[perl5.git] / ext / Fcntl / Fcntl.xs
CommitLineData
c5be433b 1#define PERL_NO_GET_CONTEXT
a0d0e21e
LW
2#include "EXTERN.h"
3#include "perl.h"
4#include "XSUB.h"
5
75ced34b
PP
6#ifdef VMS
7# include <file.h>
8#else
cd661bb6
NIS
9#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
10#define _NO_OLDNAMES
11#endif
75ced34b 12# include <fcntl.h>
cd661bb6
NIS
13#if defined(__GNUC__) && defined(__cplusplus) && defined(WIN32)
14#undef _NO_OLDNAMES
15#endif
75ced34b 16#endif
a0d0e21e 17
ac88732c
JH
18#ifdef I_UNISTD
19#include <unistd.h>
20#endif
21
8e07c86e
AD
22/* This comment is a kludge to get metaconfig to see the symbols
23 VAL_O_NONBLOCK
24 VAL_EAGAIN
25 RD_NODATA
26 EOF_NONBLOCK
27 and include the appropriate metaconfig unit
28 so that Configure will test how to turn on non-blocking I/O
29 for a file descriptor. See config.h for how to use these
30 in your extension.
31
32 While I'm at it, I'll have metaconfig look for HAS_POLL too.
33 --AD October 16, 1995
34*/
35
a0d0e21e 36static int
f0f333f4 37not_here(char *s)
a0d0e21e
LW
38{
39 croak("%s not implemented on this architecture", s);
40 return -1;
41}
42
43static double
f0f333f4 44constant(char *name, int arg)
a0d0e21e
LW
45{
46 errno = 0;
47 switch (*name) {
48 case 'F':
49 if (strnEQ(name, "F_", 2)) {
ac88732c
JH
50 if (strEQ(name, "F_ALLOCSP"))
51#ifdef F_ALLOCSP
52 return F_ALLOCSP;
53#else
54 goto not_there;
55#endif
56 if (strEQ(name, "F_ALLOCSP64"))
57#ifdef F_ALLOCSP64
58 return F_ALLOCSP64;
59#else
60 goto not_there;
61#endif
62 if (strEQ(name, "F_COMPAT"))
63#ifdef F_COMPAT
64 return F_COMPAT;
65#else
66 goto not_there;
67#endif
68 if (strEQ(name, "F_DUP2FD"))
69#ifdef F_DUP2FD
70 return F_DUP2FD;
71#else
72 goto not_there;
73#endif
a0d0e21e
LW
74 if (strEQ(name, "F_DUPFD"))
75#ifdef F_DUPFD
76 return F_DUPFD;
77#else
78 goto not_there;
79#endif
0fd60c2a
JH
80 if (strEQ(name, "F_EXLCK"))
81#ifdef F_EXLCK
82 return F_EXLCK;
83#else
84 goto not_there;
85#endif
ac88732c
JH
86 if (strEQ(name, "F_FREESP"))
87#ifdef F_FREESP
88 return F_FREESP;
89#else
90 goto not_there;
91#endif
92 if (strEQ(name, "F_FREESP64"))
93#ifdef F_FREESP64
94 return F_FREESP64;
95#else
96 goto not_there;
97#endif
98 if (strEQ(name, "F_FSYNC"))
99#ifdef F_FSYNC
100 return F_FSYNC;
101#else
102 goto not_there;
103#endif
104 if (strEQ(name, "F_FSYNC64"))
105#ifdef F_FSYNC64
106 return F_FSYNC64;
107#else
108 goto not_there;
109#endif
a0d0e21e
LW
110 if (strEQ(name, "F_GETFD"))
111#ifdef F_GETFD
112 return F_GETFD;
113#else
114 goto not_there;
115#endif
0fd60c2a
JH
116 if (strEQ(name, "F_GETFL"))
117#ifdef F_GETFL
118 return F_GETFL;
119#else
120 goto not_there;
121#endif
a0d0e21e
LW
122 if (strEQ(name, "F_GETLK"))
123#ifdef F_GETLK
124 return F_GETLK;
125#else
126 goto not_there;
127#endif
5ff3f7a4
GS
128 if (strEQ(name, "F_GETLK64"))
129#ifdef F_GETLK64
130 return F_GETLK64;
131#else
132 goto not_there;
133#endif
5f832ef3
JH
134 if (strEQ(name, "F_GETOWN"))
135#ifdef F_GETOWN
136 return F_GETOWN;
137#else
138 goto not_there;
139#endif
ac88732c
JH
140 if (strEQ(name, "F_NODNY"))
141#ifdef F_NODNY
142 return F_NODNY;
143#else
144 goto not_there;
145#endif
0fd60c2a
JH
146 if (strEQ(name, "F_POSIX"))
147#ifdef F_POSIX
148 return F_POSIX;
a0d0e21e
LW
149#else
150 goto not_there;
151#endif
ac88732c
JH
152 if (strEQ(name, "F_RDACC"))
153#ifdef F_RDACC
154 return F_RDACC;
155#else
156 goto not_there;
157#endif
158 if (strEQ(name, "F_RDDNY"))
159#ifdef F_RDDNY
160 return F_RDDNY;
161#else
162 goto not_there;
163#endif
0fd60c2a
JH
164 if (strEQ(name, "F_RDLCK"))
165#ifdef F_RDLCK
166 return F_RDLCK;
a0d0e21e
LW
167#else
168 goto not_there;
169#endif
ac88732c
JH
170 if (strEQ(name, "F_RWACC"))
171#ifdef F_RWACC
172 return F_RWACC;
173#else
174 goto not_there;
175#endif
176 if (strEQ(name, "F_RWDNY"))
177#ifdef F_RWDNY
178 return F_RWDNY;
179#else
180 goto not_there;
181#endif
0fd60c2a
JH
182 if (strEQ(name, "F_SETFD"))
183#ifdef F_SETFD
184 return F_SETFD;
3e3baf6d
TB
185#else
186 goto not_there;
187#endif
232e078e
AD
188 if (strEQ(name, "F_SETFL"))
189#ifdef F_SETFL
190 return F_SETFL;
a0d0e21e
LW
191#else
192 goto not_there;
193#endif
d9fde92e
GS
194 if (strEQ(name, "F_SETLK"))
195#ifdef F_SETLK
196 return F_SETLK;
197#else
198 goto not_there;
199#endif
5ff3f7a4
GS
200 if (strEQ(name, "F_SETLK64"))
201#ifdef F_SETLK64
202 return F_SETLK64;
a0d0e21e
LW
203#else
204 goto not_there;
205#endif
206 if (strEQ(name, "F_SETLKW"))
207#ifdef F_SETLKW
208 return F_SETLKW;
209#else
210 goto not_there;
211#endif
5ff3f7a4
GS
212 if (strEQ(name, "F_SETLKW64"))
213#ifdef F_SETLKW64
214 return F_SETLKW64;
215#else
216 goto not_there;
217#endif
5f832ef3
JH
218 if (strEQ(name, "F_SETOWN"))
219#ifdef F_SETOWN
220 return F_SETOWN;
221#else
222 goto not_there;
223#endif
ac88732c
JH
224 if (strEQ(name, "F_SHARE"))
225#ifdef F_SHARE
226 return F_SHARE;
227#else
228 goto not_there;
229#endif
0fd60c2a
JH
230 if (strEQ(name, "F_SHLCK"))
231#ifdef F_SHLCK
232 return F_SHLCK;
a0d0e21e
LW
233#else
234 goto not_there;
235#endif
236 if (strEQ(name, "F_UNLCK"))
237#ifdef F_UNLCK
238 return F_UNLCK;
239#else
240 goto not_there;
241#endif
ac88732c
JH
242 if (strEQ(name, "F_UNSHARE"))
243#ifdef F_UNSHARE
244 return F_UNSHARE;
245#else
246 goto not_there;
247#endif
248 if (strEQ(name, "F_WRACC"))
249#ifdef F_WRACC
250 return F_WRACC;
251#else
252 goto not_there;
253#endif
254 if (strEQ(name, "F_WRDNY"))
255#ifdef F_WRDNY
256 return F_WRDNY;
257#else
258 goto not_there;
259#endif
a0d0e21e
LW
260 if (strEQ(name, "F_WRLCK"))
261#ifdef F_WRLCK
262 return F_WRLCK;
263#else
264 goto not_there;
265#endif
266 errno = EINVAL;
267 return 0;
3e3baf6d
TB
268 }
269 if (strEQ(name, "FAPPEND"))
270#ifdef FAPPEND
271 return FAPPEND;
272#else
273 goto not_there;
274#endif
275 if (strEQ(name, "FASYNC"))
276#ifdef FASYNC
277 return FASYNC;
278#else
279 goto not_there;
280#endif
281 if (strEQ(name, "FCREAT"))
282#ifdef FCREAT
283 return FCREAT;
284#else
285 goto not_there;
286#endif
287 if (strEQ(name, "FD_CLOEXEC"))
a0d0e21e
LW
288#ifdef FD_CLOEXEC
289 return FD_CLOEXEC;
290#else
291 goto not_there;
292#endif
0fd60c2a
JH
293 if (strEQ(name, "FDEFER"))
294#ifdef FDEFER
295 return FDEFER;
296#else
297 goto not_there;
298#endif
ac88732c
JH
299 if (strEQ(name, "FDSYNC"))
300#ifdef FDSYNC
301 return FDSYNC;
302#else
303 goto not_there;
304#endif
3e3baf6d
TB
305 if (strEQ(name, "FEXCL"))
306#ifdef FEXCL
307 return FEXCL;
308#else
309 goto not_there;
310#endif
ac88732c
JH
311 if (strEQ(name, "FLARGEFILE"))
312#ifdef FLARGEFILE
313 return FLARGEFILE;
314#else
315 goto not_there;
316#endif
3e3baf6d
TB
317 if (strEQ(name, "FNDELAY"))
318#ifdef FNDELAY
319 return FNDELAY;
320#else
321 goto not_there;
322#endif
323 if (strEQ(name, "FNONBLOCK"))
324#ifdef FNONBLOCK
325 return FNONBLOCK;
326#else
327 goto not_there;
328#endif
ac88732c
JH
329 if (strEQ(name, "FRSYNC"))
330#ifdef FRSYNC
331 return FRSYNC;
332#else
333 goto not_there;
334#endif
3e3baf6d
TB
335 if (strEQ(name, "FSYNC"))
336#ifdef FSYNC
337 return FSYNC;
338#else
339 goto not_there;
340#endif
341 if (strEQ(name, "FTRUNC"))
342#ifdef FTRUNC
343 return FTRUNC;
344#else
345 goto not_there;
346#endif
a0d0e21e 347 break;
7e1af8bc
PP
348 case 'L':
349 if (strnEQ(name, "LOCK_", 5)) {
350 /* We support flock() on systems which don't have it, so
351 always supply the constants. */
352 if (strEQ(name, "LOCK_SH"))
353#ifdef LOCK_SH
354 return LOCK_SH;
355#else
356 return 1;
357#endif
358 if (strEQ(name, "LOCK_EX"))
359#ifdef LOCK_EX
360 return LOCK_EX;
361#else
362 return 2;
363#endif
364 if (strEQ(name, "LOCK_NB"))
365#ifdef LOCK_NB
366 return LOCK_NB;
367#else
368 return 4;
369#endif
370 if (strEQ(name, "LOCK_UN"))
371#ifdef LOCK_UN
372 return LOCK_UN;
373#else
374 return 8;
375#endif
376 } else
377 goto not_there;
378 break;
a0d0e21e
LW
379 case 'O':
380 if (strnEQ(name, "O_", 2)) {
0fd60c2a
JH
381 if (strEQ(name, "O_ACCMODE"))
382#ifdef O_ACCMODE
383 return O_ACCMODE;
384#else
385 goto not_there;
386#endif
387 if (strEQ(name, "O_APPEND"))
388#ifdef O_APPEND
389 return O_APPEND;
390#else
391 goto not_there;
392#endif
393 if (strEQ(name, "O_ASYNC"))
394#ifdef O_ASYNC
395 return O_ASYNC;
396#else
397 goto not_there;
398#endif
399 if (strEQ(name, "O_BINARY"))
400#ifdef O_BINARY
401 return O_BINARY;
402#else
403 goto not_there;
404#endif
a0d0e21e
LW
405 if (strEQ(name, "O_CREAT"))
406#ifdef O_CREAT
407 return O_CREAT;
408#else
409 goto not_there;
410#endif
0fd60c2a
JH
411 if (strEQ(name, "O_DEFER"))
412#ifdef O_DEFER
413 return O_DEFER;
414#else
415 goto not_there;
416#endif
417 if (strEQ(name, "O_DSYNC"))
418#ifdef O_DSYNC
419 return O_DSYNC;
420#else
421 goto not_there;
422#endif
a0d0e21e
LW
423 if (strEQ(name, "O_EXCL"))
424#ifdef O_EXCL
425 return O_EXCL;
426#else
427 goto not_there;
428#endif
0fd60c2a
JH
429 if (strEQ(name, "O_EXLOCK"))
430#ifdef O_EXLOCK
431 return O_EXLOCK;
a0d0e21e
LW
432#else
433 goto not_there;
434#endif
5ff3f7a4
GS
435 if (strEQ(name, "O_LARGEFILE"))
436#ifdef O_LARGEFILE
437 return O_LARGEFILE;
438#else
439 goto not_there;
440#endif
0fd60c2a
JH
441 if (strEQ(name, "O_NDELAY"))
442#ifdef O_NDELAY
443 return O_NDELAY;
a0d0e21e
LW
444#else
445 goto not_there;
446#endif
0fd60c2a
JH
447 if (strEQ(name, "O_NOCTTY"))
448#ifdef O_NOCTTY
449 return O_NOCTTY;
a0d0e21e
LW
450#else
451 goto not_there;
452#endif
453 if (strEQ(name, "O_NONBLOCK"))
454#ifdef O_NONBLOCK
455 return O_NONBLOCK;
456#else
457 goto not_there;
458#endif
a0d0e21e
LW
459 if (strEQ(name, "O_RDONLY"))
460#ifdef O_RDONLY
461 return O_RDONLY;
462#else
463 goto not_there;
464#endif
465 if (strEQ(name, "O_RDWR"))
466#ifdef O_RDWR
467 return O_RDWR;
468#else
469 goto not_there;
470#endif
0fd60c2a
JH
471 if (strEQ(name, "O_RSYNC"))
472#ifdef O_RSYNC
473 return O_RSYNC;
705af498
JH
474#else
475 goto not_there;
476#endif
477 if (strEQ(name, "O_SHLOCK"))
478#ifdef O_SHLOCK
479 return O_SHLOCK;
480#else
481 goto not_there;
482#endif
0fd60c2a
JH
483 if (strEQ(name, "O_SYNC"))
484#ifdef O_SYNC
485 return O_SYNC;
705af498
JH
486#else
487 goto not_there;
488#endif
0fd60c2a
JH
489 if (strEQ(name, "O_TEXT"))
490#ifdef O_TEXT
491 return O_TEXT;
705af498
JH
492#else
493 goto not_there;
494#endif
0fd60c2a
JH
495 if (strEQ(name, "O_TRUNC"))
496#ifdef O_TRUNC
497 return O_TRUNC;
705af498
JH
498#else
499 goto not_there;
500#endif
0fd60c2a
JH
501 if (strEQ(name, "O_WRONLY"))
502#ifdef O_WRONLY
503 return O_WRONLY;
705af498
JH
504#else
505 goto not_there;
506#endif
a0d0e21e
LW
507 } else
508 goto not_there;
509 break;
ac88732c
JH
510 case 'S':
511 if (strEQ(name, "SEEK_CUR"))
512#ifdef SEEK_CUR
513 return SEEK_CUR;
514#else
515 goto not_there;
516#endif
517 if (strEQ(name, "SEEK_END"))
518#ifdef SEEK_END
519 return SEEK_END;
520#else
521 goto not_there;
522#endif
523 if (strEQ(name, "SEEK_SET"))
524#ifdef SEEK_SET
525 return SEEK_SET;
526#else
527 goto not_there;
528#endif
529 break;
a0d0e21e
LW
530 }
531 errno = EINVAL;
532 return 0;
533
534not_there:
535 errno = ENOENT;
536 return 0;
537}
538
539
540MODULE = Fcntl PACKAGE = Fcntl
541
542double
543constant(name,arg)
544 char * name
545 int arg
546