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