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