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