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