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