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