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