This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
SDBM_File: fix 'set but not used' warning
[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     /* Ensure we get the function, not a macro implementation. Like the C89
584        standard says we can...  */
585 #undef isalnum
586     cv = newXS("POSIX::isalnum", is_common, file);
587     XSANY.any_dptr = (any_dptr_t) &isalnum;
588 #undef isalpha
589     cv = newXS("POSIX::isalpha", is_common, file);
590     XSANY.any_dptr = (any_dptr_t) &isalpha;
591 #undef iscntrl
592     cv = newXS("POSIX::iscntrl", is_common, file);
593     XSANY.any_dptr = (any_dptr_t) &iscntrl;
594 #undef isdigit
595     cv = newXS("POSIX::isdigit", is_common, file);
596     XSANY.any_dptr = (any_dptr_t) &isdigit;
597 #undef isgraph
598     cv = newXS("POSIX::isgraph", is_common, file);
599     XSANY.any_dptr = (any_dptr_t) &isgraph;
600 #undef islower
601     cv = newXS("POSIX::islower", is_common, file);
602     XSANY.any_dptr = (any_dptr_t) &islower;
603 #undef isprint
604     cv = newXS("POSIX::isprint", is_common, file);
605     XSANY.any_dptr = (any_dptr_t) &isprint;
606 #undef ispunct
607     cv = newXS("POSIX::ispunct", is_common, file);
608     XSANY.any_dptr = (any_dptr_t) &ispunct;
609 #undef isspace
610     cv = newXS("POSIX::isspace", is_common, file);
611     XSANY.any_dptr = (any_dptr_t) &isspace;
612 #undef isupper
613     cv = newXS("POSIX::isupper", is_common, file);
614     XSANY.any_dptr = (any_dptr_t) &isupper;
615 #undef isxdigit
616     cv = newXS("POSIX::isxdigit", is_common, file);
617     XSANY.any_dptr = (any_dptr_t) &isxdigit;
618 }
619
620 MODULE = SigSet         PACKAGE = POSIX::SigSet         PREFIX = sig
621
622 void
623 new(packname = "POSIX::SigSet", ...)
624     const char *        packname
625     CODE:
626         {
627             int i;
628             sigset_t *const s
629                 = (sigset_t *) allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
630                                                sizeof(sigset_t),
631                                                packname);
632             sigemptyset(s);
633             for (i = 1; i < items; i++)
634                 sigaddset(s, SvIV(ST(i)));
635             XSRETURN(1);
636         }
637
638 SysRet
639 addset(sigset, sig)
640         POSIX::SigSet   sigset
641         int             sig
642    ALIAS:
643         delset = 1
644    CODE:
645         RETVAL = ix ? sigdelset(sigset, sig) : sigaddset(sigset, sig);
646    OUTPUT:
647         RETVAL
648
649 SysRet
650 emptyset(sigset)
651         POSIX::SigSet   sigset
652    ALIAS:
653         fillset = 1
654    CODE:
655         RETVAL = ix ? sigfillset(sigset) : sigemptyset(sigset);
656    OUTPUT:
657         RETVAL
658
659 int
660 sigismember(sigset, sig)
661         POSIX::SigSet   sigset
662         int             sig
663
664 MODULE = Termios        PACKAGE = POSIX::Termios        PREFIX = cf
665
666 void
667 new(packname = "POSIX::Termios", ...)
668     const char *        packname
669     CODE:
670         {
671 #ifdef I_TERMIOS
672             void *const p = allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
673                                             sizeof(struct termios), packname);
674             /* The previous implementation stored a pointer to an uninitialised
675                struct termios. Seems safer to initialise it, particularly as
676                this implementation exposes the struct to prying from perl-space.
677             */
678             memset(p, 0, 1 + sizeof(struct termios));
679             XSRETURN(1);
680 #else
681             not_here("termios");
682 #endif
683         }
684
685 SysRet
686 getattr(termios_ref, fd = 0)
687         POSIX::Termios  termios_ref
688         int             fd
689     CODE:
690         RETVAL = tcgetattr(fd, termios_ref);
691     OUTPUT:
692         RETVAL
693
694 # If we define TCSANOW here then both a found and not found constant sub
695 # are created causing a Constant subroutine TCSANOW redefined warning
696 #ifndef TCSANOW
697 #  define DEF_SETATTR_ACTION 0
698 #else
699 #  define DEF_SETATTR_ACTION TCSANOW
700 #endif
701 SysRet
702 setattr(termios_ref, fd = 0, optional_actions = DEF_SETATTR_ACTION)
703         POSIX::Termios  termios_ref
704         int             fd
705         int             optional_actions
706     CODE:
707         /* The second argument to the call is mandatory, but we'd like to give
708            it a useful default. 0 isn't valid on all operating systems - on
709            Solaris (at least) TCSANOW, TCSADRAIN and TCSAFLUSH have the same
710            values as the equivalent ioctls, TCSETS, TCSETSW and TCSETSF.  */
711         RETVAL = tcsetattr(fd, optional_actions, termios_ref);
712     OUTPUT:
713         RETVAL
714
715 speed_t
716 getispeed(termios_ref)
717         POSIX::Termios  termios_ref
718     ALIAS:
719         getospeed = 1
720     CODE:
721         RETVAL = ix ? cfgetospeed(termios_ref) : cfgetispeed(termios_ref);
722     OUTPUT:
723         RETVAL
724
725 tcflag_t
726 getiflag(termios_ref)
727         POSIX::Termios  termios_ref
728     ALIAS:
729         getoflag = 1
730         getcflag = 2
731         getlflag = 3
732     CODE:
733 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
734         switch(ix) {
735         case 0:
736             RETVAL = termios_ref->c_iflag;
737             break;
738         case 1:
739             RETVAL = termios_ref->c_oflag;
740             break;
741         case 2:
742             RETVAL = termios_ref->c_cflag;
743             break;
744         case 3:
745             RETVAL = termios_ref->c_lflag;
746             break;
747         }
748 #else
749         not_here(GvNAME(CvGV(cv)));
750         RETVAL = 0;
751 #endif
752     OUTPUT:
753         RETVAL
754
755 cc_t
756 getcc(termios_ref, ccix)
757         POSIX::Termios  termios_ref
758         unsigned int    ccix
759     CODE:
760 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
761         if (ccix >= NCCS)
762             croak("Bad getcc subscript");
763         RETVAL = termios_ref->c_cc[ccix];
764 #else
765      not_here("getcc");
766      RETVAL = 0;
767 #endif
768     OUTPUT:
769         RETVAL
770
771 SysRet
772 setispeed(termios_ref, speed)
773         POSIX::Termios  termios_ref
774         speed_t         speed
775     ALIAS:
776         setospeed = 1
777     CODE:
778         RETVAL = ix
779             ? cfsetospeed(termios_ref, speed) : cfsetispeed(termios_ref, speed);
780     OUTPUT:
781         RETVAL
782
783 void
784 setiflag(termios_ref, flag)
785         POSIX::Termios  termios_ref
786         tcflag_t        flag
787     ALIAS:
788         setoflag = 1
789         setcflag = 2
790         setlflag = 3
791     CODE:
792 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
793         switch(ix) {
794         case 0:
795             termios_ref->c_iflag = flag;
796             break;
797         case 1:
798             termios_ref->c_oflag = flag;
799             break;
800         case 2:
801             termios_ref->c_cflag = flag;
802             break;
803         case 3:
804             termios_ref->c_lflag = flag;
805             break;
806         }
807 #else
808         not_here(GvNAME(CvGV(cv)));
809 #endif
810
811 void
812 setcc(termios_ref, ccix, cc)
813         POSIX::Termios  termios_ref
814         unsigned int    ccix
815         cc_t            cc
816     CODE:
817 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
818         if (ccix >= NCCS)
819             croak("Bad setcc subscript");
820         termios_ref->c_cc[ccix] = cc;
821 #else
822             not_here("setcc");
823 #endif
824
825
826 MODULE = POSIX          PACKAGE = POSIX
827
828 INCLUDE: const-xs.inc
829
830 int
831 WEXITSTATUS(status)
832         int status
833     ALIAS:
834         POSIX::WIFEXITED = 1
835         POSIX::WIFSIGNALED = 2
836         POSIX::WIFSTOPPED = 3
837         POSIX::WSTOPSIG = 4
838         POSIX::WTERMSIG = 5
839     CODE:
840 #if !defined(WEXITSTATUS) || !defined(WIFEXITED) || !defined(WIFSIGNALED) \
841       || !defined(WIFSTOPPED) || !defined(WSTOPSIG) || !defined(WTERMSIG)
842         RETVAL = 0; /* Silence compilers that notice this, but don't realise
843                        that not_here() can't return.  */
844 #endif
845         switch(ix) {
846         case 0:
847 #ifdef WEXITSTATUS
848             RETVAL = WEXITSTATUS(WMUNGE(status));
849 #else
850             not_here("WEXITSTATUS");
851 #endif
852             break;
853         case 1:
854 #ifdef WIFEXITED
855             RETVAL = WIFEXITED(WMUNGE(status));
856 #else
857             not_here("WIFEXITED");
858 #endif
859             break;
860         case 2:
861 #ifdef WIFSIGNALED
862             RETVAL = WIFSIGNALED(WMUNGE(status));
863 #else
864             not_here("WIFSIGNALED");
865 #endif
866             break;
867         case 3:
868 #ifdef WIFSTOPPED
869             RETVAL = WIFSTOPPED(WMUNGE(status));
870 #else
871             not_here("WIFSTOPPED");
872 #endif
873             break;
874         case 4:
875 #ifdef WSTOPSIG
876             RETVAL = WSTOPSIG(WMUNGE(status));
877 #else
878             not_here("WSTOPSIG");
879 #endif
880             break;
881         case 5:
882 #ifdef WTERMSIG
883             RETVAL = WTERMSIG(WMUNGE(status));
884 #else
885             not_here("WTERMSIG");
886 #endif
887             break;
888         default:
889             Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", (int)ix);
890         }
891     OUTPUT:
892         RETVAL
893
894 SysRet
895 open(filename, flags = O_RDONLY, mode = 0666)
896         char *          filename
897         int             flags
898         Mode_t          mode
899     CODE:
900         if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
901             TAINT_PROPER("open");
902         RETVAL = open(filename, flags, mode);
903     OUTPUT:
904         RETVAL
905
906
907 HV *
908 localeconv()
909     CODE:
910 #ifdef HAS_LOCALECONV
911         struct lconv *lcbuf;
912         RETVAL = newHV();
913         sv_2mortal((SV*)RETVAL);
914         if ((lcbuf = localeconv())) {
915             const struct lconv_offset *strings = lconv_strings;
916             const struct lconv_offset *integers = lconv_integers;
917             const char *ptr = (const char *) lcbuf;
918
919             do {
920                 const char *value = *((const char **)(ptr + strings->offset));
921
922                 if (value && *value)
923                     (void) hv_store(RETVAL, strings->name, strlen(strings->name),
924                                     newSVpv(value, 0), 0);
925             } while ((++strings)->name);
926
927             do {
928                 const char value = *((const char *)(ptr + integers->offset));
929
930                 if (value != CHAR_MAX)
931                     (void) hv_store(RETVAL, integers->name,
932                                     strlen(integers->name), newSViv(value), 0);
933             } while ((++integers)->name);
934         }
935 #else
936         localeconv(); /* A stub to call not_here(). */
937 #endif
938     OUTPUT:
939         RETVAL
940
941 char *
942 setlocale(category, locale = 0)
943         int             category
944         char *          locale
945     PREINIT:
946         char *          retval;
947     CODE:
948         retval = setlocale(category, locale);
949         if (! retval) {
950             XSRETURN_UNDEF;
951         }
952         else {
953             /* Save retval since subsequent setlocale() calls
954              * may overwrite it. */
955             RETVAL = savepv(retval);
956 #ifdef USE_LOCALE_CTYPE
957             if (category == LC_CTYPE
958 #ifdef LC_ALL
959                 || category == LC_ALL
960 #endif
961                 )
962             {
963                 char *newctype;
964 #ifdef LC_ALL
965                 if (category == LC_ALL)
966                     newctype = setlocale(LC_CTYPE, NULL);
967                 else
968 #endif
969                     newctype = RETVAL;
970                 new_ctype(newctype);
971             }
972 #endif /* USE_LOCALE_CTYPE */
973 #ifdef USE_LOCALE_COLLATE
974             if (category == LC_COLLATE
975 #ifdef LC_ALL
976                 || category == LC_ALL
977 #endif
978                 )
979             {
980                 char *newcoll;
981 #ifdef LC_ALL
982                 if (category == LC_ALL)
983                     newcoll = setlocale(LC_COLLATE, NULL);
984                 else
985 #endif
986                     newcoll = RETVAL;
987                 new_collate(newcoll);
988             }
989 #endif /* USE_LOCALE_COLLATE */
990 #ifdef USE_LOCALE_NUMERIC
991             if (category == LC_NUMERIC
992 #ifdef LC_ALL
993                 || category == LC_ALL
994 #endif
995                 )
996             {
997                 char *newnum;
998 #ifdef LC_ALL
999                 if (category == LC_ALL)
1000                     newnum = setlocale(LC_NUMERIC, NULL);
1001                 else
1002 #endif
1003                     newnum = RETVAL;
1004                 new_numeric(newnum);
1005             }
1006 #endif /* USE_LOCALE_NUMERIC */
1007         }
1008     OUTPUT:
1009         RETVAL
1010     CLEANUP:
1011         Safefree(RETVAL);
1012
1013 NV
1014 acos(x)
1015         NV              x
1016     ALIAS:
1017         asin = 1
1018         atan = 2
1019         ceil = 3
1020         cosh = 4
1021         floor = 5
1022         log10 = 6
1023         sinh = 7
1024         tan = 8
1025         tanh = 9
1026     CODE:
1027         switch (ix) {
1028         case 0:
1029             RETVAL = acos(x);
1030             break;
1031         case 1:
1032             RETVAL = asin(x);
1033             break;
1034         case 2:
1035             RETVAL = atan(x);
1036             break;
1037         case 3:
1038             RETVAL = ceil(x);
1039             break;
1040         case 4:
1041             RETVAL = cosh(x);
1042             break;
1043         case 5:
1044             RETVAL = floor(x);
1045             break;
1046         case 6:
1047             RETVAL = log10(x);
1048             break;
1049         case 7:
1050             RETVAL = sinh(x);
1051             break;
1052         case 8:
1053             RETVAL = tan(x);
1054             break;
1055         default:
1056             RETVAL = tanh(x);
1057         }
1058     OUTPUT:
1059         RETVAL
1060
1061 NV
1062 fmod(x,y)
1063         NV              x
1064         NV              y
1065
1066 void
1067 frexp(x)
1068         NV              x
1069     PPCODE:
1070         int expvar;
1071         /* (We already know stack is long enough.) */
1072         PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1073         PUSHs(sv_2mortal(newSViv(expvar)));
1074
1075 NV
1076 ldexp(x,exp)
1077         NV              x
1078         int             exp
1079
1080 void
1081 modf(x)
1082         NV              x
1083     PPCODE:
1084         NV intvar;
1085         /* (We already know stack is long enough.) */
1086         PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
1087         PUSHs(sv_2mortal(newSVnv(intvar)));
1088
1089 SysRet
1090 sigaction(sig, optaction, oldaction = 0)
1091         int                     sig
1092         SV *                    optaction
1093         POSIX::SigAction        oldaction
1094     CODE:
1095 #if defined(WIN32) || defined(NETWARE)
1096         RETVAL = not_here("sigaction");
1097 #else
1098 # This code is really grody because we're trying to make the signal
1099 # interface look beautiful, which is hard.
1100
1101         {
1102             dVAR;
1103             POSIX__SigAction action;
1104             GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
1105             struct sigaction act;
1106             struct sigaction oact;
1107             sigset_t sset;
1108             SV *osset_sv;
1109             sigset_t osset;
1110             POSIX__SigSet sigset;
1111             SV** svp;
1112             SV** sigsvp;
1113
1114             if (sig < 0) {
1115                 croak("Negative signals are not allowed");
1116             }
1117
1118             if (sig == 0 && SvPOK(ST(0))) {
1119                 const char *s = SvPVX_const(ST(0));
1120                 int i = whichsig(s);
1121
1122                 if (i < 0 && memEQ(s, "SIG", 3))
1123                     i = whichsig(s + 3);
1124                 if (i < 0) {
1125                     if (ckWARN(WARN_SIGNAL))
1126                         Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1127                                     "No such signal: SIG%s", s);
1128                     XSRETURN_UNDEF;
1129                 }
1130                 else
1131                     sig = i;
1132             }
1133 #ifdef NSIG
1134             if (sig > NSIG) { /* NSIG - 1 is still okay. */
1135                 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1136                             "No such signal: %d", sig);
1137                 XSRETURN_UNDEF;
1138             }
1139 #endif
1140             sigsvp = hv_fetch(GvHVn(siggv),
1141                               PL_sig_name[sig],
1142                               strlen(PL_sig_name[sig]),
1143                               TRUE);
1144
1145             /* Check optaction and set action */
1146             if(SvTRUE(optaction)) {
1147                 if(sv_isa(optaction, "POSIX::SigAction"))
1148                         action = (HV*)SvRV(optaction);
1149                 else
1150                         croak("action is not of type POSIX::SigAction");
1151             }
1152             else {
1153                 action=0;
1154             }
1155
1156             /* sigaction() is supposed to look atomic. In particular, any
1157              * signal handler invoked during a sigaction() call should
1158              * see either the old or the new disposition, and not something
1159              * in between. We use sigprocmask() to make it so.
1160              */
1161             sigfillset(&sset);
1162             RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1163             if(RETVAL == -1)
1164                XSRETURN_UNDEF;
1165             ENTER;
1166             /* Restore signal mask no matter how we exit this block. */
1167             osset_sv = newSVpvn((char *)(&osset), sizeof(sigset_t));
1168             SAVEFREESV( osset_sv );
1169             SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1170
1171             RETVAL=-1; /* In case both oldaction and action are 0. */
1172
1173             /* Remember old disposition if desired. */
1174             if (oldaction) {
1175                 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
1176                 if(!svp)
1177                     croak("Can't supply an oldaction without a HANDLER");
1178                 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1179                         sv_setsv(*svp, *sigsvp);
1180                 }
1181                 else {
1182                         sv_setpvs(*svp, "DEFAULT");
1183                 }
1184                 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
1185                 if(RETVAL == -1) {
1186                    LEAVE;
1187                    XSRETURN_UNDEF;
1188                 }
1189                 /* Get back the mask. */
1190                 svp = hv_fetchs(oldaction, "MASK", TRUE);
1191                 if (sv_isa(*svp, "POSIX::SigSet")) {
1192                     sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
1193                 }
1194                 else {
1195                     sigset = (sigset_t *) allocate_struct(aTHX_ *svp,
1196                                                           sizeof(sigset_t),
1197                                                           "POSIX::SigSet");
1198                 }
1199                 *sigset = oact.sa_mask;
1200
1201                 /* Get back the flags. */
1202                 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
1203                 sv_setiv(*svp, oact.sa_flags);
1204
1205                 /* Get back whether the old handler used safe signals. */
1206                 svp = hv_fetchs(oldaction, "SAFE", TRUE);
1207                 sv_setiv(*svp,
1208                 /* compare incompatible pointers by casting to integer */
1209                     PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
1210             }
1211
1212             if (action) {
1213                 /* Safe signals use "csighandler", which vectors through the
1214                    PL_sighandlerp pointer when it's safe to do so.
1215                    (BTW, "csighandler" is very different from "sighandler".) */
1216                 svp = hv_fetchs(action, "SAFE", FALSE);
1217                 act.sa_handler =
1218                         DPTR2FPTR(
1219                             void (*)(int),
1220                             (*svp && SvTRUE(*svp))
1221                                 ? PL_csighandlerp : PL_sighandlerp
1222                         );
1223
1224                 /* Vector new Perl handler through %SIG.
1225                    (The core signal handlers read %SIG to dispatch.) */
1226                 svp = hv_fetchs(action, "HANDLER", FALSE);
1227                 if (!svp)
1228                     croak("Can't supply an action without a HANDLER");
1229                 sv_setsv(*sigsvp, *svp);
1230
1231                 /* This call actually calls sigaction() with almost the
1232                    right settings, including appropriate interpretation
1233                    of DEFAULT and IGNORE.  However, why are we doing
1234                    this when we're about to do it again just below?  XXX */
1235                 SvSETMAGIC(*sigsvp);
1236
1237                 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1238                 if(SvPOK(*svp)) {
1239                         const char *s=SvPVX_const(*svp);
1240                         if(strEQ(s,"IGNORE")) {
1241                                 act.sa_handler = SIG_IGN;
1242                         }
1243                         else if(strEQ(s,"DEFAULT")) {
1244                                 act.sa_handler = SIG_DFL;
1245                         }
1246                 }
1247
1248                 /* Set up any desired mask. */
1249                 svp = hv_fetchs(action, "MASK", FALSE);
1250                 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
1251                     sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
1252                     act.sa_mask = *sigset;
1253                 }
1254                 else
1255                     sigemptyset(& act.sa_mask);
1256
1257                 /* Set up any desired flags. */
1258                 svp = hv_fetchs(action, "FLAGS", FALSE);
1259                 act.sa_flags = svp ? SvIV(*svp) : 0;
1260
1261                 /* Don't worry about cleaning up *sigsvp if this fails,
1262                  * because that means we tried to disposition a
1263                  * nonblockable signal, in which case *sigsvp is
1264                  * essentially meaningless anyway.
1265                  */
1266                 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
1267                 if(RETVAL == -1) {
1268                     LEAVE;
1269                     XSRETURN_UNDEF;
1270                 }
1271             }
1272
1273             LEAVE;
1274         }
1275 #endif
1276     OUTPUT:
1277         RETVAL
1278
1279 SysRet
1280 sigpending(sigset)
1281         POSIX::SigSet           sigset
1282     ALIAS:
1283         sigsuspend = 1
1284     CODE:
1285         RETVAL = ix ? sigsuspend(sigset) : sigpending(sigset);
1286     OUTPUT:
1287         RETVAL
1288     CLEANUP:
1289     PERL_ASYNC_CHECK();
1290
1291 SysRet
1292 sigprocmask(how, sigset, oldsigset = 0)
1293         int                     how
1294         POSIX::SigSet           sigset = NO_INIT
1295         POSIX::SigSet           oldsigset = NO_INIT
1296 INIT:
1297         if (! SvOK(ST(1))) {
1298             sigset = NULL;
1299         } else if (sv_isa(ST(1), "POSIX::SigSet")) {
1300             sigset = (sigset_t *) SvPV_nolen(SvRV(ST(1)));
1301         } else {
1302             croak("sigset is not of type POSIX::SigSet");
1303         }
1304
1305         if (items < 3 || ! SvOK(ST(2))) {
1306             oldsigset = NULL;
1307         } else if (sv_isa(ST(2), "POSIX::SigSet")) {
1308             oldsigset = (sigset_t *) SvPV_nolen(SvRV(ST(2)));
1309         } else {
1310             croak("oldsigset is not of type POSIX::SigSet");
1311         }
1312
1313 void
1314 _exit(status)
1315         int             status
1316
1317 SysRet
1318 dup2(fd1, fd2)
1319         int             fd1
1320         int             fd2
1321     CODE:
1322 #ifdef WIN32
1323         /* RT #98912 - More Microsoft muppetry - failing to actually implemented
1324            the well known documented POSIX behaviour for a POSIX API.
1325            http://msdn.microsoft.com/en-us/library/8syseb29.aspx   */
1326         RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
1327 #else
1328         RETVAL = dup2(fd1, fd2);
1329 #endif
1330     OUTPUT:
1331         RETVAL
1332
1333 SV *
1334 lseek(fd, offset, whence)
1335         int             fd
1336         Off_t           offset
1337         int             whence
1338     CODE:
1339         Off_t pos = PerlLIO_lseek(fd, offset, whence);
1340         RETVAL = sizeof(Off_t) > sizeof(IV)
1341                  ? newSVnv((NV)pos) : newSViv((IV)pos);
1342     OUTPUT:
1343         RETVAL
1344
1345 void
1346 nice(incr)
1347         int             incr
1348     PPCODE:
1349         errno = 0;
1350         if ((incr = nice(incr)) != -1 || errno == 0) {
1351             if (incr == 0)
1352                 XPUSHs(newSVpvs_flags("0 but true", SVs_TEMP));
1353             else
1354                 XPUSHs(sv_2mortal(newSViv(incr)));
1355         }
1356
1357 void
1358 pipe()
1359     PPCODE:
1360         int fds[2];
1361         if (pipe(fds) != -1) {
1362             EXTEND(SP,2);
1363             PUSHs(sv_2mortal(newSViv(fds[0])));
1364             PUSHs(sv_2mortal(newSViv(fds[1])));
1365         }
1366
1367 SysRet
1368 read(fd, buffer, nbytes)
1369     PREINIT:
1370         SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1371     INPUT:
1372         int             fd
1373         size_t          nbytes
1374         char *          buffer = sv_grow( sv_buffer, nbytes+1 );
1375     CLEANUP:
1376         if (RETVAL >= 0) {
1377             SvCUR_set(sv_buffer, RETVAL);
1378             SvPOK_only(sv_buffer);
1379             *SvEND(sv_buffer) = '\0';
1380             SvTAINTED_on(sv_buffer);
1381         }
1382
1383 SysRet
1384 setpgid(pid, pgid)
1385         pid_t           pid
1386         pid_t           pgid
1387
1388 pid_t
1389 setsid()
1390
1391 pid_t
1392 tcgetpgrp(fd)
1393         int             fd
1394
1395 SysRet
1396 tcsetpgrp(fd, pgrp_id)
1397         int             fd
1398         pid_t           pgrp_id
1399
1400 void
1401 uname()
1402     PPCODE:
1403 #ifdef HAS_UNAME
1404         struct utsname buf;
1405         if (uname(&buf) >= 0) {
1406             EXTEND(SP, 5);
1407             PUSHs(newSVpvn_flags(buf.sysname, strlen(buf.sysname), SVs_TEMP));
1408             PUSHs(newSVpvn_flags(buf.nodename, strlen(buf.nodename), SVs_TEMP));
1409             PUSHs(newSVpvn_flags(buf.release, strlen(buf.release), SVs_TEMP));
1410             PUSHs(newSVpvn_flags(buf.version, strlen(buf.version), SVs_TEMP));
1411             PUSHs(newSVpvn_flags(buf.machine, strlen(buf.machine), SVs_TEMP));
1412         }
1413 #else
1414         uname((char *) 0); /* A stub to call not_here(). */
1415 #endif
1416
1417 SysRet
1418 write(fd, buffer, nbytes)
1419         int             fd
1420         char *          buffer
1421         size_t          nbytes
1422
1423 SV *
1424 tmpnam()
1425     PREINIT:
1426         STRLEN i;
1427         int len;
1428     CODE:
1429         RETVAL = newSVpvn("", 0);
1430         SvGROW(RETVAL, L_tmpnam);
1431         len = strlen(tmpnam(SvPV(RETVAL, i)));
1432         SvCUR_set(RETVAL, len);
1433     OUTPUT:
1434         RETVAL
1435
1436 void
1437 abort()
1438
1439 int
1440 mblen(s, n)
1441         char *          s
1442         size_t          n
1443
1444 size_t
1445 mbstowcs(s, pwcs, n)
1446         wchar_t *       s
1447         char *          pwcs
1448         size_t          n
1449
1450 int
1451 mbtowc(pwc, s, n)
1452         wchar_t *       pwc
1453         char *          s
1454         size_t          n
1455
1456 int
1457 wcstombs(s, pwcs, n)
1458         char *          s
1459         wchar_t *       pwcs
1460         size_t          n
1461
1462 int
1463 wctomb(s, wchar)
1464         char *          s
1465         wchar_t         wchar
1466
1467 int
1468 strcoll(s1, s2)
1469         char *          s1
1470         char *          s2
1471
1472 void
1473 strtod(str)
1474         char *          str
1475     PREINIT:
1476         double num;
1477         char *unparsed;
1478     PPCODE:
1479         SET_NUMERIC_LOCAL();
1480         num = strtod(str, &unparsed);
1481         PUSHs(sv_2mortal(newSVnv(num)));
1482         if (GIMME == G_ARRAY) {
1483             EXTEND(SP, 1);
1484             if (unparsed)
1485                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1486             else
1487                 PUSHs(&PL_sv_undef);
1488         }
1489
1490 void
1491 strtol(str, base = 0)
1492         char *          str
1493         int             base
1494     PREINIT:
1495         long num;
1496         char *unparsed;
1497     PPCODE:
1498         num = strtol(str, &unparsed, base);
1499 #if IVSIZE <= LONGSIZE
1500         if (num < IV_MIN || num > IV_MAX)
1501             PUSHs(sv_2mortal(newSVnv((double)num)));
1502         else
1503 #endif
1504             PUSHs(sv_2mortal(newSViv((IV)num)));
1505         if (GIMME == G_ARRAY) {
1506             EXTEND(SP, 1);
1507             if (unparsed)
1508                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1509             else
1510                 PUSHs(&PL_sv_undef);
1511         }
1512
1513 void
1514 strtoul(str, base = 0)
1515         const char *    str
1516         int             base
1517     PREINIT:
1518         unsigned long num;
1519         char *unparsed;
1520     PPCODE:
1521         num = strtoul(str, &unparsed, base);
1522 #if IVSIZE <= LONGSIZE
1523         if (num > IV_MAX)
1524             PUSHs(sv_2mortal(newSVnv((double)num)));
1525         else
1526 #endif
1527             PUSHs(sv_2mortal(newSViv((IV)num)));
1528         if (GIMME == G_ARRAY) {
1529             EXTEND(SP, 1);
1530             if (unparsed)
1531                 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1532             else
1533                 PUSHs(&PL_sv_undef);
1534         }
1535
1536 void
1537 strxfrm(src)
1538         SV *            src
1539     CODE:
1540         {
1541           STRLEN srclen;
1542           STRLEN dstlen;
1543           char *p = SvPV(src,srclen);
1544           srclen++;
1545           ST(0) = sv_2mortal(newSV(srclen*4+1));
1546           dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1547           if (dstlen > srclen) {
1548               dstlen++;
1549               SvGROW(ST(0), dstlen);
1550               strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1551               dstlen--;
1552           }
1553           SvCUR_set(ST(0), dstlen);
1554             SvPOK_only(ST(0));
1555         }
1556
1557 SysRet
1558 mkfifo(filename, mode)
1559         char *          filename
1560         Mode_t          mode
1561     ALIAS:
1562         access = 1
1563     CODE:
1564         if(ix) {
1565             RETVAL = access(filename, mode);
1566         } else {
1567             TAINT_PROPER("mkfifo");
1568             RETVAL = mkfifo(filename, mode);
1569         }
1570     OUTPUT:
1571         RETVAL
1572
1573 SysRet
1574 tcdrain(fd)
1575         int             fd
1576     ALIAS:
1577         close = 1
1578         dup = 2
1579     CODE:
1580         RETVAL = ix == 1 ? close(fd)
1581             : (ix < 1 ? tcdrain(fd) : dup(fd));
1582     OUTPUT:
1583         RETVAL
1584
1585
1586 SysRet
1587 tcflow(fd, action)
1588         int             fd
1589         int             action
1590     ALIAS:
1591         tcflush = 1
1592         tcsendbreak = 2
1593     CODE:
1594         RETVAL = ix == 1 ? tcflush(fd, action)
1595             : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
1596     OUTPUT:
1597         RETVAL
1598
1599 void
1600 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
1601         int             sec
1602         int             min
1603         int             hour
1604         int             mday
1605         int             mon
1606         int             year
1607         int             wday
1608         int             yday
1609         int             isdst
1610     ALIAS:
1611         mktime = 1
1612     PPCODE:
1613         {
1614             dXSTARG;
1615             struct tm mytm;
1616             init_tm(&mytm);     /* XXX workaround - see init_tm() in core util.c */
1617             mytm.tm_sec = sec;
1618             mytm.tm_min = min;
1619             mytm.tm_hour = hour;
1620             mytm.tm_mday = mday;
1621             mytm.tm_mon = mon;
1622             mytm.tm_year = year;
1623             mytm.tm_wday = wday;
1624             mytm.tm_yday = yday;
1625             mytm.tm_isdst = isdst;
1626             if (ix) {
1627                 const time_t result = mktime(&mytm);
1628                 if (result == (time_t)-1)
1629                     SvOK_off(TARG);
1630                 else if (result == 0)
1631                     sv_setpvn(TARG, "0 but true", 10);
1632                 else
1633                     sv_setiv(TARG, (IV)result);
1634             } else {
1635                 sv_setpv(TARG, asctime(&mytm));
1636             }
1637             ST(0) = TARG;
1638             XSRETURN(1);
1639         }
1640
1641 long
1642 clock()
1643
1644 char *
1645 ctime(time)
1646         Time_t          &time
1647
1648 void
1649 times()
1650         PPCODE:
1651         struct tms tms;
1652         clock_t realtime;
1653         realtime = times( &tms );
1654         EXTEND(SP,5);
1655         PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1656         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1657         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1658         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1659         PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
1660
1661 double
1662 difftime(time1, time2)
1663         Time_t          time1
1664         Time_t          time2
1665
1666 #XXX: if $xsubpp::WantOptimize is always the default
1667 #     sv_setpv(TARG, ...) could be used rather than
1668 #     ST(0) = sv_2mortal(newSVpv(...))
1669 void
1670 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
1671         SV *            fmt
1672         int             sec
1673         int             min
1674         int             hour
1675         int             mday
1676         int             mon
1677         int             year
1678         int             wday
1679         int             yday
1680         int             isdst
1681     CODE:
1682         {
1683             char *buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
1684             if (buf) {
1685                 SV *const sv = sv_newmortal();
1686                 sv_usepvn_flags(sv, buf, strlen(buf), SV_HAS_TRAILING_NUL);
1687                 if (SvUTF8(fmt)) {
1688                     SvUTF8_on(sv);
1689                 }
1690                 ST(0) = sv;
1691             }
1692         }
1693
1694 void
1695 tzset()
1696   PPCODE:
1697     my_tzset(aTHX);
1698
1699 void
1700 tzname()
1701     PPCODE:
1702         EXTEND(SP,2);
1703         PUSHs(newSVpvn_flags(tzname[0], strlen(tzname[0]), SVs_TEMP));
1704         PUSHs(newSVpvn_flags(tzname[1], strlen(tzname[1]), SVs_TEMP));
1705
1706 char *
1707 ctermid(s = 0)
1708         char *          s = 0;
1709     CODE:
1710 #ifdef HAS_CTERMID_R
1711         s = (char *) safemalloc((size_t) L_ctermid);
1712 #endif
1713         RETVAL = ctermid(s);
1714     OUTPUT:
1715         RETVAL
1716     CLEANUP:
1717 #ifdef HAS_CTERMID_R
1718         Safefree(s);
1719 #endif
1720
1721 char *
1722 cuserid(s = 0)
1723         char *          s = 0;
1724     CODE:
1725 #ifdef HAS_CUSERID
1726   RETVAL = cuserid(s);
1727 #else
1728   RETVAL = 0;
1729   not_here("cuserid");
1730 #endif
1731     OUTPUT:
1732   RETVAL
1733
1734 SysRetLong
1735 fpathconf(fd, name)
1736         int             fd
1737         int             name
1738
1739 SysRetLong
1740 pathconf(filename, name)
1741         char *          filename
1742         int             name
1743
1744 SysRet
1745 pause()
1746     CLEANUP:
1747     PERL_ASYNC_CHECK();
1748
1749 unsigned int
1750 sleep(seconds)
1751         unsigned int    seconds
1752     CODE:
1753         RETVAL = PerlProc_sleep(seconds);
1754     OUTPUT:
1755         RETVAL
1756
1757 SysRet
1758 setgid(gid)
1759         Gid_t           gid
1760
1761 SysRet
1762 setuid(uid)
1763         Uid_t           uid
1764
1765 SysRetLong
1766 sysconf(name)
1767         int             name
1768
1769 char *
1770 ttyname(fd)
1771         int             fd
1772
1773 void
1774 getcwd()
1775     PPCODE:
1776       {
1777         dXSTARG;
1778         getcwd_sv(TARG);
1779         XSprePUSH; PUSHTARG;
1780       }
1781
1782 SysRet
1783 lchown(uid, gid, path)
1784        Uid_t           uid
1785        Gid_t           gid
1786        char *          path
1787     CODE:
1788 #ifdef HAS_LCHOWN
1789        /* yes, the order of arguments is different,
1790         * but consistent with CORE::chown() */
1791        RETVAL = lchown(path, uid, gid);
1792 #else
1793        RETVAL = not_here("lchown");
1794 #endif
1795     OUTPUT:
1796        RETVAL