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