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