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