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