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