This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
POSIX: silence some compiler warnings
[perl5.git] / ext / POSIX / POSIX.xs
CommitLineData
6e22d046
JH
1#define PERL_EXT_POSIX
2
2986a63f
JH
3#ifdef NETWARE
4 #define _POSIX_
4efcf9a2
SB
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 */
2986a63f
JH
11 #include <sys/utsname.h>
12#endif /* NETWARE */
13
c5be433b
GS
14#define PERL_NO_GET_CONTEXT
15
463ee0b2 16#include "EXTERN.h"
760ac839 17#define PERLIO_NOT_STDIO 1
463ee0b2
LW
18#include "perl.h"
19#include "XSUB.h"
acfe0abc 20#if defined(PERL_IMPLICIT_SYS)
873ef191
GS
21# undef signal
22# undef open
cd661bb6 23# undef setmode
35ff7856 24# define open PerlLIO_open3
873ef191 25#endif
2304df62 26#include <ctype.h>
a0d0e21e 27#ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */
2304df62 28#include <dirent.h>
a0d0e21e 29#endif
2304df62 30#include <errno.h>
b0ba2190
SH
31#ifdef WIN32
32#include <sys/errno2.h>
33#endif
2304df62
AD
34#ifdef I_FLOAT
35#include <float.h>
36#endif
a0d0e21e 37#ifdef I_LIMITS
2304df62 38#include <limits.h>
a0d0e21e 39#endif
2304df62
AD
40#include <locale.h>
41#include <math.h>
85e6fe83 42#ifdef I_PWD
2304df62 43#include <pwd.h>
85e6fe83 44#endif
2304df62
AD
45#include <setjmp.h>
46#include <signal.h>
2304df62 47#include <stdarg.h>
17c3b450 48
2304df62
AD
49#ifdef I_STDDEF
50#include <stddef.h>
51#endif
6990d991 52
b5846a0b
BS
53#ifdef I_UNISTD
54#include <unistd.h>
55#endif
56
3609ea0d 57/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
a0d0e21e
LW
58 metaconfig for future extension writers. We don't use them in POSIX.
59 (This is really sneaky :-) --AD
60*/
61#if defined(I_TERMIOS)
62#include <termios.h>
63#endif
a0d0e21e 64#ifdef I_STDLIB
2304df62 65#include <stdlib.h>
a0d0e21e 66#endif
5518ecd4 67#ifndef __ultrix__
2304df62 68#include <string.h>
5518ecd4 69#endif
2304df62 70#include <sys/stat.h>
2304df62 71#include <sys/types.h>
2304df62 72#include <time.h>
6dead956 73#ifdef I_UNISTD
1d2dff63 74#include <unistd.h>
6dead956 75#endif
71be2cbc
PP
76#include <fcntl.h>
77
e2465f50 78#ifdef HAS_TZNAME
fb207d52 79# if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__)
e2465f50
JH
80extern char *tzname[];
81# endif
82#else
fb207d52 83#if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname))
e2465f50
JH
84char *tzname[] = { "" , "" };
85#endif
cb2479a8
JH
86#endif
87
6c418a22 88#if defined(__VMS) && !defined(__POSIX_SOURCE)
6c418a22
PP
89# include <libdef.h> /* LIB$_INVARG constant */
90# include <lib$routines.h> /* prototype for lib$ediv() */
91# include <starlet.h> /* prototype for sys$gettim() */
774d564b 92# if DECC_VERSION < 50000000
86200d5c 93# define pid_t int /* old versions of DECC miss this in types.h */
774d564b 94# endif
6c418a22 95
6990d991 96# undef mkfifo
6c418a22
PP
97# define mkfifo(a,b) (not_here("mkfifo"),-1)
98# define tzset() not_here("tzset")
99
5f6761f9
DS
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>
5f6761f9 103# endif /* __VMS_VER >= 70000000 or Dec C 5.6 */
6c418a22
PP
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 */
34f7a5fe 111 clock_t vms_times(struct tms *bufptr) {
d28f7c37 112 dTHX;
6c418a22
PP
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 . . .*/
34f7a5fe 132 times((tbuffer_t *)bufptr);
6c418a22
PP
133 return (clock_t) retval;
134 }
135# define times(t) vms_times(t)
136#else
d308986b 137#if defined (__CYGWIN__)
f89d6eaa
FE
138# define tzname _tzname
139#endif
2986a63f 140#if defined (WIN32) || defined (NETWARE)
6990d991 141# undef mkfifo
6dead956 142# define mkfifo(a,b) not_here("mkfifo")
873ef191 143# define ttyname(a) (char*)not_here("ttyname")
6dead956 144# define sigset_t long
86200d5c 145# define pid_t long
6dead956
GS
146# ifdef _MSC_VER
147# define mode_t short
148# endif
62520c91
GS
149# ifdef __MINGW32__
150# define mode_t short
f6c6487a
GS
151# ifndef tzset
152# define tzset() not_here("tzset")
153# endif
154# ifndef _POSIX_OPEN_MAX
155# define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */
156# endif
62520c91 157# endif
6dead956
GS
158# define sigaction(a,b,c) not_here("sigaction")
159# define sigpending(a) not_here("sigpending")
160# define sigprocmask(a,b,c) not_here("sigprocmask")
161# define sigsuspend(a) not_here("sigsuspend")
162# define sigemptyset(a) not_here("sigemptyset")
163# define sigaddset(a,b) not_here("sigaddset")
164# define sigdelset(a,b) not_here("sigdelset")
165# define sigfillset(a) not_here("sigfillset")
166# define sigismember(a,b) not_here("sigismember")
2986a63f 167#ifndef NETWARE
6e22d046
JH
168# undef setuid
169# undef setgid
2986a63f
JH
170# define setuid(a) not_here("setuid")
171# define setgid(a) not_here("setgid")
172#endif /* NETWARE */
6dead956 173#else
6990d991
JH
174
175# ifndef HAS_MKFIFO
e37778c2 176# if defined(OS2)
d6a255e6 177# define mkfifo(a,b) not_here("mkfifo")
3609ea0d 178# else /* !( defined OS2 ) */
d6a255e6
IZ
179# ifndef mkfifo
180# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
181# endif
6990d991
JH
182# endif
183# endif /* !HAS_MKFIFO */
184
e37778c2
NC
185# ifdef I_GRP
186# include <grp.h>
187# endif
188# include <sys/times.h>
189# ifdef HAS_UNAME
190# include <sys/utsname.h>
6c418a22 191# endif
e37778c2 192# include <sys/wait.h>
6c418a22
PP
193# ifdef I_UTIME
194# include <utime.h>
195# endif
2986a63f 196#endif /* WIN32 || NETWARE */
6dead956 197#endif /* __VMS */
2304df62
AD
198
199typedef int SysRet;
a0d0e21e 200typedef long SysRetLong;
2304df62
AD
201typedef sigset_t* POSIX__SigSet;
202typedef HV* POSIX__SigAction;
a0d0e21e
LW
203#ifdef I_TERMIOS
204typedef struct termios* POSIX__Termios;
205#else /* Define termios types to int, and call not_here for the functions.*/
206#define POSIX__Termios int
207#define speed_t int
208#define tcflag_t int
209#define cc_t int
210#define cfgetispeed(x) not_here("cfgetispeed")
211#define cfgetospeed(x) not_here("cfgetospeed")
212#define tcdrain(x) not_here("tcdrain")
213#define tcflush(x,y) not_here("tcflush")
214#define tcsendbreak(x,y) not_here("tcsendbreak")
215#define cfsetispeed(x,y) not_here("cfsetispeed")
216#define cfsetospeed(x,y) not_here("cfsetospeed")
217#define ctermid(x) (char *) not_here("ctermid")
218#define tcflow(x,y) not_here("tcflow")
219#define tcgetattr(x,y) not_here("tcgetattr")
220#define tcsetattr(x,y,z) not_here("tcsetattr")
221#endif
222
223/* Possibly needed prototypes */
6e22d046 224#ifndef WIN32
a2e65780 225START_EXTERN_C
20ce7b12
GS
226double strtod (const char *, char **);
227long strtol (const char *, char **, int);
228unsigned long strtoul (const char *, char **, int);
a2e65780 229END_EXTERN_C
6e22d046 230#endif
a0d0e21e 231
a0d0e21e
LW
232#ifndef HAS_DIFFTIME
233#ifndef difftime
234#define difftime(a,b) not_here("difftime")
235#endif
236#endif
237#ifndef HAS_FPATHCONF
3609ea0d 238#define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
a0d0e21e
LW
239#endif
240#ifndef HAS_MKTIME
241#define mktime(a) not_here("mktime")
8990e307
LW
242#endif
243#ifndef HAS_NICE
244#define nice(a) not_here("nice")
245#endif
a0d0e21e 246#ifndef HAS_PATHCONF
3609ea0d 247#define pathconf(f,n) (SysRetLong) not_here("pathconf")
a0d0e21e
LW
248#endif
249#ifndef HAS_SYSCONF
3609ea0d 250#define sysconf(n) (SysRetLong) not_here("sysconf")
a0d0e21e 251#endif
8990e307
LW
252#ifndef HAS_READLINK
253#define readlink(a,b,c) not_here("readlink")
254#endif
255#ifndef HAS_SETPGID
256#define setpgid(a,b) not_here("setpgid")
257#endif
8990e307
LW
258#ifndef HAS_SETSID
259#define setsid() not_here("setsid")
260#endif
a0d0e21e
LW
261#ifndef HAS_STRCOLL
262#define strcoll(s1,s2) not_here("strcoll")
263#endif
a89d8a78
DH
264#ifndef HAS_STRTOD
265#define strtod(s1,s2) not_here("strtod")
266#endif
267#ifndef HAS_STRTOL
268#define strtol(s1,s2,b) not_here("strtol")
269#endif
270#ifndef HAS_STRTOUL
271#define strtoul(s1,s2,b) not_here("strtoul")
272#endif
a0d0e21e
LW
273#ifndef HAS_STRXFRM
274#define strxfrm(s1,s2,n) not_here("strxfrm")
8990e307
LW
275#endif
276#ifndef HAS_TCGETPGRP
277#define tcgetpgrp(a) not_here("tcgetpgrp")
278#endif
279#ifndef HAS_TCSETPGRP
280#define tcsetpgrp(a,b) not_here("tcsetpgrp")
281#endif
282#ifndef HAS_TIMES
2986a63f 283#ifndef NETWARE
8990e307 284#define times(a) not_here("times")
2986a63f 285#endif /* NETWARE */
8990e307
LW
286#endif
287#ifndef HAS_UNAME
288#define uname(a) not_here("uname")
289#endif
290#ifndef HAS_WAITPID
291#define waitpid(a,b,c) not_here("waitpid")
292#endif
293
a0d0e21e
LW
294#ifndef HAS_MBLEN
295#ifndef mblen
296#define mblen(a,b) not_here("mblen")
297#endif
298#endif
299#ifndef HAS_MBSTOWCS
300#define mbstowcs(s, pwcs, n) not_here("mbstowcs")
301#endif
302#ifndef HAS_MBTOWC
303#define mbtowc(pwc, s, n) not_here("mbtowc")
304#endif
305#ifndef HAS_WCSTOMBS
306#define wcstombs(s, pwcs, n) not_here("wcstombs")
307#endif
308#ifndef HAS_WCTOMB
309#define wctomb(s, wchar) not_here("wcstombs")
310#endif
311#if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
312/* If we don't have these functions, then we wouldn't have gotten a typedef
313 for wchar_t, the wide character type. Defining wchar_t allows the
314 functions referencing it to compile. Its actual type is then meaningless,
315 since without the above functions, all sections using it end up calling
316 not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
317#ifndef wchar_t
318#define wchar_t char
319#endif
320#endif
321
2f0945cb
NC
322#ifdef HAS_LOCALECONV
323struct lconv_offset {
324 const char *name;
325 size_t offset;
326};
327
328const struct lconv_offset lconv_strings[] = {
329 {"decimal_point", offsetof(struct lconv, decimal_point)},
330 {"thousands_sep", offsetof(struct lconv, thousands_sep)},
331#ifndef NO_LOCALECONV_GROUPING
332 {"grouping", offsetof(struct lconv, grouping)},
333#endif
334 {"int_curr_symbol", offsetof(struct lconv, int_curr_symbol)},
335 {"currency_symbol", offsetof(struct lconv, currency_symbol)},
336 {"mon_decimal_point", offsetof(struct lconv, mon_decimal_point)},
337#ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
338 {"mon_thousands_sep", offsetof(struct lconv, mon_thousands_sep)},
339#endif
340#ifndef NO_LOCALECONV_MON_GROUPING
341 {"mon_grouping", offsetof(struct lconv, mon_grouping)},
342#endif
343 {"positive_sign", offsetof(struct lconv, positive_sign)},
344 {"negative_sign", offsetof(struct lconv, negative_sign)},
345 {NULL, 0}
346};
347
348const struct lconv_offset lconv_integers[] = {
349 {"int_frac_digits", offsetof(struct lconv, int_frac_digits)},
350 {"frac_digits", offsetof(struct lconv, frac_digits)},
351 {"p_cs_precedes", offsetof(struct lconv, p_cs_precedes)},
352 {"p_sep_by_space", offsetof(struct lconv, p_sep_by_space)},
353 {"n_cs_precedes", offsetof(struct lconv, n_cs_precedes)},
354 {"n_sep_by_space", offsetof(struct lconv, n_sep_by_space)},
355 {"p_sign_posn", offsetof(struct lconv, p_sign_posn)},
356 {"n_sign_posn", offsetof(struct lconv, n_sign_posn)},
357 {NULL, 0}
358};
359
360#else
a0d0e21e
LW
361#define localeconv() not_here("localeconv")
362#endif
363
172ea7c8 364#ifdef HAS_LONG_DOUBLE
53796371 365# if LONG_DOUBLESIZE > NVSIZE
172ea7c8
JH
366# undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
367# endif
368#endif
369
370#ifndef HAS_LONG_DOUBLE
371#ifdef LDBL_MAX
372#undef LDBL_MAX
373#endif
374#ifdef LDBL_MIN
375#undef LDBL_MIN
376#endif
377#ifdef LDBL_EPSILON
378#undef LDBL_EPSILON
379#endif
380#endif
381
ec193bec
JH
382/* Background: in most systems the low byte of the wait status
383 * is the signal (the lowest 7 bits) and the coredump flag is
384 * the eight bit, and the second lowest byte is the exit status.
385 * BeOS bucks the trend and has the bytes in different order.
386 * See beos/beos.c for how the reality is bent even in BeOS
387 * to follow the traditional. However, to make the POSIX
388 * wait W*() macros to work in BeOS, we need to unbend the
389 * reality back in place. --jhi */
17028706
IW
390/* In actual fact the code below is to blame here. Perl has an internal
391 * representation of the exit status ($?), which it re-composes from the
392 * OS's representation using the W*() POSIX macros. The code below
393 * incorrectly uses the W*() macros on the internal representation,
394 * which fails for OSs that have a different representation (namely BeOS
395 * and Haiku). WMUNGE() is a hack that converts the internal
396 * representation into the OS specific one, so that the W*() macros work
397 * as expected. The better solution would be not to use the W*() macros
398 * in the first place, though. -- Ingo Weinhold
399 */
b6c36746 400#if defined(__HAIKU__)
ec193bec
JH
401# define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
402#else
403# define WMUNGE(x) (x)
404#endif
405
8990e307 406static int
4b48cf39 407not_here(const char *s)
8990e307
LW
408{
409 croak("POSIX::%s not implemented on this architecture", s);
410 return -1;
411}
463ee0b2 412
1cb0fb50 413#include "const-c.inc"
a290f238 414
1dfe7606 415static void
40b7a5f5 416restore_sigmask(pTHX_ SV *osset_sv)
1dfe7606 417{
7feb700b
JH
418 /* Fortunately, restoring the signal mask can't fail, because
419 * there's nothing we can do about it if it does -- we're not
420 * supposed to return -1 from sigaction unless the disposition
421 * was unaffected.
422 */
7feb700b
JH
423 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
424 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
1dfe7606 425}
426
a2261f90
NC
427static void *
428allocate_struct(pTHX_ SV *rv, const STRLEN size, const char *packname) {
429 SV *const t = newSVrv(rv, packname);
430 void *const p = sv_grow(t, size + 1);
431
432 SvCUR_set(t, size);
433 SvPOK_on(t);
434 return p;
435}
436
81ab4c44
SH
437#ifdef WIN32
438
439/*
440 * (1) The CRT maintains its own copy of the environment, separate from
441 * the Win32API copy.
442 *
443 * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
444 * copy, and then calls SetEnvironmentVariableA() to update the Win32API
445 * copy.
446 *
447 * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
448 * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
449 * environment.
450 *
451 * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
452 * calls CRT tzset(), but only the first time it is called, and in turn
453 * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
454 * local copy of the environment and hence gets the original setting as
455 * perl never updates the CRT copy when assigning to $ENV{TZ}.
456 *
457 * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
458 * putenv() to update the CRT copy of the environment (if it is different)
459 * whenever we're about to call tzset().
460 *
461 * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
462 * defined:
463 *
464 * (a) Each interpreter has its own copy of the environment inside the
465 * perlhost structure. That allows applications that host multiple
466 * independent Perl interpreters to isolate environment changes from
467 * each other. (This is similar to how the perlhost mechanism keeps a
468 * separate working directory for each Perl interpreter, so that calling
469 * chdir() will not affect other interpreters.)
470 *
471 * (b) Only the first Perl interpreter instantiated within a process will
472 * "write through" environment changes to the process environment.
473 *
474 * (c) Even the primary Perl interpreter won't update the CRT copy of the
475 * the environment, only the Win32API copy (it calls win32_putenv()).
476 *
477 * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
478 * sense to only update the process environment when inside the main
479 * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
480 * from here so we'll just have to check PL_curinterp instead.
481 *
482 * Therefore, we can simply #undef getenv() and putenv() so that those names
483 * always refer to the CRT functions, and explicitly call win32_getenv() to
484 * access perl's %ENV.
485 *
486 * We also #undef malloc() and free() to be sure we are using the CRT
487 * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
488 * into VMem::Malloc() and VMem::Free() and all allocations will be freed
489 * when the Perl interpreter is being destroyed so we'd end up with a pointer
490 * into deallocated memory in environ[] if a program embedding a Perl
491 * interpreter continues to operate even after the main Perl interpreter has
492 * been destroyed.
493 *
494 * Note that we don't free() the malloc()ed memory unless and until we call
495 * malloc() again ourselves because the CRT putenv() function simply puts its
b7b1e41b 496 * pointer argument into the environ[] array (it doesn't make a copy of it)
81ab4c44
SH
497 * so this memory must otherwise be leaked.
498 */
499
500#undef getenv
501#undef putenv
502#undef malloc
503#undef free
504
505static void
506fix_win32_tzenv(void)
507{
508 static char* oldenv = NULL;
509 char* newenv;
510 const char* perl_tz_env = win32_getenv("TZ");
511 const char* crt_tz_env = getenv("TZ");
512 if (perl_tz_env == NULL)
513 perl_tz_env = "";
514 if (crt_tz_env == NULL)
515 crt_tz_env = "";
516 if (strcmp(perl_tz_env, crt_tz_env) != 0) {
517 newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
518 if (newenv != NULL) {
519 sprintf(newenv, "TZ=%s", perl_tz_env);
520 putenv(newenv);
521 if (oldenv != NULL)
522 free(oldenv);
523 oldenv = newenv;
524 }
525 }
526}
527
528#endif
529
530/*
531 * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
532 * This code is duplicated in the Time-Piece module, so any changes made here
533 * should be made there too.
534 */
535static void
536my_tzset(pTHX)
537{
538#ifdef WIN32
539#if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
540 if (PL_curinterp == aTHX)
541#endif
542 fix_win32_tzenv();
543#endif
544 tzset();
545}
546
fb52dbc1
NC
547typedef int (*isfunc_t)(int);
548typedef void (*any_dptr_t)(void *);
549
550/* This needs to be ALIASed in a custom way, hence can't easily be defined as
551 a regular XSUB. */
552static XSPROTO(is_common); /* prototype to pass -Wmissing-prototypes */
553static XSPROTO(is_common)
554{
555 dXSARGS;
fb52dbc1
NC
556 if (items != 1)
557 croak_xs_usage(cv, "charstring");
558
559 {
560 dXSTARG;
561 STRLEN len;
562 int RETVAL;
563 unsigned char *s = (unsigned char *) SvPV(ST(0), len);
564 unsigned char *e = s + len;
565 isfunc_t isfunc = (isfunc_t) XSANY.any_dptr;
566
567 for (RETVAL = 1; RETVAL && s < e; s++)
568 if (!isfunc(*s))
569 RETVAL = 0;
570 XSprePUSH;
571 PUSHi((IV)RETVAL);
572 }
573 XSRETURN(1);
574}
575
576MODULE = POSIX PACKAGE = POSIX
577
578BOOT:
579{
580 CV *cv;
581 const char *file = __FILE__;
582
df164f52
DM
583
584 /* silence compiler warning about not_here() defined but not used */
585 if (0) not_here("");
586
fb52dbc1
NC
587 /* Ensure we get the function, not a macro implementation. Like the C89
588 standard says we can... */
589#undef isalnum
590 cv = newXS("POSIX::isalnum", is_common, file);
591 XSANY.any_dptr = (any_dptr_t) &isalnum;
592#undef isalpha
593 cv = newXS("POSIX::isalpha", is_common, file);
594 XSANY.any_dptr = (any_dptr_t) &isalpha;
595#undef iscntrl
596 cv = newXS("POSIX::iscntrl", is_common, file);
597 XSANY.any_dptr = (any_dptr_t) &iscntrl;
598#undef isdigit
599 cv = newXS("POSIX::isdigit", is_common, file);
600 XSANY.any_dptr = (any_dptr_t) &isdigit;
601#undef isgraph
602 cv = newXS("POSIX::isgraph", is_common, file);
603 XSANY.any_dptr = (any_dptr_t) &isgraph;
604#undef islower
605 cv = newXS("POSIX::islower", is_common, file);
606 XSANY.any_dptr = (any_dptr_t) &islower;
607#undef isprint
608 cv = newXS("POSIX::isprint", is_common, file);
609 XSANY.any_dptr = (any_dptr_t) &isprint;
610#undef ispunct
611 cv = newXS("POSIX::ispunct", is_common, file);
612 XSANY.any_dptr = (any_dptr_t) &ispunct;
613#undef isspace
614 cv = newXS("POSIX::isspace", is_common, file);
615 XSANY.any_dptr = (any_dptr_t) &isspace;
616#undef isupper
617 cv = newXS("POSIX::isupper", is_common, file);
618 XSANY.any_dptr = (any_dptr_t) &isupper;
619#undef isxdigit
620 cv = newXS("POSIX::isxdigit", is_common, file);
621 XSANY.any_dptr = (any_dptr_t) &isxdigit;
622}
623
2304df62
AD
624MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
625
92b39396 626void
2304df62 627new(packname = "POSIX::SigSet", ...)
d3f5e399 628 const char * packname
2304df62
AD
629 CODE:
630 {
631 int i;
92b39396
NC
632 sigset_t *const s
633 = (sigset_t *) allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
634 sizeof(sigset_t),
635 packname);
636 sigemptyset(s);
a0d0e21e 637 for (i = 1; i < items; i++)
92b39396
NC
638 sigaddset(s, SvIV(ST(i)));
639 XSRETURN(1);
2304df62 640 }
2304df62
AD
641
642SysRet
df6c2df2 643addset(sigset, sig)
2304df62
AD
644 POSIX::SigSet sigset
645 int sig
df6c2df2
NC
646 ALIAS:
647 delset = 1
648 CODE:
649 RETVAL = ix ? sigdelset(sigset, sig) : sigaddset(sigset, sig);
650 OUTPUT:
651 RETVAL
2304df62
AD
652
653SysRet
df6c2df2 654emptyset(sigset)
2304df62 655 POSIX::SigSet sigset
df6c2df2
NC
656 ALIAS:
657 fillset = 1
658 CODE:
659 RETVAL = ix ? sigfillset(sigset) : sigemptyset(sigset);
660 OUTPUT:
661 RETVAL
2304df62
AD
662
663int
664sigismember(sigset, sig)
665 POSIX::SigSet sigset
666 int sig
667
a0d0e21e
LW
668MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
669
11a39fe4 670void
a0d0e21e 671new(packname = "POSIX::Termios", ...)
d3f5e399 672 const char * packname
a0d0e21e
LW
673 CODE:
674 {
675#ifdef I_TERMIOS
a2261f90
NC
676 void *const p = allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
677 sizeof(struct termios), packname);
11a39fe4
NC
678 /* The previous implementation stored a pointer to an uninitialised
679 struct termios. Seems safer to initialise it, particularly as
680 this implementation exposes the struct to prying from perl-space.
681 */
a2261f90 682 memset(p, 0, 1 + sizeof(struct termios));
11a39fe4 683 XSRETURN(1);
a0d0e21e
LW
684#else
685 not_here("termios");
686#endif
687 }
a0d0e21e
LW
688
689SysRet
690getattr(termios_ref, fd = 0)
691 POSIX::Termios termios_ref
692 int fd
693 CODE:
694 RETVAL = tcgetattr(fd, termios_ref);
695 OUTPUT:
696 RETVAL
697
e08f19f5
TC
698# If we define TCSANOW here then both a found and not found constant sub
699# are created causing a Constant subroutine TCSANOW redefined warning
518487b2 700#ifndef TCSANOW
e08f19f5
TC
701# define DEF_SETATTR_ACTION 0
702#else
703# define DEF_SETATTR_ACTION TCSANOW
518487b2 704#endif
a0d0e21e 705SysRet
e08f19f5 706setattr(termios_ref, fd = 0, optional_actions = DEF_SETATTR_ACTION)
a0d0e21e
LW
707 POSIX::Termios termios_ref
708 int fd
709 int optional_actions
710 CODE:
518487b2
NC
711 /* The second argument to the call is mandatory, but we'd like to give
712 it a useful default. 0 isn't valid on all operating systems - on
713 Solaris (at least) TCSANOW, TCSADRAIN and TCSAFLUSH have the same
714 values as the equivalent ioctls, TCSETS, TCSETSW and TCSETSF. */
a0d0e21e
LW
715 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
716 OUTPUT:
717 RETVAL
718
719speed_t
2a59a32c 720getispeed(termios_ref)
a0d0e21e 721 POSIX::Termios termios_ref
2a59a32c
NC
722 ALIAS:
723 getospeed = 1
a0d0e21e 724 CODE:
2a59a32c 725 RETVAL = ix ? cfgetospeed(termios_ref) : cfgetispeed(termios_ref);
a0d0e21e
LW
726 OUTPUT:
727 RETVAL
728
729tcflag_t
2a59a32c 730getiflag(termios_ref)
a0d0e21e 731 POSIX::Termios termios_ref
2a59a32c
NC
732 ALIAS:
733 getoflag = 1
734 getcflag = 2
735 getlflag = 3
a0d0e21e
LW
736 CODE:
737#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
2a59a32c
NC
738 switch(ix) {
739 case 0:
740 RETVAL = termios_ref->c_iflag;
741 break;
742 case 1:
743 RETVAL = termios_ref->c_oflag;
744 break;
745 case 2:
746 RETVAL = termios_ref->c_cflag;
747 break;
748 case 3:
749 RETVAL = termios_ref->c_lflag;
750 break;
df164f52
DM
751 default:
752 RETVAL = 0; /* silence compiler warning */
2a59a32c 753 }
a0d0e21e 754#else
2a59a32c
NC
755 not_here(GvNAME(CvGV(cv)));
756 RETVAL = 0;
a0d0e21e
LW
757#endif
758 OUTPUT:
759 RETVAL
760
761cc_t
762getcc(termios_ref, ccix)
763 POSIX::Termios termios_ref
b56fc9ec 764 unsigned int ccix
a0d0e21e
LW
765 CODE:
766#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
767 if (ccix >= NCCS)
768 croak("Bad getcc subscript");
769 RETVAL = termios_ref->c_cc[ccix];
770#else
640cc986
HM
771 not_here("getcc");
772 RETVAL = 0;
a0d0e21e
LW
773#endif
774 OUTPUT:
775 RETVAL
776
777SysRet
2a59a32c 778setispeed(termios_ref, speed)
a0d0e21e
LW
779 POSIX::Termios termios_ref
780 speed_t speed
2a59a32c
NC
781 ALIAS:
782 setospeed = 1
a0d0e21e 783 CODE:
2a59a32c
NC
784 RETVAL = ix
785 ? cfsetospeed(termios_ref, speed) : cfsetispeed(termios_ref, speed);
786 OUTPUT:
787 RETVAL
a0d0e21e
LW
788
789void
2a59a32c 790setiflag(termios_ref, flag)
a0d0e21e 791 POSIX::Termios termios_ref
2a59a32c
NC
792 tcflag_t flag
793 ALIAS:
794 setoflag = 1
795 setcflag = 2
796 setlflag = 3
a0d0e21e
LW
797 CODE:
798#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
2a59a32c
NC
799 switch(ix) {
800 case 0:
801 termios_ref->c_iflag = flag;
802 break;
803 case 1:
804 termios_ref->c_oflag = flag;
805 break;
806 case 2:
807 termios_ref->c_cflag = flag;
808 break;
809 case 3:
810 termios_ref->c_lflag = flag;
811 break;
812 }
a0d0e21e 813#else
2a59a32c 814 not_here(GvNAME(CvGV(cv)));
a0d0e21e
LW
815#endif
816
817void
818setcc(termios_ref, ccix, cc)
819 POSIX::Termios termios_ref
b56fc9ec 820 unsigned int ccix
a0d0e21e
LW
821 cc_t cc
822 CODE:
823#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
824 if (ccix >= NCCS)
825 croak("Bad setcc subscript");
826 termios_ref->c_cc[ccix] = cc;
827#else
828 not_here("setcc");
829#endif
830
831
a0d0e21e
LW
832MODULE = POSIX PACKAGE = POSIX
833
1cb0fb50 834INCLUDE: const-xs.inc
a290f238 835
e99d581a
NC
836int
837WEXITSTATUS(status)
838 int status
72bfe1b2
NC
839 ALIAS:
840 POSIX::WIFEXITED = 1
841 POSIX::WIFSIGNALED = 2
842 POSIX::WIFSTOPPED = 3
843 POSIX::WSTOPSIG = 4
844 POSIX::WTERMSIG = 5
845 CODE:
fabb67aa
SK
846#if !defined(WEXITSTATUS) || !defined(WIFEXITED) || !defined(WIFSIGNALED) \
847 || !defined(WIFSTOPPED) || !defined(WSTOPSIG) || !defined(WTERMSIG)
19c4478c
NC
848 RETVAL = 0; /* Silence compilers that notice this, but don't realise
849 that not_here() can't return. */
850#endif
72bfe1b2
NC
851 switch(ix) {
852 case 0:
d49025b7 853#ifdef WEXITSTATUS
17028706 854 RETVAL = WEXITSTATUS(WMUNGE(status));
d49025b7
NC
855#else
856 not_here("WEXITSTATUS");
857#endif
72bfe1b2
NC
858 break;
859 case 1:
d49025b7 860#ifdef WIFEXITED
17028706 861 RETVAL = WIFEXITED(WMUNGE(status));
d49025b7
NC
862#else
863 not_here("WIFEXITED");
864#endif
72bfe1b2
NC
865 break;
866 case 2:
d49025b7 867#ifdef WIFSIGNALED
17028706 868 RETVAL = WIFSIGNALED(WMUNGE(status));
d49025b7
NC
869#else
870 not_here("WIFSIGNALED");
871#endif
72bfe1b2
NC
872 break;
873 case 3:
d49025b7 874#ifdef WIFSTOPPED
17028706 875 RETVAL = WIFSTOPPED(WMUNGE(status));
d49025b7
NC
876#else
877 not_here("WIFSTOPPED");
878#endif
72bfe1b2
NC
879 break;
880 case 4:
d49025b7 881#ifdef WSTOPSIG
17028706 882 RETVAL = WSTOPSIG(WMUNGE(status));
d49025b7
NC
883#else
884 not_here("WSTOPSIG");
885#endif
72bfe1b2
NC
886 break;
887 case 5:
d49025b7 888#ifdef WTERMSIG
17028706 889 RETVAL = WTERMSIG(WMUNGE(status));
d49025b7
NC
890#else
891 not_here("WTERMSIG");
892#endif
72bfe1b2
NC
893 break;
894 default:
c33e8be1 895 Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", (int)ix);
72bfe1b2
NC
896 }
897 OUTPUT:
898 RETVAL
2304df62 899
2304df62
AD
900SysRet
901open(filename, flags = O_RDONLY, mode = 0666)
902 char * filename
903 int flags
a0d0e21e 904 Mode_t mode
748a9306
LW
905 CODE:
906 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
907 TAINT_PROPER("open");
908 RETVAL = open(filename, flags, mode);
909 OUTPUT:
910 RETVAL
911
2304df62
AD
912
913HV *
914localeconv()
915 CODE:
a0d0e21e 916#ifdef HAS_LOCALECONV
2304df62
AD
917 struct lconv *lcbuf;
918 RETVAL = newHV();
c4e79b56 919 sv_2mortal((SV*)RETVAL);
8063af02 920 if ((lcbuf = localeconv())) {
2f0945cb
NC
921 const struct lconv_offset *strings = lconv_strings;
922 const struct lconv_offset *integers = lconv_integers;
923 const char *ptr = (const char *) lcbuf;
924
925 do {
926 const char *value = *((const char **)(ptr + strings->offset));
927
928 if (value && *value)
929 (void) hv_store(RETVAL, strings->name, strlen(strings->name),
930 newSVpv(value, 0), 0);
931 } while ((++strings)->name);
932
933 do {
934 const char value = *((const char *)(ptr + integers->offset));
935
936 if (value != CHAR_MAX)
937 (void) hv_store(RETVAL, integers->name,
938 strlen(integers->name), newSViv(value), 0);
939 } while ((++integers)->name);
2304df62 940 }
a0d0e21e
LW
941#else
942 localeconv(); /* A stub to call not_here(). */
943#endif
2304df62
AD
944 OUTPUT:
945 RETVAL
946
947char *
c28ee57b 948setlocale(category, locale = 0)
2304df62
AD
949 int category
950 char * locale
1ba01ae3
SH
951 PREINIT:
952 char * retval;
c28ee57b 953 CODE:
1ba01ae3 954 retval = setlocale(category, locale);
fbd840df
KW
955 if (! retval) {
956 XSRETURN_UNDEF;
957 }
958 else {
1ba01ae3
SH
959 /* Save retval since subsequent setlocale() calls
960 * may overwrite it. */
961 RETVAL = savepv(retval);
36477c24 962#ifdef USE_LOCALE_CTYPE
bbce6d69
PP
963 if (category == LC_CTYPE
964#ifdef LC_ALL
965 || category == LC_ALL
966#endif
967 )
968 {
969 char *newctype;
970#ifdef LC_ALL
971 if (category == LC_ALL)
972 newctype = setlocale(LC_CTYPE, NULL);
973 else
974#endif
975 newctype = RETVAL;
864dbfa3 976 new_ctype(newctype);
bbce6d69 977 }
36477c24
PP
978#endif /* USE_LOCALE_CTYPE */
979#ifdef USE_LOCALE_COLLATE
bbce6d69
PP
980 if (category == LC_COLLATE
981#ifdef LC_ALL
982 || category == LC_ALL
983#endif
984 )
985 {
986 char *newcoll;
987#ifdef LC_ALL
988 if (category == LC_ALL)
989 newcoll = setlocale(LC_COLLATE, NULL);
990 else
991#endif
992 newcoll = RETVAL;
864dbfa3 993 new_collate(newcoll);
bbce6d69 994 }
36477c24
PP
995#endif /* USE_LOCALE_COLLATE */
996#ifdef USE_LOCALE_NUMERIC
bbce6d69
PP
997 if (category == LC_NUMERIC
998#ifdef LC_ALL
999 || category == LC_ALL
1000#endif
1001 )
1002 {
1003 char *newnum;
1004#ifdef LC_ALL
1005 if (category == LC_ALL)
1006 newnum = setlocale(LC_NUMERIC, NULL);
1007 else
1008#endif
1009 newnum = RETVAL;
864dbfa3 1010 new_numeric(newnum);
bbce6d69 1011 }
36477c24 1012#endif /* USE_LOCALE_NUMERIC */
bbce6d69 1013 }
c28ee57b
JH
1014 OUTPUT:
1015 RETVAL
1ba01ae3 1016 CLEANUP:
fbd840df 1017 Safefree(RETVAL);
2304df62 1018
e1ca407b 1019NV
2304df62 1020acos(x)
e1ca407b 1021 NV x
b256643b
NC
1022 ALIAS:
1023 asin = 1
1024 atan = 2
1025 ceil = 3
1026 cosh = 4
1027 floor = 5
1028 log10 = 6
1029 sinh = 7
1030 tan = 8
1031 tanh = 9
1032 CODE:
1033 switch (ix) {
1034 case 0:
1035 RETVAL = acos(x);
1036 break;
1037 case 1:
1038 RETVAL = asin(x);
1039 break;
1040 case 2:
1041 RETVAL = atan(x);
1042 break;
1043 case 3:
1044 RETVAL = ceil(x);
1045 break;
1046 case 4:
1047 RETVAL = cosh(x);
1048 break;
1049 case 5:
1050 RETVAL = floor(x);
1051 break;
1052 case 6:
1053 RETVAL = log10(x);
1054 break;
1055 case 7:
1056 RETVAL = sinh(x);
1057 break;
1058 case 8:
1059 RETVAL = tan(x);
1060 break;
1061 default:
1062 RETVAL = tanh(x);
1063 }
1064 OUTPUT:
1065 RETVAL
2304df62 1066
e1ca407b 1067NV
2304df62 1068fmod(x,y)
e1ca407b
A
1069 NV x
1070 NV y
2304df62
AD
1071
1072void
1073frexp(x)
e1ca407b 1074 NV x
2304df62
AD
1075 PPCODE:
1076 int expvar;
2304df62
AD
1077 /* (We already know stack is long enough.) */
1078 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1079 PUSHs(sv_2mortal(newSViv(expvar)));
1080
e1ca407b 1081NV
2304df62 1082ldexp(x,exp)
e1ca407b 1083 NV x
2304df62
AD
1084 int exp
1085
2304df62
AD
1086void
1087modf(x)
e1ca407b 1088 NV x
2304df62 1089 PPCODE:
e1ca407b 1090 NV intvar;
2304df62 1091 /* (We already know stack is long enough.) */
bf4acbe4 1092 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
2304df62
AD
1093 PUSHs(sv_2mortal(newSVnv(intvar)));
1094
2304df62 1095SysRet
1dfe7606 1096sigaction(sig, optaction, oldaction = 0)
2304df62 1097 int sig
1dfe7606 1098 SV * optaction
2304df62
AD
1099 POSIX::SigAction oldaction
1100 CODE:
2986a63f 1101#if defined(WIN32) || defined(NETWARE)
6dead956
GS
1102 RETVAL = not_here("sigaction");
1103#else
2304df62
AD
1104# This code is really grody because we're trying to make the signal
1105# interface look beautiful, which is hard.
1106
2304df62 1107 {
27da23d5 1108 dVAR;
1dfe7606 1109 POSIX__SigAction action;
f584eb2d 1110 GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
2304df62
AD
1111 struct sigaction act;
1112 struct sigaction oact;
1dfe7606 1113 sigset_t sset;
183bde56 1114 SV *osset_sv;
27c1a449 1115 sigset_t osset;
2304df62
AD
1116 POSIX__SigSet sigset;
1117 SV** svp;
1d81eac9 1118 SV** sigsvp;
3609ea0d 1119
516d25e8
SP
1120 if (sig < 0) {
1121 croak("Negative signals are not allowed");
1122 }
1123
1d81eac9 1124 if (sig == 0 && SvPOK(ST(0))) {
aa07b2f6 1125 const char *s = SvPVX_const(ST(0));
1d81eac9
JH
1126 int i = whichsig(s);
1127
1128 if (i < 0 && memEQ(s, "SIG", 3))
1129 i = whichsig(s + 3);
1130 if (i < 0) {
1131 if (ckWARN(WARN_SIGNAL))
1132 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1133 "No such signal: SIG%s", s);
1134 XSRETURN_UNDEF;
1135 }
1136 else
1137 sig = i;
1138 }
3609ea0d
JH
1139#ifdef NSIG
1140 if (sig > NSIG) { /* NSIG - 1 is still okay. */
1141 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1142 "No such signal: %d", sig);
1143 XSRETURN_UNDEF;
1144 }
1145#endif
1d81eac9
JH
1146 sigsvp = hv_fetch(GvHVn(siggv),
1147 PL_sig_name[sig],
1148 strlen(PL_sig_name[sig]),
1149 TRUE);
2304df62 1150
1dfe7606 1151 /* Check optaction and set action */
1152 if(SvTRUE(optaction)) {
1153 if(sv_isa(optaction, "POSIX::SigAction"))
1154 action = (HV*)SvRV(optaction);
1155 else
1156 croak("action is not of type POSIX::SigAction");
1157 }
1158 else {
1159 action=0;
1160 }
1161
1162 /* sigaction() is supposed to look atomic. In particular, any
1163 * signal handler invoked during a sigaction() call should
1164 * see either the old or the new disposition, and not something
1165 * in between. We use sigprocmask() to make it so.
1166 */
1167 sigfillset(&sset);
1168 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1169 if(RETVAL == -1)
15c0d34a 1170 XSRETURN_UNDEF;
1dfe7606 1171 ENTER;
1172 /* Restore signal mask no matter how we exit this block. */
f584eb2d 1173 osset_sv = newSVpvn((char *)(&osset), sizeof(sigset_t));
183bde56 1174 SAVEFREESV( osset_sv );
40b7a5f5 1175 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1dfe7606 1176
1177 RETVAL=-1; /* In case both oldaction and action are 0. */
1178
1179 /* Remember old disposition if desired. */
2304df62 1180 if (oldaction) {
017a3ce5 1181 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
1dfe7606 1182 if(!svp)
1183 croak("Can't supply an oldaction without a HANDLER");
1184 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1185 sv_setsv(*svp, *sigsvp);
1186 }
1187 else {
f584eb2d 1188 sv_setpvs(*svp, "DEFAULT");
1dfe7606 1189 }
1190 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
6ca4bbc9
GG
1191 if(RETVAL == -1) {
1192 LEAVE;
15c0d34a 1193 XSRETURN_UNDEF;
6ca4bbc9 1194 }
1dfe7606 1195 /* Get back the mask. */
017a3ce5 1196 svp = hv_fetchs(oldaction, "MASK", TRUE);
1dfe7606 1197 if (sv_isa(*svp, "POSIX::SigSet")) {
92b39396 1198 sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
1dfe7606 1199 }
1200 else {
92b39396
NC
1201 sigset = (sigset_t *) allocate_struct(aTHX_ *svp,
1202 sizeof(sigset_t),
1203 "POSIX::SigSet");
1dfe7606 1204 }
1205 *sigset = oact.sa_mask;
1206
1207 /* Get back the flags. */
017a3ce5 1208 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
1dfe7606 1209 sv_setiv(*svp, oact.sa_flags);
d36b6582
CS
1210
1211 /* Get back whether the old handler used safe signals. */
017a3ce5 1212 svp = hv_fetchs(oldaction, "SAFE", TRUE);
e91e3b10
RB
1213 sv_setiv(*svp,
1214 /* compare incompatible pointers by casting to integer */
1215 PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
2304df62
AD
1216 }
1217
1218 if (action) {
d36b6582
CS
1219 /* Safe signals use "csighandler", which vectors through the
1220 PL_sighandlerp pointer when it's safe to do so.
1221 (BTW, "csighandler" is very different from "sighandler".) */
017a3ce5 1222 svp = hv_fetchs(action, "SAFE", FALSE);
e91e3b10
RB
1223 act.sa_handler =
1224 DPTR2FPTR(
87d46f97 1225 void (*)(int),
e91e3b10
RB
1226 (*svp && SvTRUE(*svp))
1227 ? PL_csighandlerp : PL_sighandlerp
1228 );
d36b6582
CS
1229
1230 /* Vector new Perl handler through %SIG.
1231 (The core signal handlers read %SIG to dispatch.) */
017a3ce5 1232 svp = hv_fetchs(action, "HANDLER", FALSE);
2304df62
AD
1233 if (!svp)
1234 croak("Can't supply an action without a HANDLER");
1dfe7606 1235 sv_setsv(*sigsvp, *svp);
d36b6582
CS
1236
1237 /* This call actually calls sigaction() with almost the
1238 right settings, including appropriate interpretation
1239 of DEFAULT and IGNORE. However, why are we doing
1240 this when we're about to do it again just below? XXX */
17cffb37 1241 SvSETMAGIC(*sigsvp);
d36b6582
CS
1242
1243 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1dfe7606 1244 if(SvPOK(*svp)) {
aa07b2f6 1245 const char *s=SvPVX_const(*svp);
1dfe7606 1246 if(strEQ(s,"IGNORE")) {
1247 act.sa_handler = SIG_IGN;
1248 }
1249 else if(strEQ(s,"DEFAULT")) {
1250 act.sa_handler = SIG_DFL;
1251 }
1dfe7606 1252 }
2304df62
AD
1253
1254 /* Set up any desired mask. */
017a3ce5 1255 svp = hv_fetchs(action, "MASK", FALSE);
2304df62 1256 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
92b39396 1257 sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
2304df62
AD
1258 act.sa_mask = *sigset;
1259 }
1260 else
85e6fe83 1261 sigemptyset(& act.sa_mask);
2304df62
AD
1262
1263 /* Set up any desired flags. */
017a3ce5 1264 svp = hv_fetchs(action, "FLAGS", FALSE);
2304df62 1265 act.sa_flags = svp ? SvIV(*svp) : 0;
2304df62 1266
1dfe7606 1267 /* Don't worry about cleaning up *sigsvp if this fails,
1268 * because that means we tried to disposition a
1269 * nonblockable signal, in which case *sigsvp is
1270 * essentially meaningless anyway.
1271 */
6c418a22 1272 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
6ca4bbc9
GG
1273 if(RETVAL == -1) {
1274 LEAVE;
a7aad5de 1275 XSRETURN_UNDEF;
6ca4bbc9 1276 }
2304df62 1277 }
1dfe7606 1278
1279 LEAVE;
2304df62 1280 }
6dead956 1281#endif
2304df62
AD
1282 OUTPUT:
1283 RETVAL
1284
1285SysRet
1286sigpending(sigset)
1287 POSIX::SigSet sigset
7a004119
NC
1288 ALIAS:
1289 sigsuspend = 1
1290 CODE:
1291 RETVAL = ix ? sigsuspend(sigset) : sigpending(sigset);
1292 OUTPUT:
1293 RETVAL
20120e59
LT
1294 CLEANUP:
1295 PERL_ASYNC_CHECK();
2304df62
AD
1296
1297SysRet
1298sigprocmask(how, sigset, oldsigset = 0)
1299 int how
b13bbac7 1300 POSIX::SigSet sigset = NO_INIT
33c27489
GS
1301 POSIX::SigSet oldsigset = NO_INIT
1302INIT:
a3b811a7 1303 if (! SvOK(ST(1))) {
b13bbac7 1304 sigset = NULL;
a3b811a7 1305 } else if (sv_isa(ST(1), "POSIX::SigSet")) {
92b39396 1306 sigset = (sigset_t *) SvPV_nolen(SvRV(ST(1)));
b13bbac7
AB
1307 } else {
1308 croak("sigset is not of type POSIX::SigSet");
33c27489 1309 }
b13bbac7 1310
194cfca0 1311 if (items < 3 || ! SvOK(ST(2))) {
b13bbac7 1312 oldsigset = NULL;
a3b811a7 1313 } else if (sv_isa(ST(2), "POSIX::SigSet")) {
92b39396 1314 oldsigset = (sigset_t *) SvPV_nolen(SvRV(ST(2)));
b13bbac7
AB
1315 } else {
1316 croak("oldsigset is not of type POSIX::SigSet");
33c27489 1317 }
2304df62 1318
2304df62
AD
1319void
1320_exit(status)
1321 int status
8990e307 1322
85e6fe83 1323SysRet
8990e307
LW
1324dup2(fd1, fd2)
1325 int fd1
1326 int fd2
ad413e46
NC
1327 CODE:
1328#ifdef WIN32
1329 /* RT #98912 - More Microsoft muppetry - failing to actually implemented
1330 the well known documented POSIX behaviour for a POSIX API.
1331 http://msdn.microsoft.com/en-us/library/8syseb29.aspx */
1332 RETVAL = dup2(fd1, fd2) == -1 ? -1 : fd2;
1333#else
1334 RETVAL = dup2(fd1, fd2);
1335#endif
1336 OUTPUT:
1337 RETVAL
8990e307 1338
4a9d6100 1339SV *
a0d0e21e 1340lseek(fd, offset, whence)
85e6fe83
LW
1341 int fd
1342 Off_t offset
1343 int whence
4a9d6100
GS
1344 CODE:
1345 Off_t pos = PerlLIO_lseek(fd, offset, whence);
1346 RETVAL = sizeof(Off_t) > sizeof(IV)
1347 ? newSVnv((NV)pos) : newSViv((IV)pos);
1348 OUTPUT:
1349 RETVAL
8990e307 1350
c5661c80 1351void
8990e307
LW
1352nice(incr)
1353 int incr
15f0f28a
AE
1354 PPCODE:
1355 errno = 0;
1356 if ((incr = nice(incr)) != -1 || errno == 0) {
1357 if (incr == 0)
d3d34884 1358 XPUSHs(newSVpvs_flags("0 but true", SVs_TEMP));
15f0f28a
AE
1359 else
1360 XPUSHs(sv_2mortal(newSViv(incr)));
1361 }
8990e307 1362
8063af02 1363void
8990e307 1364pipe()
85e6fe83
LW
1365 PPCODE:
1366 int fds[2];
85e6fe83 1367 if (pipe(fds) != -1) {
924508f0 1368 EXTEND(SP,2);
85e6fe83
LW
1369 PUSHs(sv_2mortal(newSViv(fds[0])));
1370 PUSHs(sv_2mortal(newSViv(fds[1])));
1371 }
8990e307 1372
85e6fe83 1373SysRet
a0d0e21e 1374read(fd, buffer, nbytes)
7747499c
TB
1375 PREINIT:
1376 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1377 INPUT:
1378 int fd
1379 size_t nbytes
1380 char * buffer = sv_grow( sv_buffer, nbytes+1 );
a0d0e21e 1381 CLEANUP:
7747499c 1382 if (RETVAL >= 0) {
b162af07 1383 SvCUR_set(sv_buffer, RETVAL);
7747499c
TB
1384 SvPOK_only(sv_buffer);
1385 *SvEND(sv_buffer) = '\0';
bbce6d69 1386 SvTAINTED_on(sv_buffer);
7747499c 1387 }
8990e307 1388
85e6fe83 1389SysRet
8990e307 1390setpgid(pid, pgid)
86200d5c
JH
1391 pid_t pid
1392 pid_t pgid
8990e307 1393
86200d5c 1394pid_t
8990e307
LW
1395setsid()
1396
86200d5c 1397pid_t
8990e307
LW
1398tcgetpgrp(fd)
1399 int fd
1400
85e6fe83 1401SysRet
8990e307
LW
1402tcsetpgrp(fd, pgrp_id)
1403 int fd
86200d5c 1404 pid_t pgrp_id
8990e307 1405
8063af02 1406void
8990e307 1407uname()
2304df62 1408 PPCODE:
a0d0e21e 1409#ifdef HAS_UNAME
85e6fe83 1410 struct utsname buf;
85e6fe83 1411 if (uname(&buf) >= 0) {
924508f0 1412 EXTEND(SP, 5);
d3d34884
NC
1413 PUSHs(newSVpvn_flags(buf.sysname, strlen(buf.sysname), SVs_TEMP));
1414 PUSHs(newSVpvn_flags(buf.nodename, strlen(buf.nodename), SVs_TEMP));
1415 PUSHs(newSVpvn_flags(buf.release, strlen(buf.release), SVs_TEMP));
1416 PUSHs(newSVpvn_flags(buf.version, strlen(buf.version), SVs_TEMP));
1417 PUSHs(newSVpvn_flags(buf.machine, strlen(buf.machine), SVs_TEMP));
8990e307 1418 }
a0d0e21e
LW
1419#else
1420 uname((char *) 0); /* A stub to call not_here(). */
1421#endif
8990e307 1422
85e6fe83 1423SysRet
a0d0e21e
LW
1424write(fd, buffer, nbytes)
1425 int fd
1426 char * buffer
1427 size_t nbytes
1428
33f01dd1
SH
1429SV *
1430tmpnam()
1431 PREINIT:
1432 STRLEN i;
1433 int len;
1434 CODE:
1435 RETVAL = newSVpvn("", 0);
1436 SvGROW(RETVAL, L_tmpnam);
1437 len = strlen(tmpnam(SvPV(RETVAL, i)));
1438 SvCUR_set(RETVAL, len);
1439 OUTPUT:
1440 RETVAL
a0d0e21e
LW
1441
1442void
1443abort()
1444
1445int
1446mblen(s, n)
1447 char * s
1448 size_t n
1449
1450size_t
1451mbstowcs(s, pwcs, n)
1452 wchar_t * s
1453 char * pwcs
1454 size_t n
1455
1456int
1457mbtowc(pwc, s, n)
1458 wchar_t * pwc
1459 char * s
1460 size_t n
1461
1462int
1463wcstombs(s, pwcs, n)
1464 char * s
1465 wchar_t * pwcs
1466 size_t n
1467
1468int
1469wctomb(s, wchar)
1470 char * s
1471 wchar_t wchar
1472
1473int
1474strcoll(s1, s2)
1475 char * s1
1476 char * s2
1477
a89d8a78
DH
1478void
1479strtod(str)
1480 char * str
1481 PREINIT:
1482 double num;
1483 char *unparsed;
1484 PPCODE:
36477c24 1485 SET_NUMERIC_LOCAL();
a89d8a78
DH
1486 num = strtod(str, &unparsed);
1487 PUSHs(sv_2mortal(newSVnv(num)));
1488 if (GIMME == G_ARRAY) {
924508f0 1489 EXTEND(SP, 1);
a89d8a78
DH
1490 if (unparsed)
1491 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1492 else
6b88bc9c 1493 PUSHs(&PL_sv_undef);
a89d8a78
DH
1494 }
1495
1496void
1497strtol(str, base = 0)
1498 char * str
1499 int base
1500 PREINIT:
1501 long num;
1502 char *unparsed;
1503 PPCODE:
1504 num = strtol(str, &unparsed, base);
42718184
RB
1505#if IVSIZE <= LONGSIZE
1506 if (num < IV_MIN || num > IV_MAX)
a89d8a78 1507 PUSHs(sv_2mortal(newSVnv((double)num)));
42718184
RB
1508 else
1509#endif
1510 PUSHs(sv_2mortal(newSViv((IV)num)));
a89d8a78 1511 if (GIMME == G_ARRAY) {
924508f0 1512 EXTEND(SP, 1);
a89d8a78
DH
1513 if (unparsed)
1514 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1515 else
6b88bc9c 1516 PUSHs(&PL_sv_undef);
a89d8a78
DH
1517 }
1518
1519void
1520strtoul(str, base = 0)
4b48cf39 1521 const char * str
a89d8a78
DH
1522 int base
1523 PREINIT:
1524 unsigned long num;
1525 char *unparsed;
1526 PPCODE:
1527 num = strtoul(str, &unparsed, base);
84c133a0
RB
1528#if IVSIZE <= LONGSIZE
1529 if (num > IV_MAX)
a89d8a78 1530 PUSHs(sv_2mortal(newSVnv((double)num)));
84c133a0
RB
1531 else
1532#endif
1533 PUSHs(sv_2mortal(newSViv((IV)num)));
a89d8a78 1534 if (GIMME == G_ARRAY) {
924508f0 1535 EXTEND(SP, 1);
a89d8a78
DH
1536 if (unparsed)
1537 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1538 else
6b88bc9c 1539 PUSHs(&PL_sv_undef);
a89d8a78
DH
1540 }
1541
8063af02 1542void
a0d0e21e
LW
1543strxfrm(src)
1544 SV * src
85e6fe83 1545 CODE:
a0d0e21e
LW
1546 {
1547 STRLEN srclen;
1548 STRLEN dstlen;
1549 char *p = SvPV(src,srclen);
1550 srclen++;
561b68a9 1551 ST(0) = sv_2mortal(newSV(srclen*4+1));
a0d0e21e
LW
1552 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1553 if (dstlen > srclen) {
1554 dstlen++;
1555 SvGROW(ST(0), dstlen);
1556 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1557 dstlen--;
1558 }
b162af07 1559 SvCUR_set(ST(0), dstlen);
a0d0e21e
LW
1560 SvPOK_only(ST(0));
1561 }
1562
1563SysRet
1564mkfifo(filename, mode)
1565 char * filename
1566 Mode_t mode
b5890904
NC
1567 ALIAS:
1568 access = 1
748a9306 1569 CODE:
b5890904
NC
1570 if(ix) {
1571 RETVAL = access(filename, mode);
1572 } else {
1573 TAINT_PROPER("mkfifo");
1574 RETVAL = mkfifo(filename, mode);
1575 }
748a9306
LW
1576 OUTPUT:
1577 RETVAL
a0d0e21e
LW
1578
1579SysRet
1580tcdrain(fd)
1581 int fd
9163475a
NC
1582 ALIAS:
1583 close = 1
1584 dup = 2
1585 CODE:
1586 RETVAL = ix == 1 ? close(fd)
1587 : (ix < 1 ? tcdrain(fd) : dup(fd));
1588 OUTPUT:
1589 RETVAL
a0d0e21e
LW
1590
1591
1592SysRet
1593tcflow(fd, action)
1594 int fd
1595 int action
7a004119
NC
1596 ALIAS:
1597 tcflush = 1
1598 tcsendbreak = 2
1599 CODE:
1600 RETVAL = ix == 1 ? tcflush(fd, action)
1601 : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
1602 OUTPUT:
1603 RETVAL
a0d0e21e 1604
250d97fd 1605void
c1646883 1606asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
a0d0e21e
LW
1607 int sec
1608 int min
1609 int hour
1610 int mday
1611 int mon
1612 int year
1613 int wday
1614 int yday
1615 int isdst
250d97fd
NC
1616 ALIAS:
1617 mktime = 1
1618 PPCODE:
a0d0e21e 1619 {
250d97fd 1620 dXSTARG;
a0d0e21e 1621 struct tm mytm;
a748fe11 1622 init_tm(&mytm); /* XXX workaround - see init_tm() in core util.c */
a0d0e21e
LW
1623 mytm.tm_sec = sec;
1624 mytm.tm_min = min;
1625 mytm.tm_hour = hour;
1626 mytm.tm_mday = mday;
1627 mytm.tm_mon = mon;
1628 mytm.tm_year = year;
1629 mytm.tm_wday = wday;
1630 mytm.tm_yday = yday;
1631 mytm.tm_isdst = isdst;
250d97fd 1632 if (ix) {
e2054bce
TC
1633 const time_t result = mktime(&mytm);
1634 if (result == (time_t)-1)
250d97fd
NC
1635 SvOK_off(TARG);
1636 else if (result == 0)
1637 sv_setpvn(TARG, "0 but true", 10);
1638 else
1639 sv_setiv(TARG, (IV)result);
1640 } else {
1641 sv_setpv(TARG, asctime(&mytm));
1642 }
1643 ST(0) = TARG;
1644 XSRETURN(1);
a0d0e21e 1645 }
a0d0e21e
LW
1646
1647long
1648clock()
1649
1650char *
1651ctime(time)
748a9306 1652 Time_t &time
8990e307 1653
37120919
AD
1654void
1655times()
1656 PPCODE:
1657 struct tms tms;
1658 clock_t realtime;
1659 realtime = times( &tms );
924508f0 1660 EXTEND(SP,5);
9607fc9c
PP
1661 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1662 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1663 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1664 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1665 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
37120919 1666
a0d0e21e
LW
1667double
1668difftime(time1, time2)
1669 Time_t time1
1670 Time_t time2
1671
8063af02
DM
1672#XXX: if $xsubpp::WantOptimize is always the default
1673# sv_setpv(TARG, ...) could be used rather than
1674# ST(0) = sv_2mortal(newSVpv(...))
1675void
e44f695e 1676strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
dc57de01 1677 SV * fmt
a0d0e21e
LW
1678 int sec
1679 int min
1680 int hour
1681 int mday
1682 int mon
1683 int year
1684 int wday
1685 int yday
1686 int isdst
1687 CODE:
1688 {
dc57de01 1689 char *buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
2a74cb2d 1690 if (buf) {
8dbe7cf7
NC
1691 SV *const sv = sv_newmortal();
1692 sv_usepvn_flags(sv, buf, strlen(buf), SV_HAS_TRAILING_NUL);
1693 if (SvUTF8(fmt)) {
1694 SvUTF8_on(sv);
1695 }
1696 ST(0) = sv;
2a74cb2d 1697 }
a0d0e21e
LW
1698 }
1699
1700void
1701tzset()
81ab4c44
SH
1702 PPCODE:
1703 my_tzset(aTHX);
a0d0e21e
LW
1704
1705void
1706tzname()
1707 PPCODE:
924508f0 1708 EXTEND(SP,2);
d3d34884
NC
1709 PUSHs(newSVpvn_flags(tzname[0], strlen(tzname[0]), SVs_TEMP));
1710 PUSHs(newSVpvn_flags(tzname[1], strlen(tzname[1]), SVs_TEMP));
a0d0e21e 1711
a0d0e21e
LW
1712char *
1713ctermid(s = 0)
3ab23a19
RGS
1714 char * s = 0;
1715 CODE:
1716#ifdef HAS_CTERMID_R
e02b9112 1717 s = (char *) safemalloc((size_t) L_ctermid);
3ab23a19
RGS
1718#endif
1719 RETVAL = ctermid(s);
1720 OUTPUT:
1721 RETVAL
d1fd7089 1722 CLEANUP:
3ab23a19 1723#ifdef HAS_CTERMID_R
d1fd7089 1724 Safefree(s);
3ab23a19 1725#endif
a0d0e21e
LW
1726
1727char *
1728cuserid(s = 0)
1729 char * s = 0;
56f4542c
TJ
1730 CODE:
1731#ifdef HAS_CUSERID
1732 RETVAL = cuserid(s);
1733#else
1734 RETVAL = 0;
1735 not_here("cuserid");
1736#endif
1737 OUTPUT:
1738 RETVAL
a0d0e21e
LW
1739
1740SysRetLong
1741fpathconf(fd, name)
1742 int fd
1743 int name
1744
1745SysRetLong
1746pathconf(filename, name)
1747 char * filename
1748 int name
1749
1750SysRet
1751pause()
20120e59
LT
1752 CLEANUP:
1753 PERL_ASYNC_CHECK();
a0d0e21e 1754
a387c53a
NC
1755unsigned int
1756sleep(seconds)
1757 unsigned int seconds
1758 CODE:
1759 RETVAL = PerlProc_sleep(seconds);
1760 OUTPUT:
1761 RETVAL
1762
a043a685
GW
1763SysRet
1764setgid(gid)
1765 Gid_t gid
1766
1767SysRet
1768setuid(uid)
1769 Uid_t uid
1770
a0d0e21e
LW
1771SysRetLong
1772sysconf(name)
1773 int name
1774
1775char *
1776ttyname(fd)
1777 int fd
a043a685 1778
c6c619a9 1779void
b5846a0b 1780getcwd()
8f95b30d
JH
1781 PPCODE:
1782 {
1783 dXSTARG;
89423764 1784 getcwd_sv(TARG);
8f95b30d
JH
1785 XSprePUSH; PUSHTARG;
1786 }
1787
0d7021f5
RGS
1788SysRet
1789lchown(uid, gid, path)
1790 Uid_t uid
1791 Gid_t gid
1792 char * path
1793 CODE:
1794#ifdef HAS_LCHOWN
1795 /* yes, the order of arguments is different,
1796 * but consistent with CORE::chown() */
1797 RETVAL = lchown(path, uid, gid);
1798#else
1799 RETVAL = not_here("lchown");
1800#endif
1801 OUTPUT:
1802 RETVAL