This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
POSIX math: Win32 shuffling.
[perl5.git] / ext / POSIX / POSIX.xs
CommitLineData
6e22d046
JH
1#define PERL_EXT_POSIX
2
2986a63f
JH
3#ifdef NETWARE
4 #define _POSIX_
4efcf9a2
SB
5 /*
6 * Ideally this should be somewhere down in the includes
7 * but putting it in other places is giving compiler errors.
8 * Also here I am unable to check for HAS_UNAME since it wouldn't have
9 * yet come into the file at this stage - sgp 18th Oct 2000
10 */
2986a63f
JH
11 #include <sys/utsname.h>
12#endif /* NETWARE */
13
c5be433b
GS
14#define PERL_NO_GET_CONTEXT
15
463ee0b2 16#include "EXTERN.h"
760ac839 17#define PERLIO_NOT_STDIO 1
463ee0b2
LW
18#include "perl.h"
19#include "XSUB.h"
acfe0abc 20#if defined(PERL_IMPLICIT_SYS)
873ef191
GS
21# undef signal
22# undef open
cd661bb6 23# undef setmode
35ff7856 24# define open PerlLIO_open3
873ef191 25#endif
2304df62 26#include <ctype.h>
a0d0e21e 27#ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */
2304df62 28#include <dirent.h>
a0d0e21e 29#endif
2304df62 30#include <errno.h>
b0ba2190
SH
31#ifdef WIN32
32#include <sys/errno2.h>
33#endif
2304df62
AD
34#ifdef I_FLOAT
35#include <float.h>
36#endif
a0d0e21e 37#ifdef I_LIMITS
2304df62 38#include <limits.h>
a0d0e21e 39#endif
2304df62
AD
40#include <locale.h>
41#include <math.h>
85e6fe83 42#ifdef I_PWD
2304df62 43#include <pwd.h>
85e6fe83 44#endif
2304df62
AD
45#include <setjmp.h>
46#include <signal.h>
2304df62 47#include <stdarg.h>
17c3b450 48
2304df62
AD
49#ifdef I_STDDEF
50#include <stddef.h>
51#endif
6990d991 52
b5846a0b
BS
53#ifdef I_UNISTD
54#include <unistd.h>
55#endif
56
7965edec
JH
57/* C89 math.h:
58
59 acos asin atan atan2 ceil cos cosh exp fabs floor fmod frexp ldexp
60 log log10 modf pow sin sinh sqrt tan tanh
61
62 * Implemented in core:
63
64 atan2 cos exp log pow sin sqrt
65
66 * Berkeley/SVID extensions:
67
68 j0 j1 jn y0 y1 yn
69
70 * C99 math.h added:
71
72 acosh asinh atanh cbrt copysign cosh erf erfc exp2 expm1 fdim fma
73 fmax fmin fpclassify hypot ilogb isfinite isgreater isgreaterequal
74 isinf isless islessequal islessgreater isnan isnormal isunordered
75 lgamma log1p log2 logb nan nearbyint nextafter nexttoward remainder
76 remquo rint round scalbn signbit sinh tanh tgamma trunc
77
78*/
79
a2f810b5
JH
80/* XXX The truthiness of acosh() is a gating proxy for all of the C99 math.
81 * This is very likely wrong, especially in non-UNIX lands like Win32
bfce4ab3
JH
82 * and VMS. For Win32 we later do some redefines for these interfaces. */
83
a2f810b5 84#if defined(HAS_C99) && defined(HAS_ACOSH)
03397f96
JH
85# if defined(USE_LONG_DOUBLE) && defined(HAS_ILOGBL)
86/* There's already a symbol for ilogbl, we will use its truthiness
87 * as a gating proxy for all the *l variants being defined. */
7965edec
JH
88# define c99_acosh acoshl
89# define c99_asinh asinhl
90# define c99_atanh atanhl
91# define c99_cbrt cbrtl
92# define c99_copysign copysignl
93# define c99_cosh coshl
94# define c99_erf erfl
95# define c99_erfc erfcl
96# define c99_exp2 exp2l
97# define c99_expm1 expm1l
98# define c99_fdim fdiml
99# define c99_fma fmal
100# define c99_fmax fmaxl
101# define c99_fmin fminl
102# define c99_hypot hypotl
103# define c99_ilogb ilogbl
104# define c99_lgamma gammal
105# define c99_log1p log1pl
106# define c99_log2 log2l
107# define c99_logb logbl
108# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
109# define c99_lrint llrintl
110# else
111# define c99_lrint lrintl
112# endif
113# define c99_nan nanl
114# define c99_nearbyint nearbyintl
115# define c99_nextafter nextafterl
116# define c99_nexttoward nexttowardl
117# define c99_remainder remainderl
118# define c99_remquo remquol
119# define c99_rint rintl
120# define c99_round roundl
121# define c99_scalbn scalbnl
122# define c99_signbit signbitl
123# define c99_sinh sinhl
124# define c99_tanh tanhl
125# define c99_tgamma tgammal
126# define c99_trunc truncl
127# else
128# define c99_acosh acosh
129# define c99_asinh asinh
130# define c99_atanh atanh
131# define c99_cbrt cbrt
132# define c99_copysign copysign
133# define c99_cosh cosh
134# define c99_erf erf
135# define c99_erfc erfc
136# define c99_exp2 exp2
137# define c99_expm1 expm1
138# define c99_fdim fdim
139# define c99_fma fma
140# define c99_fmax fmax
141# define c99_fmin fmin
142# define c99_hypot hypot
143# define c99_ilogb ilogb
144# define c99_lgamma lgamma
145# define c99_log1p log1p
146# define c99_log2 log2
147# define c99_logb logb
148# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
149# define c99_lrint llrint
150# else
151# define c99_lrint lrint
152# endif
153# define c99_nan nan
154# define c99_nearbyint nearbyint
155# define c99_nextafter nextafter
156# define c99_nexttoward nexttoward
157# define c99_remainder remainder
158# define c99_remquo remquo
159# define c99_rint rint
160# define c99_round round
161# define c99_scalbn scalbn
162# define c99_signbit signbit
163# define c99_sinh sinh
164# define c99_tanh tanh
165# define c99_tgamma tgamma
166# define c99_trunc trunc
167# endif
03397f96 168
bfce4ab3
JH
169/* XXX Add ldiv(), lldiv()? It's C99, but from stdlib.h, not math.h */
170
03397f96
JH
171/* Check both the Configure symbol and the macro-ness (like C99 promises). */
172# if defined(HAS_FPCLASSIFY) && defined(fpclassify)
173# define c99_fpclassify fpclassify
174# else
175# define c99_fpclassify not_here("fpclassify")
176# endif
177/* Like isnormal(), the isfinite(), isinf(), and isnan() are also C99
178 and also (sizeof-arg-aware) macros, but they are already well taken
179 care of by Configure et al, and defined in perl.h as
180 Perl_isfinite(), Perl_isinf(), and Perl_isnan(). */
181# ifdef isnormal
182# define c99_isnormal isnormal
183# else
184# define c99_isnormal not_here("isnormal")
185# endif
186# ifdef isgreater
187# define c99_isgreater isgreater
188# define c99_isgreaterequal isgreaterequal
189# define c99_isless isless
190# define c99_islessequal islessequal
191# define c99_islessgreater islessgreater
192# define c99_isunordered isunordered
193# endif
194
7965edec
JH
195#else
196# define c99_acosh(x) not_here("acosh")
197# define c99_asinh(x) not_here("asinh")
198# define c99_atanh(x) not_here("atanh")
199# define c99_cbrt(x) not_here("cbrt")
200# define c99_copysign(x,y) not_here("copysign")
201# define c99_cosh(x) not_here("cosh")
202# define c99_erf(x) not_here("erf")
203# define c99_erfc(x) not_here("erfc")
204# define c99_exp2(x) not_here("exp2")
205# define c99_expm1(x) not_here("expm1")
206# define c99_fdim(x,y) not_here("fdim")
207# define c99_fma(x,y,z) not_here("fma")
208# define c99_fmax(x,y) not_here("fmax")
209# define c99_fmin(x,y) not_here("fmin")
210# define c99_hypot(x,y) not_here("hypot")
211# define c99_lgamma(x) not_here("lgamma")
212# define c99_log1p(x) not_here("log1p")
213# define c99_log2(x) not_here("log2")
214# define c99_logb(x) not_here("logb")
215# define c99_lrint(x) not_here("lrint")
216# define c99_nan(x) not_here("nan")
217# define c99_nearbyint(x) not_here("nearbyint")
218# define c99_nextafter(x,y) not_here("nextafter")
219# define c99_nexttoward(x,y) not_here("nexttoward")
220# define c99_remainder(x,y) not_here("remainder")
221# define c99_remquo(x,y) not_here("remquo")
222# define c99_rint(x) not_here("rint")
223# define c99_round(x) not_here("round")
224# define c99_scalbn(x,y) not_here("scalbn")
225# define c99_signbit(x) not_here("signbit")
226# define c99_sinh(x) not_here("sinh")
227# define c99_tanh(x) not_here("tanh")
228# define c99_tgamma(x) not_here("tgamma")
229# define c99_trunc(x) not_here("trunc")
230
231# define c99_fpclassify not_here("fpclassify")
232# define c99_ilogb not_here("ilogb")
03397f96 233# define c99_isgreater not_here("isgreater")
7965edec
JH
234# define c99_isgreaterequal not_here("isgreaterequal")
235# define c99_isless not_here("isless")
236# define c99_islessequal not_here("islessequal")
237# define c99_islessgreater not_here("islessgreater")
238# define c99_isnormal not_here("isnormal")
239# define c99_isunordered not_here("isunordered")
03397f96 240
7965edec
JH
241#endif /* #ifdef HAS_C99 */
242
03397f96
JH
243#ifdef HAS_J0
244# if defined(USE_LONG_DOUBLE) && defined(HAS_J0L)
7965edec
JH
245# define bessel_j0 j0l
246# define bessel_j1 j1l
247# define bessel_jn jnl
248# define bessel_y0 y0l
249# define bessel_y1 y1l
250# define bessel_yn ynl
251# else
252# define bessel_j0 j0
253# define bessel_j1 j1
254# define bessel_jn jn
255# define bessel_y0 y0
256# define bessel_y1 y1
257# define bessel_yn yn
258# endif
259#else
260# define bessel_j0 not_here("j0")
261# define bessel_j1 not_here("j1")
262# define bessel_jn not_here("jn")
263# define bessel_y0 not_here("y0")
264# define bessel_y1 not_here("y1")
265# define bessel_yn not_here("yn")
266#endif
267
bfce4ab3
JH
268/* XXX Regarding C99 math.h, Win32 seems to be missing these:
269
270 exp2 fdim fma fmax fmin fpclassify ilogb lgamma log1p log2 lrint
271 remquo rint signbit tgamma trunc
272
273 Win32 does seem to have these:
274
275 acosh asinh atanh cbrt copysign cosh erf erfc expm1 hypot log10 nan
276 nearbyint nextafter nexttoward remainder round scalbn
277
278 And the Bessel functions are defined like _this.
279*/
280
281#ifdef WIN32
282# undef c99_exp2
283# undef c99_fdim
284# undef c99_fma
285# undef c99_fmax
286# undef c99_fmin
287# undef c99_ilogb
288# undef c99_lgamma
289# undef c99_log1p
290# undef c99_log2
291# undef c99_lrint
292# undef c99_remquo
293# undef c99_rint
294# undef c99_signbit
295# undef c99_tgamma
296# undef c99_trunc
297
298# define c99_exp2(x) not_here("exp2")
299# define c99_fdim(x) not_here("fdim")
300# define c99_fma(x) not_here("fma")
301# define c99_fmax(x) not_here("fmax")
302# define c99_fmin(x) not_here("fmin")
303# define c99_ilogb(x) not_here("ilogb")
304# define c99_lgamma(x) not_here("lgamma")
305# define c99_log1p(x) not_here("log1p")
306# define c99_log2(x) not_here("log2")
307# define c99_lrint(x) not_here("lrint")
308# define c99_remquo(x,y) not_here("remquo")
309# define c99_rint(x) not_here("rint")
310# define c99_signbit(x) not_here("signbit")
311# define c99_tgamma(x) not_here("tgamma")
312# define c99_trunc(x) not_here("trunc")
313
314# undef bessel_j0
315# undef bessel_j1
316# undef bessel_j2
317# undef bessel_y0
318# undef bessel_y1
319# undef bessel_y2
320
321# define bessel_j0 _j0
322# define bessel_j1 _j1
323# define bessel_jn _jn
324# define bessel_y0 _y0
325# define bessel_y1 _y1
326# define bessel_yn _yn
327#endif
328
329/* XXX Some of the C99 math functions, if missing, could be rather
330 * trivially emulated: cbrt, exp2, log2, round, trunc...
331 *
332 * Keep in mind that the point of many of these functions is that
333 * they, if available, are supposed to give more precise/more
334 * numerically stable results. */
335
3609ea0d 336/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
a0d0e21e
LW
337 metaconfig for future extension writers. We don't use them in POSIX.
338 (This is really sneaky :-) --AD
339*/
340#if defined(I_TERMIOS)
341#include <termios.h>
342#endif
a0d0e21e 343#ifdef I_STDLIB
2304df62 344#include <stdlib.h>
a0d0e21e 345#endif
5518ecd4 346#ifndef __ultrix__
2304df62 347#include <string.h>
5518ecd4 348#endif
2304df62 349#include <sys/stat.h>
2304df62 350#include <sys/types.h>
2304df62 351#include <time.h>
6dead956 352#ifdef I_UNISTD
1d2dff63 353#include <unistd.h>
6dead956 354#endif
71be2cbc
PP
355#include <fcntl.h>
356
e2465f50 357#ifdef HAS_TZNAME
fb207d52 358# if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__)
e2465f50
JH
359extern char *tzname[];
360# endif
361#else
fb207d52 362#if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname))
e2465f50
JH
363char *tzname[] = { "" , "" };
364#endif
cb2479a8
JH
365#endif
366
6c418a22 367#if defined(__VMS) && !defined(__POSIX_SOURCE)
294c8bc4
CB
368
369# include <utsname.h>
6c418a22 370
6990d991 371# undef mkfifo
6c418a22 372# define mkfifo(a,b) (not_here("mkfifo"),-1)
6c418a22
PP
373
374 /* The POSIX notion of ttyname() is better served by getname() under VMS */
375 static char ttnambuf[64];
376# define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
377
6c418a22 378#else
d308986b 379#if defined (__CYGWIN__)
f89d6eaa
FE
380# define tzname _tzname
381#endif
2986a63f 382#if defined (WIN32) || defined (NETWARE)
6990d991 383# undef mkfifo
6dead956 384# define mkfifo(a,b) not_here("mkfifo")
873ef191 385# define ttyname(a) (char*)not_here("ttyname")
6dead956 386# define sigset_t long
86200d5c 387# define pid_t long
6dead956
GS
388# ifdef _MSC_VER
389# define mode_t short
390# endif
62520c91
GS
391# ifdef __MINGW32__
392# define mode_t short
f6c6487a
GS
393# ifndef tzset
394# define tzset() not_here("tzset")
395# endif
396# ifndef _POSIX_OPEN_MAX
397# define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */
398# endif
62520c91 399# endif
6dead956
GS
400# define sigaction(a,b,c) not_here("sigaction")
401# define sigpending(a) not_here("sigpending")
402# define sigprocmask(a,b,c) not_here("sigprocmask")
403# define sigsuspend(a) not_here("sigsuspend")
404# define sigemptyset(a) not_here("sigemptyset")
405# define sigaddset(a,b) not_here("sigaddset")
406# define sigdelset(a,b) not_here("sigdelset")
407# define sigfillset(a) not_here("sigfillset")
408# define sigismember(a,b) not_here("sigismember")
2986a63f 409#ifndef NETWARE
6e22d046
JH
410# undef setuid
411# undef setgid
2986a63f
JH
412# define setuid(a) not_here("setuid")
413# define setgid(a) not_here("setgid")
414#endif /* NETWARE */
73e21afd 415# define strtold(s1,s2) not_here("strtold")
6dead956 416#else
6990d991
JH
417
418# ifndef HAS_MKFIFO
e37778c2 419# if defined(OS2)
d6a255e6 420# define mkfifo(a,b) not_here("mkfifo")
3609ea0d 421# else /* !( defined OS2 ) */
d6a255e6
IZ
422# ifndef mkfifo
423# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
424# endif
6990d991
JH
425# endif
426# endif /* !HAS_MKFIFO */
427
e37778c2
NC
428# ifdef I_GRP
429# include <grp.h>
430# endif
431# include <sys/times.h>
432# ifdef HAS_UNAME
433# include <sys/utsname.h>
6c418a22 434# endif
e37778c2 435# include <sys/wait.h>
6c418a22
PP
436# ifdef I_UTIME
437# include <utime.h>
438# endif
2986a63f 439#endif /* WIN32 || NETWARE */
6dead956 440#endif /* __VMS */
2304df62
AD
441
442typedef int SysRet;
a0d0e21e 443typedef long SysRetLong;
2304df62
AD
444typedef sigset_t* POSIX__SigSet;
445typedef HV* POSIX__SigAction;
a0d0e21e
LW
446#ifdef I_TERMIOS
447typedef struct termios* POSIX__Termios;
448#else /* Define termios types to int, and call not_here for the functions.*/
449#define POSIX__Termios int
450#define speed_t int
451#define tcflag_t int
452#define cc_t int
453#define cfgetispeed(x) not_here("cfgetispeed")
454#define cfgetospeed(x) not_here("cfgetospeed")
455#define tcdrain(x) not_here("tcdrain")
456#define tcflush(x,y) not_here("tcflush")
457#define tcsendbreak(x,y) not_here("tcsendbreak")
458#define cfsetispeed(x,y) not_here("cfsetispeed")
459#define cfsetospeed(x,y) not_here("cfsetospeed")
460#define ctermid(x) (char *) not_here("ctermid")
461#define tcflow(x,y) not_here("tcflow")
462#define tcgetattr(x,y) not_here("tcgetattr")
463#define tcsetattr(x,y,z) not_here("tcsetattr")
464#endif
465
466/* Possibly needed prototypes */
6e22d046 467#ifndef WIN32
a2e65780 468START_EXTERN_C
20ce7b12
GS
469double strtod (const char *, char **);
470long strtol (const char *, char **, int);
471unsigned long strtoul (const char *, char **, int);
0ff7b9da
JH
472#ifdef HAS_STRTOLD
473long double strtold (const char *, char **);
474#endif
a2e65780 475END_EXTERN_C
6e22d046 476#endif
a0d0e21e 477
a0d0e21e
LW
478#ifndef HAS_DIFFTIME
479#ifndef difftime
480#define difftime(a,b) not_here("difftime")
481#endif
482#endif
483#ifndef HAS_FPATHCONF
3609ea0d 484#define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
a0d0e21e
LW
485#endif
486#ifndef HAS_MKTIME
487#define mktime(a) not_here("mktime")
8990e307
LW
488#endif
489#ifndef HAS_NICE
490#define nice(a) not_here("nice")
491#endif
a0d0e21e 492#ifndef HAS_PATHCONF
3609ea0d 493#define pathconf(f,n) (SysRetLong) not_here("pathconf")
a0d0e21e
LW
494#endif
495#ifndef HAS_SYSCONF
3609ea0d 496#define sysconf(n) (SysRetLong) not_here("sysconf")
a0d0e21e 497#endif
8990e307
LW
498#ifndef HAS_READLINK
499#define readlink(a,b,c) not_here("readlink")
500#endif
501#ifndef HAS_SETPGID
502#define setpgid(a,b) not_here("setpgid")
503#endif
8990e307
LW
504#ifndef HAS_SETSID
505#define setsid() not_here("setsid")
506#endif
a0d0e21e
LW
507#ifndef HAS_STRCOLL
508#define strcoll(s1,s2) not_here("strcoll")
509#endif
a89d8a78
DH
510#ifndef HAS_STRTOD
511#define strtod(s1,s2) not_here("strtod")
512#endif
0ff7b9da
JH
513#ifndef HAS_STRTOLD
514#define strtold(s1,s2) not_here("strtold")
515#endif
a89d8a78
DH
516#ifndef HAS_STRTOL
517#define strtol(s1,s2,b) not_here("strtol")
518#endif
519#ifndef HAS_STRTOUL
520#define strtoul(s1,s2,b) not_here("strtoul")
521#endif
a0d0e21e
LW
522#ifndef HAS_STRXFRM
523#define strxfrm(s1,s2,n) not_here("strxfrm")
8990e307
LW
524#endif
525#ifndef HAS_TCGETPGRP
526#define tcgetpgrp(a) not_here("tcgetpgrp")
527#endif
528#ifndef HAS_TCSETPGRP
529#define tcsetpgrp(a,b) not_here("tcsetpgrp")
530#endif
531#ifndef HAS_TIMES
2986a63f 532#ifndef NETWARE
8990e307 533#define times(a) not_here("times")
2986a63f 534#endif /* NETWARE */
8990e307
LW
535#endif
536#ifndef HAS_UNAME
537#define uname(a) not_here("uname")
538#endif
539#ifndef HAS_WAITPID
540#define waitpid(a,b,c) not_here("waitpid")
541#endif
542
a0d0e21e
LW
543#ifndef HAS_MBLEN
544#ifndef mblen
545#define mblen(a,b) not_here("mblen")
546#endif
547#endif
548#ifndef HAS_MBSTOWCS
549#define mbstowcs(s, pwcs, n) not_here("mbstowcs")
550#endif
551#ifndef HAS_MBTOWC
552#define mbtowc(pwc, s, n) not_here("mbtowc")
553#endif
554#ifndef HAS_WCSTOMBS
555#define wcstombs(s, pwcs, n) not_here("wcstombs")
556#endif
557#ifndef HAS_WCTOMB
558#define wctomb(s, wchar) not_here("wcstombs")
559#endif
560#if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
561/* If we don't have these functions, then we wouldn't have gotten a typedef
562 for wchar_t, the wide character type. Defining wchar_t allows the
563 functions referencing it to compile. Its actual type is then meaningless,
564 since without the above functions, all sections using it end up calling
565 not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
566#ifndef wchar_t
567#define wchar_t char
568#endif
569#endif
570
3f3bcbfc
KW
571#ifndef HAS_LOCALECONV
572# define localeconv() not_here("localeconv")
573#else
2f0945cb
NC
574struct lconv_offset {
575 const char *name;
576 size_t offset;
577};
578
579const struct lconv_offset lconv_strings[] = {
03ceeedf 580#ifdef USE_LOCALE_NUMERIC
3800c318
JH
581 {"decimal_point", STRUCT_OFFSET(struct lconv, decimal_point)},
582 {"thousands_sep", STRUCT_OFFSET(struct lconv, thousands_sep)},
03ceeedf 583# ifndef NO_LOCALECONV_GROUPING
3800c318 584 {"grouping", STRUCT_OFFSET(struct lconv, grouping)},
03ceeedf 585# endif
2f0945cb 586#endif
03ceeedf 587#ifdef USE_LOCALE_MONETARY
3800c318
JH
588 {"int_curr_symbol", STRUCT_OFFSET(struct lconv, int_curr_symbol)},
589 {"currency_symbol", STRUCT_OFFSET(struct lconv, currency_symbol)},
590 {"mon_decimal_point", STRUCT_OFFSET(struct lconv, mon_decimal_point)},
03ceeedf 591# ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
3800c318 592 {"mon_thousands_sep", STRUCT_OFFSET(struct lconv, mon_thousands_sep)},
03ceeedf
KW
593# endif
594# ifndef NO_LOCALECONV_MON_GROUPING
3800c318 595 {"mon_grouping", STRUCT_OFFSET(struct lconv, mon_grouping)},
03ceeedf 596# endif
3800c318
JH
597 {"positive_sign", STRUCT_OFFSET(struct lconv, positive_sign)},
598 {"negative_sign", STRUCT_OFFSET(struct lconv, negative_sign)},
03ceeedf 599#endif
2f0945cb
NC
600 {NULL, 0}
601};
602
c1284011
KW
603#ifdef USE_LOCALE_NUMERIC
604
605/* The Linux man pages say these are the field names for the structure
606 * components that are LC_NUMERIC; the rest being LC_MONETARY */
607# define isLC_NUMERIC_STRING(name) (strcmp(name, "decimal_point") \
608 || strcmp(name, "thousands_sep") \
609 \
610 /* There should be no harm done \
611 * checking for this, even if \
612 * NO_LOCALECONV_GROUPING */ \
613 || strcmp(name, "grouping"))
614#else
615# define isLC_NUMERIC_STRING(name) (0)
616#endif
617
2f0945cb 618const struct lconv_offset lconv_integers[] = {
03ceeedf 619#ifdef USE_LOCALE_MONETARY
3800c318
JH
620 {"int_frac_digits", STRUCT_OFFSET(struct lconv, int_frac_digits)},
621 {"frac_digits", STRUCT_OFFSET(struct lconv, frac_digits)},
622 {"p_cs_precedes", STRUCT_OFFSET(struct lconv, p_cs_precedes)},
623 {"p_sep_by_space", STRUCT_OFFSET(struct lconv, p_sep_by_space)},
624 {"n_cs_precedes", STRUCT_OFFSET(struct lconv, n_cs_precedes)},
625 {"n_sep_by_space", STRUCT_OFFSET(struct lconv, n_sep_by_space)},
626 {"p_sign_posn", STRUCT_OFFSET(struct lconv, p_sign_posn)},
627 {"n_sign_posn", STRUCT_OFFSET(struct lconv, n_sign_posn)},
03ceeedf 628#endif
2f0945cb
NC
629 {NULL, 0}
630};
631
3f3bcbfc 632#endif /* HAS_LOCALECONV */
a0d0e21e 633
172ea7c8 634#ifdef HAS_LONG_DOUBLE
53796371 635# if LONG_DOUBLESIZE > NVSIZE
172ea7c8
JH
636# undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
637# endif
638#endif
639
640#ifndef HAS_LONG_DOUBLE
641#ifdef LDBL_MAX
642#undef LDBL_MAX
643#endif
644#ifdef LDBL_MIN
645#undef LDBL_MIN
646#endif
647#ifdef LDBL_EPSILON
648#undef LDBL_EPSILON
649#endif
650#endif
651
ec193bec
JH
652/* Background: in most systems the low byte of the wait status
653 * is the signal (the lowest 7 bits) and the coredump flag is
654 * the eight bit, and the second lowest byte is the exit status.
655 * BeOS bucks the trend and has the bytes in different order.
656 * See beos/beos.c for how the reality is bent even in BeOS
657 * to follow the traditional. However, to make the POSIX
658 * wait W*() macros to work in BeOS, we need to unbend the
659 * reality back in place. --jhi */
17028706
IW
660/* In actual fact the code below is to blame here. Perl has an internal
661 * representation of the exit status ($?), which it re-composes from the
662 * OS's representation using the W*() POSIX macros. The code below
663 * incorrectly uses the W*() macros on the internal representation,
664 * which fails for OSs that have a different representation (namely BeOS
665 * and Haiku). WMUNGE() is a hack that converts the internal
666 * representation into the OS specific one, so that the W*() macros work
667 * as expected. The better solution would be not to use the W*() macros
668 * in the first place, though. -- Ingo Weinhold
669 */
b6c36746 670#if defined(__HAIKU__)
ec193bec
JH
671# define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
672#else
673# define WMUNGE(x) (x)
674#endif
675
8990e307 676static int
4b48cf39 677not_here(const char *s)
8990e307
LW
678{
679 croak("POSIX::%s not implemented on this architecture", s);
680 return -1;
681}
463ee0b2 682
1cb0fb50 683#include "const-c.inc"
a290f238 684
1dfe7606 685static void
40b7a5f5 686restore_sigmask(pTHX_ SV *osset_sv)
1dfe7606 687{
7feb700b
JH
688 /* Fortunately, restoring the signal mask can't fail, because
689 * there's nothing we can do about it if it does -- we're not
690 * supposed to return -1 from sigaction unless the disposition
691 * was unaffected.
692 */
7feb700b
JH
693 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
694 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
1dfe7606 695}
696
a2261f90
NC
697static void *
698allocate_struct(pTHX_ SV *rv, const STRLEN size, const char *packname) {
699 SV *const t = newSVrv(rv, packname);
700 void *const p = sv_grow(t, size + 1);
701
702 SvCUR_set(t, size);
703 SvPOK_on(t);
704 return p;
705}
706
81ab4c44
SH
707#ifdef WIN32
708
709/*
710 * (1) The CRT maintains its own copy of the environment, separate from
711 * the Win32API copy.
712 *
713 * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
714 * copy, and then calls SetEnvironmentVariableA() to update the Win32API
715 * copy.
716 *
717 * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
718 * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
719 * environment.
720 *
721 * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
722 * calls CRT tzset(), but only the first time it is called, and in turn
723 * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
724 * local copy of the environment and hence gets the original setting as
725 * perl never updates the CRT copy when assigning to $ENV{TZ}.
726 *
727 * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
728 * putenv() to update the CRT copy of the environment (if it is different)
729 * whenever we're about to call tzset().
730 *
731 * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
732 * defined:
733 *
734 * (a) Each interpreter has its own copy of the environment inside the
735 * perlhost structure. That allows applications that host multiple
736 * independent Perl interpreters to isolate environment changes from
737 * each other. (This is similar to how the perlhost mechanism keeps a
738 * separate working directory for each Perl interpreter, so that calling
739 * chdir() will not affect other interpreters.)
740 *
741 * (b) Only the first Perl interpreter instantiated within a process will
742 * "write through" environment changes to the process environment.
743 *
744 * (c) Even the primary Perl interpreter won't update the CRT copy of the
745 * the environment, only the Win32API copy (it calls win32_putenv()).
746 *
747 * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
748 * sense to only update the process environment when inside the main
749 * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
750 * from here so we'll just have to check PL_curinterp instead.
751 *
752 * Therefore, we can simply #undef getenv() and putenv() so that those names
753 * always refer to the CRT functions, and explicitly call win32_getenv() to
754 * access perl's %ENV.
755 *
756 * We also #undef malloc() and free() to be sure we are using the CRT
757 * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
758 * into VMem::Malloc() and VMem::Free() and all allocations will be freed
759 * when the Perl interpreter is being destroyed so we'd end up with a pointer
760 * into deallocated memory in environ[] if a program embedding a Perl
761 * interpreter continues to operate even after the main Perl interpreter has
762 * been destroyed.
763 *
764 * Note that we don't free() the malloc()ed memory unless and until we call
765 * malloc() again ourselves because the CRT putenv() function simply puts its
b7b1e41b 766 * pointer argument into the environ[] array (it doesn't make a copy of it)
81ab4c44
SH
767 * so this memory must otherwise be leaked.
768 */
769
770#undef getenv
771#undef putenv
772#undef malloc
773#undef free
774
775static void
776fix_win32_tzenv(void)
777{
778 static char* oldenv = NULL;
779 char* newenv;
780 const char* perl_tz_env = win32_getenv("TZ");
781 const char* crt_tz_env = getenv("TZ");
782 if (perl_tz_env == NULL)
783 perl_tz_env = "";
784 if (crt_tz_env == NULL)
785 crt_tz_env = "";
786 if (strcmp(perl_tz_env, crt_tz_env) != 0) {
787 newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
788 if (newenv != NULL) {
789 sprintf(newenv, "TZ=%s", perl_tz_env);
790 putenv(newenv);
791 if (oldenv != NULL)
792 free(oldenv);
793 oldenv = newenv;
794 }
795 }
796}
797
798#endif
799
800/*
801 * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
802 * This code is duplicated in the Time-Piece module, so any changes made here
803 * should be made there too.
804 */
805static void
806my_tzset(pTHX)
807{
808#ifdef WIN32
809#if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
810 if (PL_curinterp == aTHX)
811#endif
812 fix_win32_tzenv();
813#endif
814 tzset();
815}
816
fb52dbc1
NC
817typedef int (*isfunc_t)(int);
818typedef void (*any_dptr_t)(void *);
819
820/* This needs to be ALIASed in a custom way, hence can't easily be defined as
821 a regular XSUB. */
822static XSPROTO(is_common); /* prototype to pass -Wmissing-prototypes */
823static XSPROTO(is_common)
824{
825 dXSARGS;
2da736a2 826
fb52dbc1
NC
827 if (items != 1)
828 croak_xs_usage(cv, "charstring");
829
830 {
831 dXSTARG;
832 STRLEN len;
31e107a4
KW
833 /*int RETVAL = 0; YYY means uncomment this to return false on an
834 * empty string input */
fb52dbc1
NC
835 int RETVAL;
836 unsigned char *s = (unsigned char *) SvPV(ST(0), len);
837 unsigned char *e = s + len;
838 isfunc_t isfunc = (isfunc_t) XSANY.any_dptr;
839
2da736a2
KW
840 if (ckWARN_d(WARN_DEPRECATED)) {
841
842 /* Warn exactly once for each lexical place this function is
843 * called. See thread at
844 * http://markmail.org/thread/jhqcag5njmx7jpyu */
845
5c45bbe0
TC
846 HV *warned = get_hv("POSIX::_warned", GV_ADD | GV_ADDMULTI);
847 if (! hv_exists(warned, (const char *)&PL_op, sizeof(PL_op))) {
2da736a2
KW
848 Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
849 "Calling POSIX::%"HEKf"() is deprecated",
850 HEKfARG(GvNAME_HEK(CvGV(cv))));
5c45bbe0 851 hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
2da736a2
KW
852 }
853 }
854
31e107a4 855 /*if (e > s) { YYY */
fb52dbc1
NC
856 for (RETVAL = 1; RETVAL && s < e; s++)
857 if (!isfunc(*s))
858 RETVAL = 0;
31e107a4 859 /*} YYY */
fb52dbc1
NC
860 XSprePUSH;
861 PUSHi((IV)RETVAL);
862 }
863 XSRETURN(1);
864}
865
866MODULE = POSIX PACKAGE = POSIX
867
868BOOT:
869{
870 CV *cv;
871 const char *file = __FILE__;
872
df164f52
DM
873
874 /* silence compiler warning about not_here() defined but not used */
875 if (0) not_here("");
876
fb52dbc1
NC
877 /* Ensure we get the function, not a macro implementation. Like the C89
878 standard says we can... */
879#undef isalnum
880 cv = newXS("POSIX::isalnum", is_common, file);
881 XSANY.any_dptr = (any_dptr_t) &isalnum;
882#undef isalpha
883 cv = newXS("POSIX::isalpha", is_common, file);
884 XSANY.any_dptr = (any_dptr_t) &isalpha;
885#undef iscntrl
886 cv = newXS("POSIX::iscntrl", is_common, file);
887 XSANY.any_dptr = (any_dptr_t) &iscntrl;
888#undef isdigit
889 cv = newXS("POSIX::isdigit", is_common, file);
890 XSANY.any_dptr = (any_dptr_t) &isdigit;
891#undef isgraph
892 cv = newXS("POSIX::isgraph", is_common, file);
893 XSANY.any_dptr = (any_dptr_t) &isgraph;
894#undef islower
895 cv = newXS("POSIX::islower", is_common, file);
896 XSANY.any_dptr = (any_dptr_t) &islower;
897#undef isprint
898 cv = newXS("POSIX::isprint", is_common, file);
899 XSANY.any_dptr = (any_dptr_t) &isprint;
900#undef ispunct
901 cv = newXS("POSIX::ispunct", is_common, file);
902 XSANY.any_dptr = (any_dptr_t) &ispunct;
903#undef isspace
904 cv = newXS("POSIX::isspace", is_common, file);
905 XSANY.any_dptr = (any_dptr_t) &isspace;
906#undef isupper
907 cv = newXS("POSIX::isupper", is_common, file);
908 XSANY.any_dptr = (any_dptr_t) &isupper;
909#undef isxdigit
910 cv = newXS("POSIX::isxdigit", is_common, file);
911 XSANY.any_dptr = (any_dptr_t) &isxdigit;
912}
913
2304df62
AD
914MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
915
92b39396 916void
2304df62 917new(packname = "POSIX::SigSet", ...)
d3f5e399 918 const char * packname
2304df62
AD
919 CODE:
920 {
921 int i;
92b39396
NC
922 sigset_t *const s
923 = (sigset_t *) allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
924 sizeof(sigset_t),
925 packname);
926 sigemptyset(s);
a0d0e21e 927 for (i = 1; i < items; i++)
92b39396
NC
928 sigaddset(s, SvIV(ST(i)));
929 XSRETURN(1);
2304df62 930 }
2304df62
AD
931
932SysRet
df6c2df2 933addset(sigset, sig)
2304df62
AD
934 POSIX::SigSet sigset
935 int sig
df6c2df2
NC
936 ALIAS:
937 delset = 1
938 CODE:
939 RETVAL = ix ? sigdelset(sigset, sig) : sigaddset(sigset, sig);
940 OUTPUT:
941 RETVAL
2304df62
AD
942
943SysRet
df6c2df2 944emptyset(sigset)
2304df62 945 POSIX::SigSet sigset
df6c2df2
NC
946 ALIAS:
947 fillset = 1
948 CODE:
949 RETVAL = ix ? sigfillset(sigset) : sigemptyset(sigset);
950 OUTPUT:
951 RETVAL
2304df62
AD
952
953int
954sigismember(sigset, sig)
955 POSIX::SigSet sigset
956 int sig
957
a0d0e21e
LW
958MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
959
11a39fe4 960void
a0d0e21e 961new(packname = "POSIX::Termios", ...)
d3f5e399 962 const char * packname
a0d0e21e
LW
963 CODE:
964 {
965#ifdef I_TERMIOS
a2261f90
NC
966 void *const p = allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
967 sizeof(struct termios), packname);
11a39fe4
NC
968 /* The previous implementation stored a pointer to an uninitialised
969 struct termios. Seems safer to initialise it, particularly as
970 this implementation exposes the struct to prying from perl-space.
971 */
a2261f90 972 memset(p, 0, 1 + sizeof(struct termios));
11a39fe4 973 XSRETURN(1);
a0d0e21e
LW
974#else
975 not_here("termios");
976#endif
977 }
a0d0e21e
LW
978
979SysRet
980getattr(termios_ref, fd = 0)
981 POSIX::Termios termios_ref
982 int fd
983 CODE:
984 RETVAL = tcgetattr(fd, termios_ref);
985 OUTPUT:
986 RETVAL
987
e08f19f5
TC
988# If we define TCSANOW here then both a found and not found constant sub
989# are created causing a Constant subroutine TCSANOW redefined warning
518487b2 990#ifndef TCSANOW
e08f19f5
TC
991# define DEF_SETATTR_ACTION 0
992#else
993# define DEF_SETATTR_ACTION TCSANOW
518487b2 994#endif
a0d0e21e 995SysRet
e08f19f5 996setattr(termios_ref, fd = 0, optional_actions = DEF_SETATTR_ACTION)
a0d0e21e
LW
997 POSIX::Termios termios_ref
998 int fd
999 int optional_actions
1000 CODE:
518487b2
NC
1001 /* The second argument to the call is mandatory, but we'd like to give
1002 it a useful default. 0 isn't valid on all operating systems - on
1003 Solaris (at least) TCSANOW, TCSADRAIN and TCSAFLUSH have the same
1004 values as the equivalent ioctls, TCSETS, TCSETSW and TCSETSF. */
a0d0e21e
LW
1005 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
1006 OUTPUT:
1007 RETVAL
1008
1009speed_t
2a59a32c 1010getispeed(termios_ref)
a0d0e21e 1011 POSIX::Termios termios_ref
2a59a32c
NC
1012 ALIAS:
1013 getospeed = 1
a0d0e21e 1014 CODE:
2a59a32c 1015 RETVAL = ix ? cfgetospeed(termios_ref) : cfgetispeed(termios_ref);
a0d0e21e
LW
1016 OUTPUT:
1017 RETVAL
1018
1019tcflag_t
2a59a32c 1020getiflag(termios_ref)
a0d0e21e 1021 POSIX::Termios termios_ref
2a59a32c
NC
1022 ALIAS:
1023 getoflag = 1
1024 getcflag = 2
1025 getlflag = 3
a0d0e21e
LW
1026 CODE:
1027#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
2a59a32c
NC
1028 switch(ix) {
1029 case 0:
1030 RETVAL = termios_ref->c_iflag;
1031 break;
1032 case 1:
1033 RETVAL = termios_ref->c_oflag;
1034 break;
1035 case 2:
1036 RETVAL = termios_ref->c_cflag;
1037 break;
1038 case 3:
1039 RETVAL = termios_ref->c_lflag;
1040 break;
df164f52
DM
1041 default:
1042 RETVAL = 0; /* silence compiler warning */
2a59a32c 1043 }
a0d0e21e 1044#else
2a59a32c
NC
1045 not_here(GvNAME(CvGV(cv)));
1046 RETVAL = 0;
a0d0e21e
LW
1047#endif
1048 OUTPUT:
1049 RETVAL
1050
1051cc_t
1052getcc(termios_ref, ccix)
1053 POSIX::Termios termios_ref
b56fc9ec 1054 unsigned int ccix
a0d0e21e
LW
1055 CODE:
1056#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
1057 if (ccix >= NCCS)
1058 croak("Bad getcc subscript");
1059 RETVAL = termios_ref->c_cc[ccix];
1060#else
640cc986
HM
1061 not_here("getcc");
1062 RETVAL = 0;
a0d0e21e
LW
1063#endif
1064 OUTPUT:
1065 RETVAL
1066
1067SysRet
2a59a32c 1068setispeed(termios_ref, speed)
a0d0e21e
LW
1069 POSIX::Termios termios_ref
1070 speed_t speed
2a59a32c
NC
1071 ALIAS:
1072 setospeed = 1
a0d0e21e 1073 CODE:
2a59a32c
NC
1074 RETVAL = ix
1075 ? cfsetospeed(termios_ref, speed) : cfsetispeed(termios_ref, speed);
1076 OUTPUT:
1077 RETVAL
a0d0e21e
LW
1078
1079void
2a59a32c 1080setiflag(termios_ref, flag)
a0d0e21e 1081 POSIX::Termios termios_ref
2a59a32c
NC
1082 tcflag_t flag
1083 ALIAS:
1084 setoflag = 1
1085 setcflag = 2
1086 setlflag = 3
a0d0e21e
LW
1087 CODE:
1088#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
2a59a32c
NC
1089 switch(ix) {
1090 case 0:
1091 termios_ref->c_iflag = flag;
1092 break;
1093 case 1:
1094 termios_ref->c_oflag = flag;
1095 break;
1096 case 2:
1097 termios_ref->c_cflag = flag;
1098 break;
1099 case 3:
1100 termios_ref->c_lflag = flag;
1101 break;
1102 }
a0d0e21e 1103#else
2a59a32c 1104 not_here(GvNAME(CvGV(cv)));
a0d0e21e
LW
1105#endif
1106
1107void
1108setcc(termios_ref, ccix, cc)
1109 POSIX::Termios termios_ref
b56fc9ec 1110 unsigned int ccix
a0d0e21e
LW
1111 cc_t cc
1112 CODE:
1113#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
1114 if (ccix >= NCCS)
1115 croak("Bad setcc subscript");
1116 termios_ref->c_cc[ccix] = cc;
1117#else
1118 not_here("setcc");
1119#endif
1120
1121
a0d0e21e
LW
1122MODULE = POSIX PACKAGE = POSIX
1123
1cb0fb50 1124INCLUDE: const-xs.inc
a290f238 1125
e99d581a
NC
1126int
1127WEXITSTATUS(status)
1128 int status
72bfe1b2
NC
1129 ALIAS:
1130 POSIX::WIFEXITED = 1
1131 POSIX::WIFSIGNALED = 2
1132 POSIX::WIFSTOPPED = 3
1133 POSIX::WSTOPSIG = 4
1134 POSIX::WTERMSIG = 5
1135 CODE:
fabb67aa
SK
1136#if !defined(WEXITSTATUS) || !defined(WIFEXITED) || !defined(WIFSIGNALED) \
1137 || !defined(WIFSTOPPED) || !defined(WSTOPSIG) || !defined(WTERMSIG)
19c4478c
NC
1138 RETVAL = 0; /* Silence compilers that notice this, but don't realise
1139 that not_here() can't return. */
1140#endif
72bfe1b2
NC
1141 switch(ix) {
1142 case 0:
d49025b7 1143#ifdef WEXITSTATUS
17028706 1144 RETVAL = WEXITSTATUS(WMUNGE(status));
d49025b7
NC
1145#else
1146 not_here("WEXITSTATUS");
1147#endif
72bfe1b2
NC
1148 break;
1149 case 1:
d49025b7 1150#ifdef WIFEXITED
17028706 1151 RETVAL = WIFEXITED(WMUNGE(status));
d49025b7
NC
1152#else
1153 not_here("WIFEXITED");
1154#endif
72bfe1b2
NC
1155 break;
1156 case 2:
d49025b7 1157#ifdef WIFSIGNALED
17028706 1158 RETVAL = WIFSIGNALED(WMUNGE(status));
d49025b7
NC
1159#else
1160 not_here("WIFSIGNALED");
1161#endif
72bfe1b2
NC
1162 break;
1163 case 3:
d49025b7 1164#ifdef WIFSTOPPED
17028706 1165 RETVAL = WIFSTOPPED(WMUNGE(status));
d49025b7
NC
1166#else
1167 not_here("WIFSTOPPED");
1168#endif
72bfe1b2
NC
1169 break;
1170 case 4:
d49025b7 1171#ifdef WSTOPSIG
17028706 1172 RETVAL = WSTOPSIG(WMUNGE(status));
d49025b7
NC
1173#else
1174 not_here("WSTOPSIG");
1175#endif
72bfe1b2
NC
1176 break;
1177 case 5:
d49025b7 1178#ifdef WTERMSIG
17028706 1179 RETVAL = WTERMSIG(WMUNGE(status));
d49025b7
NC
1180#else
1181 not_here("WTERMSIG");
1182#endif
72bfe1b2
NC
1183 break;
1184 default:
c33e8be1 1185 Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", (int)ix);
72bfe1b2
NC
1186 }
1187 OUTPUT:
1188 RETVAL
2304df62 1189
2304df62
AD
1190SysRet
1191open(filename, flags = O_RDONLY, mode = 0666)
1192 char * filename
1193 int flags
a0d0e21e 1194 Mode_t mode
748a9306
LW
1195 CODE:
1196 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
1197 TAINT_PROPER("open");
1198 RETVAL = open(filename, flags, mode);
1199 OUTPUT:
1200 RETVAL
1201
2304df62
AD
1202
1203HV *
1204localeconv()
1205 CODE:
3f3bcbfc
KW
1206#ifndef HAS_LOCALECONV
1207 localeconv(); /* A stub to call not_here(). */
1208#else
2304df62 1209 struct lconv *lcbuf;
a835cd47
KW
1210
1211 /* localeconv() deals with both LC_NUMERIC and LC_MONETARY, but
1212 * LC_MONETARY is already in the correct locale */
1213 STORE_NUMERIC_STANDARD_FORCE_LOCAL();
1214
2304df62 1215 RETVAL = newHV();
c4e79b56 1216 sv_2mortal((SV*)RETVAL);
8063af02 1217 if ((lcbuf = localeconv())) {
2f0945cb
NC
1218 const struct lconv_offset *strings = lconv_strings;
1219 const struct lconv_offset *integers = lconv_integers;
1220 const char *ptr = (const char *) lcbuf;
1221
1222 do {
c1284011
KW
1223 /* This string may be controlled by either LC_NUMERIC, or
1224 * LC_MONETARY */
1225 bool is_utf8_locale
1226#if defined(USE_LOCALE_NUMERIC) && defined(USE_LOCALE_MONETARY)
1227 = _is_cur_LC_category_utf8((isLC_NUMERIC_STRING(strings->name))
1228 ? LC_NUMERIC
1229 : LC_MONETARY);
1230#elif defined(USE_LOCALE_NUMERIC)
1231 = _is_cur_LC_category_utf8(LC_NUMERIC);
1232#elif defined(USE_LOCALE_MONETARY)
1233 = _is_cur_LC_category_utf8(LC_MONETARY);
1234#else
1235 = FALSE;
1236#endif
1237
2f0945cb
NC
1238 const char *value = *((const char **)(ptr + strings->offset));
1239
c1284011
KW
1240 if (value && *value) {
1241 (void) hv_store(RETVAL,
1242 strings->name,
1243 strlen(strings->name),
1244 newSVpvn_utf8(value,
1245 strlen(value),
1246
1247 /* We mark it as UTF-8 if a utf8 locale
1248 * and is valid, non-ascii UTF-8 */
1249 is_utf8_locale
1250 && ! is_ascii_string((U8 *) value, 0)
1251 && is_utf8_string((U8 *) value, 0)),
1252 0);
1253 }
2f0945cb
NC
1254 } while ((++strings)->name);
1255
1256 do {
1257 const char value = *((const char *)(ptr + integers->offset));
1258
1259 if (value != CHAR_MAX)
1260 (void) hv_store(RETVAL, integers->name,
1261 strlen(integers->name), newSViv(value), 0);
1262 } while ((++integers)->name);
2304df62 1263 }
a835cd47 1264 RESTORE_NUMERIC_STANDARD();
3f3bcbfc 1265#endif /* HAS_LOCALECONV */
2304df62
AD
1266 OUTPUT:
1267 RETVAL
1268
1269char *
c28ee57b 1270setlocale(category, locale = 0)
2304df62 1271 int category
8e70cf7a 1272 const char * locale
1ba01ae3
SH
1273 PREINIT:
1274 char * retval;
c28ee57b 1275 CODE:
49efabc8
KW
1276#ifdef USE_LOCALE_NUMERIC
1277 /* A 0 (or NULL) locale means only query what the current one is. We
1278 * have the LC_NUMERIC name saved, because we are normally switched
1279 * into the C locale for it. Switch back so an LC_ALL query will yield
1280 * the correct results; all other categories don't require special
1281 * handling */
1282 if (locale == 0) {
1283 if (category == LC_NUMERIC) {
1284 XSRETURN_PV(PL_numeric_name);
1285 }
1286# ifdef LC_ALL
1287 else if (category == LC_ALL) {
1288 SET_NUMERIC_LOCAL();
1289 }
1290# endif
1291 }
1292#endif
b385bb4d
KW
1293#ifdef WIN32 /* Use wrapper on Windows */
1294 retval = Perl_my_setlocale(aTHX_ category, locale);
1295#else
1ba01ae3 1296 retval = setlocale(category, locale);
b385bb4d 1297#endif
fbd840df 1298 if (! retval) {
49efabc8
KW
1299 /* Should never happen that a query would return an error, but be
1300 * sure and reset to C locale */
1301 if (locale == 0) {
1302 SET_NUMERIC_STANDARD();
1303 }
fbd840df
KW
1304 XSRETURN_UNDEF;
1305 }
49efabc8
KW
1306
1307 /* Save retval since subsequent setlocale() calls may overwrite it. */
1308 retval = savepv(retval);
1309
1310 /* For locale == 0, we may have switched to NUMERIC_LOCAL. Switch back
1311 * */
1312 if (locale == 0) {
1313 SET_NUMERIC_STANDARD();
1314 XSRETURN_PV(retval);
1315 }
fbd840df 1316 else {
49efabc8 1317 RETVAL = retval;
36477c24 1318#ifdef USE_LOCALE_CTYPE
bbce6d69
PP
1319 if (category == LC_CTYPE
1320#ifdef LC_ALL
1321 || category == LC_ALL
1322#endif
1323 )
1324 {
1325 char *newctype;
1326#ifdef LC_ALL
1327 if (category == LC_ALL)
1328 newctype = setlocale(LC_CTYPE, NULL);
1329 else
1330#endif
1331 newctype = RETVAL;
864dbfa3 1332 new_ctype(newctype);
bbce6d69 1333 }
36477c24
PP
1334#endif /* USE_LOCALE_CTYPE */
1335#ifdef USE_LOCALE_COLLATE
bbce6d69
PP
1336 if (category == LC_COLLATE
1337#ifdef LC_ALL
1338 || category == LC_ALL
1339#endif
1340 )
1341 {
1342 char *newcoll;
1343#ifdef LC_ALL
1344 if (category == LC_ALL)
1345 newcoll = setlocale(LC_COLLATE, NULL);
1346 else
1347#endif
1348 newcoll = RETVAL;
864dbfa3 1349 new_collate(newcoll);
bbce6d69 1350 }
36477c24
PP
1351#endif /* USE_LOCALE_COLLATE */
1352#ifdef USE_LOCALE_NUMERIC
bbce6d69
PP
1353 if (category == LC_NUMERIC
1354#ifdef LC_ALL
1355 || category == LC_ALL
1356#endif
1357 )
1358 {
1359 char *newnum;
1360#ifdef LC_ALL
1361 if (category == LC_ALL)
1362 newnum = setlocale(LC_NUMERIC, NULL);
1363 else
1364#endif
1365 newnum = RETVAL;
864dbfa3 1366 new_numeric(newnum);
bbce6d69 1367 }
36477c24 1368#endif /* USE_LOCALE_NUMERIC */
bbce6d69 1369 }
c28ee57b
JH
1370 OUTPUT:
1371 RETVAL
1ba01ae3 1372 CLEANUP:
fbd840df 1373 Safefree(RETVAL);
2304df62 1374
e1ca407b 1375NV
2304df62 1376acos(x)
e1ca407b 1377 NV x
b256643b 1378 ALIAS:
7965edec
JH
1379 acosh = 1
1380 asin = 2
1381 asinh = 3
1382 atan = 4
1383 atanh = 5
1384 cbrt = 6
1385 ceil = 7
1386 cosh = 8
1387 erf = 9
1388 erfc = 10
1389 exp2 = 11
1390 expm1 = 12
1391 floor = 13
1392 j0 = 14
1393 j1 = 15
1394 lgamma = 16
1395 log10 = 17
1396 log1p = 18
1397 log2 = 19
1398 logb = 20
1399 nearbyint = 21
1400 rint = 22
1401 round = 23
1402 sinh = 24
1403 tan = 25
1404 tanh = 26
1405 tgamma = 27
1406 trunc = 28
1407 y0 = 29
1408 y1 = 30
b256643b
NC
1409 CODE:
1410 switch (ix) {
1411 case 0:
1412 RETVAL = acos(x);
1413 break;
1414 case 1:
7965edec 1415 RETVAL = c99_acosh(x);
b256643b
NC
1416 break;
1417 case 2:
7965edec 1418 RETVAL = asin(x);
b256643b
NC
1419 break;
1420 case 3:
7965edec 1421 RETVAL = c99_asinh(x);
b256643b
NC
1422 break;
1423 case 4:
7965edec 1424 RETVAL = atan(x);
b256643b
NC
1425 break;
1426 case 5:
7965edec 1427 RETVAL = c99_atanh(x);
b256643b
NC
1428 break;
1429 case 6:
7965edec 1430 RETVAL = c99_cbrt(x);
b256643b
NC
1431 break;
1432 case 7:
7965edec 1433 RETVAL = ceil(x);
b256643b
NC
1434 break;
1435 case 8:
7965edec
JH
1436 RETVAL = c99_cosh(x);
1437 break;
1438 case 9:
1439 RETVAL = c99_erf(x);
1440 break;
1441 case 10:
1442 RETVAL = c99_erfc(x);
1443 break;
1444 case 11:
1445 RETVAL = c99_exp2(x);
1446 break;
1447 case 12:
1448 RETVAL = c99_expm1(x);
1449 break;
1450 case 13:
1451 RETVAL = floor(x);
1452 break;
1453 case 14:
1454 RETVAL = bessel_j0(x);
1455 break;
1456 case 15:
1457 RETVAL = bessel_j1(x);
1458 break;
1459 case 16:
1460 /* XXX lgamma_r */
1461 RETVAL = c99_lgamma(x);
1462 break;
1463 case 17:
1464 RETVAL = log10(x);
1465 break;
1466 case 18:
1467 RETVAL = c99_log1p(x);
1468 break;
1469 case 19:
1470 RETVAL = c99_log2(x);
1471 break;
1472 case 20:
1473 RETVAL = c99_logb(x);
1474 break;
1475 case 21:
1476 RETVAL = c99_nearbyint(x);
1477 break;
1478 case 22:
1479 RETVAL = c99_rint(x);
1480 break;
1481 case 23:
1482 RETVAL = c99_round(x);
1483 break;
1484 case 24:
1485 RETVAL = c99_sinh(x);
1486 break;
1487 case 25:
b256643b
NC
1488 RETVAL = tan(x);
1489 break;
7965edec 1490 case 26:
b256643b 1491 RETVAL = tanh(x);
7965edec
JH
1492 break;
1493 case 27:
1494 /* XXX tgamma_r */
1495 RETVAL = c99_tgamma(x);
1496 break;
1497 case 28:
1498 RETVAL = c99_trunc(x);
1499 break;
1500 case 29:
1501 RETVAL = bessel_y0(x);
1502 break;
1503 case 30:
1504 default:
1505 RETVAL = bessel_y1(x);
1506 }
1507 OUTPUT:
1508 RETVAL
1509
1510IV
1511fpclassify(x)
1512 NV x
1513 ALIAS:
1514 ilogb = 1
1515 isfinite = 2
1516 isinf = 3
1517 isnan = 4
1518 isnormal = 5
1519 signbit = 6
1520 CODE:
1521 switch (ix) {
1522 case 0:
1523 RETVAL = c99_fpclassify(x);
1524 break;
1525 case 1:
1526 RETVAL = c99_ilogb(x);
1527 break;
1528 case 2:
1529 RETVAL = Perl_isfinite(x);
1530 break;
1531 case 3:
1532 RETVAL = Perl_isinf(x);
1533 break;
1534 case 4:
1535 RETVAL = Perl_isnan(x);
1536 break;
1537 case 5:
1538 RETVAL = c99_isnormal(x);
1539 break;
1540 case 6:
1541 default:
1542 RETVAL = c99_signbit(x);
1543 break;
b256643b
NC
1544 }
1545 OUTPUT:
1546 RETVAL
2304df62 1547
e1ca407b 1548NV
7965edec 1549copysign(x,y)
e1ca407b
A
1550 NV x
1551 NV y
7965edec
JH
1552 ALIAS:
1553 fdim = 1
1554 fmax = 2
1555 fmin = 3
1556 fmod = 4
1557 hypot = 5
1558 isgreater = 6
1559 isgreaterequal = 7
1560 isless = 8
1561 islessequal = 9
1562 islessgreater = 10
1563 isunordered = 11
1564 nextafter = 12
1565 nexttoward = 13
1566 remainder = 14
1567 CODE:
1568 switch (ix) {
1569 case 0:
1570 RETVAL = c99_copysign(x, y);
1571 break;
1572 case 1:
1573 RETVAL = c99_fdim(x, y);
1574 break;
1575 case 2:
1576 RETVAL = c99_fmax(x, y);
1577 break;
1578 case 3:
1579 RETVAL = c99_fmin(x, y);
1580 break;
1581 case 4:
1582 RETVAL = fmod(x, y);
1583 break;
1584 case 5:
1585 RETVAL = c99_hypot(x, y);
1586 break;
1587 case 6:
1588 RETVAL = c99_isgreater(x, y);
1589 break;
1590 case 7:
1591 RETVAL = c99_isgreaterequal(x, y);
1592 break;
1593 case 8:
1594 RETVAL = c99_isless(x, y);
1595 break;
1596 case 9:
1597 RETVAL = c99_islessequal(x, y);
1598 break;
1599 case 10:
1600 RETVAL = c99_islessgreater(x, y);
1601 break;
1602 case 11:
1603 RETVAL = c99_isunordered(x, y);
1604 break;
1605 case 12:
1606 RETVAL = c99_nextafter(x, y);
1607 break;
1608 case 13:
1609 RETVAL = c99_nexttoward(x, y);
1610 break;
1611 case 14:
1612 default:
1613 RETVAL = c99_remainder(x, y);
1614 break;
1615 }
1616 OUTPUT:
1617 RETVAL
2304df62
AD
1618
1619void
1620frexp(x)
e1ca407b 1621 NV x
2304df62
AD
1622 PPCODE:
1623 int expvar;
2304df62
AD
1624 /* (We already know stack is long enough.) */
1625 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1626 PUSHs(sv_2mortal(newSViv(expvar)));
1627
e1ca407b 1628NV
2304df62 1629ldexp(x,exp)
e1ca407b 1630 NV x
2304df62
AD
1631 int exp
1632
2304df62
AD
1633void
1634modf(x)
e1ca407b 1635 NV x
2304df62 1636 PPCODE:
e1ca407b 1637 NV intvar;
2304df62 1638 /* (We already know stack is long enough.) */
bf4acbe4 1639 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
2304df62
AD
1640 PUSHs(sv_2mortal(newSVnv(intvar)));
1641
7965edec
JH
1642void
1643remquo(x,y)
1644 NV x
1645 NV y
1646 PPCODE:
1647 int intvar;
1648 PUSHs(sv_2mortal(newSVnv(c99_remquo(x,y,&intvar))));
1649 PUSHs(sv_2mortal(newSVnv(intvar)));
1650
1651NV
1652scalbn(x,y)
1653 NV x
1654 IV y
1655 CODE:
1656 RETVAL = c99_scalbn(x, y);
1657 OUTPUT:
1658 RETVAL
1659
1660NV
1661fma(x,y,z)
1662 NV x
1663 NV y
1664 NV z
1665 CODE:
1666 RETVAL = c99_fma(x, y, z);
1667 OUTPUT:
1668 RETVAL
1669
1670NV
1671nan(s = 0)
1672 char* s;
1673 CODE:
1674 RETVAL = c99_nan(s);
1675 OUTPUT:
1676 RETVAL
1677
1678NV
1679jn(x,y)
1680 IV x
1681 NV y
1682 ALIAS:
1683 yn = 1
1684 CODE:
1685 switch (ix) {
1686 case 0:
1687 RETVAL = bessel_jn(x, y);
1688 break;
1689 case 1:
1690 default:
1691 RETVAL = bessel_yn(x, y);
1692 break;
1693 }
1694 OUTPUT:
1695 RETVAL
1696
2304df62 1697SysRet
1dfe7606 1698sigaction(sig, optaction, oldaction = 0)
2304df62 1699 int sig
1dfe7606 1700 SV * optaction
2304df62
AD
1701 POSIX::SigAction oldaction
1702 CODE:
2986a63f 1703#if defined(WIN32) || defined(NETWARE)
6dead956
GS
1704 RETVAL = not_here("sigaction");
1705#else
2304df62
AD
1706# This code is really grody because we're trying to make the signal
1707# interface look beautiful, which is hard.
1708
2304df62 1709 {
27da23d5 1710 dVAR;
1dfe7606 1711 POSIX__SigAction action;
f584eb2d 1712 GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
2304df62
AD
1713 struct sigaction act;
1714 struct sigaction oact;
1dfe7606 1715 sigset_t sset;
183bde56 1716 SV *osset_sv;
27c1a449 1717 sigset_t osset;
2304df62
AD
1718 POSIX__SigSet sigset;
1719 SV** svp;
1d81eac9 1720 SV** sigsvp;
3609ea0d 1721
516d25e8
SP
1722 if (sig < 0) {
1723 croak("Negative signals are not allowed");
1724 }
1725
1d81eac9 1726 if (sig == 0 && SvPOK(ST(0))) {
aa07b2f6 1727 const char *s = SvPVX_const(ST(0));
1d81eac9
JH
1728 int i = whichsig(s);
1729
1730 if (i < 0 && memEQ(s, "SIG", 3))
1731 i = whichsig(s + 3);
1732 if (i < 0) {
1733 if (ckWARN(WARN_SIGNAL))
1734 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1735 "No such signal: SIG%s", s);
1736 XSRETURN_UNDEF;
1737 }
1738 else
1739 sig = i;
1740 }
3609ea0d
JH
1741#ifdef NSIG
1742 if (sig > NSIG) { /* NSIG - 1 is still okay. */
1743 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1744 "No such signal: %d", sig);
1745 XSRETURN_UNDEF;
1746 }
1747#endif
1d81eac9
JH
1748 sigsvp = hv_fetch(GvHVn(siggv),
1749 PL_sig_name[sig],
1750 strlen(PL_sig_name[sig]),
1751 TRUE);
2304df62 1752
1dfe7606 1753 /* Check optaction and set action */
1754 if(SvTRUE(optaction)) {
1755 if(sv_isa(optaction, "POSIX::SigAction"))
1756 action = (HV*)SvRV(optaction);
1757 else
1758 croak("action is not of type POSIX::SigAction");
1759 }
1760 else {
1761 action=0;
1762 }
1763
1764 /* sigaction() is supposed to look atomic. In particular, any
1765 * signal handler invoked during a sigaction() call should
1766 * see either the old or the new disposition, and not something
1767 * in between. We use sigprocmask() to make it so.
1768 */
1769 sigfillset(&sset);
1770 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1771 if(RETVAL == -1)
15c0d34a 1772 XSRETURN_UNDEF;
1dfe7606 1773 ENTER;
1774 /* Restore signal mask no matter how we exit this block. */
f584eb2d 1775 osset_sv = newSVpvn((char *)(&osset), sizeof(sigset_t));
183bde56 1776 SAVEFREESV( osset_sv );
40b7a5f5 1777 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1dfe7606 1778
1779 RETVAL=-1; /* In case both oldaction and action are 0. */
1780
1781 /* Remember old disposition if desired. */
2304df62 1782 if (oldaction) {
017a3ce5 1783 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
1dfe7606 1784 if(!svp)
1785 croak("Can't supply an oldaction without a HANDLER");
1786 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1787 sv_setsv(*svp, *sigsvp);
1788 }
1789 else {
f584eb2d 1790 sv_setpvs(*svp, "DEFAULT");
1dfe7606 1791 }
1792 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
6ca4bbc9
GG
1793 if(RETVAL == -1) {
1794 LEAVE;
15c0d34a 1795 XSRETURN_UNDEF;
6ca4bbc9 1796 }
1dfe7606 1797 /* Get back the mask. */
017a3ce5 1798 svp = hv_fetchs(oldaction, "MASK", TRUE);
1dfe7606 1799 if (sv_isa(*svp, "POSIX::SigSet")) {
92b39396 1800 sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
1dfe7606 1801 }
1802 else {
92b39396
NC
1803 sigset = (sigset_t *) allocate_struct(aTHX_ *svp,
1804 sizeof(sigset_t),
1805 "POSIX::SigSet");
1dfe7606 1806 }
1807 *sigset = oact.sa_mask;
1808
1809 /* Get back the flags. */
017a3ce5 1810 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
1dfe7606 1811 sv_setiv(*svp, oact.sa_flags);
d36b6582
CS
1812
1813 /* Get back whether the old handler used safe signals. */
017a3ce5 1814 svp = hv_fetchs(oldaction, "SAFE", TRUE);
e91e3b10
RB
1815 sv_setiv(*svp,
1816 /* compare incompatible pointers by casting to integer */
1817 PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
2304df62
AD
1818 }
1819
1820 if (action) {
d36b6582
CS
1821 /* Safe signals use "csighandler", which vectors through the
1822 PL_sighandlerp pointer when it's safe to do so.
1823 (BTW, "csighandler" is very different from "sighandler".) */
017a3ce5 1824 svp = hv_fetchs(action, "SAFE", FALSE);
e91e3b10
RB
1825 act.sa_handler =
1826 DPTR2FPTR(
87d46f97 1827 void (*)(int),
e91e3b10
RB
1828 (*svp && SvTRUE(*svp))
1829 ? PL_csighandlerp : PL_sighandlerp
1830 );
d36b6582
CS
1831
1832 /* Vector new Perl handler through %SIG.
1833 (The core signal handlers read %SIG to dispatch.) */
017a3ce5 1834 svp = hv_fetchs(action, "HANDLER", FALSE);
2304df62
AD
1835 if (!svp)
1836 croak("Can't supply an action without a HANDLER");
1dfe7606 1837 sv_setsv(*sigsvp, *svp);
d36b6582
CS
1838
1839 /* This call actually calls sigaction() with almost the
1840 right settings, including appropriate interpretation
1841 of DEFAULT and IGNORE. However, why are we doing
1842 this when we're about to do it again just below? XXX */
17cffb37 1843 SvSETMAGIC(*sigsvp);
d36b6582
CS
1844
1845 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1dfe7606 1846 if(SvPOK(*svp)) {
aa07b2f6 1847 const char *s=SvPVX_const(*svp);
1dfe7606 1848 if(strEQ(s,"IGNORE")) {
1849 act.sa_handler = SIG_IGN;
1850 }
1851 else if(strEQ(s,"DEFAULT")) {
1852 act.sa_handler = SIG_DFL;
1853 }
1dfe7606 1854 }
2304df62
AD
1855
1856 /* Set up any desired mask. */
017a3ce5 1857 svp = hv_fetchs(action, "MASK", FALSE);
2304df62 1858 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
92b39396 1859 sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
2304df62
AD
1860 act.sa_mask = *sigset;
1861 }
1862 else
85e6fe83 1863 sigemptyset(& act.sa_mask);
2304df62
AD
1864
1865 /* Set up any desired flags. */
017a3ce5 1866 svp = hv_fetchs(action, "FLAGS", FALSE);
2304df62 1867 act.sa_flags = svp ? SvIV(*svp) : 0;
2304df62 1868
1dfe7606 1869 /* Don't worry about cleaning up *sigsvp if this fails,
1870 * because that means we tried to disposition a
1871 * nonblockable signal, in which case *sigsvp is
1872 * essentially meaningless anyway.
1873 */
6c418a22 1874 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
6ca4bbc9
GG
1875 if(RETVAL == -1) {
1876 LEAVE;
a7aad5de 1877 XSRETURN_UNDEF;
6ca4bbc9 1878 }
2304df62 1879 }
1dfe7606 1880
1881 LEAVE;
2304df62 1882 }
6dead956 1883#endif
2304df62
AD
1884 OUTPUT:
1885 RETVAL
1886
1887SysRet
1888sigpending(sigset)
1889 POSIX::SigSet sigset
7a004119
NC
1890 ALIAS:
1891 sigsuspend = 1
1892 CODE:
1893 RETVAL = ix ? sigsuspend(sigset) : sigpending(sigset);
1894 OUTPUT:
1895 RETVAL
20120e59
LT
1896 CLEANUP:
1897 PERL_ASYNC_CHECK();
2304df62
AD
1898
1899SysRet
1900sigprocmask(how, sigset, oldsigset = 0)
1901 int how
b13bbac7 1902 POSIX::SigSet sigset = NO_INIT
33c27489
GS
1903 POSIX::SigSet oldsigset = NO_INIT
1904INIT:
a3b811a7 1905 if (! SvOK(ST(1))) {
b13bbac7 1906 sigset = NULL;
a3b811a7 1907 } else if (sv_isa(ST(1), "POSIX::SigSet")) {
92b39396 1908 sigset = (sigset_t *) SvPV_nolen(SvRV(ST(1)));
b13bbac7
AB
1909 } else {
1910 croak("sigset is not of type POSIX::SigSet");
33c27489 1911 }
b13bbac7 1912
194cfca0 1913 if (items < 3 || ! SvOK(ST(2))) {
b13bbac7 1914 oldsigset = NULL;
a3b811a7 1915 } else if (sv_isa(ST(2), "POSIX::SigSet")) {
92b39396 1916 oldsigset = (sigset_t *) SvPV_nolen(SvRV(ST(2)));
b13bbac7
AB
1917 } else {
1918 croak("oldsigset is not of type POSIX::SigSet");
33c27489 1919 }
2304df62 1920
2304df62
AD
1921void
1922_exit(status)
1923 int status
8990e307 1924
85e6fe83 1925SysRet
8990e307
LW
1926dup2(fd1, fd2)
1927 int fd1
1928 int fd2
ad413e46
NC
1929 CODE:
1930#ifdef WIN32
1931 /* RT #98912 - More Microsoft muppetry - failing to actually implemented
1932 the well known documented POSIX behaviour for a POSIX API.
1933 http://msdn.microsoft.com/en-us/library/8syseb29.aspx */
1934 RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
1935#else
1936 RETVAL = dup2(fd1, fd2);
1937#endif
1938 OUTPUT:
1939 RETVAL
8990e307 1940
4a9d6100 1941SV *
a0d0e21e 1942lseek(fd, offset, whence)
85e6fe83
LW
1943 int fd
1944 Off_t offset
1945 int whence
4a9d6100
GS
1946 CODE:
1947 Off_t pos = PerlLIO_lseek(fd, offset, whence);
1948 RETVAL = sizeof(Off_t) > sizeof(IV)
1949 ? newSVnv((NV)pos) : newSViv((IV)pos);
1950 OUTPUT:
1951 RETVAL
8990e307 1952
c5661c80 1953void
8990e307
LW
1954nice(incr)
1955 int incr
15f0f28a
AE
1956 PPCODE:
1957 errno = 0;
1958 if ((incr = nice(incr)) != -1 || errno == 0) {
1959 if (incr == 0)
d3d34884 1960 XPUSHs(newSVpvs_flags("0 but true", SVs_TEMP));
15f0f28a
AE
1961 else
1962 XPUSHs(sv_2mortal(newSViv(incr)));
1963 }
8990e307 1964
8063af02 1965void
8990e307 1966pipe()
85e6fe83
LW
1967 PPCODE:
1968 int fds[2];
85e6fe83 1969 if (pipe(fds) != -1) {
924508f0 1970 EXTEND(SP,2);
85e6fe83
LW
1971 PUSHs(sv_2mortal(newSViv(fds[0])));
1972 PUSHs(sv_2mortal(newSViv(fds[1])));
1973 }
8990e307 1974
85e6fe83 1975SysRet
a0d0e21e 1976read(fd, buffer, nbytes)
7747499c
TB
1977 PREINIT:
1978 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1979 INPUT:
1980 int fd
1981 size_t nbytes
1982 char * buffer = sv_grow( sv_buffer, nbytes+1 );
a0d0e21e 1983 CLEANUP:
7747499c 1984 if (RETVAL >= 0) {
b162af07 1985 SvCUR_set(sv_buffer, RETVAL);
7747499c
TB
1986 SvPOK_only(sv_buffer);
1987 *SvEND(sv_buffer) = '\0';
bbce6d69 1988 SvTAINTED_on(sv_buffer);
7747499c 1989 }
8990e307 1990
85e6fe83 1991SysRet
8990e307 1992setpgid(pid, pgid)
86200d5c
JH
1993 pid_t pid
1994 pid_t pgid
8990e307 1995
86200d5c 1996pid_t
8990e307
LW
1997setsid()
1998
86200d5c 1999pid_t
8990e307
LW
2000tcgetpgrp(fd)
2001 int fd
2002
85e6fe83 2003SysRet
8990e307
LW
2004tcsetpgrp(fd, pgrp_id)
2005 int fd
86200d5c 2006 pid_t pgrp_id
8990e307 2007
8063af02 2008void
8990e307 2009uname()
2304df62 2010 PPCODE:
a0d0e21e 2011#ifdef HAS_UNAME
85e6fe83 2012 struct utsname buf;
85e6fe83 2013 if (uname(&buf) >= 0) {
924508f0 2014 EXTEND(SP, 5);
d3d34884
NC
2015 PUSHs(newSVpvn_flags(buf.sysname, strlen(buf.sysname), SVs_TEMP));
2016 PUSHs(newSVpvn_flags(buf.nodename, strlen(buf.nodename), SVs_TEMP));
2017 PUSHs(newSVpvn_flags(buf.release, strlen(buf.release), SVs_TEMP));
2018 PUSHs(newSVpvn_flags(buf.version, strlen(buf.version), SVs_TEMP));
2019 PUSHs(newSVpvn_flags(buf.machine, strlen(buf.machine), SVs_TEMP));
8990e307 2020 }
a0d0e21e
LW
2021#else
2022 uname((char *) 0); /* A stub to call not_here(). */
2023#endif
8990e307 2024
85e6fe83 2025SysRet
a0d0e21e
LW
2026write(fd, buffer, nbytes)
2027 int fd
2028 char * buffer
2029 size_t nbytes
2030
33f01dd1
SH
2031SV *
2032tmpnam()
2033 PREINIT:
2034 STRLEN i;
2035 int len;
2036 CODE:
c2b90b61 2037 RETVAL = newSVpvs("");
33f01dd1 2038 SvGROW(RETVAL, L_tmpnam);
0fadf2db
JH
2039 /* Yes, we know tmpnam() is bad. So bad that some compilers
2040 * and linkers warn against using it. But it is here for
2041 * completeness. POSIX.pod warns against using it.
2042 *
2043 * Then again, maybe this should be removed at some point.
2044 * No point in enabling dangerous interfaces. */
33f01dd1
SH
2045 len = strlen(tmpnam(SvPV(RETVAL, i)));
2046 SvCUR_set(RETVAL, len);
2047 OUTPUT:
2048 RETVAL
a0d0e21e
LW
2049
2050void
2051abort()
2052
2053int
2054mblen(s, n)
2055 char * s
2056 size_t n
2057
2058size_t
2059mbstowcs(s, pwcs, n)
2060 wchar_t * s
2061 char * pwcs
2062 size_t n
2063
2064int
2065mbtowc(pwc, s, n)
2066 wchar_t * pwc
2067 char * s
2068 size_t n
2069
2070int
2071wcstombs(s, pwcs, n)
2072 char * s
2073 wchar_t * pwcs
2074 size_t n
2075
2076int
2077wctomb(s, wchar)
2078 char * s
2079 wchar_t wchar
2080
2081int
2082strcoll(s1, s2)
2083 char * s1
2084 char * s2
2085
a89d8a78
DH
2086void
2087strtod(str)
2088 char * str
2089 PREINIT:
2090 double num;
2091 char *unparsed;
2092 PPCODE:
371d5d44 2093 STORE_NUMERIC_STANDARD_FORCE_LOCAL();
a89d8a78
DH
2094 num = strtod(str, &unparsed);
2095 PUSHs(sv_2mortal(newSVnv(num)));
2096 if (GIMME == G_ARRAY) {
924508f0 2097 EXTEND(SP, 1);
a89d8a78
DH
2098 if (unparsed)
2099 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
2100 else
6b88bc9c 2101 PUSHs(&PL_sv_undef);
a89d8a78 2102 }
371d5d44 2103 RESTORE_NUMERIC_STANDARD();
a89d8a78 2104
0ff7b9da
JH
2105#ifdef HAS_STRTOLD
2106
2107void
2108strtold(str)
2109 char * str
2110 PREINIT:
2111 long double num;
2112 char *unparsed;
2113 PPCODE:
2114 STORE_NUMERIC_STANDARD_FORCE_LOCAL();
2115 num = strtold(str, &unparsed);
2116 PUSHs(sv_2mortal(newSVnv(num)));
2117 if (GIMME == G_ARRAY) {
2118 EXTEND(SP, 1);
2119 if (unparsed)
2120 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
2121 else
2122 PUSHs(&PL_sv_undef);
2123 }
2124 RESTORE_NUMERIC_STANDARD();
2125
2126#endif
2127
a89d8a78
DH
2128void
2129strtol(str, base = 0)
2130 char * str
2131 int base
2132 PREINIT:
2133 long num;
2134 char *unparsed;
2135 PPCODE:
2136 num = strtol(str, &unparsed, base);
42718184
RB
2137#if IVSIZE <= LONGSIZE
2138 if (num < IV_MIN || num > IV_MAX)
a89d8a78 2139 PUSHs(sv_2mortal(newSVnv((double)num)));
42718184
RB
2140 else
2141#endif
2142 PUSHs(sv_2mortal(newSViv((IV)num)));
a89d8a78 2143 if (GIMME == G_ARRAY) {
924508f0 2144 EXTEND(SP, 1);
a89d8a78
DH
2145 if (unparsed)
2146 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
2147 else
6b88bc9c 2148 PUSHs(&PL_sv_undef);
a89d8a78
DH
2149 }
2150
2151void
2152strtoul(str, base = 0)
4b48cf39 2153 const char * str
a89d8a78
DH
2154 int base
2155 PREINIT:
2156 unsigned long num;
2157 char *unparsed;
2158 PPCODE:
2159 num = strtoul(str, &unparsed, base);
84c133a0
RB
2160#if IVSIZE <= LONGSIZE
2161 if (num > IV_MAX)
a89d8a78 2162 PUSHs(sv_2mortal(newSVnv((double)num)));
84c133a0
RB
2163 else
2164#endif
2165 PUSHs(sv_2mortal(newSViv((IV)num)));
a89d8a78 2166 if (GIMME == G_ARRAY) {
924508f0 2167 EXTEND(SP, 1);
a89d8a78
DH
2168 if (unparsed)
2169 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
2170 else
6b88bc9c 2171 PUSHs(&PL_sv_undef);
a89d8a78
DH
2172 }
2173
8063af02 2174void
a0d0e21e
LW
2175strxfrm(src)
2176 SV * src
85e6fe83 2177 CODE:
a0d0e21e
LW
2178 {
2179 STRLEN srclen;
2180 STRLEN dstlen;
6ec5f825 2181 STRLEN buflen;
a0d0e21e
LW
2182 char *p = SvPV(src,srclen);
2183 srclen++;
6ec5f825
TC
2184 buflen = srclen * 4 + 1;
2185 ST(0) = sv_2mortal(newSV(buflen));
2186 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)buflen);
2187 if (dstlen >= buflen) {
a0d0e21e
LW
2188 dstlen++;
2189 SvGROW(ST(0), dstlen);
2190 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
2191 dstlen--;
2192 }
b162af07 2193 SvCUR_set(ST(0), dstlen);
a0d0e21e
LW
2194 SvPOK_only(ST(0));
2195 }
2196
2197SysRet
2198mkfifo(filename, mode)
2199 char * filename
2200 Mode_t mode
b5890904
NC
2201 ALIAS:
2202 access = 1
748a9306 2203 CODE:
b5890904
NC
2204 if(ix) {
2205 RETVAL = access(filename, mode);
2206 } else {
2207 TAINT_PROPER("mkfifo");
2208 RETVAL = mkfifo(filename, mode);
2209 }
748a9306
LW
2210 OUTPUT:
2211 RETVAL
a0d0e21e
LW
2212
2213SysRet
2214tcdrain(fd)
2215 int fd
9163475a
NC
2216 ALIAS:
2217 close = 1
2218 dup = 2
2219 CODE:
2220 RETVAL = ix == 1 ? close(fd)
2221 : (ix < 1 ? tcdrain(fd) : dup(fd));
2222 OUTPUT:
2223 RETVAL
a0d0e21e
LW
2224
2225
2226SysRet
2227tcflow(fd, action)
2228 int fd
2229 int action
7a004119
NC
2230 ALIAS:
2231 tcflush = 1
2232 tcsendbreak = 2
2233 CODE:
2234 RETVAL = ix == 1 ? tcflush(fd, action)
2235 : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
2236 OUTPUT:
2237 RETVAL
a0d0e21e 2238
250d97fd 2239void
c1646883 2240asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
a0d0e21e
LW
2241 int sec
2242 int min
2243 int hour
2244 int mday
2245 int mon
2246 int year
2247 int wday
2248 int yday
2249 int isdst
250d97fd
NC
2250 ALIAS:
2251 mktime = 1
2252 PPCODE:
a0d0e21e 2253 {
250d97fd 2254 dXSTARG;
a0d0e21e 2255 struct tm mytm;
a748fe11 2256 init_tm(&mytm); /* XXX workaround - see init_tm() in core util.c */
a0d0e21e
LW
2257 mytm.tm_sec = sec;
2258 mytm.tm_min = min;
2259 mytm.tm_hour = hour;
2260 mytm.tm_mday = mday;
2261 mytm.tm_mon = mon;
2262 mytm.tm_year = year;
2263 mytm.tm_wday = wday;
2264 mytm.tm_yday = yday;
2265 mytm.tm_isdst = isdst;
250d97fd 2266 if (ix) {
e2054bce
TC
2267 const time_t result = mktime(&mytm);
2268 if (result == (time_t)-1)
250d97fd
NC
2269 SvOK_off(TARG);
2270 else if (result == 0)
2271 sv_setpvn(TARG, "0 but true", 10);
2272 else
2273 sv_setiv(TARG, (IV)result);
2274 } else {
2275 sv_setpv(TARG, asctime(&mytm));
2276 }
2277 ST(0) = TARG;
2278 XSRETURN(1);
a0d0e21e 2279 }
a0d0e21e
LW
2280
2281long
2282clock()
2283
2284char *
2285ctime(time)
748a9306 2286 Time_t &time
8990e307 2287
37120919
AD
2288void
2289times()
2290 PPCODE:
2291 struct tms tms;
2292 clock_t realtime;
2293 realtime = times( &tms );
924508f0 2294 EXTEND(SP,5);
9607fc9c
PP
2295 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
2296 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
2297 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
2298 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
2299 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
37120919 2300
a0d0e21e
LW
2301double
2302difftime(time1, time2)
2303 Time_t time1
2304 Time_t time2
2305
8063af02
DM
2306#XXX: if $xsubpp::WantOptimize is always the default
2307# sv_setpv(TARG, ...) could be used rather than
2308# ST(0) = sv_2mortal(newSVpv(...))
2309void
e44f695e 2310strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
dc57de01 2311 SV * fmt
a0d0e21e
LW
2312 int sec
2313 int min
2314 int hour
2315 int mday
2316 int mon
2317 int year
2318 int wday
2319 int yday
2320 int isdst
2321 CODE:
2322 {
5d37acd6 2323 char *buf;
f406a445 2324 SV *sv;
5d37acd6
DM
2325
2326 /* allowing user-supplied (rather than literal) formats
2327 * is normally frowned upon as a potential security risk;
2328 * but this is part of the API so we have to allow it */
2329 GCC_DIAG_IGNORE(-Wformat-nonliteral);
2330 buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
2331 GCC_DIAG_RESTORE;
f406a445 2332 sv = sv_newmortal();
2a74cb2d 2333 if (buf) {
9717af6d
KW
2334 STRLEN len = strlen(buf);
2335 sv_usepvn_flags(sv, buf, len, SV_HAS_TRAILING_NUL);
2336 if (SvUTF8(fmt)
2337 || (! is_ascii_string((U8*) buf, len)
2338 && is_utf8_string((U8*) buf, len)
323fd7cc 2339#ifdef USE_LOCALE_TIME
130c5df3
KW
2340 && _is_cur_LC_category_utf8(LC_TIME)
2341#endif
2342 )) {
8dbe7cf7
NC
2343 SvUTF8_on(sv);
2344 }
f406a445
KW
2345 }
2346 else { /* We can't distinguish between errors and just an empty
2347 * return; in all cases just return an empty string */
2348 SvUPGRADE(sv, SVt_PV);
2349 SvPV_set(sv, (char *) "");
2350 SvPOK_on(sv);
2351 SvCUR_set(sv, 0);
2352 SvLEN_set(sv, 0); /* Won't attempt to free the string when sv
2353 gets destroyed */
2354 }
2355 ST(0) = sv;
a0d0e21e
LW
2356 }
2357
2358void
2359tzset()
81ab4c44
SH
2360 PPCODE:
2361 my_tzset(aTHX);
a0d0e21e
LW
2362
2363void
2364tzname()
2365 PPCODE:
924508f0 2366 EXTEND(SP,2);
d3d34884
NC
2367 PUSHs(newSVpvn_flags(tzname[0], strlen(tzname[0]), SVs_TEMP));
2368 PUSHs(newSVpvn_flags(tzname[1], strlen(tzname[1]), SVs_TEMP));
a0d0e21e 2369
a0d0e21e
LW
2370char *
2371ctermid(s = 0)
3ab23a19
RGS
2372 char * s = 0;
2373 CODE:
2374#ifdef HAS_CTERMID_R
e02b9112 2375 s = (char *) safemalloc((size_t) L_ctermid);
3ab23a19
RGS
2376#endif
2377 RETVAL = ctermid(s);
2378 OUTPUT:
2379 RETVAL
d1fd7089 2380 CLEANUP:
3ab23a19 2381#ifdef HAS_CTERMID_R
d1fd7089 2382 Safefree(s);
3ab23a19 2383#endif
a0d0e21e
LW
2384
2385char *
2386cuserid(s = 0)
2387 char * s = 0;
56f4542c
TJ
2388 CODE:
2389#ifdef HAS_CUSERID
2390 RETVAL = cuserid(s);
2391#else
2392 RETVAL = 0;
2393 not_here("cuserid");
2394#endif
2395 OUTPUT:
2396 RETVAL
a0d0e21e
LW
2397
2398SysRetLong
2399fpathconf(fd, name)
2400 int fd
2401 int name
2402
2403SysRetLong
2404pathconf(filename, name)
2405 char * filename
2406 int name
2407
2408SysRet
2409pause()
20120e59
LT
2410 CLEANUP:
2411 PERL_ASYNC_CHECK();
a0d0e21e 2412
a387c53a
NC
2413unsigned int
2414sleep(seconds)
2415 unsigned int seconds
2416 CODE:
2417 RETVAL = PerlProc_sleep(seconds);
2418 OUTPUT:
2419 RETVAL
2420
a043a685
GW
2421SysRet
2422setgid(gid)
2423 Gid_t gid
2424
2425SysRet
2426setuid(uid)
2427 Uid_t uid
2428
a0d0e21e
LW
2429SysRetLong
2430sysconf(name)
2431 int name
2432
2433char *
2434ttyname(fd)
2435 int fd
a043a685 2436
c6c619a9 2437void
b5846a0b 2438getcwd()
8f95b30d
JH
2439 PPCODE:
2440 {
2441 dXSTARG;
89423764 2442 getcwd_sv(TARG);
8f95b30d
JH
2443 XSprePUSH; PUSHTARG;
2444 }
2445
0d7021f5
RGS
2446SysRet
2447lchown(uid, gid, path)
2448 Uid_t uid
2449 Gid_t gid
2450 char * path
2451 CODE:
2452#ifdef HAS_LCHOWN
2453 /* yes, the order of arguments is different,
2454 * but consistent with CORE::chown() */
2455 RETVAL = lchown(path, uid, gid);
2456#else
2457 RETVAL = not_here("lchown");
2458#endif
2459 OUTPUT:
2460 RETVAL