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