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