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