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