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