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