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