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