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