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