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