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