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