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