This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
POSIX math: s = "0" is not happy with -Wwrite-strings.
[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
a5713e21
JH
37#ifdef I_FENV
38#include <fenv.h>
39#endif
a0d0e21e 40#ifdef I_LIMITS
2304df62 41#include <limits.h>
a0d0e21e 42#endif
2304df62
AD
43#include <locale.h>
44#include <math.h>
85e6fe83 45#ifdef I_PWD
2304df62 46#include <pwd.h>
85e6fe83 47#endif
2304df62
AD
48#include <setjmp.h>
49#include <signal.h>
2304df62 50#include <stdarg.h>
17c3b450 51
2304df62
AD
52#ifdef I_STDDEF
53#include <stddef.h>
54#endif
6990d991 55
b5846a0b
BS
56#ifdef I_UNISTD
57#include <unistd.h>
58#endif
59
39b5f1c4
JH
60#ifndef M_E
61# define M_E 2.71828182845904523536028747135266250
62#endif
63#ifndef M_LOG2E
64# define M_LOG2E 1.44269504088896340735992468100189214
65#endif
66#ifndef M_LOG10E
67# define M_LOG10E 0.434294481903251827651128918916605082
68#endif
69#ifndef M_LN2
70# define M_LN2 0.693147180559945309417232121458176568
71#endif
72#ifndef M_LN10
73# define M_LN10 2.30258509299404568401799145468436421
74#endif
75#ifndef M_PI
76# define M_PI 3.14159265358979323846264338327950288
77#endif
78#ifndef M_PI_2
79# define M_PI_2 1.57079632679489661923132169163975144
80#endif
81#ifndef M_PI_4
82# define M_PI_4 0.785398163397448309615660845819875721
83#endif
84#ifndef M_1_PI
85# define M_1_PI 0.318309886183790671537767526745028724
86#endif
87#ifndef M_2_PI
88# define M_2_PI 0.636619772367581343075535053490057448
89#endif
90#ifndef M_2_SQRTPI
91# define M_2_SQRTPI 1.12837916709551257389615890312154517
92#endif
93#ifndef M_SQRT2
94# define M_SQRT2 1.41421356237309504880168872420969808
95#endif
96#ifndef M_SQRT1_2
97# define M_SQRT1_2 0.707106781186547524400844362104849039
98#endif
99
a5f1a7e5
JH
100#if !defined(INFINITY) && defined(NV_INF)
101# define INFINITY NV_INF
102#endif
103
104#if !defined(NAN) && defined(NV_NAN)
105# define NAN NV_NAN
106#endif
107
108#if !defined(Inf) && defined(NV_INF)
109# define Inf NV_INF
110#endif
111
112#if !defined(NaN) && defined(NV_NAN)
113# define NaN NV_NAN
114#endif
115
935e3c48 116/* We will have an emulation. */
3f8e6f93 117#ifndef FP_INFINITE
935e3c48
JH
118# define FP_INFINITE 0
119# define FP_NAN 1
120# define FP_NORMAL 2
121# define FP_SUBNORMAL 3
122# define FP_ZERO 4
123#endif
124
7965edec
JH
125/* C89 math.h:
126
127 acos asin atan atan2 ceil cos cosh exp fabs floor fmod frexp ldexp
128 log log10 modf pow sin sinh sqrt tan tanh
129
130 * Implemented in core:
131
132 atan2 cos exp log pow sin sqrt
133
9d233e12 134 * C99 math.h added:
7965edec 135
9d233e12
JH
136 acosh asinh atanh cbrt copysign erf erfc exp2 expm1 fdim fma fmax
137 fmin fpclassify hypot ilogb isfinite isgreater isgreaterequal isinf
138 isless islessequal islessgreater isnan isnormal isunordered lgamma
139 log1p log2 logb lrint nan nearbyint nextafter nexttoward remainder
140 remquo rint round scalbn signbit tgamma trunc
7965edec 141
26e0f0d3 142 * Berkeley/SVID extensions:
7965edec 143
26e0f0d3 144 j0 j1 jn y0 y1 yn
7965edec 145
26e0f0d3 146 * Configure already (5.21.0) scans for:
d2bce0fd 147
26e0f0d3 148 fpclassify isfinite isinf isnan ilogb*l* signbit
d2bce0fd 149
26e0f0d3 150 * For floating-point round mode (which matters for e.g. lrint and rint)
9d233e12 151
26e0f0d3 152 fegetround fesetround
9d233e12 153
7965edec
JH
154*/
155
9d233e12
JH
156/* XXX Constant FP_FAST_FMA (if true, FMA is faster) */
157
5716d070
JH
158/* XXX Add ldiv(), lldiv()? It's C99, but from stdlib.h, not math.h */
159
39b5f1c4 160/* XXX Beware old gamma() -- one cannot know whether that is the
d334ccbe
JH
161 * gamma or the log of gamma, that's why the new tgamma and lgamma.
162 * Though also remember tgamma_r and lgamma_r. */
39b5f1c4
JH
163
164/* XXX The truthiness of acosh() is the canary for all of the
d2bce0fd 165 * C99 math. This is very likely wrong, especially in non-UNIX lands
d334ccbe
JH
166 * like Win32 and VMS, but also older UNIXes have issues. For Win32,
167 * and other non-fully-C99, we later do some undefines for these interfaces.
d2bce0fd
JH
168 *
169 * But we are very trying very hard to avoid introducing separate Configure
170 * symbols for all the 40-ish new math symbols. Especially since the set
171 * of missing functions doesn't seem to follow any patterns. */
bfce4ab3 172
5716d070 173#ifdef HAS_ACOSH
03397f96
JH
174# if defined(USE_LONG_DOUBLE) && defined(HAS_ILOGBL)
175/* There's already a symbol for ilogbl, we will use its truthiness
5716d070 176 * as the canary for all the *l variants being defined. */
7965edec
JH
177# define c99_acosh acoshl
178# define c99_asinh asinhl
179# define c99_atanh atanhl
180# define c99_cbrt cbrtl
181# define c99_copysign copysignl
7965edec
JH
182# define c99_erf erfl
183# define c99_erfc erfcl
184# define c99_exp2 exp2l
185# define c99_expm1 expm1l
186# define c99_fdim fdiml
187# define c99_fma fmal
188# define c99_fmax fmaxl
189# define c99_fmin fminl
190# define c99_hypot hypotl
191# define c99_ilogb ilogbl
002ae7aa 192# define c99_lgamma lgammal
7965edec
JH
193# define c99_log1p log1pl
194# define c99_log2 log2l
195# define c99_logb logbl
196# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
197# define c99_lrint llrintl
198# else
199# define c99_lrint lrintl
200# endif
201# define c99_nan nanl
202# define c99_nearbyint nearbyintl
203# define c99_nextafter nextafterl
204# define c99_nexttoward nexttowardl
205# define c99_remainder remainderl
206# define c99_remquo remquol
207# define c99_rint rintl
208# define c99_round roundl
209# define c99_scalbn scalbnl
5716d070
JH
210# ifdef HAS_SIGNBIT /* possibly bad assumption */
211# define c99_signbit signbitl
212# endif
7965edec
JH
213# define c99_tgamma tgammal
214# define c99_trunc truncl
215# else
216# define c99_acosh acosh
217# define c99_asinh asinh
218# define c99_atanh atanh
219# define c99_cbrt cbrt
220# define c99_copysign copysign
7965edec
JH
221# define c99_erf erf
222# define c99_erfc erfc
223# define c99_exp2 exp2
224# define c99_expm1 expm1
225# define c99_fdim fdim
226# define c99_fma fma
227# define c99_fmax fmax
228# define c99_fmin fmin
229# define c99_hypot hypot
230# define c99_ilogb ilogb
231# define c99_lgamma lgamma
232# define c99_log1p log1p
233# define c99_log2 log2
234# define c99_logb logb
235# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
236# define c99_lrint llrint
237# else
238# define c99_lrint lrint
239# endif
240# define c99_nan nan
241# define c99_nearbyint nearbyint
242# define c99_nextafter nextafter
243# define c99_nexttoward nexttoward
244# define c99_remainder remainder
245# define c99_remquo remquo
246# define c99_rint rint
247# define c99_round round
248# define c99_scalbn scalbn
5716d070
JH
249/* We already define Perl_signbit in perl.h. */
250# ifdef HAS_SIGNBIT
251# define c99_signbit signbit
252# endif
7965edec
JH
253# define c99_tgamma tgamma
254# define c99_trunc trunc
255# endif
03397f96 256
92d982a3
JH
257# ifndef isunordered
258# ifdef Perl_isnan
259# define isunordered(x, y) (Perl_isnan(x) || Perl_isnan(y))
260# elif defined(HAS_UNORDERED)
261# define isunordered(x, y) unordered(x, y)
262# endif
2bf3fd6f
JH
263# endif
264
265# if !defined(isgreater) && defined(isunordered)
266# define isgreater(x, y) (!isunordered((x), (y)) && (x) > (y))
267# define isgreaterequal(x, y) (!isunordered((x), (y)) && (x) >= (y))
268# define isless(x, y) (!isunordered((x), (y)) && (x) < (y))
269# define islessequal(x, y) (!isunordered((x), (y)) && (x) <= (y))
270# define islessgreater(x, y) (!isunordered((x), (y)) && \
271 ((x) > (y) || (y) > (x)))
272# endif
273
03397f96
JH
274/* Check both the Configure symbol and the macro-ness (like C99 promises). */
275# if defined(HAS_FPCLASSIFY) && defined(fpclassify)
276# define c99_fpclassify fpclassify
03397f96
JH
277# endif
278/* Like isnormal(), the isfinite(), isinf(), and isnan() are also C99
279 and also (sizeof-arg-aware) macros, but they are already well taken
280 care of by Configure et al, and defined in perl.h as
281 Perl_isfinite(), Perl_isinf(), and Perl_isnan(). */
282# ifdef isnormal
5716d070 283# define c99_isnormal isnormal
03397f96 284# endif
5716d070 285# ifdef isgreater /* canary for all the C99 is*<cmp>* macros. */
03397f96
JH
286# define c99_isgreater isgreater
287# define c99_isgreaterequal isgreaterequal
288# define c99_isless isless
289# define c99_islessequal islessequal
290# define c99_islessgreater islessgreater
291# define c99_isunordered isunordered
292# endif
7965edec
JH
293#endif
294
360baf49
JH
295/* If on legacy platforms, and not using gcc, some C99 math interfaces
296 * might be missing, turn them off so that the emulations hopefully
297 * kick in. This is admittedly nasty, and fragile, but the alternative
53e66ff6
JH
298 * is to have Configure scans for all the 40+ interfaces.
299 *
300 * In other words: if you have an incomplete (or broken) C99 math interface,
301 * #undef the c99_foo here, and let the emulations kick in. */
302
360baf49
JH
303#ifndef __GNUC__
304
d2bce0fd
JH
305/* HP-UX on PA-RISC is missing certain C99 math functions,
306 * but on IA64 (Integrity) these do exist. */
360baf49 307# if defined(__hpux) && defined(__hppa)
53e66ff6
JH
308# undef c99_exp2
309# undef c99_fdim
360baf49 310# undef c99_fma
53e66ff6
JH
311# undef c99_fmax
312# undef c99_fmin
313# undef c99_fpclassify
314# undef c99_lrint
315# undef c99_nan
316# undef c99_nearbyint
360baf49 317# undef c99_nexttoward
53e66ff6
JH
318# undef c99_remquo
319# undef c99_round
320# undef c99_scalbn
360baf49 321# undef c99_tgamma
53e66ff6 322# undef c99_trunc
360baf49
JH
323# endif
324
325# if defined(__irix__)
326# undef c99_ilogb
327# undef c99_exp2
328# endif
329
330# if defined(__osf__) /* Tru64 */
331# undef c99_fdim
332# undef c99_fma
333# undef c99_fmax
334# undef c99_fmin
335# undef c99_fpclassify
336# undef c99_isfinite
337# undef c99_isinf
338# undef c99_isunordered
339# undef c99_lrint
340# undef c99_nearbyint
341# undef c99_nexttoward
342# undef c99_remquo
343# undef c99_rint
344# undef c99_round
345# undef c99_scalbn
346# endif
347
d2bce0fd
JH
348#endif
349
c0cd65b2
CB
350/* XXX Regarding C99 math.h, VMS seems to be missing these:
351
51a0624d 352 nan nearbyint round scalbn llrint
c0cd65b2
CB
353 */
354
355#ifdef __VMS
356# undef c99_nan
357# undef c99_nearbyint
358# undef c99_round
359# undef c99_scalbn
51a0624d
CB
360/* Have lrint but not llrint. */
361# if defined(USE_64_BIT_INT) && QUADKIND == QUAD_IS_LONG_LONG
362# undef c99_lrint
363# endif
c0cd65b2
CB
364#endif
365
bfce4ab3
JH
366/* XXX Regarding C99 math.h, Win32 seems to be missing these:
367
368 exp2 fdim fma fmax fmin fpclassify ilogb lgamma log1p log2 lrint
369 remquo rint signbit tgamma trunc
370
371 Win32 does seem to have these:
372
373 acosh asinh atanh cbrt copysign cosh erf erfc expm1 hypot log10 nan
374 nearbyint nextafter nexttoward remainder round scalbn
375
376 And the Bessel functions are defined like _this.
377*/
39b5f1c4 378
bfce4ab3
JH
379#ifdef WIN32
380# undef c99_exp2
381# undef c99_fdim
382# undef c99_fma
383# undef c99_fmax
384# undef c99_fmin
385# undef c99_ilogb
386# undef c99_lgamma
387# undef c99_log1p
388# undef c99_log2
389# undef c99_lrint
390# undef c99_remquo
391# undef c99_rint
392# undef c99_signbit
393# undef c99_tgamma
394# undef c99_trunc
39b5f1c4
JH
395
396/* Some APIs exist under Win32 with "underbar" names. */
397# undef c99_hypot
398# undef c99_logb
399# undef c99_nextafter
400# define c99_hypot _hypot
401# define c99_logb _logb
402# define c99_nextafter _nextafter
403
85c93440
JH
404# define bessel_j0 _j0
405# define bessel_j1 _j1
406# define bessel_jn _jn
407# define bessel_y0 _y0
408# define bessel_y1 _y1
409# define bessel_yn _yn
410
5716d070 411#endif
bfce4ab3 412
39b5f1c4 413/* The Bessel functions: BSD, SVID, XPG4, and POSIX. But not C99. */
5716d070
JH
414#ifdef HAS_J0
415# if defined(USE_LONG_DOUBLE) && defined(HAS_J0L)
416# define bessel_j0 j0l
417# define bessel_j1 j1l
418# define bessel_jn jnl
419# define bessel_y0 y0l
420# define bessel_y1 y1l
421# define bessel_yn ynl
422# else
85c93440
JH
423# define bessel_j0 j0
424# define bessel_j1 j1
425# define bessel_jn jn
426# define bessel_y0 y0
427# define bessel_y1 y1
428# define bessel_yn yn
5716d070 429# endif
bfce4ab3
JH
430#endif
431
39b5f1c4 432/* Emulations for missing math APIs.
bfce4ab3
JH
433 *
434 * Keep in mind that the point of many of these functions is that
435 * they, if available, are supposed to give more precise/more
39b5f1c4
JH
436 * numerically stable results.
437 *
438 * See e.g. http://www.johndcook.com/math_h.html
439 */
440
39b5f1c4
JH
441#ifndef c99_acosh
442static NV my_acosh(NV x)
443{
444 return Perl_log(x + Perl_sqrt(x * x - 1));
445}
446# define c99_acosh my_acosh
447#endif
448
449#ifndef c99_asinh
450static NV my_asinh(NV x)
451{
452 return Perl_log(x + Perl_sqrt(x * x + 1));
453}
454# define c99_asinh my_asinh
455#endif
456
457#ifndef c99_atanh
458static NV my_atanh(NV x)
459{
460 return (Perl_log(1 + x) - Perl_log(1 - x)) / 2;
461}
462# define c99_atanh my_atanh
463#endif
464
465#ifndef c99_cbrt
466static NV my_cbrt(NV x)
467{
468 static const NV one_third = (NV)1.0/3;
469 return x >= 0.0 ? Perl_pow(x, one_third) : -Perl_pow(-x, one_third);
470}
471# define c99_cbrt my_cbrt
472#endif
473
474#ifndef c99_copysign
475static NV my_copysign(NV x, NV y)
476{
477 return y >= 0 ? (x < 0 ? -x : x) : (x < 0 ? x : -x);
478}
479# define c99_copysign my_copysign
480#endif
481
1ae51000 482/* XXX cosh (though c89) */
d5f4f26a 483
7895eac5
JH
484#ifndef c99_erf
485static NV my_erf(NV x)
486{
487 /* http://www.johndcook.com/cpp_erf.html -- public domain */
488 NV a1 = 0.254829592;
489 NV a2 = -0.284496736;
490 NV a3 = 1.421413741;
491 NV a4 = -1.453152027;
492 NV a5 = 1.061405429;
493 NV p = 0.3275911;
efc74307 494 NV t, y;
7895eac5
JH
495 int sign = x < 0 ? -1 : 1; /* Save the sign. */
496 x = PERL_ABS(x);
497
498 /* Abramowitz and Stegun formula 7.1.26 */
efc74307
JH
499 t = 1.0 / (1.0 + p * x);
500 y = 1.0 - (((((a5*t + a4)*t) + a3)*t + a2)*t + a1) * t * exp(-x*x);
7895eac5
JH
501
502 return sign * y;
503}
504# define c99_erf my_erf
505#endif
506
ffbadafb
JH
507#ifndef c99_erfc
508static NV my_erfc(NV x) {
aed13ba6
JH
509 /* This is not necessarily numerically stable, but better than nothing. */
510 return 1.0 - c99_erf(x);
ffbadafb
JH
511}
512# define c99_erfc my_erfc
513#endif
d5f4f26a 514
39b5f1c4
JH
515#ifndef c99_exp2
516static NV my_exp2(NV x)
517{
518 return Perl_pow((NV)2.0, x);
519}
520# define c99_exp2 my_exp2
521#endif
522
523#ifndef c99_expm1
524static NV my_expm1(NV x)
525{
526 if (PERL_ABS(x) < 1e-5)
7895eac5
JH
527 /* http://www.johndcook.com/cpp_expm1.html -- public domain.
528 * Also including the cubic term. */
39b5f1c4
JH
529 /* Probably not enough for long doubles. */
530 return x * (1.0 + x * (0.5 + x / 6.0)); /* Taylor series */
531 else
532 return Perl_exp(x) - 1;
533}
534# define c99_expm1 my_expm1
535#endif
536
537#ifndef c99_fdim
538static NV my_fdim(NV x, NV y)
539{
540 return x > y ? x - y : 0;
541}
542# define c99_fdim my_fdim
543#endif
544
545#ifndef c99_fmax
546static NV my_fmax(NV x, NV y)
547{
548 if (Perl_isnan(x)) {
549 return Perl_isnan(y) ? NV_NAN : y;
550 } else if (Perl_isnan(y)) {
551 return x;
552 }
553 return x > y ? x : y;
554}
555# define c99_fmax my_fmax
556#endif
557
558#ifndef c99_fmin
559static NV my_fmin(NV x, NV y)
560{
561 if (Perl_isnan(x)) {
562 return Perl_isnan(y) ? NV_NAN : y;
563 } else if (Perl_isnan(y)) {
564 return x;
565 }
566 return x < y ? x : y;
567}
568# define c99_fmin my_fmin
569#endif
570
26e0f0d3
JH
571#ifndef c99_fpclassify
572
ea464252 573static IV my_fpclassify(NV x)
935e3c48 574{
53e66ff6 575#if defined(HAS_FPCLASSIFY) && defined(FP_PLUS_INF) /* E.g. HP-UX */
1ae51000
JH
576 switch (Perl_fp_class(x)) {
577 case FP_PLUS_INF: case FP_MINUS_INF: return FP_INFINITE;
578 case FP_SNAN: case FP_QNAN: return FP_NAN;
579 case FP_PLUS_NORM: case FP_MINUS_NORM: return FP_NORMAL;
580 case FP_PLUS_DENORM: case FP_MINUS_DENORM: return FP_SUBNORMAL;
53e66ff6 581 case FP_PLUS_ZERO: case FP_MINUS_ZERO: return FP_ZERO;
1ae51000
JH
582 default: return -1;
583 }
584# define c99_fpclassify my_fpclassify
585#elif (defined(HAS_FPCLASS) || defined(HAS_FPCLASSL)) && defined(FP_CLASS_SNAN)
935e3c48
JH
586 switch (Perl_fp_class(x)) {
587 case FP_CLASS_NINF: case FP_CLASS_PINF: return FP_INFINITE;
588 case FP_CLASS_SNAN: case FP_CLASS_QNAN: return FP_NAN;
589 case FP_CLASS_NNORM: case FP_CLASS_PNORM: return FP_NORMAL;
590 case FP_CLASS_NDENORM: case FP_CLASS_PDENORM: return FP_SUBNORMAL;
591 case FP_CLASS_NZERO: case FP_CLASS_PZERO: return FP_ZERO;
592 default: return -1;
593 }
594# define c99_fpclassify my_fpclassify
595#elif (defined(HAS_FPCLASS) || defined(HAS_FP_CLASSL)) && defined(FP_SNAN)
596 switch (Perl_fp_class(x)) {
597 case FP_NINF: case FP_PINF: return FP_INFINITE;
598 case FP_SNAN: case FP_QNAN: return FP_NAN;
599 case FP_NNORM: case FP_PNORM: return FP_NORMAL;
600 case FP_NDENORM: case FP_PDENORM: return FP_SUBNORMAL;
601 case FP_NZERO: case FP_PZERO: return FP_ZERO;
602 default: return -1;
603 }
604# define c99_fpclassify my_fpclassify
605#elif defined(HAS_FP_CLASS) && defined(FP_POS_INF)
606 switch (Perl_fp_class(x)) {
607 case FP_NEG_INF: case FP_POS_INF: return FP_INFINITE;
608 case FP_SNAN: case FP_QNAN: return FP_NAN;
609 case FP_NEG_NORM: case FP_POS_NORM: return FP_NORMAL;
610 case FP_NEG_DENORM: case FP_POS_DENORM: return FP_SUBNORMAL;
611 case FP_NEG_ZERO: case FP_POS_ZERO: return FP_ZERO;
612 default: return -1;
613 }
614# define c99_fpclassify my_fpclassify
615#elif defined(HAS_CLASS) && defined(FP_PLUS_INF)
616 switch (Perl_fp_class(x)) {
617 case FP_MINUS_INF: case FP_PLUS_INF: return FP_INFINITE;
618 case FP_SNAN: case FP_QNAN: return FP_NAN;
619 case FP_MINUS_NORM: case FP_PLUS_NORM: return FP_NORMAL;
620 case FP_MINUS_DENORM: case FP_PLUS_DENORM: return FP_SUBNORMAL;
621 case FP_MINUS_ZERO: case FP_PLUS_ZERO: return FP_ZERO;
622 default: return -1;
623 }
624# define c99_fpclassify my_fpclassify
625#elif defined(HAS_FP_CLASSIFY)
626 return Perl_fp_class(x);
627# define c99_fpclassify my_fpclassify
628#elif defined(WIN32)
629 int fpclass = _fpclass(x);
630 if (Perl_fp_class_inf(x)) return FP_INFINITE;
631 if (Perl_fp_class_nan(x)) return FP_NAN;
632 if (Perl_fp_class_norm(x)) return FP_NORMAL;
633 if (Perl_fp_class_denorm(x)) return FP_SUBNORMAL;
634 if (Perl_fp_class_zero(x)) return FP_ZERO;
635 return -1;
636# define c99_fpclassify my_fpclassify
1ae51000
JH
637#else
638 return -1;
935e3c48
JH
639#endif
640}
935e3c48 641
26e0f0d3
JH
642#endif
643
39b5f1c4
JH
644#ifndef c99_hypot
645static NV my_hypot(NV x, NV y)
646{
7bbf2c9b
JH
647 /* http://en.wikipedia.org/wiki/Hypot */
648 NV t;
649 x = PERL_ABS(x); /* Take absolute values. */
650 if (y == 0)
651 return x;
652 if (Perl_isnan(y))
653 return NV_INF;
654 y = PERL_ABS(y);
655 if (x < y) { /* Swap so that y is less. */
656 t = x;
657 x = y;
658 y = t;
39b5f1c4 659 }
7bbf2c9b
JH
660 t = y / x;
661 return x * sqrt(1.0 + t * t);
39b5f1c4
JH
662}
663# define c99_hypot my_hypot
664#endif
665
666#ifndef c99_ilogb
667static IV my_ilogb(NV x)
668{
669 return (IV)(Perl_log(x) * M_LOG2E);
670}
671# define c99_ilogb my_ilogb
672#endif
673
d5f4f26a
JH
674/* XXX lgamma -- non-trivial */
675
39b5f1c4
JH
676#ifndef c99_log1p
677static NV my_log1p(NV x)
678{
7895eac5
JH
679 /* http://www.johndcook.com/cpp_log_one_plus_x.html -- public domain.
680 * Including also quadratic term. */
39b5f1c4
JH
681 if (PERL_ABS(x) > 1e-4)
682 return Perl_log(1.0 + x);
683 else
684 /* Probably not enough for long doubles. */
685 return x * (1.0 - x * (-x / 2.0 + x / 3.0)); /* Taylor series */
686}
687# define c99_log1p my_log1p
688#endif
689
690#ifndef c99_log2
691static NV my_log2(NV x)
692{
693 return Perl_log(x) * M_LOG2E;
694}
695# define c99_log2 my_log2
696#endif
697
d5f4f26a
JH
698/* XXX nextafter */
699
700/* XXX nexttoward */
701
702static int my_fegetround()
703{
704#ifdef HAS_FEGETROUND
705 return fegetround();
706#elif defined(FLT_ROUNDS)
707 return FLT_ROUNDS;
8ef03df4
JH
708 /* XXX emulate using fpgetround() (HAS_FPGETROUND):
709 * FP_RN to nearest, FP_RM down, FP_RP, up, FP_RZ truncate */
d5f4f26a
JH
710#else
711 return -1;
712#endif
713}
714
715static NV my_rint(NV x)
716{
717#ifdef FE_TONEAREST
718 switch (my_fegetround()) {
719 default:
720 case FE_TONEAREST:
721 return (NV)((IV)(x >= 0.0 ? x + 0.5 : x - 0.5)); /* like round() */
722 case FE_TOWARDZERO:
723 return (NV)((IV)(x)); /* like trunc() */
724 case FE_DOWNWARD:
725 return (NV)((IV)(x >= 0.0 ? x : x - 0.5));
726 case FE_UPWARD:
727 return (NV)((IV)(x >= 0.0 ? x + 0.5 : x));
728 }
729#else
8ef03df4
JH
730 /* XXX emulate using fpsetround() (HAS_FPGETROUND):
731 * FP_RN to nearest, FP_RM down, FP_RP, up, FP_RZ truncate */
d5f4f26a
JH
732 return NV_NAN;
733#endif
734}
735
736/* XXX nearbyint() and rint() are not really identical -- but the difference
737 * is messy: nearbyint is defined NOT to raise FE_INEXACT floating point
738 * exceptions, while rint() is defined to MAYBE raise them. At the moment
739 * Perl is blissfully unaware of such fine detail of floating point. */
740#ifndef c99_nearbyint
741# ifdef FE_TONEAREST
742# define c99_nearbyrint my_rint
743# endif
744#endif
745
746#ifndef c99_lrint
747# ifdef FE_TONEAREST
748static IV lrint(NV x)
749{
750 return (IV)my_rint(x);
751}
752# define c99_lrint my_lrint
753# endif
754#endif
755
756/* XXX remainder */
757
758/* XXX remquo */
759
760#ifndef c99_rint
761# ifdef FE_TONEAREST
762# define c99_rint my_rint
763# endif
764#endif
765
39b5f1c4
JH
766#ifndef c99_round
767static NV my_round(NV x)
768{
769 return (NV)((IV)(x >= 0.0 ? x + 0.5 : x - 0.5));
770}
771# define c99_round my_round
772#endif
773
774#ifndef c99_scalbn
93ddb856 775# if defined(Perl_ldexp) && FLT_RADIX == 2
ea464252 776static NV my_scalbn(NV x, int y)
39b5f1c4
JH
777{
778 return Perl_ldexp(x, y);
779}
780# define c99_scalbn my_scalbn
781# endif
782#endif
783
1ae51000 784/* XXX sinh (though c89) */
39b5f1c4
JH
785
786#ifndef c99_tgamma
787# ifdef c99_lgamma
788static NV my_tgamma(NV x)
789{
790 double l = c99_lgamma(x);
791 return signgam * Perl_exp(l); /* XXX evil global signgam, need lgamma_r */
792}
d5f4f26a
JH
793# define c99_tgamma my_tgamma
794/* XXX tgamma without lgamma -- non-trivial */
39b5f1c4
JH
795# endif
796#endif
bfce4ab3 797
1ae51000 798/* XXX tanh (though c89) */
d5f4f26a
JH
799
800#ifndef c99_trunc
801static NV my_trunc(NV x)
802{
803 return (NV)((IV)(x));
804}
805# define c99_trunc my_trunc
806#endif
807
3609ea0d 808/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
a0d0e21e
LW
809 metaconfig for future extension writers. We don't use them in POSIX.
810 (This is really sneaky :-) --AD
811*/
812#if defined(I_TERMIOS)
813#include <termios.h>
814#endif
a0d0e21e 815#ifdef I_STDLIB
2304df62 816#include <stdlib.h>
a0d0e21e 817#endif
5518ecd4 818#ifndef __ultrix__
2304df62 819#include <string.h>
5518ecd4 820#endif
2304df62 821#include <sys/stat.h>
2304df62 822#include <sys/types.h>
2304df62 823#include <time.h>
6dead956 824#ifdef I_UNISTD
1d2dff63 825#include <unistd.h>
6dead956 826#endif
71be2cbc
PP
827#include <fcntl.h>
828
e2465f50 829#ifdef HAS_TZNAME
fb207d52 830# if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__)
e2465f50
JH
831extern char *tzname[];
832# endif
833#else
fb207d52 834#if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname))
e2465f50
JH
835char *tzname[] = { "" , "" };
836#endif
cb2479a8
JH
837#endif
838
6c418a22 839#if defined(__VMS) && !defined(__POSIX_SOURCE)
294c8bc4
CB
840
841# include <utsname.h>
6c418a22 842
6990d991 843# undef mkfifo
6c418a22 844# define mkfifo(a,b) (not_here("mkfifo"),-1)
6c418a22
PP
845
846 /* The POSIX notion of ttyname() is better served by getname() under VMS */
847 static char ttnambuf[64];
848# define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
849
6c418a22 850#else
d308986b 851#if defined (__CYGWIN__)
f89d6eaa
FE
852# define tzname _tzname
853#endif
2986a63f 854#if defined (WIN32) || defined (NETWARE)
6990d991 855# undef mkfifo
6dead956 856# define mkfifo(a,b) not_here("mkfifo")
873ef191 857# define ttyname(a) (char*)not_here("ttyname")
6dead956 858# define sigset_t long
86200d5c 859# define pid_t long
6dead956
GS
860# ifdef _MSC_VER
861# define mode_t short
862# endif
62520c91
GS
863# ifdef __MINGW32__
864# define mode_t short
f6c6487a
GS
865# ifndef tzset
866# define tzset() not_here("tzset")
867# endif
868# ifndef _POSIX_OPEN_MAX
869# define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */
870# endif
62520c91 871# endif
6dead956
GS
872# define sigaction(a,b,c) not_here("sigaction")
873# define sigpending(a) not_here("sigpending")
874# define sigprocmask(a,b,c) not_here("sigprocmask")
875# define sigsuspend(a) not_here("sigsuspend")
876# define sigemptyset(a) not_here("sigemptyset")
877# define sigaddset(a,b) not_here("sigaddset")
878# define sigdelset(a,b) not_here("sigdelset")
879# define sigfillset(a) not_here("sigfillset")
880# define sigismember(a,b) not_here("sigismember")
2986a63f 881#ifndef NETWARE
6e22d046
JH
882# undef setuid
883# undef setgid
2986a63f
JH
884# define setuid(a) not_here("setuid")
885# define setgid(a) not_here("setgid")
886#endif /* NETWARE */
73e21afd 887# define strtold(s1,s2) not_here("strtold")
6dead956 888#else
6990d991
JH
889
890# ifndef HAS_MKFIFO
e37778c2 891# if defined(OS2)
d6a255e6 892# define mkfifo(a,b) not_here("mkfifo")
3609ea0d 893# else /* !( defined OS2 ) */
d6a255e6
IZ
894# ifndef mkfifo
895# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
896# endif
6990d991
JH
897# endif
898# endif /* !HAS_MKFIFO */
899
e37778c2
NC
900# ifdef I_GRP
901# include <grp.h>
902# endif
903# include <sys/times.h>
904# ifdef HAS_UNAME
905# include <sys/utsname.h>
6c418a22 906# endif
e37778c2 907# include <sys/wait.h>
6c418a22
PP
908# ifdef I_UTIME
909# include <utime.h>
910# endif
2986a63f 911#endif /* WIN32 || NETWARE */
6dead956 912#endif /* __VMS */
2304df62
AD
913
914typedef int SysRet;
a0d0e21e 915typedef long SysRetLong;
2304df62
AD
916typedef sigset_t* POSIX__SigSet;
917typedef HV* POSIX__SigAction;
a0d0e21e
LW
918#ifdef I_TERMIOS
919typedef struct termios* POSIX__Termios;
920#else /* Define termios types to int, and call not_here for the functions.*/
921#define POSIX__Termios int
922#define speed_t int
923#define tcflag_t int
924#define cc_t int
925#define cfgetispeed(x) not_here("cfgetispeed")
926#define cfgetospeed(x) not_here("cfgetospeed")
927#define tcdrain(x) not_here("tcdrain")
928#define tcflush(x,y) not_here("tcflush")
929#define tcsendbreak(x,y) not_here("tcsendbreak")
930#define cfsetispeed(x,y) not_here("cfsetispeed")
931#define cfsetospeed(x,y) not_here("cfsetospeed")
932#define ctermid(x) (char *) not_here("ctermid")
933#define tcflow(x,y) not_here("tcflow")
934#define tcgetattr(x,y) not_here("tcgetattr")
935#define tcsetattr(x,y,z) not_here("tcsetattr")
936#endif
937
938/* Possibly needed prototypes */
6e22d046 939#ifndef WIN32
a2e65780 940START_EXTERN_C
20ce7b12
GS
941double strtod (const char *, char **);
942long strtol (const char *, char **, int);
943unsigned long strtoul (const char *, char **, int);
0ff7b9da
JH
944#ifdef HAS_STRTOLD
945long double strtold (const char *, char **);
946#endif
a2e65780 947END_EXTERN_C
6e22d046 948#endif
a0d0e21e 949
a0d0e21e
LW
950#ifndef HAS_DIFFTIME
951#ifndef difftime
952#define difftime(a,b) not_here("difftime")
953#endif
954#endif
955#ifndef HAS_FPATHCONF
3609ea0d 956#define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
a0d0e21e
LW
957#endif
958#ifndef HAS_MKTIME
959#define mktime(a) not_here("mktime")
8990e307
LW
960#endif
961#ifndef HAS_NICE
962#define nice(a) not_here("nice")
963#endif
a0d0e21e 964#ifndef HAS_PATHCONF
3609ea0d 965#define pathconf(f,n) (SysRetLong) not_here("pathconf")
a0d0e21e
LW
966#endif
967#ifndef HAS_SYSCONF
3609ea0d 968#define sysconf(n) (SysRetLong) not_here("sysconf")
a0d0e21e 969#endif
8990e307
LW
970#ifndef HAS_READLINK
971#define readlink(a,b,c) not_here("readlink")
972#endif
973#ifndef HAS_SETPGID
974#define setpgid(a,b) not_here("setpgid")
975#endif
8990e307
LW
976#ifndef HAS_SETSID
977#define setsid() not_here("setsid")
978#endif
a0d0e21e
LW
979#ifndef HAS_STRCOLL
980#define strcoll(s1,s2) not_here("strcoll")
981#endif
a89d8a78
DH
982#ifndef HAS_STRTOD
983#define strtod(s1,s2) not_here("strtod")
984#endif
0ff7b9da
JH
985#ifndef HAS_STRTOLD
986#define strtold(s1,s2) not_here("strtold")
987#endif
a89d8a78
DH
988#ifndef HAS_STRTOL
989#define strtol(s1,s2,b) not_here("strtol")
990#endif
991#ifndef HAS_STRTOUL
992#define strtoul(s1,s2,b) not_here("strtoul")
993#endif
a0d0e21e
LW
994#ifndef HAS_STRXFRM
995#define strxfrm(s1,s2,n) not_here("strxfrm")
8990e307
LW
996#endif
997#ifndef HAS_TCGETPGRP
998#define tcgetpgrp(a) not_here("tcgetpgrp")
999#endif
1000#ifndef HAS_TCSETPGRP
1001#define tcsetpgrp(a,b) not_here("tcsetpgrp")
1002#endif
1003#ifndef HAS_TIMES
2986a63f 1004#ifndef NETWARE
8990e307 1005#define times(a) not_here("times")
2986a63f 1006#endif /* NETWARE */
8990e307
LW
1007#endif
1008#ifndef HAS_UNAME
1009#define uname(a) not_here("uname")
1010#endif
1011#ifndef HAS_WAITPID
1012#define waitpid(a,b,c) not_here("waitpid")
1013#endif
1014
a0d0e21e
LW
1015#ifndef HAS_MBLEN
1016#ifndef mblen
1017#define mblen(a,b) not_here("mblen")
1018#endif
1019#endif
1020#ifndef HAS_MBSTOWCS
1021#define mbstowcs(s, pwcs, n) not_here("mbstowcs")
1022#endif
1023#ifndef HAS_MBTOWC
1024#define mbtowc(pwc, s, n) not_here("mbtowc")
1025#endif
1026#ifndef HAS_WCSTOMBS
1027#define wcstombs(s, pwcs, n) not_here("wcstombs")
1028#endif
1029#ifndef HAS_WCTOMB
1030#define wctomb(s, wchar) not_here("wcstombs")
1031#endif
1032#if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
1033/* If we don't have these functions, then we wouldn't have gotten a typedef
1034 for wchar_t, the wide character type. Defining wchar_t allows the
1035 functions referencing it to compile. Its actual type is then meaningless,
1036 since without the above functions, all sections using it end up calling
1037 not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
1038#ifndef wchar_t
1039#define wchar_t char
1040#endif
1041#endif
1042
3f3bcbfc
KW
1043#ifndef HAS_LOCALECONV
1044# define localeconv() not_here("localeconv")
1045#else
2f0945cb
NC
1046struct lconv_offset {
1047 const char *name;
1048 size_t offset;
1049};
1050
1051const struct lconv_offset lconv_strings[] = {
03ceeedf 1052#ifdef USE_LOCALE_NUMERIC
3800c318
JH
1053 {"decimal_point", STRUCT_OFFSET(struct lconv, decimal_point)},
1054 {"thousands_sep", STRUCT_OFFSET(struct lconv, thousands_sep)},
03ceeedf 1055# ifndef NO_LOCALECONV_GROUPING
3800c318 1056 {"grouping", STRUCT_OFFSET(struct lconv, grouping)},
03ceeedf 1057# endif
2f0945cb 1058#endif
03ceeedf 1059#ifdef USE_LOCALE_MONETARY
3800c318
JH
1060 {"int_curr_symbol", STRUCT_OFFSET(struct lconv, int_curr_symbol)},
1061 {"currency_symbol", STRUCT_OFFSET(struct lconv, currency_symbol)},
1062 {"mon_decimal_point", STRUCT_OFFSET(struct lconv, mon_decimal_point)},
03ceeedf 1063# ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
3800c318 1064 {"mon_thousands_sep", STRUCT_OFFSET(struct lconv, mon_thousands_sep)},
03ceeedf
KW
1065# endif
1066# ifndef NO_LOCALECONV_MON_GROUPING
3800c318 1067 {"mon_grouping", STRUCT_OFFSET(struct lconv, mon_grouping)},
03ceeedf 1068# endif
3800c318
JH
1069 {"positive_sign", STRUCT_OFFSET(struct lconv, positive_sign)},
1070 {"negative_sign", STRUCT_OFFSET(struct lconv, negative_sign)},
03ceeedf 1071#endif
2f0945cb
NC
1072 {NULL, 0}
1073};
1074
c1284011
KW
1075#ifdef USE_LOCALE_NUMERIC
1076
1077/* The Linux man pages say these are the field names for the structure
1078 * components that are LC_NUMERIC; the rest being LC_MONETARY */
1079# define isLC_NUMERIC_STRING(name) (strcmp(name, "decimal_point") \
1080 || strcmp(name, "thousands_sep") \
1081 \
1082 /* There should be no harm done \
1083 * checking for this, even if \
1084 * NO_LOCALECONV_GROUPING */ \
1085 || strcmp(name, "grouping"))
1086#else
1087# define isLC_NUMERIC_STRING(name) (0)
1088#endif
1089
2f0945cb 1090const struct lconv_offset lconv_integers[] = {
03ceeedf 1091#ifdef USE_LOCALE_MONETARY
3800c318
JH
1092 {"int_frac_digits", STRUCT_OFFSET(struct lconv, int_frac_digits)},
1093 {"frac_digits", STRUCT_OFFSET(struct lconv, frac_digits)},
1094 {"p_cs_precedes", STRUCT_OFFSET(struct lconv, p_cs_precedes)},
1095 {"p_sep_by_space", STRUCT_OFFSET(struct lconv, p_sep_by_space)},
1096 {"n_cs_precedes", STRUCT_OFFSET(struct lconv, n_cs_precedes)},
1097 {"n_sep_by_space", STRUCT_OFFSET(struct lconv, n_sep_by_space)},
1098 {"p_sign_posn", STRUCT_OFFSET(struct lconv, p_sign_posn)},
1099 {"n_sign_posn", STRUCT_OFFSET(struct lconv, n_sign_posn)},
03ceeedf 1100#endif
2f0945cb
NC
1101 {NULL, 0}
1102};
1103
3f3bcbfc 1104#endif /* HAS_LOCALECONV */
a0d0e21e 1105
172ea7c8 1106#ifdef HAS_LONG_DOUBLE
53796371 1107# if LONG_DOUBLESIZE > NVSIZE
172ea7c8
JH
1108# undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
1109# endif
1110#endif
1111
1112#ifndef HAS_LONG_DOUBLE
1113#ifdef LDBL_MAX
1114#undef LDBL_MAX
1115#endif
1116#ifdef LDBL_MIN
1117#undef LDBL_MIN
1118#endif
1119#ifdef LDBL_EPSILON
1120#undef LDBL_EPSILON
1121#endif
1122#endif
1123
ec193bec
JH
1124/* Background: in most systems the low byte of the wait status
1125 * is the signal (the lowest 7 bits) and the coredump flag is
1126 * the eight bit, and the second lowest byte is the exit status.
1127 * BeOS bucks the trend and has the bytes in different order.
1128 * See beos/beos.c for how the reality is bent even in BeOS
1129 * to follow the traditional. However, to make the POSIX
1130 * wait W*() macros to work in BeOS, we need to unbend the
1131 * reality back in place. --jhi */
17028706
IW
1132/* In actual fact the code below is to blame here. Perl has an internal
1133 * representation of the exit status ($?), which it re-composes from the
1134 * OS's representation using the W*() POSIX macros. The code below
1135 * incorrectly uses the W*() macros on the internal representation,
1136 * which fails for OSs that have a different representation (namely BeOS
1137 * and Haiku). WMUNGE() is a hack that converts the internal
1138 * representation into the OS specific one, so that the W*() macros work
1139 * as expected. The better solution would be not to use the W*() macros
1140 * in the first place, though. -- Ingo Weinhold
1141 */
b6c36746 1142#if defined(__HAIKU__)
ec193bec
JH
1143# define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
1144#else
1145# define WMUNGE(x) (x)
1146#endif
1147
8990e307 1148static int
4b48cf39 1149not_here(const char *s)
8990e307
LW
1150{
1151 croak("POSIX::%s not implemented on this architecture", s);
1152 return -1;
1153}
463ee0b2 1154
1cb0fb50 1155#include "const-c.inc"
a290f238 1156
1dfe7606 1157static void
40b7a5f5 1158restore_sigmask(pTHX_ SV *osset_sv)
1dfe7606 1159{
7feb700b
JH
1160 /* Fortunately, restoring the signal mask can't fail, because
1161 * there's nothing we can do about it if it does -- we're not
1162 * supposed to return -1 from sigaction unless the disposition
1163 * was unaffected.
1164 */
7feb700b
JH
1165 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
1166 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
1dfe7606 1167}
1168
a2261f90
NC
1169static void *
1170allocate_struct(pTHX_ SV *rv, const STRLEN size, const char *packname) {
1171 SV *const t = newSVrv(rv, packname);
1172 void *const p = sv_grow(t, size + 1);
1173
1174 SvCUR_set(t, size);
1175 SvPOK_on(t);
1176 return p;
1177}
1178
81ab4c44
SH
1179#ifdef WIN32
1180
1181/*
1182 * (1) The CRT maintains its own copy of the environment, separate from
1183 * the Win32API copy.
1184 *
1185 * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
1186 * copy, and then calls SetEnvironmentVariableA() to update the Win32API
1187 * copy.
1188 *
1189 * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
1190 * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
1191 * environment.
1192 *
1193 * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
1194 * calls CRT tzset(), but only the first time it is called, and in turn
1195 * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
1196 * local copy of the environment and hence gets the original setting as
1197 * perl never updates the CRT copy when assigning to $ENV{TZ}.
1198 *
1199 * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
1200 * putenv() to update the CRT copy of the environment (if it is different)
1201 * whenever we're about to call tzset().
1202 *
1203 * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
1204 * defined:
1205 *
1206 * (a) Each interpreter has its own copy of the environment inside the
1207 * perlhost structure. That allows applications that host multiple
1208 * independent Perl interpreters to isolate environment changes from
1209 * each other. (This is similar to how the perlhost mechanism keeps a
1210 * separate working directory for each Perl interpreter, so that calling
1211 * chdir() will not affect other interpreters.)
1212 *
1213 * (b) Only the first Perl interpreter instantiated within a process will
1214 * "write through" environment changes to the process environment.
1215 *
1216 * (c) Even the primary Perl interpreter won't update the CRT copy of the
1217 * the environment, only the Win32API copy (it calls win32_putenv()).
1218 *
1219 * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
1220 * sense to only update the process environment when inside the main
1221 * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
1222 * from here so we'll just have to check PL_curinterp instead.
1223 *
1224 * Therefore, we can simply #undef getenv() and putenv() so that those names
1225 * always refer to the CRT functions, and explicitly call win32_getenv() to
1226 * access perl's %ENV.
1227 *
1228 * We also #undef malloc() and free() to be sure we are using the CRT
1229 * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
1230 * into VMem::Malloc() and VMem::Free() and all allocations will be freed
1231 * when the Perl interpreter is being destroyed so we'd end up with a pointer
1232 * into deallocated memory in environ[] if a program embedding a Perl
1233 * interpreter continues to operate even after the main Perl interpreter has
1234 * been destroyed.
1235 *
1236 * Note that we don't free() the malloc()ed memory unless and until we call
1237 * malloc() again ourselves because the CRT putenv() function simply puts its
b7b1e41b 1238 * pointer argument into the environ[] array (it doesn't make a copy of it)
81ab4c44
SH
1239 * so this memory must otherwise be leaked.
1240 */
1241
1242#undef getenv
1243#undef putenv
1244#undef malloc
1245#undef free
1246
1247static void
1248fix_win32_tzenv(void)
1249{
1250 static char* oldenv = NULL;
1251 char* newenv;
1252 const char* perl_tz_env = win32_getenv("TZ");
1253 const char* crt_tz_env = getenv("TZ");
1254 if (perl_tz_env == NULL)
1255 perl_tz_env = "";
1256 if (crt_tz_env == NULL)
1257 crt_tz_env = "";
1258 if (strcmp(perl_tz_env, crt_tz_env) != 0) {
1259 newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
1260 if (newenv != NULL) {
1261 sprintf(newenv, "TZ=%s", perl_tz_env);
1262 putenv(newenv);
1263 if (oldenv != NULL)
1264 free(oldenv);
1265 oldenv = newenv;
1266 }
1267 }
1268}
1269
1270#endif
1271
1272/*
1273 * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
1274 * This code is duplicated in the Time-Piece module, so any changes made here
1275 * should be made there too.
1276 */
1277static void
1278my_tzset(pTHX)
1279{
1280#ifdef WIN32
1281#if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
1282 if (PL_curinterp == aTHX)
1283#endif
1284 fix_win32_tzenv();
1285#endif
1286 tzset();
1287}
1288
fb52dbc1
NC
1289typedef int (*isfunc_t)(int);
1290typedef void (*any_dptr_t)(void *);
1291
1292/* This needs to be ALIASed in a custom way, hence can't easily be defined as
1293 a regular XSUB. */
1294static XSPROTO(is_common); /* prototype to pass -Wmissing-prototypes */
1295static XSPROTO(is_common)
1296{
1297 dXSARGS;
2da736a2 1298
fb52dbc1
NC
1299 if (items != 1)
1300 croak_xs_usage(cv, "charstring");
1301
1302 {
1303 dXSTARG;
1304 STRLEN len;
31e107a4
KW
1305 /*int RETVAL = 0; YYY means uncomment this to return false on an
1306 * empty string input */
fb52dbc1
NC
1307 int RETVAL;
1308 unsigned char *s = (unsigned char *) SvPV(ST(0), len);
1309 unsigned char *e = s + len;
1310 isfunc_t isfunc = (isfunc_t) XSANY.any_dptr;
1311
2da736a2
KW
1312 if (ckWARN_d(WARN_DEPRECATED)) {
1313
1314 /* Warn exactly once for each lexical place this function is
1315 * called. See thread at
1316 * http://markmail.org/thread/jhqcag5njmx7jpyu */
1317
5c45bbe0
TC
1318 HV *warned = get_hv("POSIX::_warned", GV_ADD | GV_ADDMULTI);
1319 if (! hv_exists(warned, (const char *)&PL_op, sizeof(PL_op))) {
2da736a2
KW
1320 Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
1321 "Calling POSIX::%"HEKf"() is deprecated",
1322 HEKfARG(GvNAME_HEK(CvGV(cv))));
5c45bbe0 1323 hv_store(warned, (const char *)&PL_op, sizeof(PL_op), &PL_sv_yes, 0);
2da736a2
KW
1324 }
1325 }
1326
31e107a4 1327 /*if (e > s) { YYY */
fb52dbc1
NC
1328 for (RETVAL = 1; RETVAL && s < e; s++)
1329 if (!isfunc(*s))
1330 RETVAL = 0;
31e107a4 1331 /*} YYY */
fb52dbc1
NC
1332 XSprePUSH;
1333 PUSHi((IV)RETVAL);
1334 }
1335 XSRETURN(1);
1336}
1337
1338MODULE = POSIX PACKAGE = POSIX
1339
1340BOOT:
1341{
1342 CV *cv;
1343 const char *file = __FILE__;
1344
df164f52
DM
1345
1346 /* silence compiler warning about not_here() defined but not used */
1347 if (0) not_here("");
1348
fb52dbc1
NC
1349 /* Ensure we get the function, not a macro implementation. Like the C89
1350 standard says we can... */
1351#undef isalnum
1352 cv = newXS("POSIX::isalnum", is_common, file);
1353 XSANY.any_dptr = (any_dptr_t) &isalnum;
1354#undef isalpha
1355 cv = newXS("POSIX::isalpha", is_common, file);
1356 XSANY.any_dptr = (any_dptr_t) &isalpha;
1357#undef iscntrl
1358 cv = newXS("POSIX::iscntrl", is_common, file);
1359 XSANY.any_dptr = (any_dptr_t) &iscntrl;
1360#undef isdigit
1361 cv = newXS("POSIX::isdigit", is_common, file);
1362 XSANY.any_dptr = (any_dptr_t) &isdigit;
1363#undef isgraph
1364 cv = newXS("POSIX::isgraph", is_common, file);
1365 XSANY.any_dptr = (any_dptr_t) &isgraph;
1366#undef islower
1367 cv = newXS("POSIX::islower", is_common, file);
1368 XSANY.any_dptr = (any_dptr_t) &islower;
1369#undef isprint
1370 cv = newXS("POSIX::isprint", is_common, file);
1371 XSANY.any_dptr = (any_dptr_t) &isprint;
1372#undef ispunct
1373 cv = newXS("POSIX::ispunct", is_common, file);
1374 XSANY.any_dptr = (any_dptr_t) &ispunct;
1375#undef isspace
1376 cv = newXS("POSIX::isspace", is_common, file);
1377 XSANY.any_dptr = (any_dptr_t) &isspace;
1378#undef isupper
1379 cv = newXS("POSIX::isupper", is_common, file);
1380 XSANY.any_dptr = (any_dptr_t) &isupper;
1381#undef isxdigit
1382 cv = newXS("POSIX::isxdigit", is_common, file);
1383 XSANY.any_dptr = (any_dptr_t) &isxdigit;
1384}
1385
2304df62
AD
1386MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
1387
92b39396 1388void
2304df62 1389new(packname = "POSIX::SigSet", ...)
d3f5e399 1390 const char * packname
2304df62
AD
1391 CODE:
1392 {
1393 int i;
92b39396
NC
1394 sigset_t *const s
1395 = (sigset_t *) allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
1396 sizeof(sigset_t),
1397 packname);
1398 sigemptyset(s);
a0d0e21e 1399 for (i = 1; i < items; i++)
92b39396
NC
1400 sigaddset(s, SvIV(ST(i)));
1401 XSRETURN(1);
2304df62 1402 }
2304df62
AD
1403
1404SysRet
df6c2df2 1405addset(sigset, sig)
2304df62
AD
1406 POSIX::SigSet sigset
1407 int sig
df6c2df2
NC
1408 ALIAS:
1409 delset = 1
1410 CODE:
1411 RETVAL = ix ? sigdelset(sigset, sig) : sigaddset(sigset, sig);
1412 OUTPUT:
1413 RETVAL
2304df62
AD
1414
1415SysRet
df6c2df2 1416emptyset(sigset)
2304df62 1417 POSIX::SigSet sigset
df6c2df2
NC
1418 ALIAS:
1419 fillset = 1
1420 CODE:
1421 RETVAL = ix ? sigfillset(sigset) : sigemptyset(sigset);
1422 OUTPUT:
1423 RETVAL
2304df62
AD
1424
1425int
1426sigismember(sigset, sig)
1427 POSIX::SigSet sigset
1428 int sig
1429
a0d0e21e
LW
1430MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
1431
11a39fe4 1432void
a0d0e21e 1433new(packname = "POSIX::Termios", ...)
d3f5e399 1434 const char * packname
a0d0e21e
LW
1435 CODE:
1436 {
1437#ifdef I_TERMIOS
a2261f90
NC
1438 void *const p = allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
1439 sizeof(struct termios), packname);
11a39fe4
NC
1440 /* The previous implementation stored a pointer to an uninitialised
1441 struct termios. Seems safer to initialise it, particularly as
1442 this implementation exposes the struct to prying from perl-space.
1443 */
a2261f90 1444 memset(p, 0, 1 + sizeof(struct termios));
11a39fe4 1445 XSRETURN(1);
a0d0e21e
LW
1446#else
1447 not_here("termios");
1448#endif
1449 }
a0d0e21e
LW
1450
1451SysRet
1452getattr(termios_ref, fd = 0)
1453 POSIX::Termios termios_ref
1454 int fd
1455 CODE:
1456 RETVAL = tcgetattr(fd, termios_ref);
1457 OUTPUT:
1458 RETVAL
1459
e08f19f5
TC
1460# If we define TCSANOW here then both a found and not found constant sub
1461# are created causing a Constant subroutine TCSANOW redefined warning
518487b2 1462#ifndef TCSANOW
e08f19f5
TC
1463# define DEF_SETATTR_ACTION 0
1464#else
1465# define DEF_SETATTR_ACTION TCSANOW
518487b2 1466#endif
a0d0e21e 1467SysRet
e08f19f5 1468setattr(termios_ref, fd = 0, optional_actions = DEF_SETATTR_ACTION)
a0d0e21e
LW
1469 POSIX::Termios termios_ref
1470 int fd
1471 int optional_actions
1472 CODE:
518487b2
NC
1473 /* The second argument to the call is mandatory, but we'd like to give
1474 it a useful default. 0 isn't valid on all operating systems - on
1475 Solaris (at least) TCSANOW, TCSADRAIN and TCSAFLUSH have the same
1476 values as the equivalent ioctls, TCSETS, TCSETSW and TCSETSF. */
a0d0e21e
LW
1477 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
1478 OUTPUT:
1479 RETVAL
1480
1481speed_t
2a59a32c 1482getispeed(termios_ref)
a0d0e21e 1483 POSIX::Termios termios_ref
2a59a32c
NC
1484 ALIAS:
1485 getospeed = 1
a0d0e21e 1486 CODE:
2a59a32c 1487 RETVAL = ix ? cfgetospeed(termios_ref) : cfgetispeed(termios_ref);
a0d0e21e
LW
1488 OUTPUT:
1489 RETVAL
1490
1491tcflag_t
2a59a32c 1492getiflag(termios_ref)
a0d0e21e 1493 POSIX::Termios termios_ref
2a59a32c
NC
1494 ALIAS:
1495 getoflag = 1
1496 getcflag = 2
1497 getlflag = 3
a0d0e21e
LW
1498 CODE:
1499#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
2a59a32c
NC
1500 switch(ix) {
1501 case 0:
1502 RETVAL = termios_ref->c_iflag;
1503 break;
1504 case 1:
1505 RETVAL = termios_ref->c_oflag;
1506 break;
1507 case 2:
1508 RETVAL = termios_ref->c_cflag;
1509 break;
1510 case 3:
1511 RETVAL = termios_ref->c_lflag;
1512 break;
df164f52
DM
1513 default:
1514 RETVAL = 0; /* silence compiler warning */
2a59a32c 1515 }
a0d0e21e 1516#else
2a59a32c
NC
1517 not_here(GvNAME(CvGV(cv)));
1518 RETVAL = 0;
a0d0e21e
LW
1519#endif
1520 OUTPUT:
1521 RETVAL
1522
1523cc_t
1524getcc(termios_ref, ccix)
1525 POSIX::Termios termios_ref
b56fc9ec 1526 unsigned int ccix
a0d0e21e
LW
1527 CODE:
1528#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
1529 if (ccix >= NCCS)
1530 croak("Bad getcc subscript");
1531 RETVAL = termios_ref->c_cc[ccix];
1532#else
640cc986
HM
1533 not_here("getcc");
1534 RETVAL = 0;
a0d0e21e
LW
1535#endif
1536 OUTPUT:
1537 RETVAL
1538
1539SysRet
2a59a32c 1540setispeed(termios_ref, speed)
a0d0e21e
LW
1541 POSIX::Termios termios_ref
1542 speed_t speed
2a59a32c
NC
1543 ALIAS:
1544 setospeed = 1
a0d0e21e 1545 CODE:
2a59a32c
NC
1546 RETVAL = ix
1547 ? cfsetospeed(termios_ref, speed) : cfsetispeed(termios_ref, speed);
1548 OUTPUT:
1549 RETVAL
a0d0e21e
LW
1550
1551void
2a59a32c 1552setiflag(termios_ref, flag)
a0d0e21e 1553 POSIX::Termios termios_ref
2a59a32c
NC
1554 tcflag_t flag
1555 ALIAS:
1556 setoflag = 1
1557 setcflag = 2
1558 setlflag = 3
a0d0e21e
LW
1559 CODE:
1560#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
2a59a32c
NC
1561 switch(ix) {
1562 case 0:
1563 termios_ref->c_iflag = flag;
1564 break;
1565 case 1:
1566 termios_ref->c_oflag = flag;
1567 break;
1568 case 2:
1569 termios_ref->c_cflag = flag;
1570 break;
1571 case 3:
1572 termios_ref->c_lflag = flag;
1573 break;
1574 }
a0d0e21e 1575#else
2a59a32c 1576 not_here(GvNAME(CvGV(cv)));
a0d0e21e
LW
1577#endif
1578
1579void
1580setcc(termios_ref, ccix, cc)
1581 POSIX::Termios termios_ref
b56fc9ec 1582 unsigned int ccix
a0d0e21e
LW
1583 cc_t cc
1584 CODE:
1585#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
1586 if (ccix >= NCCS)
1587 croak("Bad setcc subscript");
1588 termios_ref->c_cc[ccix] = cc;
1589#else
1590 not_here("setcc");
1591#endif
1592
1593
a0d0e21e
LW
1594MODULE = POSIX PACKAGE = POSIX
1595
1cb0fb50 1596INCLUDE: const-xs.inc
a290f238 1597
e99d581a
NC
1598int
1599WEXITSTATUS(status)
1600 int status
72bfe1b2
NC
1601 ALIAS:
1602 POSIX::WIFEXITED = 1
1603 POSIX::WIFSIGNALED = 2
1604 POSIX::WIFSTOPPED = 3
1605 POSIX::WSTOPSIG = 4
1606 POSIX::WTERMSIG = 5
1607 CODE:
fabb67aa
SK
1608#if !defined(WEXITSTATUS) || !defined(WIFEXITED) || !defined(WIFSIGNALED) \
1609 || !defined(WIFSTOPPED) || !defined(WSTOPSIG) || !defined(WTERMSIG)
19c4478c
NC
1610 RETVAL = 0; /* Silence compilers that notice this, but don't realise
1611 that not_here() can't return. */
1612#endif
72bfe1b2
NC
1613 switch(ix) {
1614 case 0:
d49025b7 1615#ifdef WEXITSTATUS
17028706 1616 RETVAL = WEXITSTATUS(WMUNGE(status));
d49025b7
NC
1617#else
1618 not_here("WEXITSTATUS");
1619#endif
72bfe1b2
NC
1620 break;
1621 case 1:
d49025b7 1622#ifdef WIFEXITED
17028706 1623 RETVAL = WIFEXITED(WMUNGE(status));
d49025b7
NC
1624#else
1625 not_here("WIFEXITED");
1626#endif
72bfe1b2
NC
1627 break;
1628 case 2:
d49025b7 1629#ifdef WIFSIGNALED
17028706 1630 RETVAL = WIFSIGNALED(WMUNGE(status));
d49025b7
NC
1631#else
1632 not_here("WIFSIGNALED");
1633#endif
72bfe1b2
NC
1634 break;
1635 case 3:
d49025b7 1636#ifdef WIFSTOPPED
17028706 1637 RETVAL = WIFSTOPPED(WMUNGE(status));
d49025b7
NC
1638#else
1639 not_here("WIFSTOPPED");
1640#endif
72bfe1b2
NC
1641 break;
1642 case 4:
d49025b7 1643#ifdef WSTOPSIG
17028706 1644 RETVAL = WSTOPSIG(WMUNGE(status));
d49025b7
NC
1645#else
1646 not_here("WSTOPSIG");
1647#endif
72bfe1b2
NC
1648 break;
1649 case 5:
d49025b7 1650#ifdef WTERMSIG
17028706 1651 RETVAL = WTERMSIG(WMUNGE(status));
d49025b7
NC
1652#else
1653 not_here("WTERMSIG");
1654#endif
72bfe1b2
NC
1655 break;
1656 default:
c33e8be1 1657 Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", (int)ix);
72bfe1b2
NC
1658 }
1659 OUTPUT:
1660 RETVAL
2304df62 1661
2304df62
AD
1662SysRet
1663open(filename, flags = O_RDONLY, mode = 0666)
1664 char * filename
1665 int flags
a0d0e21e 1666 Mode_t mode
748a9306
LW
1667 CODE:
1668 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
1669 TAINT_PROPER("open");
1670 RETVAL = open(filename, flags, mode);
1671 OUTPUT:
1672 RETVAL
1673
2304df62
AD
1674
1675HV *
1676localeconv()
1677 CODE:
3f3bcbfc
KW
1678#ifndef HAS_LOCALECONV
1679 localeconv(); /* A stub to call not_here(). */
1680#else
2304df62 1681 struct lconv *lcbuf;
a835cd47
KW
1682
1683 /* localeconv() deals with both LC_NUMERIC and LC_MONETARY, but
1684 * LC_MONETARY is already in the correct locale */
1685 STORE_NUMERIC_STANDARD_FORCE_LOCAL();
1686
2304df62 1687 RETVAL = newHV();
c4e79b56 1688 sv_2mortal((SV*)RETVAL);
8063af02 1689 if ((lcbuf = localeconv())) {
2f0945cb
NC
1690 const struct lconv_offset *strings = lconv_strings;
1691 const struct lconv_offset *integers = lconv_integers;
1692 const char *ptr = (const char *) lcbuf;
1693
1694 do {
c1284011
KW
1695 /* This string may be controlled by either LC_NUMERIC, or
1696 * LC_MONETARY */
1697 bool is_utf8_locale
1698#if defined(USE_LOCALE_NUMERIC) && defined(USE_LOCALE_MONETARY)
1699 = _is_cur_LC_category_utf8((isLC_NUMERIC_STRING(strings->name))
1700 ? LC_NUMERIC
1701 : LC_MONETARY);
1702#elif defined(USE_LOCALE_NUMERIC)
1703 = _is_cur_LC_category_utf8(LC_NUMERIC);
1704#elif defined(USE_LOCALE_MONETARY)
1705 = _is_cur_LC_category_utf8(LC_MONETARY);
1706#else
1707 = FALSE;
1708#endif
1709
2f0945cb
NC
1710 const char *value = *((const char **)(ptr + strings->offset));
1711
c1284011
KW
1712 if (value && *value) {
1713 (void) hv_store(RETVAL,
1714 strings->name,
1715 strlen(strings->name),
1716 newSVpvn_utf8(value,
1717 strlen(value),
1718
1719 /* We mark it as UTF-8 if a utf8 locale
1720 * and is valid, non-ascii UTF-8 */
1721 is_utf8_locale
1722 && ! is_ascii_string((U8 *) value, 0)
1723 && is_utf8_string((U8 *) value, 0)),
1724 0);
1725 }
2f0945cb
NC
1726 } while ((++strings)->name);
1727
1728 do {
1729 const char value = *((const char *)(ptr + integers->offset));
1730
1731 if (value != CHAR_MAX)
1732 (void) hv_store(RETVAL, integers->name,
1733 strlen(integers->name), newSViv(value), 0);
1734 } while ((++integers)->name);
2304df62 1735 }
a835cd47 1736 RESTORE_NUMERIC_STANDARD();
3f3bcbfc 1737#endif /* HAS_LOCALECONV */
2304df62
AD
1738 OUTPUT:
1739 RETVAL
1740
1741char *
c28ee57b 1742setlocale(category, locale = 0)
2304df62 1743 int category
8e70cf7a 1744 const char * locale
1ba01ae3
SH
1745 PREINIT:
1746 char * retval;
c28ee57b 1747 CODE:
49efabc8
KW
1748#ifdef USE_LOCALE_NUMERIC
1749 /* A 0 (or NULL) locale means only query what the current one is. We
1750 * have the LC_NUMERIC name saved, because we are normally switched
1751 * into the C locale for it. Switch back so an LC_ALL query will yield
1752 * the correct results; all other categories don't require special
1753 * handling */
1754 if (locale == 0) {
1755 if (category == LC_NUMERIC) {
1756 XSRETURN_PV(PL_numeric_name);
1757 }
1758# ifdef LC_ALL
1759 else if (category == LC_ALL) {
1760 SET_NUMERIC_LOCAL();
1761 }
1762# endif
1763 }
1764#endif
b385bb4d
KW
1765#ifdef WIN32 /* Use wrapper on Windows */
1766 retval = Perl_my_setlocale(aTHX_ category, locale);
1767#else
1ba01ae3 1768 retval = setlocale(category, locale);
b385bb4d 1769#endif
fbd840df 1770 if (! retval) {
49efabc8
KW
1771 /* Should never happen that a query would return an error, but be
1772 * sure and reset to C locale */
1773 if (locale == 0) {
1774 SET_NUMERIC_STANDARD();
1775 }
fbd840df
KW
1776 XSRETURN_UNDEF;
1777 }
49efabc8
KW
1778
1779 /* Save retval since subsequent setlocale() calls may overwrite it. */
1780 retval = savepv(retval);
1781
1782 /* For locale == 0, we may have switched to NUMERIC_LOCAL. Switch back
1783 * */
1784 if (locale == 0) {
1785 SET_NUMERIC_STANDARD();
1786 XSRETURN_PV(retval);
1787 }
fbd840df 1788 else {
49efabc8 1789 RETVAL = retval;
36477c24 1790#ifdef USE_LOCALE_CTYPE
bbce6d69
PP
1791 if (category == LC_CTYPE
1792#ifdef LC_ALL
1793 || category == LC_ALL
1794#endif
1795 )
1796 {
1797 char *newctype;
1798#ifdef LC_ALL
1799 if (category == LC_ALL)
1800 newctype = setlocale(LC_CTYPE, NULL);
1801 else
1802#endif
1803 newctype = RETVAL;
864dbfa3 1804 new_ctype(newctype);
bbce6d69 1805 }
36477c24
PP
1806#endif /* USE_LOCALE_CTYPE */
1807#ifdef USE_LOCALE_COLLATE
bbce6d69
PP
1808 if (category == LC_COLLATE
1809#ifdef LC_ALL
1810 || category == LC_ALL
1811#endif
1812 )
1813 {
1814 char *newcoll;
1815#ifdef LC_ALL
1816 if (category == LC_ALL)
1817 newcoll = setlocale(LC_COLLATE, NULL);
1818 else
1819#endif
1820 newcoll = RETVAL;
864dbfa3 1821 new_collate(newcoll);
bbce6d69 1822 }
36477c24
PP
1823#endif /* USE_LOCALE_COLLATE */
1824#ifdef USE_LOCALE_NUMERIC
bbce6d69
PP
1825 if (category == LC_NUMERIC
1826#ifdef LC_ALL
1827 || category == LC_ALL
1828#endif
1829 )
1830 {
1831 char *newnum;
1832#ifdef LC_ALL
1833 if (category == LC_ALL)
1834 newnum = setlocale(LC_NUMERIC, NULL);
1835 else
1836#endif
1837 newnum = RETVAL;
864dbfa3 1838 new_numeric(newnum);
bbce6d69 1839 }
36477c24 1840#endif /* USE_LOCALE_NUMERIC */
bbce6d69 1841 }
c28ee57b
JH
1842 OUTPUT:
1843 RETVAL
1ba01ae3 1844 CLEANUP:
fbd840df 1845 Safefree(RETVAL);
2304df62 1846
e1ca407b 1847NV
2304df62 1848acos(x)
e1ca407b 1849 NV x
b256643b 1850 ALIAS:
7965edec
JH
1851 acosh = 1
1852 asin = 2
1853 asinh = 3
1854 atan = 4
1855 atanh = 5
1856 cbrt = 6
1857 ceil = 7
1858 cosh = 8
1859 erf = 9
1860 erfc = 10
1861 exp2 = 11
1862 expm1 = 12
1863 floor = 13
1864 j0 = 14
1865 j1 = 15
1866 lgamma = 16
1867 log10 = 17
1868 log1p = 18
1869 log2 = 19
1870 logb = 20
1871 nearbyint = 21
1872 rint = 22
1873 round = 23
1874 sinh = 24
1875 tan = 25
1876 tanh = 26
1877 tgamma = 27
1878 trunc = 28
1879 y0 = 29
1880 y1 = 30
b256643b 1881 CODE:
78a0541a 1882 RETVAL = NV_NAN;
b256643b
NC
1883 switch (ix) {
1884 case 0:
5716d070 1885 RETVAL = acos(x); /* C89 math */
b256643b
NC
1886 break;
1887 case 1:
5716d070 1888#ifdef c99_acosh
7965edec 1889 RETVAL = c99_acosh(x);
5716d070
JH
1890#else
1891 not_here("acosh");
1892#endif
b256643b
NC
1893 break;
1894 case 2:
5716d070 1895 RETVAL = asin(x); /* C89 math */
b256643b
NC
1896 break;
1897 case 3:
5716d070 1898#ifdef c99_asinh
7965edec 1899 RETVAL = c99_asinh(x);
5716d070
JH
1900#else
1901 not_here("asinh");
1902#endif
b256643b
NC
1903 break;
1904 case 4:
5716d070 1905 RETVAL = atan(x); /* C89 math */
b256643b
NC
1906 break;
1907 case 5:
5716d070 1908#ifdef c99_atanh
7965edec 1909 RETVAL = c99_atanh(x);
5716d070
JH
1910#else
1911 not_here("atanh");
1912#endif
b256643b
NC
1913 break;
1914 case 6:
5716d070 1915#ifdef c99_cbrt
7965edec 1916 RETVAL = c99_cbrt(x);
5716d070
JH
1917#else
1918 not_here("cbrt");
1919#endif
b256643b
NC
1920 break;
1921 case 7:
5716d070 1922 RETVAL = ceil(x); /* C89 math */
b256643b
NC
1923 break;
1924 case 8:
5716d070 1925 RETVAL = cosh(x); /* C89 math */
7965edec
JH
1926 break;
1927 case 9:
5716d070 1928#ifdef c99_erf
7965edec 1929 RETVAL = c99_erf(x);
5716d070
JH
1930#else
1931 not_here("erf");
1932#endif
7965edec
JH
1933 break;
1934 case 10:
5716d070
JH
1935#ifdef c99_erfc
1936 RETVAL = erfc(x);
1937#else
1938 not_here("erfc");
1939#endif
7965edec
JH
1940 break;
1941 case 11:
5716d070 1942#ifdef c99_exp2
7965edec 1943 RETVAL = c99_exp2(x);
5716d070
JH
1944#else
1945 not_here("exp2");
1946#endif
7965edec
JH
1947 break;
1948 case 12:
5716d070 1949#ifdef c99_expm1
7965edec 1950 RETVAL = c99_expm1(x);
5716d070
JH
1951#else
1952 not_here("expm1");
1953#endif
7965edec
JH
1954 break;
1955 case 13:
5716d070 1956 RETVAL = floor(x); /* C89 math */
7965edec
JH
1957 break;
1958 case 14:
5716d070 1959#ifdef bessel_j0
7965edec 1960 RETVAL = bessel_j0(x);
5716d070 1961#else
85c93440 1962 not_here("j0");
5716d070 1963#endif
7965edec
JH
1964 break;
1965 case 15:
5716d070 1966#ifdef bessel_j1
7965edec 1967 RETVAL = bessel_j1(x);
5716d070 1968#else
85c93440 1969 not_here("j1");
5716d070 1970#endif
7965edec
JH
1971 break;
1972 case 16:
d334ccbe
JH
1973 /* XXX lgamma_r -- the lgamma accesses a global variable (signgam),
1974 * which is evil. Some platforms have lgamma_r, which has
1975 * extra parameter instead of the global variable. */
5716d070 1976#ifdef c99_lgamma
7965edec 1977 RETVAL = c99_lgamma(x);
5716d070
JH
1978#else
1979 not_here("lgamma");
1980#endif
7965edec
JH
1981 break;
1982 case 17:
5716d070 1983 RETVAL = log10(x); /* C89 math */
7965edec
JH
1984 break;
1985 case 18:
5716d070 1986#ifdef c99_log1p
7965edec 1987 RETVAL = c99_log1p(x);
5716d070
JH
1988#else
1989 not_here("log1p");
1990#endif
7965edec
JH
1991 break;
1992 case 19:
5716d070 1993#ifdef c99_log2
7965edec 1994 RETVAL = c99_log2(x);
5716d070
JH
1995#else
1996 not_here("log2");
1997#endif
7965edec
JH
1998 break;
1999 case 20:
5716d070 2000#ifdef c99_logb
7965edec 2001 RETVAL = c99_logb(x);
5716d070
JH
2002#else
2003 not_here("logb");
2004#endif
7965edec
JH
2005 break;
2006 case 21:
5716d070 2007#ifdef c99_nearbyint
7965edec 2008 RETVAL = c99_nearbyint(x);
5716d070
JH
2009#else
2010 not_here("nearbyint");
2011#endif
7965edec
JH
2012 break;
2013 case 22:
5716d070 2014#ifdef c99_rint
7965edec 2015 RETVAL = c99_rint(x);
5716d070
JH
2016#else
2017 not_here("rint");
2018#endif
7965edec
JH
2019 break;
2020 case 23:
5716d070 2021#ifdef c99_round
7965edec 2022 RETVAL = c99_round(x);
5716d070
JH
2023#else
2024 not_here("round");
2025#endif
7965edec
JH
2026 break;
2027 case 24:
5716d070 2028 RETVAL = sinh(x); /* C89 math */
7965edec
JH
2029 break;
2030 case 25:
5716d070 2031 RETVAL = tan(x); /* C89 math */
b256643b 2032 break;
7965edec 2033 case 26:
5716d070 2034 RETVAL = tanh(x); /* C89 math */
7965edec
JH
2035 break;
2036 case 27:
d334ccbe
JH
2037 /* XXX tgamma_r -- the lgamma accesses a global variable (signgam),
2038 * which is evil. Some platforms have tgamma_r, which has
2039 * extra parameter instead of the global variable. */
5716d070 2040#ifdef c99_tgamma
7965edec 2041 RETVAL = c99_tgamma(x);
5716d070
JH
2042#else
2043 not_here("tgamma");
2044#endif
7965edec
JH
2045 break;
2046 case 28:
5716d070 2047#ifdef c99_trunc
7965edec 2048 RETVAL = c99_trunc(x);
5716d070
JH
2049#else
2050 not_here("trunc");
2051#endif
7965edec
JH
2052 break;
2053 case 29:
5716d070 2054#ifdef bessel_y0
7965edec 2055 RETVAL = bessel_y0(x);
5716d070 2056#else
85c93440 2057 not_here("y0");
5716d070 2058#endif
7965edec
JH
2059 break;
2060 case 30:
2061 default:
5716d070 2062#ifdef bessel_y1
7965edec 2063 RETVAL = bessel_y1(x);
5716d070 2064#else
85c93440 2065 not_here("y1");
5716d070 2066#endif
7965edec
JH
2067 }
2068 OUTPUT:
2069 RETVAL
2070
2071IV
a5713e21
JH
2072fegetround()
2073 CODE:
78a0541a 2074#ifdef HAS_FEGETROUND
d5f4f26a 2075 RETVAL = my_fegetround();
78a0541a
JH
2076#else
2077 RETVAL = -1;
a5713e21
JH
2078 not_here("fegetround");
2079#endif
2080 OUTPUT:
2081 RETVAL
2082
2083IV
2084fesetround(x)
2085 IV x
2086 CODE:
2087#ifdef HAS_FEGETROUND /* canary for fesetround */
2088 RETVAL = fesetround(x);
2089#else
78a0541a 2090 RETVAL = -1;
a5713e21
JH
2091 not_here("fesetround");
2092#endif
2093 OUTPUT:
2094 RETVAL
2095
2096IV
7965edec
JH
2097fpclassify(x)
2098 NV x
2099 ALIAS:
2100 ilogb = 1
2101 isfinite = 2
2102 isinf = 3
2103 isnan = 4
2104 isnormal = 5
d5f4f26a
JH
2105 lrint = 6
2106 signbit = 7
7965edec 2107 CODE:
78a0541a 2108 RETVAL = -1;
7965edec
JH
2109 switch (ix) {
2110 case 0:
5716d070 2111#ifdef c99_fpclassify
7965edec 2112 RETVAL = c99_fpclassify(x);
5716d070
JH
2113#else
2114 not_here("fpclassify");
2115#endif
7965edec
JH
2116 break;
2117 case 1:
5716d070 2118#ifdef c99_ilogb
7965edec 2119 RETVAL = c99_ilogb(x);
5716d070
JH
2120#else
2121 not_here("ilogb");
2122#endif
7965edec
JH
2123 break;
2124 case 2:
2125 RETVAL = Perl_isfinite(x);
2126 break;
2127 case 3:
2128 RETVAL = Perl_isinf(x);
2129 break;
2130 case 4:
2131 RETVAL = Perl_isnan(x);
2132 break;
2133 case 5:
5716d070 2134#ifdef c99_isnormal
7965edec 2135 RETVAL = c99_isnormal(x);
5716d070
JH
2136#else
2137 not_here("isnormal");
2138#endif
7965edec
JH
2139 break;
2140 case 6:
d5f4f26a
JH
2141#ifdef c99_lrint
2142 RETVAL = c99_lrint(x);
2143#else
2144 not_here("lrint");
2145#endif
2146 break;
2147 case 7:
7965edec 2148 default:
5716d070
JH
2149#ifdef Perl_signbit
2150 RETVAL = Perl_signbit(x);
2151#endif
7965edec 2152 break;
b256643b
NC
2153 }
2154 OUTPUT:
2155 RETVAL
2304df62 2156
e1ca407b 2157NV
7965edec 2158copysign(x,y)
e1ca407b
A
2159 NV x
2160 NV y
7965edec
JH
2161 ALIAS:
2162 fdim = 1
2163 fmax = 2
2164 fmin = 3
2165 fmod = 4
2166 hypot = 5
2167 isgreater = 6
2168 isgreaterequal = 7
2169 isless = 8
2170 islessequal = 9
2171 islessgreater = 10
2172 isunordered = 11
2173 nextafter = 12
2174 nexttoward = 13
2175 remainder = 14
2176 CODE:
78a0541a 2177 RETVAL = NV_NAN;
7965edec
JH
2178 switch (ix) {
2179 case 0:
5716d070 2180#ifdef c99_copysign
7965edec 2181 RETVAL = c99_copysign(x, y);
5716d070
JH
2182#else
2183 not_here("copysign");
2184#endif
7965edec
JH
2185 break;
2186 case 1:
5716d070 2187#ifdef c99_fdim
7965edec 2188 RETVAL = c99_fdim(x, y);
5716d070
JH
2189#else
2190 not_here("fdim");
2191#endif
7965edec
JH
2192 break;
2193 case 2:
5716d070 2194#ifdef c99_fmax
7965edec 2195 RETVAL = c99_fmax(x, y);
5716d070
JH
2196#else
2197 not_here("fmax");
2198#endif
7965edec
JH
2199 break;
2200 case 3:
5716d070 2201#ifdef c99_fmin
7965edec 2202 RETVAL = c99_fmin(x, y);
5716d070
JH
2203#else
2204 not_here("fmin");
2205#endif
7965edec
JH
2206 break;
2207 case 4:
5716d070 2208 RETVAL = fmod(x, y); /* C89 math */
7965edec
JH
2209 break;
2210 case 5:
5716d070 2211#ifdef c99_hypot
7965edec 2212 RETVAL = c99_hypot(x, y);
5716d070
JH
2213#else
2214 not_here("hypot");
2215#endif
7965edec
JH
2216 break;
2217 case 6:
5716d070 2218#ifdef c99_isgreater
7965edec 2219 RETVAL = c99_isgreater(x, y);
5716d070
JH
2220#else
2221 not_here("isgreater");
2222#endif
7965edec
JH
2223 break;
2224 case 7:
5716d070 2225#ifdef c99_isgreaterequal
7965edec 2226 RETVAL = c99_isgreaterequal(x, y);
5716d070
JH
2227#else
2228 not_here("isgreaterequal");
2229#endif
7965edec
JH
2230 break;
2231 case 8:
5716d070 2232#ifdef c99_isless
7965edec 2233 RETVAL = c99_isless(x, y);
5716d070
JH
2234#else
2235 not_here("isless");
2236#endif
7965edec
JH
2237 break;
2238 case 9:
5716d070 2239#ifdef c99_islessequal
7965edec 2240 RETVAL = c99_islessequal(x, y);
5716d070
JH
2241#else
2242 not_here("islessequal");
2243#endif
7965edec
JH
2244 break;
2245 case 10:
5716d070 2246#ifdef c99_islessgreater
7965edec 2247 RETVAL = c99_islessgreater(x, y);
5716d070
JH
2248#else
2249 not_here("islessgreater");
2250#endif
7965edec
JH
2251 break;
2252 case 11:
5716d070 2253#ifdef c99_isunordered
7965edec 2254 RETVAL = c99_isunordered(x, y);
5716d070
JH
2255#else
2256 not_here("isunordered");
2257#endif
7965edec
JH
2258 break;
2259 case 12:
5716d070 2260#ifdef c99_nextafter
7965edec 2261 RETVAL = c99_nextafter(x, y);
5716d070
JH
2262#else
2263 not_here("nextafter");
2264#endif
7965edec
JH
2265 break;
2266 case 13:
5716d070 2267#ifdef c99_nexttoward
7965edec 2268 RETVAL = c99_nexttoward(x, y);
5716d070
JH
2269#else
2270 not_here("nexttoward");
2271#endif
7965edec
JH
2272 break;
2273 case 14:
2274 default:
5716d070 2275#ifdef c99_remainder
7965edec 2276 RETVAL = c99_remainder(x, y);
5716d070
JH
2277#else
2278 not_here("remainder");
2279#endif
7965edec
JH
2280 break;
2281 }
2282 OUTPUT:
2283 RETVAL
2304df62
AD
2284
2285void
2286frexp(x)
e1ca407b 2287 NV x
2304df62
AD
2288 PPCODE:
2289 int expvar;
2304df62 2290 /* (We already know stack is long enough.) */
5716d070 2291 PUSHs(sv_2mortal(newSVnv(Perl_frexp(x,&expvar)))); /* C89 math */
2304df62
AD
2292 PUSHs(sv_2mortal(newSViv(expvar)));
2293
e1ca407b 2294NV
2304df62 2295ldexp(x,exp)
e1ca407b 2296 NV x
2304df62
AD
2297 int exp
2298
2304df62
AD
2299void
2300modf(x)
e1ca407b 2301 NV x
2304df62 2302 PPCODE:
e1ca407b 2303 NV intvar;
2304df62 2304 /* (We already know stack is long enough.) */
5716d070 2305 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar)))); /* C89 math */
2304df62
AD
2306 PUSHs(sv_2mortal(newSVnv(intvar)));
2307
7965edec
JH
2308void
2309remquo(x,y)
2310 NV x
2311 NV y
2312 PPCODE:
5716d070 2313#ifdef c99_remquo
7965edec
JH
2314 int intvar;
2315 PUSHs(sv_2mortal(newSVnv(c99_remquo(x,y,&intvar))));
2316 PUSHs(sv_2mortal(newSVnv(intvar)));
5716d070
JH
2317#else
2318 not_here("remquo");
2319#endif
7965edec
JH
2320
2321NV
2322scalbn(x,y)
2323 NV x
2324 IV y
2325 CODE:
5716d070 2326#ifdef c99_scalbn
7965edec 2327 RETVAL = c99_scalbn(x, y);
5716d070 2328#else
78a0541a 2329 RETVAL = NV_NAN;
5716d070
JH
2330 not_here("scalbn");
2331#endif
7965edec
JH
2332 OUTPUT:
2333 RETVAL
2334
2335NV
2336fma(x,y,z)
2337 NV x
2338 NV y
2339 NV z
2340 CODE:
5716d070 2341#ifdef c99_fma
7965edec 2342 RETVAL = c99_fma(x, y, z);
5716d070 2343#else
78a0541a 2344 RETVAL = NV_NAN;
5716d070
JH
2345 not_here("fma");
2346#endif
7965edec
JH
2347 OUTPUT:
2348 RETVAL
2349
2350NV
b05fd80e 2351nan(s = 0)
7965edec
JH
2352 char* s;
2353 CODE:
5716d070 2354#ifdef c99_nan
b05fd80e 2355 RETVAL = c99_nan(s ? s : "");
5716d070 2356#else
78a0541a 2357 RETVAL = NV_NAN;
5716d070
JH
2358 not_here("nan");
2359#endif
7965edec
JH
2360 OUTPUT:
2361 RETVAL
2362
2363NV
2364jn(x,y)
2365 IV x
2366 NV y
2367 ALIAS:
2368 yn = 1
2369 CODE:
78a0541a 2370 RETVAL = NV_NAN;
7965edec
JH
2371 switch (ix) {
2372 case 0:
5716d070 2373#ifdef bessel_jn
7965edec 2374 RETVAL = bessel_jn(x, y);
5716d070
JH
2375#else
2376 not_here("jn");
2377#endif
7965edec
JH
2378 break;
2379 case 1:
2380 default:
5716d070 2381#ifdef bessel_yn
7965edec 2382 RETVAL = bessel_yn(x, y);
5716d070
JH
2383#else
2384 not_here("yn");
2385#endif
7965edec
JH
2386 break;
2387 }
2388 OUTPUT:
2389 RETVAL
2390
2304df62 2391SysRet
1dfe7606 2392sigaction(sig, optaction, oldaction = 0)
2304df62 2393 int sig
1dfe7606 2394 SV * optaction
2304df62
AD
2395 POSIX::SigAction oldaction
2396 CODE:
2986a63f 2397#if defined(WIN32) || defined(NETWARE)
6dead956
GS
2398 RETVAL = not_here("sigaction");
2399#else
2304df62
AD
2400# This code is really grody because we're trying to make the signal
2401# interface look beautiful, which is hard.
2402
2304df62 2403 {
27da23d5 2404 dVAR;
1dfe7606 2405 POSIX__SigAction action;
f584eb2d 2406 GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
2304df62
AD
2407 struct sigaction act;
2408 struct sigaction oact;
1dfe7606 2409 sigset_t sset;
183bde56 2410 SV *osset_sv;
27c1a449 2411 sigset_t osset;
2304df62
AD
2412 POSIX__SigSet sigset;
2413 SV** svp;
1d81eac9 2414 SV** sigsvp;
3609ea0d 2415
516d25e8
SP
2416 if (sig < 0) {
2417 croak("Negative signals are not allowed");
2418 }
2419
1d81eac9 2420 if (sig == 0 && SvPOK(ST(0))) {
aa07b2f6 2421 const char *s = SvPVX_const(ST(0));
1d81eac9
JH
2422 int i = whichsig(s);
2423
2424 if (i < 0 && memEQ(s, "SIG", 3))
2425 i = whichsig(s + 3);
2426 if (i < 0) {
2427 if (ckWARN(WARN_SIGNAL))
2428 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
2429 "No such signal: SIG%s", s);
2430 XSRETURN_UNDEF;
2431 }
2432 else
2433 sig = i;
2434 }
3609ea0d
JH
2435#ifdef NSIG
2436 if (sig > NSIG) { /* NSIG - 1 is still okay. */
2437 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
2438 "No such signal: %d", sig);
2439 XSRETURN_UNDEF;
2440 }
2441#endif
1d81eac9
JH
2442 sigsvp = hv_fetch(GvHVn(siggv),
2443 PL_sig_name[sig],
2444 strlen(PL_sig_name[sig]),
2445 TRUE);
2304df62 2446
1dfe7606 2447 /* Check optaction and set action */
2448 if(SvTRUE(optaction)) {
2449 if(sv_isa(optaction, "POSIX::SigAction"))
2450 action = (HV*)SvRV(optaction);
2451 else
2452 croak("action is not of type POSIX::SigAction");
2453 }
2454 else {
2455 action=0;
2456 }
2457
2458 /* sigaction() is supposed to look atomic. In particular, any
2459 * signal handler invoked during a sigaction() call should
2460 * see either the old or the new disposition, and not something
2461 * in between. We use sigprocmask() to make it so.
2462 */
2463 sigfillset(&sset);
2464 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
2465 if(RETVAL == -1)
15c0d34a 2466 XSRETURN_UNDEF;
1dfe7606 2467 ENTER;
2468 /* Restore signal mask no matter how we exit this block. */
f584eb2d 2469 osset_sv = newSVpvn((char *)(&osset), sizeof(sigset_t));
183bde56 2470 SAVEFREESV( osset_sv );
40b7a5f5 2471 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1dfe7606 2472
2473 RETVAL=-1; /* In case both oldaction and action are 0. */
2474
2475 /* Remember old disposition if desired. */
2304df62 2476 if (oldaction) {
017a3ce5 2477 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
1dfe7606 2478 if(!svp)
2479 croak("Can't supply an oldaction without a HANDLER");
2480 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
2481 sv_setsv(*svp, *sigsvp);
2482 }
2483 else {
f584eb2d 2484 sv_setpvs(*svp, "DEFAULT");
1dfe7606 2485 }
2486 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
6ca4bbc9
GG
2487 if(RETVAL == -1) {
2488 LEAVE;
15c0d34a 2489 XSRETURN_UNDEF;
6ca4bbc9 2490 }
1dfe7606 2491 /* Get back the mask. */
017a3ce5 2492 svp = hv_fetchs(oldaction, "MASK", TRUE);
1dfe7606 2493 if (sv_isa(*svp, "POSIX::SigSet")) {
92b39396 2494 sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
1dfe7606 2495 }
2496 else {
92b39396
NC
2497 sigset = (sigset_t *) allocate_struct(aTHX_ *svp,
2498 sizeof(sigset_t),
2499 "POSIX::SigSet");
1dfe7606 2500 }
2501 *sigset = oact.sa_mask;
2502
2503 /* Get back the flags. */
017a3ce5 2504 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
1dfe7606 2505 sv_setiv(*svp, oact.sa_flags);
d36b6582
CS
2506
2507 /* Get back whether the old handler used safe signals. */
017a3ce5 2508 svp = hv_fetchs(oldaction, "SAFE", TRUE);
e91e3b10
RB
2509 sv_setiv(*svp,
2510 /* compare incompatible pointers by casting to integer */
2511 PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
2304df62
AD
2512 }
2513
2514 if (action) {
d36b6582
CS
2515 /* Safe signals use "csighandler", which vectors through the
2516 PL_sighandlerp pointer when it's safe to do so.
2517 (BTW, "csighandler" is very different from "sighandler".) */
017a3ce5 2518 svp = hv_fetchs(action, "SAFE", FALSE);
e91e3b10
RB
2519 act.sa_handler =
2520 DPTR2FPTR(
87d46f97 2521 void (*)(int),
e91e3b10
RB
2522 (*svp && SvTRUE(*svp))
2523 ? PL_csighandlerp : PL_sighandlerp
2524 );
d36b6582
CS
2525
2526 /* Vector new Perl handler through %SIG.
2527 (The core signal handlers read %SIG to dispatch.) */
017a3ce5 2528 svp = hv_fetchs(action, "HANDLER", FALSE);
2304df62
AD
2529 if (!svp)
2530 croak("Can't supply an action without a HANDLER");
1dfe7606 2531 sv_setsv(*sigsvp, *svp);
d36b6582
CS
2532
2533 /* This call actually calls sigaction() with almost the
2534 right settings, including appropriate interpretation
2535 of DEFAULT and IGNORE. However, why are we doing
2536 this when we're about to do it again just below? XXX */
17cffb37 2537 SvSETMAGIC(*sigsvp);
d36b6582
CS
2538
2539 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1dfe7606 2540 if(SvPOK(*svp)) {
aa07b2f6 2541 const char *s=SvPVX_const(*svp);
1dfe7606 2542 if(strEQ(s,"IGNORE")) {
2543 act.sa_handler = SIG_IGN;
2544 }
2545 else if(strEQ(s,"DEFAULT")) {
2546 act.sa_handler = SIG_DFL;
2547 }
1dfe7606 2548 }
2304df62
AD
2549
2550 /* Set up any desired mask. */
017a3ce5 2551 svp = hv_fetchs(action, "MASK", FALSE);
2304df62 2552 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
92b39396 2553 sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
2304df62
AD
2554 act.sa_mask = *sigset;
2555 }
2556 else
85e6fe83 2557 sigemptyset(& act.sa_mask);
2304df62
AD
2558
2559 /* Set up any desired flags. */
017a3ce5 2560 svp = hv_fetchs(action, "FLAGS", FALSE);
2304df62 2561 act.sa_flags = svp ? SvIV(*svp) : 0;
2304df62 2562
1dfe7606 2563 /* Don't worry about cleaning up *sigsvp if this fails,
2564 * because that means we tried to disposition a
2565 * nonblockable signal, in which case *sigsvp is
2566 * essentially meaningless anyway.
2567 */
6c418a22 2568 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
6ca4bbc9
GG
2569 if(RETVAL == -1) {
2570 LEAVE;
a7aad5de 2571 XSRETURN_UNDEF;
6ca4bbc9 2572 }
2304df62 2573 }
1dfe7606 2574
2575 LEAVE;
2304df62 2576 }
6dead956 2577#endif
2304df62
AD
2578 OUTPUT:
2579 RETVAL
2580
2581SysRet
2582sigpending(sigset)
2583 POSIX::SigSet sigset
7a004119
NC
2584 ALIAS:
2585 sigsuspend = 1
2586 CODE:
2587 RETVAL = ix ? sigsuspend(sigset) : sigpending(sigset);
2588 OUTPUT:
2589 RETVAL
20120e59
LT
2590 CLEANUP:
2591 PERL_ASYNC_CHECK();
2304df62
AD
2592
2593SysRet
2594sigprocmask(how, sigset, oldsigset = 0)
2595 int how
b13bbac7 2596 POSIX::SigSet sigset = NO_INIT
33c27489
GS
2597 POSIX::SigSet oldsigset = NO_INIT
2598INIT:
a3b811a7 2599 if (! SvOK(ST(1))) {
b13bbac7 2600 sigset = NULL;
a3b811a7 2601 } else if (sv_isa(ST(1), "POSIX::SigSet")) {
92b39396 2602 sigset = (sigset_t *) SvPV_nolen(SvRV(ST(1)));
b13bbac7
AB
2603 } else {
2604 croak("sigset is not of type POSIX::SigSet");
33c27489 2605 }
b13bbac7 2606
194cfca0 2607 if (items < 3 || ! SvOK(ST(2))) {
b13bbac7 2608 oldsigset = NULL;
a3b811a7 2609 } else if (sv_isa(ST(2), "POSIX::SigSet")) {
92b39396 2610 oldsigset = (sigset_t *) SvPV_nolen(SvRV(ST(2)));
b13bbac7
AB
2611 } else {
2612 croak("oldsigset is not of type POSIX::SigSet");
33c27489 2613 }
2304df62 2614
2304df62
AD
2615void
2616_exit(status)
2617 int status
8990e307 2618
85e6fe83 2619SysRet
8990e307
LW
2620dup2(fd1, fd2)
2621 int fd1
2622 int fd2
ad413e46
NC
2623 CODE:
2624#ifdef WIN32
2625 /* RT #98912 - More Microsoft muppetry - failing to actually implemented
2626 the well known documented POSIX behaviour for a POSIX API.
2627 http://msdn.microsoft.com/en-us/library/8syseb29.aspx */
2628 RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
2629#else
2630 RETVAL = dup2(fd1, fd2);
2631#endif
2632 OUTPUT:
2633 RETVAL
8990e307 2634
4a9d6100 2635SV *
a0d0e21e 2636lseek(fd, offset, whence)
85e6fe83
LW
2637 int fd
2638 Off_t offset
2639 int whence
4a9d6100
GS
2640 CODE:
2641 Off_t pos = PerlLIO_lseek(fd, offset, whence);
2642 RETVAL = sizeof(Off_t) > sizeof(IV)
2643 ? newSVnv((NV)pos) : newSViv((IV)pos);
2644 OUTPUT:
2645 RETVAL
8990e307 2646
c5661c80 2647void
8990e307
LW
2648nice(incr)
2649 int incr
15f0f28a
AE
2650 PPCODE:
2651 errno = 0;
2652 if ((incr = nice(incr)) != -1 || errno == 0) {
2653 if (incr == 0)
d3d34884 2654 XPUSHs(newSVpvs_flags("0 but true", SVs_TEMP));
15f0f28a
AE
2655 else
2656 XPUSHs(sv_2mortal(newSViv(incr)));
2657 }
8990e307 2658
8063af02 2659void
8990e307 2660pipe()
85e6fe83
LW
2661 PPCODE:
2662 int fds[2];
85e6fe83 2663 if (pipe(fds) != -1) {
924508f0 2664 EXTEND(SP,2);
85e6fe83
LW
2665 PUSHs(sv_2mortal(newSViv(fds[0])));
2666 PUSHs(sv_2mortal(newSViv(fds[1])));
2667 }
8990e307 2668
85e6fe83 2669SysRet
a0d0e21e 2670read(fd, buffer, nbytes)
7747499c
TB
2671 PREINIT:
2672 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
2673 INPUT:
2674 int fd
2675 size_t nbytes
2676 char * buffer = sv_grow( sv_buffer, nbytes+1 );
a0d0e21e 2677 CLEANUP:
7747499c 2678 if (RETVAL >= 0) {
b162af07 2679 SvCUR_set(sv_buffer, RETVAL);
7747499c
TB
2680 SvPOK_only(sv_buffer);
2681 *SvEND(sv_buffer) = '\0';
bbce6d69 2682 SvTAINTED_on(sv_buffer);
7747499c 2683 }
8990e307 2684
85e6fe83 2685SysRet
8990e307 2686setpgid(pid, pgid)
86200d5c
JH
2687 pid_t pid
2688 pid_t pgid
8990e307 2689
86200d5c 2690pid_t
8990e307
LW
2691setsid()
2692
86200d5c 2693pid_t
8990e307
LW
2694tcgetpgrp(fd)
2695 int fd
2696
85e6fe83 2697SysRet
8990e307
LW
2698tcsetpgrp(fd, pgrp_id)
2699 int fd
86200d5c 2700 pid_t pgrp_id
8990e307 2701
8063af02 2702void
8990e307 2703uname()
2304df62 2704 PPCODE:
a0d0e21e 2705#ifdef HAS_UNAME
85e6fe83 2706 struct utsname buf;
85e6fe83 2707 if (uname(&buf) >= 0) {
924508f0 2708 EXTEND(SP, 5);
d3d34884
NC
2709 PUSHs(newSVpvn_flags(buf.sysname, strlen(buf.sysname), SVs_TEMP));
2710 PUSHs(newSVpvn_flags(buf.nodename, strlen(buf.nodename), SVs_TEMP));
2711 PUSHs(newSVpvn_flags(buf.release, strlen(buf.release), SVs_TEMP));
2712 PUSHs(newSVpvn_flags(buf.version, strlen(buf.version), SVs_TEMP));
2713 PUSHs(newSVpvn_flags(buf.machine, strlen(buf.machine), SVs_TEMP));
8990e307 2714 }
a0d0e21e
LW
2715#else
2716 uname((char *) 0); /* A stub to call not_here(). */
2717#endif
8990e307 2718
85e6fe83 2719SysRet
a0d0e21e
LW
2720write(fd, buffer, nbytes)
2721 int fd
2722 char * buffer
2723 size_t nbytes
2724
33f01dd1
SH
2725SV *
2726tmpnam()
2727 PREINIT:
2728 STRLEN i;
2729 int len;
2730 CODE:
c2b90b61 2731 RETVAL = newSVpvs("");
33f01dd1 2732 SvGROW(RETVAL, L_tmpnam);
0fadf2db
JH
2733 /* Yes, we know tmpnam() is bad. So bad that some compilers
2734 * and linkers warn against using it. But it is here for
2735 * completeness. POSIX.pod warns against using it.
2736 *
2737 * Then again, maybe this should be removed at some point.
2738 * No point in enabling dangerous interfaces. */
33f01dd1
SH
2739 len = strlen(tmpnam(SvPV(RETVAL, i)));
2740 SvCUR_set(RETVAL, len);
2741 OUTPUT:
2742 RETVAL
a0d0e21e
LW
2743
2744void
2745abort()
2746
2747int
2748mblen(s, n)
2749 char * s
2750 size_t n
2751
2752size_t
2753mbstowcs(s, pwcs, n)
2754 wchar_t * s
2755 char * pwcs
2756 size_t n
2757
2758int
2759mbtowc(pwc, s, n)
2760 wchar_t * pwc
2761 char * s
2762 size_t n
2763
2764int
2765wcstombs(s, pwcs, n)
2766 char * s
2767 wchar_t * pwcs
2768 size_t n
2769
2770int
2771wctomb(s, wchar)
2772 char * s
2773 wchar_t wchar
2774
2775int
2776strcoll(s1, s2)
2777 char * s1
2778 char * s2
2779
a89d8a78
DH
2780void
2781strtod(str)
2782 char * str
2783 PREINIT:
2784 double num;
2785 char *unparsed;
2786 PPCODE:
371d5d44 2787 STORE_NUMERIC_STANDARD_FORCE_LOCAL();
a89d8a78
DH
2788 num = strtod(str, &unparsed);
2789 PUSHs(sv_2mortal(newSVnv(num)));
2790 if (GIMME == G_ARRAY) {
924508f0 2791 EXTEND(SP, 1);
a89d8a78
DH
2792 if (unparsed)
2793 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
2794 else
6b88bc9c 2795 PUSHs(&PL_sv_undef);
a89d8a78 2796 }
371d5d44 2797 RESTORE_NUMERIC_STANDARD();
a89d8a78 2798
0ff7b9da
JH
2799#ifdef HAS_STRTOLD
2800
2801void
2802strtold(str)
2803 char * str
2804 PREINIT:
2805 long double num;
2806 char *unparsed;
2807 PPCODE:
2808 STORE_NUMERIC_STANDARD_FORCE_LOCAL();
2809 num = strtold(str, &unparsed);
2810 PUSHs(sv_2mortal(newSVnv(num)));
2811 if (GIMME == G_ARRAY) {
2812 EXTEND(SP, 1);
2813 if (unparsed)
2814 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
2815 else
2816 PUSHs(&PL_sv_undef);
2817 }
2818 RESTORE_NUMERIC_STANDARD();
2819
2820#endif
2821
a89d8a78
DH
2822void
2823strtol(str, base = 0)
2824 char * str
2825 int base
2826 PREINIT:
2827 long num;
2828 char *unparsed;
2829 PPCODE:
2830 num = strtol(str, &unparsed, base);
42718184
RB
2831#if IVSIZE <= LONGSIZE
2832 if (num < IV_MIN || num > IV_MAX)
a89d8a78 2833 PUSHs(sv_2mortal(newSVnv((double)num)));
42718184
RB
2834 else
2835#endif
2836 PUSHs(sv_2mortal(newSViv((IV)num)));
a89d8a78 2837 if (GIMME == G_ARRAY) {
924508f0 2838 EXTEND(SP, 1);
a89d8a78
DH
2839 if (unparsed)
2840 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
2841 else
6b88bc9c 2842 PUSHs(&PL_sv_undef);
a89d8a78
DH
2843 }
2844
2845void
2846strtoul(str, base = 0)
4b48cf39 2847 const char * str
a89d8a78
DH
2848 int base
2849 PREINIT:
2850 unsigned long num;
2851 char *unparsed;
2852 PPCODE:
2853 num = strtoul(str, &unparsed, base);
84c133a0
RB
2854#if IVSIZE <= LONGSIZE
2855 if (num > IV_MAX)
a89d8a78 2856 PUSHs(sv_2mortal(newSVnv((double)num)));
84c133a0
RB
2857 else
2858#endif
2859 PUSHs(sv_2mortal(newSViv((IV)num)));
a89d8a78 2860 if (GIMME == G_ARRAY) {
924508f0 2861 EXTEND(SP, 1);
a89d8a78
DH
2862 if (unparsed)
2863 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
2864 else
6b88bc9c 2865 PUSHs(&PL_sv_undef);
a89d8a78
DH
2866 }
2867
8063af02 2868void
a0d0e21e
LW
2869strxfrm(src)
2870 SV * src
85e6fe83 2871 CODE:
a0d0e21e
LW
2872 {
2873 STRLEN srclen;
2874 STRLEN dstlen;
6ec5f825 2875 STRLEN buflen;
a0d0e21e
LW
2876 char *p = SvPV(src,srclen);
2877 srclen++;
6ec5f825
TC
2878 buflen = srclen * 4 + 1;
2879 ST(0) = sv_2mortal(newSV(buflen));
2880 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)buflen);
2881 if (dstlen >= buflen) {
a0d0e21e
LW
2882 dstlen++;
2883 SvGROW(ST(0), dstlen);
2884 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
2885 dstlen--;
2886 }
b162af07 2887 SvCUR_set(ST(0), dstlen);
a0d0e21e
LW
2888 SvPOK_only(ST(0));
2889 }
2890
2891SysRet
2892mkfifo(filename, mode)
2893 char * filename
2894 Mode_t mode
b5890904
NC
2895 ALIAS:
2896 access = 1
748a9306 2897 CODE:
b5890904
NC
2898 if(ix) {
2899 RETVAL = access(filename, mode);
2900 } else {
2901 TAINT_PROPER("mkfifo");
2902 RETVAL = mkfifo(filename, mode);
2903 }
748a9306
LW
2904 OUTPUT:
2905 RETVAL
a0d0e21e
LW
2906
2907SysRet
2908tcdrain(fd)
2909 int fd
9163475a
NC
2910 ALIAS:
2911 close = 1
2912 dup = 2
2913 CODE:
2914 RETVAL = ix == 1 ? close(fd)
2915 : (ix < 1 ? tcdrain(fd) : dup(fd));
2916 OUTPUT:
2917 RETVAL
a0d0e21e
LW
2918
2919
2920SysRet
2921tcflow(fd, action)
2922 int fd
2923 int action
7a004119
NC
2924 ALIAS:
2925 tcflush = 1
2926 tcsendbreak = 2
2927 CODE:
2928 RETVAL = ix == 1 ? tcflush(fd, action)
2929 : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
2930 OUTPUT:
2931 RETVAL
a0d0e21e 2932
250d97fd 2933void
c1646883 2934asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
a0d0e21e
LW
2935 int sec
2936 int min
2937 int hour
2938 int mday
2939 int mon
2940 int year
2941 int wday
2942 int yday
2943 int isdst
250d97fd
NC
2944 ALIAS:
2945 mktime = 1
2946 PPCODE:
a0d0e21e 2947 {
250d97fd 2948 dXSTARG;
a0d0e21e 2949 struct tm mytm;
a748fe11 2950 init_tm(&mytm); /* XXX workaround - see init_tm() in core util.c */
a0d0e21e
LW
2951 mytm.tm_sec = sec;
2952 mytm.tm_min = min;
2953 mytm.tm_hour = hour;
2954 mytm.tm_mday = mday;
2955 mytm.tm_mon = mon;
2956 mytm.tm_year = year;
2957 mytm.tm_wday = wday;
2958 mytm.tm_yday = yday;
2959 mytm.tm_isdst = isdst;
250d97fd 2960 if (ix) {
e2054bce
TC
2961 const time_t result = mktime(&mytm);
2962 if (result == (time_t)-1)
250d97fd
NC
2963 SvOK_off(TARG);
2964 else if (result == 0)
2965 sv_setpvn(TARG, "0 but true", 10);
2966 else
2967 sv_setiv(TARG, (IV)result);
2968 } else {
2969 sv_setpv(TARG, asctime(&mytm));
2970 }
2971 ST(0) = TARG;
2972 XSRETURN(1);
a0d0e21e 2973 }
a0d0e21e
LW
2974
2975long
2976clock()
2977
2978char *
2979ctime(time)
748a9306 2980 Time_t &time
8990e307 2981
37120919
AD
2982void
2983times()
2984 PPCODE:
2985 struct tms tms;
2986 clock_t realtime;
2987 realtime = times( &tms );
924508f0 2988 EXTEND(SP,5);
9607fc9c
PP
2989 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
2990 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
2991 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
2992 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
2993 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
37120919 2994
a0d0e21e
LW
2995double
2996difftime(time1, time2)
2997 Time_t time1
2998 Time_t time2
2999
8063af02
DM
3000#XXX: if $xsubpp::WantOptimize is always the default
3001# sv_setpv(TARG, ...) could be used rather than
3002# ST(0) = sv_2mortal(newSVpv(...))
3003void
e44f695e 3004strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
dc57de01 3005 SV * fmt
a0d0e21e
LW
3006 int sec
3007 int min
3008 int hour
3009 int mday
3010 int mon
3011 int year
3012 int wday
3013 int yday
3014 int isdst
3015 CODE:
3016 {
5d37acd6 3017 char *buf;
f406a445 3018 SV *sv;
5d37acd6
DM
3019
3020 /* allowing user-supplied (rather than literal) formats
3021 * is normally frowned upon as a potential security risk;
3022 * but this is part of the API so we have to allow it */
3023 GCC_DIAG_IGNORE(-Wformat-nonliteral);
3024 buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
3025 GCC_DIAG_RESTORE;
f406a445 3026 sv = sv_newmortal();
2a74cb2d 3027 if (buf) {
9717af6d
KW
3028 STRLEN len = strlen(buf);
3029 sv_usepvn_flags(sv, buf, len, SV_HAS_TRAILING_NUL);
3030 if (SvUTF8(fmt)
3031 || (! is_ascii_string((U8*) buf, len)
3032 && is_utf8_string((U8*) buf, len)
323fd7cc 3033#ifdef USE_LOCALE_TIME
130c5df3
KW
3034 && _is_cur_LC_category_utf8(LC_TIME)
3035#endif
3036 )) {
8dbe7cf7
NC
3037 SvUTF8_on(sv);
3038 }
f406a445
KW
3039 }
3040 else { /* We can't distinguish between errors and just an empty
3041 * return; in all cases just return an empty string */
3042 SvUPGRADE(sv, SVt_PV);
3043 SvPV_set(sv, (char *) "");
3044 SvPOK_on(sv);
3045 SvCUR_set(sv, 0);
3046 SvLEN_set(sv, 0); /* Won't attempt to free the string when sv
3047 gets destroyed */
3048 }
3049 ST(0) = sv;
a0d0e21e
LW
3050 }
3051
3052void
3053tzset()
81ab4c44
SH
3054 PPCODE:
3055 my_tzset(aTHX);
a0d0e21e
LW
3056
3057void
3058tzname()
3059 PPCODE:
924508f0 3060 EXTEND(SP,2);
d3d34884
NC
3061 PUSHs(newSVpvn_flags(tzname[0], strlen(tzname[0]), SVs_TEMP));
3062 PUSHs(newSVpvn_flags(tzname[1], strlen(tzname[1]), SVs_TEMP));
a0d0e21e 3063
a0d0e21e
LW
3064char *
3065ctermid(s = 0)
3ab23a19
RGS
3066 char * s = 0;
3067 CODE:
3068#ifdef HAS_CTERMID_R
e02b9112 3069 s = (char *) safemalloc((size_t) L_ctermid);
3ab23a19
RGS
3070#endif
3071 RETVAL = ctermid(s);
3072 OUTPUT:
3073 RETVAL
d1fd7089 3074 CLEANUP:
3ab23a19 3075#ifdef HAS_CTERMID_R
d1fd7089 3076 Safefree(s);
3ab23a19 3077#endif
a0d0e21e
LW
3078
3079char *
3080cuserid(s = 0)
3081 char * s = 0;
56f4542c
TJ
3082 CODE:
3083#ifdef HAS_CUSERID
3084 RETVAL = cuserid(s);
3085#else
3086 RETVAL = 0;
3087 not_here("cuserid");
3088#endif
3089 OUTPUT:
3090 RETVAL
a0d0e21e
LW
3091
3092SysRetLong
3093fpathconf(fd, name)
3094 int fd
3095 int name
3096
3097SysRetLong
3098pathconf(filename, name)
3099 char * filename
3100 int name
3101
3102SysRet
3103pause()
20120e59
LT
3104 CLEANUP:
3105 PERL_ASYNC_CHECK();
a0d0e21e 3106
a387c53a
NC
3107unsigned int
3108sleep(seconds)
3109 unsigned int seconds
3110 CODE:
3111 RETVAL = PerlProc_sleep(seconds);
3112 OUTPUT:
3113 RETVAL
3114
a043a685
GW
3115SysRet
3116setgid(gid)
3117 Gid_t gid
3118
3119SysRet
3120setuid(uid)
3121 Uid_t uid
3122
a0d0e21e
LW
3123SysRetLong
3124sysconf(name)
3125 int name
3126
3127char *
3128ttyname(fd)
3129 int fd
a043a685 3130
c6c619a9 3131void
b5846a0b 3132getcwd()
8f95b30d
JH
3133 PPCODE:
3134 {
3135 dXSTARG;
89423764 3136 getcwd_sv(TARG);
8f95b30d
JH
3137 XSprePUSH; PUSHTARG;
3138 }
3139
0d7021f5
RGS
3140SysRet
3141lchown(uid, gid, path)
3142 Uid_t uid
3143 Gid_t gid
3144 char * path
3145 CODE:
3146#ifdef HAS_LCHOWN
3147 /* yes, the order of arguments is different,
3148 * but consistent with CORE::chown() */
3149 RETVAL = lchown(path, uid, gid);
3150#else
3151 RETVAL = not_here("lchown");
3152#endif
3153 OUTPUT:
3154 RETVAL