This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Localeconv() should be independent of 'use locale'
[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 /* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
58    metaconfig for future extension writers.  We don't use them in POSIX.
59    (This is really sneaky :-)  --AD
60 */
61 #if defined(I_TERMIOS)
62 #include <termios.h>
63 #endif
64 #ifdef I_STDLIB
65 #include <stdlib.h>
66 #endif
67 #ifndef __ultrix__
68 #include <string.h>
69 #endif
70 #include <sys/stat.h>
71 #include <sys/types.h>
72 #include <time.h>
73 #ifdef I_UNISTD
74 #include <unistd.h>
75 #endif
76 #include <fcntl.h>
77
78 #ifdef HAS_TZNAME
79 #  if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__)
80 extern char *tzname[];
81 #  endif
82 #else
83 #if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname))
84 char *tzname[] = { "" , "" };
85 #endif
86 #endif
87
88 #if defined(__VMS) && !defined(__POSIX_SOURCE)
89
90 #  include <utsname.h>
91
92 #  undef mkfifo
93 #  define mkfifo(a,b) (not_here("mkfifo"),-1)
94
95    /* The POSIX notion of ttyname() is better served by getname() under VMS */
96    static char ttnambuf[64];
97 #  define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
98
99 #else
100 #if defined (__CYGWIN__)
101 #    define tzname _tzname
102 #endif
103 #if defined (WIN32) || defined (NETWARE)
104 #  undef mkfifo
105 #  define mkfifo(a,b) not_here("mkfifo")
106 #  define ttyname(a) (char*)not_here("ttyname")
107 #  define sigset_t long
108 #  define pid_t long
109 #  ifdef _MSC_VER
110 #    define mode_t short
111 #  endif
112 #  ifdef __MINGW32__
113 #    define mode_t short
114 #    ifndef tzset
115 #      define tzset()           not_here("tzset")
116 #    endif
117 #    ifndef _POSIX_OPEN_MAX
118 #      define _POSIX_OPEN_MAX   FOPEN_MAX       /* XXX bogus ? */
119 #    endif
120 #  endif
121 #  define sigaction(a,b,c)      not_here("sigaction")
122 #  define sigpending(a)         not_here("sigpending")
123 #  define sigprocmask(a,b,c)    not_here("sigprocmask")
124 #  define sigsuspend(a)         not_here("sigsuspend")
125 #  define sigemptyset(a)        not_here("sigemptyset")
126 #  define sigaddset(a,b)        not_here("sigaddset")
127 #  define sigdelset(a,b)        not_here("sigdelset")
128 #  define sigfillset(a)         not_here("sigfillset")
129 #  define sigismember(a,b)      not_here("sigismember")
130 #ifndef NETWARE
131 #  undef setuid
132 #  undef setgid
133 #  define setuid(a)             not_here("setuid")
134 #  define setgid(a)             not_here("setgid")
135 #endif  /* NETWARE */
136 #else
137
138 #  ifndef HAS_MKFIFO
139 #    if defined(OS2)
140 #      define mkfifo(a,b) not_here("mkfifo")
141 #    else       /* !( defined OS2 ) */
142 #      ifndef mkfifo
143 #        define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
144 #      endif
145 #    endif
146 #  endif /* !HAS_MKFIFO */
147
148 #  ifdef I_GRP
149 #    include <grp.h>
150 #  endif
151 #  include <sys/times.h>
152 #  ifdef HAS_UNAME
153 #    include <sys/utsname.h>
154 #  endif
155 #  include <sys/wait.h>
156 #  ifdef I_UTIME
157 #    include <utime.h>
158 #  endif
159 #endif /* WIN32 || NETWARE */
160 #endif /* __VMS */
161
162 typedef int SysRet;
163 typedef long SysRetLong;
164 typedef sigset_t* POSIX__SigSet;
165 typedef HV* POSIX__SigAction;
166 #ifdef I_TERMIOS
167 typedef struct termios* POSIX__Termios;
168 #else /* Define termios types to int, and call not_here for the functions.*/
169 #define POSIX__Termios int
170 #define speed_t int
171 #define tcflag_t int
172 #define cc_t int
173 #define cfgetispeed(x) not_here("cfgetispeed")
174 #define cfgetospeed(x) not_here("cfgetospeed")
175 #define tcdrain(x) not_here("tcdrain")
176 #define tcflush(x,y) not_here("tcflush")
177 #define tcsendbreak(x,y) not_here("tcsendbreak")
178 #define cfsetispeed(x,y) not_here("cfsetispeed")
179 #define cfsetospeed(x,y) not_here("cfsetospeed")
180 #define ctermid(x) (char *) not_here("ctermid")
181 #define tcflow(x,y) not_here("tcflow")
182 #define tcgetattr(x,y) not_here("tcgetattr")
183 #define tcsetattr(x,y,z) not_here("tcsetattr")
184 #endif
185
186 /* Possibly needed prototypes */
187 #ifndef WIN32
188 START_EXTERN_C
189 double strtod (const char *, char **);
190 long strtol (const char *, char **, int);
191 unsigned long strtoul (const char *, char **, int);
192 END_EXTERN_C
193 #endif
194
195 #ifndef HAS_DIFFTIME
196 #ifndef difftime
197 #define difftime(a,b) not_here("difftime")
198 #endif
199 #endif
200 #ifndef HAS_FPATHCONF
201 #define fpathconf(f,n)  (SysRetLong) not_here("fpathconf")
202 #endif
203 #ifndef HAS_MKTIME
204 #define mktime(a) not_here("mktime")
205 #endif
206 #ifndef HAS_NICE
207 #define nice(a) not_here("nice")
208 #endif
209 #ifndef HAS_PATHCONF
210 #define pathconf(f,n)   (SysRetLong) not_here("pathconf")
211 #endif
212 #ifndef HAS_SYSCONF
213 #define sysconf(n)      (SysRetLong) not_here("sysconf")
214 #endif
215 #ifndef HAS_READLINK
216 #define readlink(a,b,c) not_here("readlink")
217 #endif
218 #ifndef HAS_SETPGID
219 #define setpgid(a,b) not_here("setpgid")
220 #endif
221 #ifndef HAS_SETSID
222 #define setsid() not_here("setsid")
223 #endif
224 #ifndef HAS_STRCOLL
225 #define strcoll(s1,s2) not_here("strcoll")
226 #endif
227 #ifndef HAS_STRTOD
228 #define strtod(s1,s2) not_here("strtod")
229 #endif
230 #ifndef HAS_STRTOL
231 #define strtol(s1,s2,b) not_here("strtol")
232 #endif
233 #ifndef HAS_STRTOUL
234 #define strtoul(s1,s2,b) not_here("strtoul")
235 #endif
236 #ifndef HAS_STRXFRM
237 #define strxfrm(s1,s2,n) not_here("strxfrm")
238 #endif
239 #ifndef HAS_TCGETPGRP
240 #define tcgetpgrp(a) not_here("tcgetpgrp")
241 #endif
242 #ifndef HAS_TCSETPGRP
243 #define tcsetpgrp(a,b) not_here("tcsetpgrp")
244 #endif
245 #ifndef HAS_TIMES
246 #ifndef NETWARE
247 #define times(a) not_here("times")
248 #endif  /* NETWARE */
249 #endif
250 #ifndef HAS_UNAME
251 #define uname(a) not_here("uname")
252 #endif
253 #ifndef HAS_WAITPID
254 #define waitpid(a,b,c) not_here("waitpid")
255 #endif
256
257 #ifndef HAS_MBLEN
258 #ifndef mblen
259 #define mblen(a,b) not_here("mblen")
260 #endif
261 #endif
262 #ifndef HAS_MBSTOWCS
263 #define mbstowcs(s, pwcs, n) not_here("mbstowcs")
264 #endif
265 #ifndef HAS_MBTOWC
266 #define mbtowc(pwc, s, n) not_here("mbtowc")
267 #endif
268 #ifndef HAS_WCSTOMBS
269 #define wcstombs(s, pwcs, n) not_here("wcstombs")
270 #endif
271 #ifndef HAS_WCTOMB
272 #define wctomb(s, wchar) not_here("wcstombs")
273 #endif
274 #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
275 /* If we don't have these functions, then we wouldn't have gotten a typedef
276    for wchar_t, the wide character type.  Defining wchar_t allows the
277    functions referencing it to compile.  Its actual type is then meaningless,
278    since without the above functions, all sections using it end up calling
279    not_here() and croak.  --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
280 #ifndef wchar_t
281 #define wchar_t char
282 #endif
283 #endif
284
285 #ifdef HAS_LOCALECONV
286 struct lconv_offset {
287     const char *name;
288     size_t offset;
289 };
290
291 const struct lconv_offset lconv_strings[] = {
292     {"decimal_point",     STRUCT_OFFSET(struct lconv, decimal_point)},
293     {"thousands_sep",     STRUCT_OFFSET(struct lconv, thousands_sep)},
294 #ifndef NO_LOCALECONV_GROUPING
295     {"grouping",          STRUCT_OFFSET(struct lconv, grouping)},
296 #endif
297     {"int_curr_symbol",   STRUCT_OFFSET(struct lconv, int_curr_symbol)},
298     {"currency_symbol",   STRUCT_OFFSET(struct lconv, currency_symbol)},
299     {"mon_decimal_point", STRUCT_OFFSET(struct lconv, mon_decimal_point)},
300 #ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
301     {"mon_thousands_sep", STRUCT_OFFSET(struct lconv, mon_thousands_sep)},
302 #endif
303 #ifndef NO_LOCALECONV_MON_GROUPING
304     {"mon_grouping",      STRUCT_OFFSET(struct lconv, mon_grouping)},
305 #endif
306     {"positive_sign",     STRUCT_OFFSET(struct lconv, positive_sign)},
307     {"negative_sign",     STRUCT_OFFSET(struct lconv, negative_sign)},
308     {NULL, 0}
309 };
310
311 const struct lconv_offset lconv_integers[] = {
312     {"int_frac_digits",   STRUCT_OFFSET(struct lconv, int_frac_digits)},
313     {"frac_digits",       STRUCT_OFFSET(struct lconv, frac_digits)},
314     {"p_cs_precedes",     STRUCT_OFFSET(struct lconv, p_cs_precedes)},
315     {"p_sep_by_space",    STRUCT_OFFSET(struct lconv, p_sep_by_space)},
316     {"n_cs_precedes",     STRUCT_OFFSET(struct lconv, n_cs_precedes)},
317     {"n_sep_by_space",    STRUCT_OFFSET(struct lconv, n_sep_by_space)},
318     {"p_sign_posn",       STRUCT_OFFSET(struct lconv, p_sign_posn)},
319     {"n_sign_posn",       STRUCT_OFFSET(struct lconv, n_sign_posn)},
320     {NULL, 0}
321 };
322
323 #else
324 #define localeconv() not_here("localeconv")
325 #endif
326
327 #ifdef HAS_LONG_DOUBLE
328 #  if LONG_DOUBLESIZE > NVSIZE
329 #    undef HAS_LONG_DOUBLE  /* XXX until we figure out how to use them */
330 #  endif
331 #endif
332
333 #ifndef HAS_LONG_DOUBLE
334 #ifdef LDBL_MAX
335 #undef LDBL_MAX
336 #endif
337 #ifdef LDBL_MIN
338 #undef LDBL_MIN
339 #endif
340 #ifdef LDBL_EPSILON
341 #undef LDBL_EPSILON
342 #endif
343 #endif
344
345 /* Background: in most systems the low byte of the wait status
346  * is the signal (the lowest 7 bits) and the coredump flag is
347  * the eight bit, and the second lowest byte is the exit status.
348  * BeOS bucks the trend and has the bytes in different order.
349  * See beos/beos.c for how the reality is bent even in BeOS
350  * to follow the traditional.  However, to make the POSIX
351  * wait W*() macros to work in BeOS, we need to unbend the
352  * reality back in place. --jhi */
353 /* In actual fact the code below is to blame here. Perl has an internal
354  * representation of the exit status ($?), which it re-composes from the
355  * OS's representation using the W*() POSIX macros. The code below
356  * incorrectly uses the W*() macros on the internal representation,
357  * which fails for OSs that have a different representation (namely BeOS
358  * and Haiku). WMUNGE() is a hack that converts the internal
359  * representation into the OS specific one, so that the W*() macros work
360  * as expected. The better solution would be not to use the W*() macros
361  * in the first place, though. -- Ingo Weinhold
362  */
363 #if defined(__HAIKU__)
364 #    define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
365 #else
366 #    define WMUNGE(x) (x)
367 #endif
368
369 static int
370 not_here(const char *s)
371 {
372     croak("POSIX::%s not implemented on this architecture", s);
373     return -1;
374 }
375
376 #include "const-c.inc"
377
378 static void
379 restore_sigmask(pTHX_ SV *osset_sv)
380 {
381      /* Fortunately, restoring the signal mask can't fail, because
382       * there's nothing we can do about it if it does -- we're not
383       * supposed to return -1 from sigaction unless the disposition
384       * was unaffected.
385       */
386      sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
387      (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
388 }
389
390 static void *
391 allocate_struct(pTHX_ SV *rv, const STRLEN size, const char *packname) {
392     SV *const t = newSVrv(rv, packname);
393     void *const p = sv_grow(t, size + 1);
394
395     SvCUR_set(t, size);
396     SvPOK_on(t);
397     return p;
398 }
399
400 #ifdef WIN32
401
402 /*
403  * (1) The CRT maintains its own copy of the environment, separate from
404  * the Win32API copy.
405  *
406  * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
407  * copy, and then calls SetEnvironmentVariableA() to update the Win32API
408  * copy.
409  *
410  * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
411  * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
412  * environment.
413  *
414  * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
415  * calls CRT tzset(), but only the first time it is called, and in turn
416  * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
417  * local copy of the environment and hence gets the original setting as
418  * perl never updates the CRT copy when assigning to $ENV{TZ}.
419  *
420  * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
421  * putenv() to update the CRT copy of the environment (if it is different)
422  * whenever we're about to call tzset().
423  *
424  * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
425  * defined:
426  *
427  * (a) Each interpreter has its own copy of the environment inside the
428  * perlhost structure. That allows applications that host multiple
429  * independent Perl interpreters to isolate environment changes from
430  * each other. (This is similar to how the perlhost mechanism keeps a
431  * separate working directory for each Perl interpreter, so that calling
432  * chdir() will not affect other interpreters.)
433  *
434  * (b) Only the first Perl interpreter instantiated within a process will
435  * "write through" environment changes to the process environment.
436  *
437  * (c) Even the primary Perl interpreter won't update the CRT copy of the
438  * the environment, only the Win32API copy (it calls win32_putenv()).
439  *
440  * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
441  * sense to only update the process environment when inside the main
442  * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
443  * from here so we'll just have to check PL_curinterp instead.
444  *
445  * Therefore, we can simply #undef getenv() and putenv() so that those names
446  * always refer to the CRT functions, and explicitly call win32_getenv() to
447  * access perl's %ENV.
448  *
449  * We also #undef malloc() and free() to be sure we are using the CRT
450  * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
451  * into VMem::Malloc() and VMem::Free() and all allocations will be freed
452  * when the Perl interpreter is being destroyed so we'd end up with a pointer
453  * into deallocated memory in environ[] if a program embedding a Perl
454  * interpreter continues to operate even after the main Perl interpreter has
455  * been destroyed.
456  *
457  * Note that we don't free() the malloc()ed memory unless and until we call
458  * malloc() again ourselves because the CRT putenv() function simply puts its
459  * pointer argument into the environ[] array (it doesn't make a copy of it)
460  * so this memory must otherwise be leaked.
461  */
462
463 #undef getenv
464 #undef putenv
465 #undef malloc
466 #undef free
467
468 static void
469 fix_win32_tzenv(void)
470 {
471     static char* oldenv = NULL;
472     char* newenv;
473     const char* perl_tz_env = win32_getenv("TZ");
474     const char* crt_tz_env = getenv("TZ");
475     if (perl_tz_env == NULL)
476         perl_tz_env = "";
477     if (crt_tz_env == NULL)
478         crt_tz_env = "";
479     if (strcmp(perl_tz_env, crt_tz_env) != 0) {
480         newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
481         if (newenv != NULL) {
482             sprintf(newenv, "TZ=%s", perl_tz_env);
483             putenv(newenv);
484             if (oldenv != NULL)
485                 free(oldenv);
486             oldenv = newenv;
487         }
488     }
489 }
490
491 #endif
492
493 /*
494  * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
495  * This code is duplicated in the Time-Piece module, so any changes made here
496  * should be made there too.
497  */
498 static void
499 my_tzset(pTHX)
500 {
501 #ifdef WIN32
502 #if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
503     if (PL_curinterp == aTHX)
504 #endif
505         fix_win32_tzenv();
506 #endif
507     tzset();
508 }
509
510 typedef int (*isfunc_t)(int);
511 typedef void (*any_dptr_t)(void *);
512
513 /* This needs to be ALIASed in a custom way, hence can't easily be defined as
514    a regular XSUB.  */
515 static XSPROTO(is_common); /* prototype to pass -Wmissing-prototypes */
516 static XSPROTO(is_common)
517 {
518     dXSARGS;
519     static PTR_TBL_t * is_common_ptr_table;
520
521     if (items != 1)
522        croak_xs_usage(cv,  "charstring");
523
524     {
525         dXSTARG;
526         STRLEN  len;
527         /*int   RETVAL = 0;   YYY means uncomment this to return false on an
528                             * empty string input */
529         int     RETVAL;
530         unsigned char *s = (unsigned char *) SvPV(ST(0), len);
531         unsigned char *e = s + len;
532         isfunc_t isfunc = (isfunc_t) XSANY.any_dptr;
533
534         if (ckWARN_d(WARN_DEPRECATED)) {
535
536             /* Warn exactly once for each lexical place this function is
537              * called.  See thread at
538              * http://markmail.org/thread/jhqcag5njmx7jpyu */
539
540             if (! is_common_ptr_table) {
541                is_common_ptr_table = ptr_table_new();
542             }
543             if (! ptr_table_fetch(is_common_ptr_table, PL_op)) {
544                 Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
545                             "Calling POSIX::%"HEKf"() is deprecated",
546                             HEKfARG(GvNAME_HEK(CvGV(cv))));
547                 ptr_table_store(is_common_ptr_table, PL_op, (void *) 1);
548             }
549         }
550
551         /*if (e > s) { YYY */
552         for (RETVAL = 1; RETVAL && s < e; s++)
553             if (!isfunc(*s))
554                 RETVAL = 0;
555         /*} YYY */
556         XSprePUSH;
557         PUSHi((IV)RETVAL);
558     }
559     XSRETURN(1);
560 }
561
562 MODULE = POSIX          PACKAGE = POSIX
563
564 BOOT:
565 {
566     CV *cv;
567     const char *file = __FILE__;
568
569
570     /* silence compiler warning about not_here() defined but not used */
571     if (0) not_here("");
572
573     /* Ensure we get the function, not a macro implementation. Like the C89
574        standard says we can...  */
575 #undef isalnum
576     cv = newXS("POSIX::isalnum", is_common, file);
577     XSANY.any_dptr = (any_dptr_t) &isalnum;
578 #undef isalpha
579     cv = newXS("POSIX::isalpha", is_common, file);
580     XSANY.any_dptr = (any_dptr_t) &isalpha;
581 #undef iscntrl
582     cv = newXS("POSIX::iscntrl", is_common, file);
583     XSANY.any_dptr = (any_dptr_t) &iscntrl;
584 #undef isdigit
585     cv = newXS("POSIX::isdigit", is_common, file);
586     XSANY.any_dptr = (any_dptr_t) &isdigit;
587 #undef isgraph
588     cv = newXS("POSIX::isgraph", is_common, file);
589     XSANY.any_dptr = (any_dptr_t) &isgraph;
590 #undef islower
591     cv = newXS("POSIX::islower", is_common, file);
592     XSANY.any_dptr = (any_dptr_t) &islower;
593 #undef isprint
594     cv = newXS("POSIX::isprint", is_common, file);
595     XSANY.any_dptr = (any_dptr_t) &isprint;
596 #undef ispunct
597     cv = newXS("POSIX::ispunct", is_common, file);
598     XSANY.any_dptr = (any_dptr_t) &ispunct;
599 #undef isspace
600     cv = newXS("POSIX::isspace", is_common, file);
601     XSANY.any_dptr = (any_dptr_t) &isspace;
602 #undef isupper
603     cv = newXS("POSIX::isupper", is_common, file);
604     XSANY.any_dptr = (any_dptr_t) &isupper;
605 #undef isxdigit
606     cv = newXS("POSIX::isxdigit", is_common, file);
607     XSANY.any_dptr = (any_dptr_t) &isxdigit;
608 }
609
610 MODULE = SigSet         PACKAGE = POSIX::SigSet         PREFIX = sig
611
612 void
613 new(packname = "POSIX::SigSet", ...)
614     const char *        packname
615     CODE:
616         {
617             int i;
618             sigset_t *const s
619                 = (sigset_t *) allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
620                                                sizeof(sigset_t),
621                                                packname);
622             sigemptyset(s);
623             for (i = 1; i < items; i++)
624                 sigaddset(s, SvIV(ST(i)));
625             XSRETURN(1);
626         }
627
628 SysRet
629 addset(sigset, sig)
630         POSIX::SigSet   sigset
631         int             sig
632    ALIAS:
633         delset = 1
634    CODE:
635         RETVAL = ix ? sigdelset(sigset, sig) : sigaddset(sigset, sig);
636    OUTPUT:
637         RETVAL
638
639 SysRet
640 emptyset(sigset)
641         POSIX::SigSet   sigset
642    ALIAS:
643         fillset = 1
644    CODE:
645         RETVAL = ix ? sigfillset(sigset) : sigemptyset(sigset);
646    OUTPUT:
647         RETVAL
648
649 int
650 sigismember(sigset, sig)
651         POSIX::SigSet   sigset
652         int             sig
653
654 MODULE = Termios        PACKAGE = POSIX::Termios        PREFIX = cf
655
656 void
657 new(packname = "POSIX::Termios", ...)
658     const char *        packname
659     CODE:
660         {
661 #ifdef I_TERMIOS
662             void *const p = allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
663                                             sizeof(struct termios), packname);
664             /* The previous implementation stored a pointer to an uninitialised
665                struct termios. Seems safer to initialise it, particularly as
666                this implementation exposes the struct to prying from perl-space.
667             */
668             memset(p, 0, 1 + sizeof(struct termios));
669             XSRETURN(1);
670 #else
671             not_here("termios");
672 #endif
673         }
674
675 SysRet
676 getattr(termios_ref, fd = 0)
677         POSIX::Termios  termios_ref
678         int             fd
679     CODE:
680         RETVAL = tcgetattr(fd, termios_ref);
681     OUTPUT:
682         RETVAL
683
684 # If we define TCSANOW here then both a found and not found constant sub
685 # are created causing a Constant subroutine TCSANOW redefined warning
686 #ifndef TCSANOW
687 #  define DEF_SETATTR_ACTION 0
688 #else
689 #  define DEF_SETATTR_ACTION TCSANOW
690 #endif
691 SysRet
692 setattr(termios_ref, fd = 0, optional_actions = DEF_SETATTR_ACTION)
693         POSIX::Termios  termios_ref
694         int             fd
695         int             optional_actions
696     CODE:
697         /* The second argument to the call is mandatory, but we'd like to give
698            it a useful default. 0 isn't valid on all operating systems - on
699            Solaris (at least) TCSANOW, TCSADRAIN and TCSAFLUSH have the same
700            values as the equivalent ioctls, TCSETS, TCSETSW and TCSETSF.  */
701         RETVAL = tcsetattr(fd, optional_actions, termios_ref);
702     OUTPUT:
703         RETVAL
704
705 speed_t
706 getispeed(termios_ref)
707         POSIX::Termios  termios_ref
708     ALIAS:
709         getospeed = 1
710     CODE:
711         RETVAL = ix ? cfgetospeed(termios_ref) : cfgetispeed(termios_ref);
712     OUTPUT:
713         RETVAL
714
715 tcflag_t
716 getiflag(termios_ref)
717         POSIX::Termios  termios_ref
718     ALIAS:
719         getoflag = 1
720         getcflag = 2
721         getlflag = 3
722     CODE:
723 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
724         switch(ix) {
725         case 0:
726             RETVAL = termios_ref->c_iflag;
727             break;
728         case 1:
729             RETVAL = termios_ref->c_oflag;
730             break;
731         case 2:
732             RETVAL = termios_ref->c_cflag;
733             break;
734         case 3:
735             RETVAL = termios_ref->c_lflag;
736             break;
737         default:
738             RETVAL = 0; /* silence compiler warning */
739         }
740 #else
741         not_here(GvNAME(CvGV(cv)));
742         RETVAL = 0;
743 #endif
744     OUTPUT:
745         RETVAL
746
747 cc_t
748 getcc(termios_ref, ccix)
749         POSIX::Termios  termios_ref
750         unsigned int    ccix
751     CODE:
752 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
753         if (ccix >= NCCS)
754             croak("Bad getcc subscript");
755         RETVAL = termios_ref->c_cc[ccix];
756 #else
757      not_here("getcc");
758      RETVAL = 0;
759 #endif
760     OUTPUT:
761         RETVAL
762
763 SysRet
764 setispeed(termios_ref, speed)
765         POSIX::Termios  termios_ref
766         speed_t         speed
767     ALIAS:
768         setospeed = 1
769     CODE:
770         RETVAL = ix
771             ? cfsetospeed(termios_ref, speed) : cfsetispeed(termios_ref, speed);
772     OUTPUT:
773         RETVAL
774
775 void
776 setiflag(termios_ref, flag)
777         POSIX::Termios  termios_ref
778         tcflag_t        flag
779     ALIAS:
780         setoflag = 1
781         setcflag = 2
782         setlflag = 3
783     CODE:
784 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
785         switch(ix) {
786         case 0:
787             termios_ref->c_iflag = flag;
788             break;
789         case 1:
790             termios_ref->c_oflag = flag;
791             break;
792         case 2:
793             termios_ref->c_cflag = flag;
794             break;
795         case 3:
796             termios_ref->c_lflag = flag;
797             break;
798         }
799 #else
800         not_here(GvNAME(CvGV(cv)));
801 #endif
802
803 void
804 setcc(termios_ref, ccix, cc)
805         POSIX::Termios  termios_ref
806         unsigned int    ccix
807         cc_t            cc
808     CODE:
809 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
810         if (ccix >= NCCS)
811             croak("Bad setcc subscript");
812         termios_ref->c_cc[ccix] = cc;
813 #else
814             not_here("setcc");
815 #endif
816
817
818 MODULE = POSIX          PACKAGE = POSIX
819
820 INCLUDE: const-xs.inc
821
822 int
823 WEXITSTATUS(status)
824         int status
825     ALIAS:
826         POSIX::WIFEXITED = 1
827         POSIX::WIFSIGNALED = 2
828         POSIX::WIFSTOPPED = 3
829         POSIX::WSTOPSIG = 4
830         POSIX::WTERMSIG = 5
831     CODE:
832 #if !defined(WEXITSTATUS) || !defined(WIFEXITED) || !defined(WIFSIGNALED) \
833       || !defined(WIFSTOPPED) || !defined(WSTOPSIG) || !defined(WTERMSIG)
834         RETVAL = 0; /* Silence compilers that notice this, but don't realise
835                        that not_here() can't return.  */
836 #endif
837         switch(ix) {
838         case 0:
839 #ifdef WEXITSTATUS
840             RETVAL = WEXITSTATUS(WMUNGE(status));
841 #else
842             not_here("WEXITSTATUS");
843 #endif
844             break;
845         case 1:
846 #ifdef WIFEXITED
847             RETVAL = WIFEXITED(WMUNGE(status));
848 #else
849             not_here("WIFEXITED");
850 #endif
851             break;
852         case 2:
853 #ifdef WIFSIGNALED
854             RETVAL = WIFSIGNALED(WMUNGE(status));
855 #else
856             not_here("WIFSIGNALED");
857 #endif
858             break;
859         case 3:
860 #ifdef WIFSTOPPED
861             RETVAL = WIFSTOPPED(WMUNGE(status));
862 #else
863             not_here("WIFSTOPPED");
864 #endif
865             break;
866         case 4:
867 #ifdef WSTOPSIG
868             RETVAL = WSTOPSIG(WMUNGE(status));
869 #else
870             not_here("WSTOPSIG");
871 #endif
872             break;
873         case 5:
874 #ifdef WTERMSIG
875             RETVAL = WTERMSIG(WMUNGE(status));
876 #else
877             not_here("WTERMSIG");
878 #endif
879             break;
880         default:
881             Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", (int)ix);
882         }
883     OUTPUT:
884         RETVAL
885
886 SysRet
887 open(filename, flags = O_RDONLY, mode = 0666)
888         char *          filename
889         int             flags
890         Mode_t          mode
891     CODE:
892         if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
893             TAINT_PROPER("open");
894         RETVAL = open(filename, flags, mode);
895     OUTPUT:
896         RETVAL
897
898
899 HV *
900 localeconv()
901     CODE:
902 #ifdef HAS_LOCALECONV
903         struct lconv *lcbuf;
904
905         /* localeconv() deals with both LC_NUMERIC and LC_MONETARY, but
906          * LC_MONETARY is already in the correct locale */
907         STORE_NUMERIC_STANDARD_FORCE_LOCAL();
908
909         RETVAL = newHV();
910         sv_2mortal((SV*)RETVAL);
911         if ((lcbuf = localeconv())) {
912             const struct lconv_offset *strings = lconv_strings;
913             const struct lconv_offset *integers = lconv_integers;
914             const char *ptr = (const char *) lcbuf;
915
916             do {
917                 const char *value = *((const char **)(ptr + strings->offset));
918
919                 if (value && *value)
920                     (void) hv_store(RETVAL, strings->name, strlen(strings->name),
921                                     newSVpv(value, 0), 0);
922             } while ((++strings)->name);
923
924             do {
925                 const char value = *((const char *)(ptr + integers->offset));
926
927                 if (value != CHAR_MAX)
928                     (void) hv_store(RETVAL, integers->name,
929                                     strlen(integers->name), newSViv(value), 0);
930             } while ((++integers)->name);
931         }
932         RESTORE_NUMERIC_STANDARD();
933 #else
934         localeconv(); /* A stub to call not_here(). */
935 #endif
936     OUTPUT:
937         RETVAL
938
939 char *
940 setlocale(category, locale = 0)
941         int             category
942         char *          locale
943     PREINIT:
944         char *          retval;
945     CODE:
946 #ifdef WIN32    /* Use wrapper on Windows */
947         retval = Perl_my_setlocale(aTHX_ category, locale);
948 #else
949         retval = setlocale(category, locale);
950 #endif
951         if (! retval) {
952             XSRETURN_UNDEF;
953         }
954         else {
955             /* Save retval since subsequent setlocale() calls
956              * may overwrite it. */
957             RETVAL = savepv(retval);
958 #ifdef USE_LOCALE_CTYPE
959             if (category == LC_CTYPE
960 #ifdef LC_ALL
961                 || category == LC_ALL
962 #endif
963                 )
964             {
965                 char *newctype;
966 #ifdef LC_ALL
967                 if (category == LC_ALL)
968                     newctype = setlocale(LC_CTYPE, NULL);
969                 else
970 #endif
971                     newctype = RETVAL;
972                 new_ctype(newctype);
973             }
974 #endif /* USE_LOCALE_CTYPE */
975 #ifdef USE_LOCALE_COLLATE
976             if (category == LC_COLLATE
977 #ifdef LC_ALL
978                 || category == LC_ALL
979 #endif
980                 )
981             {
982                 char *newcoll;
983 #ifdef LC_ALL
984                 if (category == LC_ALL)
985                     newcoll = setlocale(LC_COLLATE, NULL);
986                 else
987 #endif
988                     newcoll = RETVAL;
989                 new_collate(newcoll);
990             }
991 #endif /* USE_LOCALE_COLLATE */
992 #ifdef USE_LOCALE_NUMERIC
993             if (category == LC_NUMERIC
994 #ifdef LC_ALL
995                 || category == LC_ALL
996 #endif
997                 )
998             {
999                 char *newnum;
1000 #ifdef LC_ALL
1001                 if (category == LC_ALL)
1002                     newnum = setlocale(LC_NUMERIC, NULL);
1003                 else
1004 #endif
1005                     newnum = RETVAL;
1006                 new_numeric(newnum);
1007             }
1008 #endif /* USE_LOCALE_NUMERIC */
1009         }
1010     OUTPUT:
1011         RETVAL
1012     CLEANUP:
1013         Safefree(RETVAL);
1014
1015 NV
1016 acos(x)
1017         NV              x
1018     ALIAS:
1019         asin = 1
1020         atan = 2
1021         ceil = 3
1022         cosh = 4
1023         floor = 5
1024         log10 = 6
1025         sinh = 7
1026         tan = 8
1027         tanh = 9
1028     CODE:
1029         switch (ix) {
1030         case 0:
1031             RETVAL = acos(x);
1032             break;
1033         case 1:
1034             RETVAL = asin(x);
1035             break;
1036         case 2:
1037             RETVAL = atan(x);
1038             break;
1039         case 3:
1040             RETVAL = ceil(x);
1041             break;
1042         case 4:
1043             RETVAL = cosh(x);
1044             break;
1045         case 5:
1046             RETVAL = floor(x);
1047             break;
1048         case 6:
1049             RETVAL = log10(x);
1050             break;
1051         case 7:
1052             RETVAL = sinh(x);
1053             break;
1054         case 8:
1055             RETVAL = tan(x);
1056             break;
1057         default:
1058             RETVAL = tanh(x);
1059         }
1060     OUTPUT:
1061         RETVAL
1062
1063 NV
1064 fmod(x,y)
1065         NV              x
1066         NV              y
1067
1068 void
1069 frexp(x)
1070         NV              x
1071     PPCODE:
1072         int expvar;
1073         /* (We already know stack is long enough.) */
1074         PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1075         PUSHs(sv_2mortal(newSViv(expvar)));
1076
1077 NV
1078 ldexp(x,exp)
1079         NV              x
1080         int             exp
1081
1082 void
1083 modf(x)
1084         NV              x
1085     PPCODE:
1086         NV intvar;
1087         /* (We already know stack is long enough.) */
1088         PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
1089         PUSHs(sv_2mortal(newSVnv(intvar)));
1090
1091 SysRet
1092 sigaction(sig, optaction, oldaction = 0)
1093         int                     sig
1094         SV *                    optaction
1095         POSIX::SigAction        oldaction
1096     CODE:
1097 #if defined(WIN32) || defined(NETWARE)
1098         RETVAL = not_here("sigaction");
1099 #else
1100 # This code is really grody because we're trying to make the signal
1101 # interface look beautiful, which is hard.
1102
1103         {
1104             dVAR;
1105             POSIX__SigAction action;
1106             GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
1107             struct sigaction act;
1108             struct sigaction oact;
1109             sigset_t sset;
1110             SV *osset_sv;
1111             sigset_t osset;
1112             POSIX__SigSet sigset;
1113             SV** svp;
1114             SV** sigsvp;
1115
1116             if (sig < 0) {
1117                 croak("Negative signals are not allowed");
1118             }
1119
1120             if (sig == 0 && SvPOK(ST(0))) {
1121                 const char *s = SvPVX_const(ST(0));
1122                 int i = whichsig(s);
1123
1124                 if (i < 0 && memEQ(s, "SIG", 3))
1125                     i = whichsig(s + 3);
1126                 if (i < 0) {
1127                     if (ckWARN(WARN_SIGNAL))
1128                         Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1129                                     "No such signal: SIG%s", s);
1130                     XSRETURN_UNDEF;
1131                 }
1132                 else
1133                     sig = i;
1134             }
1135 #ifdef NSIG
1136             if (sig > NSIG) { /* NSIG - 1 is still okay. */
1137                 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1138                             "No such signal: %d", sig);
1139                 XSRETURN_UNDEF;
1140             }
1141 #endif
1142             sigsvp = hv_fetch(GvHVn(siggv),
1143                               PL_sig_name[sig],
1144                               strlen(PL_sig_name[sig]),
1145                               TRUE);
1146
1147             /* Check optaction and set action */
1148             if(SvTRUE(optaction)) {
1149                 if(sv_isa(optaction, "POSIX::SigAction"))
1150                         action = (HV*)SvRV(optaction);
1151                 else
1152                         croak("action is not of type POSIX::SigAction");
1153             }
1154             else {
1155                 action=0;
1156             }
1157
1158             /* sigaction() is supposed to look atomic. In particular, any
1159              * signal handler invoked during a sigaction() call should
1160              * see either the old or the new disposition, and not something
1161              * in between. We use sigprocmask() to make it so.
1162              */
1163             sigfillset(&sset);
1164             RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1165             if(RETVAL == -1)
1166                XSRETURN_UNDEF;
1167             ENTER;
1168             /* Restore signal mask no matter how we exit this block. */
1169             osset_sv = newSVpvn((char *)(&osset), sizeof(sigset_t));
1170             SAVEFREESV( osset_sv );
1171             SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1172
1173             RETVAL=-1; /* In case both oldaction and action are 0. */
1174
1175             /* Remember old disposition if desired. */
1176             if (oldaction) {
1177                 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
1178                 if(!svp)
1179                     croak("Can't supply an oldaction without a HANDLER");
1180                 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1181                         sv_setsv(*svp, *sigsvp);
1182                 }
1183                 else {
1184                         sv_setpvs(*svp, "DEFAULT");
1185                 }
1186                 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
1187                 if(RETVAL == -1) {
1188                    LEAVE;
1189                    XSRETURN_UNDEF;
1190                 }
1191                 /* Get back the mask. */
1192                 svp = hv_fetchs(oldaction, "MASK", TRUE);
1193                 if (sv_isa(*svp, "POSIX::SigSet")) {
1194                     sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
1195                 }
1196                 else {
1197                     sigset = (sigset_t *) allocate_struct(aTHX_ *svp,
1198                                                           sizeof(sigset_t),
1199                                                           "POSIX::SigSet");
1200                 }
1201                 *sigset = oact.sa_mask;
1202
1203                 /* Get back the flags. */
1204                 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
1205                 sv_setiv(*svp, oact.sa_flags);
1206
1207                 /* Get back whether the old handler used safe signals. */
1208                 svp = hv_fetchs(oldaction, "SAFE", TRUE);
1209                 sv_setiv(*svp,
1210                 /* compare incompatible pointers by casting to integer */
1211                     PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
1212             }
1213
1214             if (action) {
1215                 /* Safe signals use "csighandler", which vectors through the
1216                    PL_sighandlerp pointer when it's safe to do so.
1217                    (BTW, "csighandler" is very different from "sighandler".) */
1218                 svp = hv_fetchs(action, "SAFE", FALSE);
1219                 act.sa_handler =
1220                         DPTR2FPTR(
1221                             void (*)(int),
1222                             (*svp && SvTRUE(*svp))
1223                                 ? PL_csighandlerp : PL_sighandlerp
1224                         );
1225
1226                 /* Vector new Perl handler through %SIG.
1227                    (The core signal handlers read %SIG to dispatch.) */
1228                 svp = hv_fetchs(action, "HANDLER", FALSE);
1229                 if (!svp)
1230                     croak("Can't supply an action without a HANDLER");
1231                 sv_setsv(*sigsvp, *svp);
1232
1233                 /* This call actually calls sigaction() with almost the
1234                    right settings, including appropriate interpretation
1235                    of DEFAULT and IGNORE.  However, why are we doing
1236                    this when we're about to do it again just below?  XXX */
1237                 SvSETMAGIC(*sigsvp);
1238
1239                 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1240                 if(SvPOK(*svp)) {
1241                         const char *s=SvPVX_const(*svp);
1242                         if(strEQ(s,"IGNORE")) {
1243                                 act.sa_handler = SIG_IGN;
1244                         }
1245                         else if(strEQ(s,"DEFAULT")) {
1246                                 act.sa_handler = SIG_DFL;
1247                         }
1248                 }
1249
1250                 /* Set up any desired mask. */
1251                 svp = hv_fetchs(action, "MASK", FALSE);
1252                 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
1253                     sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
1254                     act.sa_mask = *sigset;
1255                 }
1256                 else
1257                     sigemptyset(& act.sa_mask);
1258
1259                 /* Set up any desired flags. */
1260                 svp = hv_fetchs(action, "FLAGS", FALSE);
1261                 act.sa_flags = svp ? SvIV(*svp) : 0;
1262
1263                 /* Don't worry about cleaning up *sigsvp if this fails,
1264                  * because that means we tried to disposition a
1265                  * nonblockable signal, in which case *sigsvp is
1266                  * essentially meaningless anyway.
1267                  */
1268                 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
1269                 if(RETVAL == -1) {
1270                     LEAVE;
1271                     XSRETURN_UNDEF;
1272                 }
1273             }
1274
1275             LEAVE;
1276         }
1277 #endif
1278     OUTPUT:
1279         RETVAL
1280
1281 SysRet
1282 sigpending(sigset)
1283         POSIX::SigSet           sigset
1284     ALIAS:
1285         sigsuspend = 1
1286     CODE:
1287         RETVAL = ix ? sigsuspend(sigset) : sigpending(sigset);
1288     OUTPUT:
1289         RETVAL
1290     CLEANUP:
1291     PERL_ASYNC_CHECK();
1292
1293 SysRet
1294 sigprocmask(how, sigset, oldsigset = 0)
1295         int                     how
1296         POSIX::SigSet           sigset = NO_INIT
1297         POSIX::SigSet           oldsigset = NO_INIT
1298 INIT:
1299         if (! SvOK(ST(1))) {
1300             sigset = NULL;
1301         } else if (sv_isa(ST(1), "POSIX::SigSet")) {
1302             sigset = (sigset_t *) SvPV_nolen(SvRV(ST(1)));
1303         } else {
1304             croak("sigset is not of type POSIX::SigSet");
1305         }
1306
1307         if (items < 3 || ! SvOK(ST(2))) {
1308             oldsigset = NULL;
1309         } else if (sv_isa(ST(2), "POSIX::SigSet")) {
1310             oldsigset = (sigset_t *) SvPV_nolen(SvRV(ST(2)));
1311         } else {
1312             croak("oldsigset is not of type POSIX::SigSet");
1313         }
1314
1315 void
1316 _exit(status)
1317         int             status
1318
1319 SysRet
1320 dup2(fd1, fd2)
1321         int             fd1
1322         int             fd2
1323     CODE:
1324 #ifdef WIN32
1325         /* RT #98912 - More Microsoft muppetry - failing to actually implemented
1326            the well known documented POSIX behaviour for a POSIX API.
1327            http://msdn.microsoft.com/en-us/library/8syseb29.aspx   */
1328         RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
1329 #else
1330         RETVAL = dup2(fd1, fd2);
1331 #endif
1332     OUTPUT:
1333         RETVAL
1334
1335 SV *
1336 lseek(fd, offset, whence)
1337         int             fd
1338         Off_t           offset
1339         int             whence
1340     CODE:
1341         Off_t pos = PerlLIO_lseek(fd, offset, whence);
1342         RETVAL = sizeof(Off_t) > sizeof(IV)
1343                  ? newSVnv((NV)pos) : newSViv((IV)pos);
1344     OUTPUT:
1345         RETVAL
1346
1347 void
1348 nice(incr)
1349         int             incr
1350     PPCODE:
1351         errno = 0;
1352         if ((incr = nice(incr)) != -1 || errno == 0) {
1353             if (incr == 0)
1354                 XPUSHs(newSVpvs_flags("0 but true", SVs_TEMP));
1355             else
1356                 XPUSHs(sv_2mortal(newSViv(incr)));
1357         }
1358
1359 void
1360 pipe()
1361     PPCODE:
1362         int fds[2];
1363         if (pipe(fds) != -1) {
1364             EXTEND(SP,2);
1365             PUSHs(sv_2mortal(newSViv(fds[0])));
1366             PUSHs(sv_2mortal(newSViv(fds[1])));
1367         }
1368
1369 SysRet
1370 read(fd, buffer, nbytes)
1371     PREINIT:
1372         SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1373     INPUT:
1374         int             fd
1375         size_t          nbytes
1376         char *          buffer = sv_grow( sv_buffer, nbytes+1 );
1377     CLEANUP:
1378         if (RETVAL >= 0) {
1379             SvCUR_set(sv_buffer, RETVAL);
1380             SvPOK_only(sv_buffer);
1381             *SvEND(sv_buffer) = '\0';
1382             SvTAINTED_on(sv_buffer);
1383         }
1384
1385 SysRet
1386 setpgid(pid, pgid)
1387         pid_t           pid
1388         pid_t           pgid
1389
1390 pid_t
1391 setsid()
1392
1393 pid_t
1394 tcgetpgrp(fd)
1395         int             fd
1396
1397 SysRet
1398 tcsetpgrp(fd, pgrp_id)
1399         int             fd
1400         pid_t           pgrp_id
1401
1402 void
1403 uname()
1404     PPCODE:
1405 #ifdef HAS_UNAME
1406         struct utsname buf;
1407         if (uname(&buf) >= 0) {
1408             EXTEND(SP, 5);
1409             PUSHs(newSVpvn_flags(buf.sysname, strlen(buf.sysname), SVs_TEMP));
1410             PUSHs(newSVpvn_flags(buf.nodename, strlen(buf.nodename), SVs_TEMP));
1411             PUSHs(newSVpvn_flags(buf.release, strlen(buf.release), SVs_TEMP));
1412             PUSHs(newSVpvn_flags(buf.version, strlen(buf.version), SVs_TEMP));
1413             PUSHs(newSVpvn_flags(buf.machine, strlen(buf.machine), SVs_TEMP));
1414         }
1415 #else
1416         uname((char *) 0); /* A stub to call not_here(). */
1417 #endif
1418
1419 SysRet
1420 write(fd, buffer, nbytes)
1421         int             fd
1422         char *          buffer
1423         size_t          nbytes
1424
1425 SV *
1426 tmpnam()
1427     PREINIT:
1428         STRLEN i;
1429         int len;
1430     CODE:
1431         RETVAL = newSVpvn("", 0);
1432         SvGROW(RETVAL, L_tmpnam);
1433         /* Yes, we know tmpnam() is bad.  So bad that some compilers
1434          * and linkers warn against using it.  But it is here for
1435          * completeness.  POSIX.pod warns against using it.
1436          *
1437          * Then again, maybe this should be removed at some point.
1438          * No point in enabling dangerous interfaces. */
1439         len = strlen(tmpnam(SvPV(RETVAL, i)));
1440         SvCUR_set(RETVAL, len);
1441     OUTPUT:
1442         RETVAL
1443
1444 void
1445 abort()
1446
1447 int
1448 mblen(s, n)
1449         char *          s
1450         size_t          n
1451
1452 size_t
1453 mbstowcs(s, pwcs, n)
1454         wchar_t *       s
1455         char *          pwcs
1456         size_t          n
1457
1458 int
1459 mbtowc(pwc, s, n)
1460         wchar_t *       pwc
1461         char *          s
1462         size_t          n
1463
1464 int
1465 wcstombs(s, pwcs, n)
1466         char *          s
1467         wchar_t *       pwcs
1468         size_t          n
1469
1470 int
1471 wctomb(s, wchar)
1472         char *          s
1473         wchar_t         wchar
1474
1475 int
1476 strcoll(s1, s2)
1477         char *          s1
1478         char *          s2
1479
1480 void
1481 strtod(str)
1482         char *          str
1483     PREINIT:
1484         double num;
1485         char *unparsed;
1486     PPCODE:
1487         STORE_NUMERIC_STANDARD_FORCE_LOCAL();
1488         num = strtod(str, &unparsed);
1489         PUSHs(sv_2mortal(newSVnv(num)));
1490         if (GIMME == G_ARRAY) {
1491             EXTEND(SP, 1);
1492             if (unparsed)
1493                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1494             else
1495                 PUSHs(&PL_sv_undef);
1496         }
1497         RESTORE_NUMERIC_STANDARD();
1498
1499 void
1500 strtol(str, base = 0)
1501         char *          str
1502         int             base
1503     PREINIT:
1504         long num;
1505         char *unparsed;
1506     PPCODE:
1507         num = strtol(str, &unparsed, base);
1508 #if IVSIZE <= LONGSIZE
1509         if (num < IV_MIN || num > IV_MAX)
1510             PUSHs(sv_2mortal(newSVnv((double)num)));
1511         else
1512 #endif
1513             PUSHs(sv_2mortal(newSViv((IV)num)));
1514         if (GIMME == G_ARRAY) {
1515             EXTEND(SP, 1);
1516             if (unparsed)
1517                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1518             else
1519                 PUSHs(&PL_sv_undef);
1520         }
1521
1522 void
1523 strtoul(str, base = 0)
1524         const char *    str
1525         int             base
1526     PREINIT:
1527         unsigned long num;
1528         char *unparsed;
1529     PPCODE:
1530         num = strtoul(str, &unparsed, base);
1531 #if IVSIZE <= LONGSIZE
1532         if (num > IV_MAX)
1533             PUSHs(sv_2mortal(newSVnv((double)num)));
1534         else
1535 #endif
1536             PUSHs(sv_2mortal(newSViv((IV)num)));
1537         if (GIMME == G_ARRAY) {
1538             EXTEND(SP, 1);
1539             if (unparsed)
1540                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1541             else
1542                 PUSHs(&PL_sv_undef);
1543         }
1544
1545 void
1546 strxfrm(src)
1547         SV *            src
1548     CODE:
1549         {
1550           STRLEN srclen;
1551           STRLEN dstlen;
1552           char *p = SvPV(src,srclen);
1553           srclen++;
1554           ST(0) = sv_2mortal(newSV(srclen*4+1));
1555           dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1556           if (dstlen > srclen) {
1557               dstlen++;
1558               SvGROW(ST(0), dstlen);
1559               strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1560               dstlen--;
1561           }
1562           SvCUR_set(ST(0), dstlen);
1563             SvPOK_only(ST(0));
1564         }
1565
1566 SysRet
1567 mkfifo(filename, mode)
1568         char *          filename
1569         Mode_t          mode
1570     ALIAS:
1571         access = 1
1572     CODE:
1573         if(ix) {
1574             RETVAL = access(filename, mode);
1575         } else {
1576             TAINT_PROPER("mkfifo");
1577             RETVAL = mkfifo(filename, mode);
1578         }
1579     OUTPUT:
1580         RETVAL
1581
1582 SysRet
1583 tcdrain(fd)
1584         int             fd
1585     ALIAS:
1586         close = 1
1587         dup = 2
1588     CODE:
1589         RETVAL = ix == 1 ? close(fd)
1590             : (ix < 1 ? tcdrain(fd) : dup(fd));
1591     OUTPUT:
1592         RETVAL
1593
1594
1595 SysRet
1596 tcflow(fd, action)
1597         int             fd
1598         int             action
1599     ALIAS:
1600         tcflush = 1
1601         tcsendbreak = 2
1602     CODE:
1603         RETVAL = ix == 1 ? tcflush(fd, action)
1604             : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
1605     OUTPUT:
1606         RETVAL
1607
1608 void
1609 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
1610         int             sec
1611         int             min
1612         int             hour
1613         int             mday
1614         int             mon
1615         int             year
1616         int             wday
1617         int             yday
1618         int             isdst
1619     ALIAS:
1620         mktime = 1
1621     PPCODE:
1622         {
1623             dXSTARG;
1624             struct tm mytm;
1625             init_tm(&mytm);     /* XXX workaround - see init_tm() in core util.c */
1626             mytm.tm_sec = sec;
1627             mytm.tm_min = min;
1628             mytm.tm_hour = hour;
1629             mytm.tm_mday = mday;
1630             mytm.tm_mon = mon;
1631             mytm.tm_year = year;
1632             mytm.tm_wday = wday;
1633             mytm.tm_yday = yday;
1634             mytm.tm_isdst = isdst;
1635             if (ix) {
1636                 const time_t result = mktime(&mytm);
1637                 if (result == (time_t)-1)
1638                     SvOK_off(TARG);
1639                 else if (result == 0)
1640                     sv_setpvn(TARG, "0 but true", 10);
1641                 else
1642                     sv_setiv(TARG, (IV)result);
1643             } else {
1644                 sv_setpv(TARG, asctime(&mytm));
1645             }
1646             ST(0) = TARG;
1647             XSRETURN(1);
1648         }
1649
1650 long
1651 clock()
1652
1653 char *
1654 ctime(time)
1655         Time_t          &time
1656
1657 void
1658 times()
1659         PPCODE:
1660         struct tms tms;
1661         clock_t realtime;
1662         realtime = times( &tms );
1663         EXTEND(SP,5);
1664         PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1665         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1666         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1667         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1668         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
1669
1670 double
1671 difftime(time1, time2)
1672         Time_t          time1
1673         Time_t          time2
1674
1675 #XXX: if $xsubpp::WantOptimize is always the default
1676 #     sv_setpv(TARG, ...) could be used rather than
1677 #     ST(0) = sv_2mortal(newSVpv(...))
1678 void
1679 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
1680         SV *            fmt
1681         int             sec
1682         int             min
1683         int             hour
1684         int             mday
1685         int             mon
1686         int             year
1687         int             wday
1688         int             yday
1689         int             isdst
1690     CODE:
1691         {
1692             char *buf;
1693
1694             /* allowing user-supplied (rather than literal) formats
1695              * is normally frowned upon as a potential security risk;
1696              * but this is part of the API so we have to allow it */
1697             GCC_DIAG_IGNORE(-Wformat-nonliteral);
1698             buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
1699             GCC_DIAG_RESTORE;
1700             if (buf) {
1701                 SV *const sv = sv_newmortal();
1702                 sv_usepvn_flags(sv, buf, strlen(buf), SV_HAS_TRAILING_NUL);
1703                 if (SvUTF8(fmt)) {
1704                     SvUTF8_on(sv);
1705                 }
1706                 ST(0) = sv;
1707             }
1708         }
1709
1710 void
1711 tzset()
1712   PPCODE:
1713     my_tzset(aTHX);
1714
1715 void
1716 tzname()
1717     PPCODE:
1718         EXTEND(SP,2);
1719         PUSHs(newSVpvn_flags(tzname[0], strlen(tzname[0]), SVs_TEMP));
1720         PUSHs(newSVpvn_flags(tzname[1], strlen(tzname[1]), SVs_TEMP));
1721
1722 char *
1723 ctermid(s = 0)
1724         char *          s = 0;
1725     CODE:
1726 #ifdef HAS_CTERMID_R
1727         s = (char *) safemalloc((size_t) L_ctermid);
1728 #endif
1729         RETVAL = ctermid(s);
1730     OUTPUT:
1731         RETVAL
1732     CLEANUP:
1733 #ifdef HAS_CTERMID_R
1734         Safefree(s);
1735 #endif
1736
1737 char *
1738 cuserid(s = 0)
1739         char *          s = 0;
1740     CODE:
1741 #ifdef HAS_CUSERID
1742   RETVAL = cuserid(s);
1743 #else
1744   RETVAL = 0;
1745   not_here("cuserid");
1746 #endif
1747     OUTPUT:
1748   RETVAL
1749
1750 SysRetLong
1751 fpathconf(fd, name)
1752         int             fd
1753         int             name
1754
1755 SysRetLong
1756 pathconf(filename, name)
1757         char *          filename
1758         int             name
1759
1760 SysRet
1761 pause()
1762     CLEANUP:
1763     PERL_ASYNC_CHECK();
1764
1765 unsigned int
1766 sleep(seconds)
1767         unsigned int    seconds
1768     CODE:
1769         RETVAL = PerlProc_sleep(seconds);
1770     OUTPUT:
1771         RETVAL
1772
1773 SysRet
1774 setgid(gid)
1775         Gid_t           gid
1776
1777 SysRet
1778 setuid(uid)
1779         Uid_t           uid
1780
1781 SysRetLong
1782 sysconf(name)
1783         int             name
1784
1785 char *
1786 ttyname(fd)
1787         int             fd
1788
1789 void
1790 getcwd()
1791     PPCODE:
1792       {
1793         dXSTARG;
1794         getcwd_sv(TARG);
1795         XSprePUSH; PUSHTARG;
1796       }
1797
1798 SysRet
1799 lchown(uid, gid, path)
1800        Uid_t           uid
1801        Gid_t           gid
1802        char *          path
1803     CODE:
1804 #ifdef HAS_LCHOWN
1805        /* yes, the order of arguments is different,
1806         * but consistent with CORE::chown() */
1807        RETVAL = lchown(path, uid, gid);
1808 #else
1809        RETVAL = not_here("lchown");
1810 #endif
1811     OUTPUT:
1812        RETVAL