This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Merge the implementations of 10 maths functions in POSIX using ALIAS.
[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
2f0945cb
NC
491#ifdef HAS_LOCALECONV
492struct lconv_offset {
493 const char *name;
494 size_t offset;
495};
496
497const struct lconv_offset lconv_strings[] = {
498 {"decimal_point", offsetof(struct lconv, decimal_point)},
499 {"thousands_sep", offsetof(struct lconv, thousands_sep)},
500#ifndef NO_LOCALECONV_GROUPING
501 {"grouping", offsetof(struct lconv, grouping)},
502#endif
503 {"int_curr_symbol", offsetof(struct lconv, int_curr_symbol)},
504 {"currency_symbol", offsetof(struct lconv, currency_symbol)},
505 {"mon_decimal_point", offsetof(struct lconv, mon_decimal_point)},
506#ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
507 {"mon_thousands_sep", offsetof(struct lconv, mon_thousands_sep)},
508#endif
509#ifndef NO_LOCALECONV_MON_GROUPING
510 {"mon_grouping", offsetof(struct lconv, mon_grouping)},
511#endif
512 {"positive_sign", offsetof(struct lconv, positive_sign)},
513 {"negative_sign", offsetof(struct lconv, negative_sign)},
514 {NULL, 0}
515};
516
517const struct lconv_offset lconv_integers[] = {
518 {"int_frac_digits", offsetof(struct lconv, int_frac_digits)},
519 {"frac_digits", offsetof(struct lconv, frac_digits)},
520 {"p_cs_precedes", offsetof(struct lconv, p_cs_precedes)},
521 {"p_sep_by_space", offsetof(struct lconv, p_sep_by_space)},
522 {"n_cs_precedes", offsetof(struct lconv, n_cs_precedes)},
523 {"n_sep_by_space", offsetof(struct lconv, n_sep_by_space)},
524 {"p_sign_posn", offsetof(struct lconv, p_sign_posn)},
525 {"n_sign_posn", offsetof(struct lconv, n_sign_posn)},
526 {NULL, 0}
527};
528
529#else
a0d0e21e
LW
530#define localeconv() not_here("localeconv")
531#endif
532
172ea7c8 533#ifdef HAS_LONG_DOUBLE
53796371 534# if LONG_DOUBLESIZE > NVSIZE
172ea7c8
JH
535# undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
536# endif
537#endif
538
539#ifndef HAS_LONG_DOUBLE
540#ifdef LDBL_MAX
541#undef LDBL_MAX
542#endif
543#ifdef LDBL_MIN
544#undef LDBL_MIN
545#endif
546#ifdef LDBL_EPSILON
547#undef LDBL_EPSILON
548#endif
549#endif
550
ec193bec
JH
551/* Background: in most systems the low byte of the wait status
552 * is the signal (the lowest 7 bits) and the coredump flag is
553 * the eight bit, and the second lowest byte is the exit status.
554 * BeOS bucks the trend and has the bytes in different order.
555 * See beos/beos.c for how the reality is bent even in BeOS
556 * to follow the traditional. However, to make the POSIX
557 * wait W*() macros to work in BeOS, we need to unbend the
558 * reality back in place. --jhi */
17028706
IW
559/* In actual fact the code below is to blame here. Perl has an internal
560 * representation of the exit status ($?), which it re-composes from the
561 * OS's representation using the W*() POSIX macros. The code below
562 * incorrectly uses the W*() macros on the internal representation,
563 * which fails for OSs that have a different representation (namely BeOS
564 * and Haiku). WMUNGE() is a hack that converts the internal
565 * representation into the OS specific one, so that the W*() macros work
566 * as expected. The better solution would be not to use the W*() macros
567 * in the first place, though. -- Ingo Weinhold
568 */
569#if defined(__BEOS__) || defined(__HAIKU__)
ec193bec
JH
570# define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
571#else
572# define WMUNGE(x) (x)
573#endif
574
8990e307 575static int
4b48cf39 576not_here(const char *s)
8990e307
LW
577{
578 croak("POSIX::%s not implemented on this architecture", s);
579 return -1;
580}
463ee0b2 581
1cb0fb50 582#include "const-c.inc"
a290f238 583
1dfe7606 584static void
40b7a5f5 585restore_sigmask(pTHX_ SV *osset_sv)
1dfe7606 586{
7feb700b
JH
587 /* Fortunately, restoring the signal mask can't fail, because
588 * there's nothing we can do about it if it does -- we're not
589 * supposed to return -1 from sigaction unless the disposition
590 * was unaffected.
591 */
7feb700b
JH
592 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
593 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
1dfe7606 594}
595
a2261f90
NC
596static void *
597allocate_struct(pTHX_ SV *rv, const STRLEN size, const char *packname) {
598 SV *const t = newSVrv(rv, packname);
599 void *const p = sv_grow(t, size + 1);
600
601 SvCUR_set(t, size);
602 SvPOK_on(t);
603 return p;
604}
605
81ab4c44
SH
606#ifdef WIN32
607
608/*
609 * (1) The CRT maintains its own copy of the environment, separate from
610 * the Win32API copy.
611 *
612 * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
613 * copy, and then calls SetEnvironmentVariableA() to update the Win32API
614 * copy.
615 *
616 * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
617 * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
618 * environment.
619 *
620 * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
621 * calls CRT tzset(), but only the first time it is called, and in turn
622 * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
623 * local copy of the environment and hence gets the original setting as
624 * perl never updates the CRT copy when assigning to $ENV{TZ}.
625 *
626 * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
627 * putenv() to update the CRT copy of the environment (if it is different)
628 * whenever we're about to call tzset().
629 *
630 * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
631 * defined:
632 *
633 * (a) Each interpreter has its own copy of the environment inside the
634 * perlhost structure. That allows applications that host multiple
635 * independent Perl interpreters to isolate environment changes from
636 * each other. (This is similar to how the perlhost mechanism keeps a
637 * separate working directory for each Perl interpreter, so that calling
638 * chdir() will not affect other interpreters.)
639 *
640 * (b) Only the first Perl interpreter instantiated within a process will
641 * "write through" environment changes to the process environment.
642 *
643 * (c) Even the primary Perl interpreter won't update the CRT copy of the
644 * the environment, only the Win32API copy (it calls win32_putenv()).
645 *
646 * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
647 * sense to only update the process environment when inside the main
648 * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
649 * from here so we'll just have to check PL_curinterp instead.
650 *
651 * Therefore, we can simply #undef getenv() and putenv() so that those names
652 * always refer to the CRT functions, and explicitly call win32_getenv() to
653 * access perl's %ENV.
654 *
655 * We also #undef malloc() and free() to be sure we are using the CRT
656 * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
657 * into VMem::Malloc() and VMem::Free() and all allocations will be freed
658 * when the Perl interpreter is being destroyed so we'd end up with a pointer
659 * into deallocated memory in environ[] if a program embedding a Perl
660 * interpreter continues to operate even after the main Perl interpreter has
661 * been destroyed.
662 *
663 * Note that we don't free() the malloc()ed memory unless and until we call
664 * malloc() again ourselves because the CRT putenv() function simply puts its
b7b1e41b 665 * pointer argument into the environ[] array (it doesn't make a copy of it)
81ab4c44
SH
666 * so this memory must otherwise be leaked.
667 */
668
669#undef getenv
670#undef putenv
671#undef malloc
672#undef free
673
674static void
675fix_win32_tzenv(void)
676{
677 static char* oldenv = NULL;
678 char* newenv;
679 const char* perl_tz_env = win32_getenv("TZ");
680 const char* crt_tz_env = getenv("TZ");
681 if (perl_tz_env == NULL)
682 perl_tz_env = "";
683 if (crt_tz_env == NULL)
684 crt_tz_env = "";
685 if (strcmp(perl_tz_env, crt_tz_env) != 0) {
686 newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
687 if (newenv != NULL) {
688 sprintf(newenv, "TZ=%s", perl_tz_env);
689 putenv(newenv);
690 if (oldenv != NULL)
691 free(oldenv);
692 oldenv = newenv;
693 }
694 }
695}
696
697#endif
698
699/*
700 * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
701 * This code is duplicated in the Time-Piece module, so any changes made here
702 * should be made there too.
703 */
704static void
705my_tzset(pTHX)
706{
707#ifdef WIN32
708#if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
709 if (PL_curinterp == aTHX)
710#endif
711 fix_win32_tzenv();
712#endif
713 tzset();
714}
715
2304df62
AD
716MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
717
92b39396 718void
2304df62 719new(packname = "POSIX::SigSet", ...)
d3f5e399 720 const char * packname
2304df62
AD
721 CODE:
722 {
723 int i;
92b39396
NC
724 sigset_t *const s
725 = (sigset_t *) allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
726 sizeof(sigset_t),
727 packname);
728 sigemptyset(s);
a0d0e21e 729 for (i = 1; i < items; i++)
92b39396
NC
730 sigaddset(s, SvIV(ST(i)));
731 XSRETURN(1);
2304df62 732 }
2304df62
AD
733
734SysRet
df6c2df2 735addset(sigset, sig)
2304df62
AD
736 POSIX::SigSet sigset
737 int sig
df6c2df2
NC
738 ALIAS:
739 delset = 1
740 CODE:
741 RETVAL = ix ? sigdelset(sigset, sig) : sigaddset(sigset, sig);
742 OUTPUT:
743 RETVAL
2304df62
AD
744
745SysRet
df6c2df2 746emptyset(sigset)
2304df62 747 POSIX::SigSet sigset
df6c2df2
NC
748 ALIAS:
749 fillset = 1
750 CODE:
751 RETVAL = ix ? sigfillset(sigset) : sigemptyset(sigset);
752 OUTPUT:
753 RETVAL
2304df62
AD
754
755int
756sigismember(sigset, sig)
757 POSIX::SigSet sigset
758 int sig
759
a0d0e21e
LW
760MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
761
11a39fe4 762void
a0d0e21e 763new(packname = "POSIX::Termios", ...)
d3f5e399 764 const char * packname
a0d0e21e
LW
765 CODE:
766 {
767#ifdef I_TERMIOS
a2261f90
NC
768 void *const p = allocate_struct(aTHX_ (ST(0) = sv_newmortal()),
769 sizeof(struct termios), packname);
11a39fe4
NC
770 /* The previous implementation stored a pointer to an uninitialised
771 struct termios. Seems safer to initialise it, particularly as
772 this implementation exposes the struct to prying from perl-space.
773 */
a2261f90 774 memset(p, 0, 1 + sizeof(struct termios));
11a39fe4 775 XSRETURN(1);
a0d0e21e
LW
776#else
777 not_here("termios");
778#endif
779 }
a0d0e21e
LW
780
781SysRet
782getattr(termios_ref, fd = 0)
783 POSIX::Termios termios_ref
784 int fd
785 CODE:
786 RETVAL = tcgetattr(fd, termios_ref);
787 OUTPUT:
788 RETVAL
789
790SysRet
791setattr(termios_ref, fd = 0, optional_actions = 0)
792 POSIX::Termios termios_ref
793 int fd
794 int optional_actions
795 CODE:
796 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
797 OUTPUT:
798 RETVAL
799
800speed_t
2a59a32c 801getispeed(termios_ref)
a0d0e21e 802 POSIX::Termios termios_ref
2a59a32c
NC
803 ALIAS:
804 getospeed = 1
a0d0e21e 805 CODE:
2a59a32c 806 RETVAL = ix ? cfgetospeed(termios_ref) : cfgetispeed(termios_ref);
a0d0e21e
LW
807 OUTPUT:
808 RETVAL
809
810tcflag_t
2a59a32c 811getiflag(termios_ref)
a0d0e21e 812 POSIX::Termios termios_ref
2a59a32c
NC
813 ALIAS:
814 getoflag = 1
815 getcflag = 2
816 getlflag = 3
a0d0e21e
LW
817 CODE:
818#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
2a59a32c
NC
819 switch(ix) {
820 case 0:
821 RETVAL = termios_ref->c_iflag;
822 break;
823 case 1:
824 RETVAL = termios_ref->c_oflag;
825 break;
826 case 2:
827 RETVAL = termios_ref->c_cflag;
828 break;
829 case 3:
830 RETVAL = termios_ref->c_lflag;
831 break;
832 }
a0d0e21e 833#else
2a59a32c
NC
834 not_here(GvNAME(CvGV(cv)));
835 RETVAL = 0;
a0d0e21e
LW
836#endif
837 OUTPUT:
838 RETVAL
839
840cc_t
841getcc(termios_ref, ccix)
842 POSIX::Termios termios_ref
b56fc9ec 843 unsigned int ccix
a0d0e21e
LW
844 CODE:
845#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
846 if (ccix >= NCCS)
847 croak("Bad getcc subscript");
848 RETVAL = termios_ref->c_cc[ccix];
849#else
640cc986
HM
850 not_here("getcc");
851 RETVAL = 0;
a0d0e21e
LW
852#endif
853 OUTPUT:
854 RETVAL
855
856SysRet
2a59a32c 857setispeed(termios_ref, speed)
a0d0e21e
LW
858 POSIX::Termios termios_ref
859 speed_t speed
2a59a32c
NC
860 ALIAS:
861 setospeed = 1
a0d0e21e 862 CODE:
2a59a32c
NC
863 RETVAL = ix
864 ? cfsetospeed(termios_ref, speed) : cfsetispeed(termios_ref, speed);
865 OUTPUT:
866 RETVAL
a0d0e21e
LW
867
868void
2a59a32c 869setiflag(termios_ref, flag)
a0d0e21e 870 POSIX::Termios termios_ref
2a59a32c
NC
871 tcflag_t flag
872 ALIAS:
873 setoflag = 1
874 setcflag = 2
875 setlflag = 3
a0d0e21e
LW
876 CODE:
877#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
2a59a32c
NC
878 switch(ix) {
879 case 0:
880 termios_ref->c_iflag = flag;
881 break;
882 case 1:
883 termios_ref->c_oflag = flag;
884 break;
885 case 2:
886 termios_ref->c_cflag = flag;
887 break;
888 case 3:
889 termios_ref->c_lflag = flag;
890 break;
891 }
a0d0e21e 892#else
2a59a32c 893 not_here(GvNAME(CvGV(cv)));
a0d0e21e
LW
894#endif
895
896void
897setcc(termios_ref, ccix, cc)
898 POSIX::Termios termios_ref
b56fc9ec 899 unsigned int ccix
a0d0e21e
LW
900 cc_t cc
901 CODE:
902#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
903 if (ccix >= NCCS)
904 croak("Bad setcc subscript");
905 termios_ref->c_cc[ccix] = cc;
906#else
907 not_here("setcc");
908#endif
909
910
a0d0e21e
LW
911MODULE = POSIX PACKAGE = POSIX
912
1cb0fb50 913INCLUDE: const-xs.inc
a290f238 914
e99d581a
NC
915int
916WEXITSTATUS(status)
917 int status
72bfe1b2
NC
918 ALIAS:
919 POSIX::WIFEXITED = 1
920 POSIX::WIFSIGNALED = 2
921 POSIX::WIFSTOPPED = 3
922 POSIX::WSTOPSIG = 4
923 POSIX::WTERMSIG = 5
924 CODE:
fabb67aa
SK
925#if !defined(WEXITSTATUS) || !defined(WIFEXITED) || !defined(WIFSIGNALED) \
926 || !defined(WIFSTOPPED) || !defined(WSTOPSIG) || !defined(WTERMSIG)
19c4478c
NC
927 RETVAL = 0; /* Silence compilers that notice this, but don't realise
928 that not_here() can't return. */
929#endif
72bfe1b2
NC
930 switch(ix) {
931 case 0:
d49025b7 932#ifdef WEXITSTATUS
17028706 933 RETVAL = WEXITSTATUS(WMUNGE(status));
d49025b7
NC
934#else
935 not_here("WEXITSTATUS");
936#endif
72bfe1b2
NC
937 break;
938 case 1:
d49025b7 939#ifdef WIFEXITED
17028706 940 RETVAL = WIFEXITED(WMUNGE(status));
d49025b7
NC
941#else
942 not_here("WIFEXITED");
943#endif
72bfe1b2
NC
944 break;
945 case 2:
d49025b7 946#ifdef WIFSIGNALED
17028706 947 RETVAL = WIFSIGNALED(WMUNGE(status));
d49025b7
NC
948#else
949 not_here("WIFSIGNALED");
950#endif
72bfe1b2
NC
951 break;
952 case 3:
d49025b7 953#ifdef WIFSTOPPED
17028706 954 RETVAL = WIFSTOPPED(WMUNGE(status));
d49025b7
NC
955#else
956 not_here("WIFSTOPPED");
957#endif
72bfe1b2
NC
958 break;
959 case 4:
d49025b7 960#ifdef WSTOPSIG
17028706 961 RETVAL = WSTOPSIG(WMUNGE(status));
d49025b7
NC
962#else
963 not_here("WSTOPSIG");
964#endif
72bfe1b2
NC
965 break;
966 case 5:
d49025b7 967#ifdef WTERMSIG
17028706 968 RETVAL = WTERMSIG(WMUNGE(status));
d49025b7
NC
969#else
970 not_here("WTERMSIG");
971#endif
72bfe1b2
NC
972 break;
973 default:
c33e8be1 974 Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", (int)ix);
72bfe1b2
NC
975 }
976 OUTPUT:
977 RETVAL
2304df62
AD
978
979int
980isalnum(charstring)
767bb2e0
ST
981 SV * charstring
982 PREINIT:
983 STRLEN len;
2304df62 984 CODE:
767bb2e0
ST
985 unsigned char *s = (unsigned char *) SvPV(charstring, len);
986 unsigned char *e = s + len;
5344da4e 987 for (RETVAL = 1; RETVAL && s < e; s++)
2304df62
AD
988 if (!isalnum(*s))
989 RETVAL = 0;
990 OUTPUT:
991 RETVAL
992
993int
994isalpha(charstring)
767bb2e0
ST
995 SV * charstring
996 PREINIT:
997 STRLEN len;
2304df62 998 CODE:
767bb2e0
ST
999 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1000 unsigned char *e = s + len;
5344da4e 1001 for (RETVAL = 1; RETVAL && s < e; s++)
2304df62
AD
1002 if (!isalpha(*s))
1003 RETVAL = 0;
1004 OUTPUT:
1005 RETVAL
1006
1007int
1008iscntrl(charstring)
767bb2e0
ST
1009 SV * charstring
1010 PREINIT:
1011 STRLEN len;
2304df62 1012 CODE:
767bb2e0
ST
1013 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1014 unsigned char *e = s + len;
5344da4e 1015 for (RETVAL = 1; RETVAL && s < e; s++)
2304df62
AD
1016 if (!iscntrl(*s))
1017 RETVAL = 0;
1018 OUTPUT:
1019 RETVAL
1020
1021int
1022isdigit(charstring)
767bb2e0
ST
1023 SV * charstring
1024 PREINIT:
1025 STRLEN len;
2304df62 1026 CODE:
767bb2e0
ST
1027 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1028 unsigned char *e = s + len;
5344da4e 1029 for (RETVAL = 1; RETVAL && s < e; s++)
2304df62
AD
1030 if (!isdigit(*s))
1031 RETVAL = 0;
1032 OUTPUT:
1033 RETVAL
1034
1035int
1036isgraph(charstring)
767bb2e0
ST
1037 SV * charstring
1038 PREINIT:
1039 STRLEN len;
2304df62 1040 CODE:
767bb2e0
ST
1041 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1042 unsigned char *e = s + len;
5344da4e 1043 for (RETVAL = 1; RETVAL && s < e; s++)
2304df62
AD
1044 if (!isgraph(*s))
1045 RETVAL = 0;
1046 OUTPUT:
1047 RETVAL
1048
1049int
1050islower(charstring)
767bb2e0
ST
1051 SV * charstring
1052 PREINIT:
1053 STRLEN len;
2304df62 1054 CODE:
767bb2e0
ST
1055 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1056 unsigned char *e = s + len;
5344da4e 1057 for (RETVAL = 1; RETVAL && s < e; s++)
2304df62
AD
1058 if (!islower(*s))
1059 RETVAL = 0;
1060 OUTPUT:
1061 RETVAL
1062
1063int
1064isprint(charstring)
767bb2e0
ST
1065 SV * charstring
1066 PREINIT:
1067 STRLEN len;
2304df62 1068 CODE:
767bb2e0
ST
1069 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1070 unsigned char *e = s + len;
5344da4e 1071 for (RETVAL = 1; RETVAL && s < e; s++)
2304df62
AD
1072 if (!isprint(*s))
1073 RETVAL = 0;
1074 OUTPUT:
1075 RETVAL
1076
1077int
1078ispunct(charstring)
767bb2e0
ST
1079 SV * charstring
1080 PREINIT:
1081 STRLEN len;
2304df62 1082 CODE:
767bb2e0
ST
1083 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1084 unsigned char *e = s + len;
5344da4e 1085 for (RETVAL = 1; RETVAL && s < e; s++)
2304df62
AD
1086 if (!ispunct(*s))
1087 RETVAL = 0;
1088 OUTPUT:
1089 RETVAL
1090
1091int
1092isspace(charstring)
767bb2e0
ST
1093 SV * charstring
1094 PREINIT:
1095 STRLEN len;
2304df62 1096 CODE:
767bb2e0
ST
1097 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1098 unsigned char *e = s + len;
5344da4e 1099 for (RETVAL = 1; RETVAL && s < e; s++)
2304df62
AD
1100 if (!isspace(*s))
1101 RETVAL = 0;
1102 OUTPUT:
1103 RETVAL
8990e307
LW
1104
1105int
2304df62 1106isupper(charstring)
767bb2e0
ST
1107 SV * charstring
1108 PREINIT:
1109 STRLEN len;
2304df62 1110 CODE:
767bb2e0
ST
1111 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1112 unsigned char *e = s + len;
5344da4e 1113 for (RETVAL = 1; RETVAL && s < e; s++)
2304df62
AD
1114 if (!isupper(*s))
1115 RETVAL = 0;
1116 OUTPUT:
1117 RETVAL
8990e307
LW
1118
1119int
2304df62 1120isxdigit(charstring)
767bb2e0
ST
1121 SV * charstring
1122 PREINIT:
1123 STRLEN len;
2304df62 1124 CODE:
767bb2e0
ST
1125 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1126 unsigned char *e = s + len;
5344da4e 1127 for (RETVAL = 1; RETVAL && s < e; s++)
2304df62
AD
1128 if (!isxdigit(*s))
1129 RETVAL = 0;
1130 OUTPUT:
1131 RETVAL
1132
1133SysRet
1134open(filename, flags = O_RDONLY, mode = 0666)
1135 char * filename
1136 int flags
a0d0e21e 1137 Mode_t mode
748a9306
LW
1138 CODE:
1139 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
1140 TAINT_PROPER("open");
1141 RETVAL = open(filename, flags, mode);
1142 OUTPUT:
1143 RETVAL
1144
2304df62
AD
1145
1146HV *
1147localeconv()
1148 CODE:
a0d0e21e 1149#ifdef HAS_LOCALECONV
2304df62
AD
1150 struct lconv *lcbuf;
1151 RETVAL = newHV();
c4e79b56 1152 sv_2mortal((SV*)RETVAL);
8063af02 1153 if ((lcbuf = localeconv())) {
2f0945cb
NC
1154 const struct lconv_offset *strings = lconv_strings;
1155 const struct lconv_offset *integers = lconv_integers;
1156 const char *ptr = (const char *) lcbuf;
1157
1158 do {
1159 const char *value = *((const char **)(ptr + strings->offset));
1160
1161 if (value && *value)
1162 (void) hv_store(RETVAL, strings->name, strlen(strings->name),
1163 newSVpv(value, 0), 0);
1164 } while ((++strings)->name);
1165
1166 do {
1167 const char value = *((const char *)(ptr + integers->offset));
1168
1169 if (value != CHAR_MAX)
1170 (void) hv_store(RETVAL, integers->name,
1171 strlen(integers->name), newSViv(value), 0);
1172 } while ((++integers)->name);
2304df62 1173 }
a0d0e21e
LW
1174#else
1175 localeconv(); /* A stub to call not_here(). */
1176#endif
2304df62
AD
1177 OUTPUT:
1178 RETVAL
1179
1180char *
c28ee57b 1181setlocale(category, locale = 0)
2304df62
AD
1182 int category
1183 char * locale
1ba01ae3
SH
1184 PREINIT:
1185 char * retval;
c28ee57b 1186 CODE:
1ba01ae3
SH
1187 retval = setlocale(category, locale);
1188 if (retval) {
1189 /* Save retval since subsequent setlocale() calls
1190 * may overwrite it. */
1191 RETVAL = savepv(retval);
36477c24 1192#ifdef USE_LOCALE_CTYPE
bbce6d69
PP
1193 if (category == LC_CTYPE
1194#ifdef LC_ALL
1195 || category == LC_ALL
1196#endif
1197 )
1198 {
1199 char *newctype;
1200#ifdef LC_ALL
1201 if (category == LC_ALL)
1202 newctype = setlocale(LC_CTYPE, NULL);
1203 else
1204#endif
1205 newctype = RETVAL;
864dbfa3 1206 new_ctype(newctype);
bbce6d69 1207 }
36477c24
PP
1208#endif /* USE_LOCALE_CTYPE */
1209#ifdef USE_LOCALE_COLLATE
bbce6d69
PP
1210 if (category == LC_COLLATE
1211#ifdef LC_ALL
1212 || category == LC_ALL
1213#endif
1214 )
1215 {
1216 char *newcoll;
1217#ifdef LC_ALL
1218 if (category == LC_ALL)
1219 newcoll = setlocale(LC_COLLATE, NULL);
1220 else
1221#endif
1222 newcoll = RETVAL;
864dbfa3 1223 new_collate(newcoll);
bbce6d69 1224 }
36477c24
PP
1225#endif /* USE_LOCALE_COLLATE */
1226#ifdef USE_LOCALE_NUMERIC
bbce6d69
PP
1227 if (category == LC_NUMERIC
1228#ifdef LC_ALL
1229 || category == LC_ALL
1230#endif
1231 )
1232 {
1233 char *newnum;
1234#ifdef LC_ALL
1235 if (category == LC_ALL)
1236 newnum = setlocale(LC_NUMERIC, NULL);
1237 else
1238#endif
1239 newnum = RETVAL;
864dbfa3 1240 new_numeric(newnum);
bbce6d69 1241 }
36477c24 1242#endif /* USE_LOCALE_NUMERIC */
bbce6d69 1243 }
1ba01ae3
SH
1244 else
1245 RETVAL = NULL;
c28ee57b
JH
1246 OUTPUT:
1247 RETVAL
1ba01ae3
SH
1248 CLEANUP:
1249 if (RETVAL)
1250 Safefree(RETVAL);
2304df62 1251
e1ca407b 1252NV
2304df62 1253acos(x)
e1ca407b 1254 NV x
b256643b
NC
1255 ALIAS:
1256 asin = 1
1257 atan = 2
1258 ceil = 3
1259 cosh = 4
1260 floor = 5
1261 log10 = 6
1262 sinh = 7
1263 tan = 8
1264 tanh = 9
1265 CODE:
1266 switch (ix) {
1267 case 0:
1268 RETVAL = acos(x);
1269 break;
1270 case 1:
1271 RETVAL = asin(x);
1272 break;
1273 case 2:
1274 RETVAL = atan(x);
1275 break;
1276 case 3:
1277 RETVAL = ceil(x);
1278 break;
1279 case 4:
1280 RETVAL = cosh(x);
1281 break;
1282 case 5:
1283 RETVAL = floor(x);
1284 break;
1285 case 6:
1286 RETVAL = log10(x);
1287 break;
1288 case 7:
1289 RETVAL = sinh(x);
1290 break;
1291 case 8:
1292 RETVAL = tan(x);
1293 break;
1294 default:
1295 RETVAL = tanh(x);
1296 }
1297 OUTPUT:
1298 RETVAL
2304df62 1299
e1ca407b 1300NV
2304df62 1301fmod(x,y)
e1ca407b
A
1302 NV x
1303 NV y
2304df62
AD
1304
1305void
1306frexp(x)
e1ca407b 1307 NV x
2304df62
AD
1308 PPCODE:
1309 int expvar;
2304df62
AD
1310 /* (We already know stack is long enough.) */
1311 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1312 PUSHs(sv_2mortal(newSViv(expvar)));
1313
e1ca407b 1314NV
2304df62 1315ldexp(x,exp)
e1ca407b 1316 NV x
2304df62
AD
1317 int exp
1318
2304df62
AD
1319void
1320modf(x)
e1ca407b 1321 NV x
2304df62 1322 PPCODE:
e1ca407b 1323 NV intvar;
2304df62 1324 /* (We already know stack is long enough.) */
bf4acbe4 1325 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
2304df62
AD
1326 PUSHs(sv_2mortal(newSVnv(intvar)));
1327
2304df62 1328SysRet
1dfe7606 1329sigaction(sig, optaction, oldaction = 0)
2304df62 1330 int sig
1dfe7606 1331 SV * optaction
2304df62
AD
1332 POSIX::SigAction oldaction
1333 CODE:
2986a63f 1334#if defined(WIN32) || defined(NETWARE)
6dead956
GS
1335 RETVAL = not_here("sigaction");
1336#else
2304df62
AD
1337# This code is really grody because we're trying to make the signal
1338# interface look beautiful, which is hard.
1339
2304df62 1340 {
27da23d5 1341 dVAR;
1dfe7606 1342 POSIX__SigAction action;
f584eb2d 1343 GV *siggv = gv_fetchpvs("SIG", GV_ADD, SVt_PVHV);
2304df62
AD
1344 struct sigaction act;
1345 struct sigaction oact;
1dfe7606 1346 sigset_t sset;
183bde56 1347 SV *osset_sv;
27c1a449 1348 sigset_t osset;
2304df62
AD
1349 POSIX__SigSet sigset;
1350 SV** svp;
1d81eac9 1351 SV** sigsvp;
3609ea0d 1352
516d25e8
SP
1353 if (sig < 0) {
1354 croak("Negative signals are not allowed");
1355 }
1356
1d81eac9 1357 if (sig == 0 && SvPOK(ST(0))) {
aa07b2f6 1358 const char *s = SvPVX_const(ST(0));
1d81eac9
JH
1359 int i = whichsig(s);
1360
1361 if (i < 0 && memEQ(s, "SIG", 3))
1362 i = whichsig(s + 3);
1363 if (i < 0) {
1364 if (ckWARN(WARN_SIGNAL))
1365 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1366 "No such signal: SIG%s", s);
1367 XSRETURN_UNDEF;
1368 }
1369 else
1370 sig = i;
1371 }
3609ea0d
JH
1372#ifdef NSIG
1373 if (sig > NSIG) { /* NSIG - 1 is still okay. */
1374 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1375 "No such signal: %d", sig);
1376 XSRETURN_UNDEF;
1377 }
1378#endif
1d81eac9
JH
1379 sigsvp = hv_fetch(GvHVn(siggv),
1380 PL_sig_name[sig],
1381 strlen(PL_sig_name[sig]),
1382 TRUE);
2304df62 1383
1dfe7606 1384 /* Check optaction and set action */
1385 if(SvTRUE(optaction)) {
1386 if(sv_isa(optaction, "POSIX::SigAction"))
1387 action = (HV*)SvRV(optaction);
1388 else
1389 croak("action is not of type POSIX::SigAction");
1390 }
1391 else {
1392 action=0;
1393 }
1394
1395 /* sigaction() is supposed to look atomic. In particular, any
1396 * signal handler invoked during a sigaction() call should
1397 * see either the old or the new disposition, and not something
1398 * in between. We use sigprocmask() to make it so.
1399 */
1400 sigfillset(&sset);
1401 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1402 if(RETVAL == -1)
15c0d34a 1403 XSRETURN_UNDEF;
1dfe7606 1404 ENTER;
1405 /* Restore signal mask no matter how we exit this block. */
f584eb2d 1406 osset_sv = newSVpvn((char *)(&osset), sizeof(sigset_t));
183bde56 1407 SAVEFREESV( osset_sv );
40b7a5f5 1408 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1dfe7606 1409
1410 RETVAL=-1; /* In case both oldaction and action are 0. */
1411
1412 /* Remember old disposition if desired. */
2304df62 1413 if (oldaction) {
017a3ce5 1414 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
1dfe7606 1415 if(!svp)
1416 croak("Can't supply an oldaction without a HANDLER");
1417 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1418 sv_setsv(*svp, *sigsvp);
1419 }
1420 else {
f584eb2d 1421 sv_setpvs(*svp, "DEFAULT");
1dfe7606 1422 }
1423 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
6ca4bbc9
GG
1424 if(RETVAL == -1) {
1425 LEAVE;
15c0d34a 1426 XSRETURN_UNDEF;
6ca4bbc9 1427 }
1dfe7606 1428 /* Get back the mask. */
017a3ce5 1429 svp = hv_fetchs(oldaction, "MASK", TRUE);
1dfe7606 1430 if (sv_isa(*svp, "POSIX::SigSet")) {
92b39396 1431 sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
1dfe7606 1432 }
1433 else {
92b39396
NC
1434 sigset = (sigset_t *) allocate_struct(aTHX_ *svp,
1435 sizeof(sigset_t),
1436 "POSIX::SigSet");
1dfe7606 1437 }
1438 *sigset = oact.sa_mask;
1439
1440 /* Get back the flags. */
017a3ce5 1441 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
1dfe7606 1442 sv_setiv(*svp, oact.sa_flags);
d36b6582
CS
1443
1444 /* Get back whether the old handler used safe signals. */
017a3ce5 1445 svp = hv_fetchs(oldaction, "SAFE", TRUE);
e91e3b10
RB
1446 sv_setiv(*svp,
1447 /* compare incompatible pointers by casting to integer */
1448 PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
2304df62
AD
1449 }
1450
1451 if (action) {
d36b6582
CS
1452 /* Safe signals use "csighandler", which vectors through the
1453 PL_sighandlerp pointer when it's safe to do so.
1454 (BTW, "csighandler" is very different from "sighandler".) */
017a3ce5 1455 svp = hv_fetchs(action, "SAFE", FALSE);
e91e3b10
RB
1456 act.sa_handler =
1457 DPTR2FPTR(
87d46f97 1458 void (*)(int),
e91e3b10
RB
1459 (*svp && SvTRUE(*svp))
1460 ? PL_csighandlerp : PL_sighandlerp
1461 );
d36b6582
CS
1462
1463 /* Vector new Perl handler through %SIG.
1464 (The core signal handlers read %SIG to dispatch.) */
017a3ce5 1465 svp = hv_fetchs(action, "HANDLER", FALSE);
2304df62
AD
1466 if (!svp)
1467 croak("Can't supply an action without a HANDLER");
1dfe7606 1468 sv_setsv(*sigsvp, *svp);
d36b6582
CS
1469
1470 /* This call actually calls sigaction() with almost the
1471 right settings, including appropriate interpretation
1472 of DEFAULT and IGNORE. However, why are we doing
1473 this when we're about to do it again just below? XXX */
17cffb37 1474 SvSETMAGIC(*sigsvp);
d36b6582
CS
1475
1476 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1dfe7606 1477 if(SvPOK(*svp)) {
aa07b2f6 1478 const char *s=SvPVX_const(*svp);
1dfe7606 1479 if(strEQ(s,"IGNORE")) {
1480 act.sa_handler = SIG_IGN;
1481 }
1482 else if(strEQ(s,"DEFAULT")) {
1483 act.sa_handler = SIG_DFL;
1484 }
1dfe7606 1485 }
2304df62
AD
1486
1487 /* Set up any desired mask. */
017a3ce5 1488 svp = hv_fetchs(action, "MASK", FALSE);
2304df62 1489 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
92b39396 1490 sigset = (sigset_t *) SvPV_nolen(SvRV(*svp));
2304df62
AD
1491 act.sa_mask = *sigset;
1492 }
1493 else
85e6fe83 1494 sigemptyset(& act.sa_mask);
2304df62
AD
1495
1496 /* Set up any desired flags. */
017a3ce5 1497 svp = hv_fetchs(action, "FLAGS", FALSE);
2304df62 1498 act.sa_flags = svp ? SvIV(*svp) : 0;
2304df62 1499
1dfe7606 1500 /* Don't worry about cleaning up *sigsvp if this fails,
1501 * because that means we tried to disposition a
1502 * nonblockable signal, in which case *sigsvp is
1503 * essentially meaningless anyway.
1504 */
6c418a22 1505 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
6ca4bbc9
GG
1506 if(RETVAL == -1) {
1507 LEAVE;
a7aad5de 1508 XSRETURN_UNDEF;
6ca4bbc9 1509 }
2304df62 1510 }
1dfe7606 1511
1512 LEAVE;
2304df62 1513 }
6dead956 1514#endif
2304df62
AD
1515 OUTPUT:
1516 RETVAL
1517
1518SysRet
1519sigpending(sigset)
1520 POSIX::SigSet sigset
7a004119
NC
1521 ALIAS:
1522 sigsuspend = 1
1523 CODE:
1524 RETVAL = ix ? sigsuspend(sigset) : sigpending(sigset);
1525 OUTPUT:
1526 RETVAL
2304df62
AD
1527
1528SysRet
1529sigprocmask(how, sigset, oldsigset = 0)
1530 int how
b13bbac7 1531 POSIX::SigSet sigset = NO_INIT
33c27489
GS
1532 POSIX::SigSet oldsigset = NO_INIT
1533INIT:
a3b811a7 1534 if (! SvOK(ST(1))) {
b13bbac7 1535 sigset = NULL;
a3b811a7 1536 } else if (sv_isa(ST(1), "POSIX::SigSet")) {
92b39396 1537 sigset = (sigset_t *) SvPV_nolen(SvRV(ST(1)));
b13bbac7
AB
1538 } else {
1539 croak("sigset is not of type POSIX::SigSet");
33c27489 1540 }
b13bbac7 1541
194cfca0 1542 if (items < 3 || ! SvOK(ST(2))) {
b13bbac7 1543 oldsigset = NULL;
a3b811a7 1544 } else if (sv_isa(ST(2), "POSIX::SigSet")) {
92b39396 1545 oldsigset = (sigset_t *) SvPV_nolen(SvRV(ST(2)));
b13bbac7
AB
1546 } else {
1547 croak("oldsigset is not of type POSIX::SigSet");
33c27489 1548 }
2304df62 1549
2304df62
AD
1550void
1551_exit(status)
1552 int status
8990e307 1553
85e6fe83 1554SysRet
8990e307
LW
1555close(fd)
1556 int fd
1557
85e6fe83 1558SysRet
8990e307
LW
1559dup(fd)
1560 int fd
1561
85e6fe83 1562SysRet
8990e307
LW
1563dup2(fd1, fd2)
1564 int fd1
1565 int fd2
1566
4a9d6100 1567SV *
a0d0e21e 1568lseek(fd, offset, whence)
85e6fe83
LW
1569 int fd
1570 Off_t offset
1571 int whence
4a9d6100
GS
1572 CODE:
1573 Off_t pos = PerlLIO_lseek(fd, offset, whence);
1574 RETVAL = sizeof(Off_t) > sizeof(IV)
1575 ? newSVnv((NV)pos) : newSViv((IV)pos);
1576 OUTPUT:
1577 RETVAL
8990e307 1578
c5661c80 1579void
8990e307
LW
1580nice(incr)
1581 int incr
15f0f28a
AE
1582 PPCODE:
1583 errno = 0;
1584 if ((incr = nice(incr)) != -1 || errno == 0) {
1585 if (incr == 0)
d3d34884 1586 XPUSHs(newSVpvs_flags("0 but true", SVs_TEMP));
15f0f28a
AE
1587 else
1588 XPUSHs(sv_2mortal(newSViv(incr)));
1589 }
8990e307 1590
8063af02 1591void
8990e307 1592pipe()
85e6fe83
LW
1593 PPCODE:
1594 int fds[2];
85e6fe83 1595 if (pipe(fds) != -1) {
924508f0 1596 EXTEND(SP,2);
85e6fe83
LW
1597 PUSHs(sv_2mortal(newSViv(fds[0])));
1598 PUSHs(sv_2mortal(newSViv(fds[1])));
1599 }
8990e307 1600
85e6fe83 1601SysRet
a0d0e21e 1602read(fd, buffer, nbytes)
7747499c
TB
1603 PREINIT:
1604 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1605 INPUT:
1606 int fd
1607 size_t nbytes
1608 char * buffer = sv_grow( sv_buffer, nbytes+1 );
a0d0e21e 1609 CLEANUP:
7747499c 1610 if (RETVAL >= 0) {
b162af07 1611 SvCUR_set(sv_buffer, RETVAL);
7747499c
TB
1612 SvPOK_only(sv_buffer);
1613 *SvEND(sv_buffer) = '\0';
bbce6d69 1614 SvTAINTED_on(sv_buffer);
7747499c 1615 }
8990e307 1616
85e6fe83 1617SysRet
8990e307 1618setpgid(pid, pgid)
86200d5c
JH
1619 pid_t pid
1620 pid_t pgid
8990e307 1621
86200d5c 1622pid_t
8990e307
LW
1623setsid()
1624
86200d5c 1625pid_t
8990e307
LW
1626tcgetpgrp(fd)
1627 int fd
1628
85e6fe83 1629SysRet
8990e307
LW
1630tcsetpgrp(fd, pgrp_id)
1631 int fd
86200d5c 1632 pid_t pgrp_id
8990e307 1633
8063af02 1634void
8990e307 1635uname()
2304df62 1636 PPCODE:
a0d0e21e 1637#ifdef HAS_UNAME
85e6fe83 1638 struct utsname buf;
85e6fe83 1639 if (uname(&buf) >= 0) {
924508f0 1640 EXTEND(SP, 5);
d3d34884
NC
1641 PUSHs(newSVpvn_flags(buf.sysname, strlen(buf.sysname), SVs_TEMP));
1642 PUSHs(newSVpvn_flags(buf.nodename, strlen(buf.nodename), SVs_TEMP));
1643 PUSHs(newSVpvn_flags(buf.release, strlen(buf.release), SVs_TEMP));
1644 PUSHs(newSVpvn_flags(buf.version, strlen(buf.version), SVs_TEMP));
1645 PUSHs(newSVpvn_flags(buf.machine, strlen(buf.machine), SVs_TEMP));
8990e307 1646 }
a0d0e21e
LW
1647#else
1648 uname((char *) 0); /* A stub to call not_here(). */
1649#endif
8990e307 1650
85e6fe83 1651SysRet
a0d0e21e
LW
1652write(fd, buffer, nbytes)
1653 int fd
1654 char * buffer
1655 size_t nbytes
1656
33f01dd1
SH
1657SV *
1658tmpnam()
1659 PREINIT:
1660 STRLEN i;
1661 int len;
1662 CODE:
1663 RETVAL = newSVpvn("", 0);
1664 SvGROW(RETVAL, L_tmpnam);
1665 len = strlen(tmpnam(SvPV(RETVAL, i)));
1666 SvCUR_set(RETVAL, len);
1667 OUTPUT:
1668 RETVAL
a0d0e21e
LW
1669
1670void
1671abort()
1672
1673int
1674mblen(s, n)
1675 char * s
1676 size_t n
1677
1678size_t
1679mbstowcs(s, pwcs, n)
1680 wchar_t * s
1681 char * pwcs
1682 size_t n
1683
1684int
1685mbtowc(pwc, s, n)
1686 wchar_t * pwc
1687 char * s
1688 size_t n
1689
1690int
1691wcstombs(s, pwcs, n)
1692 char * s
1693 wchar_t * pwcs
1694 size_t n
1695
1696int
1697wctomb(s, wchar)
1698 char * s
1699 wchar_t wchar
1700
1701int
1702strcoll(s1, s2)
1703 char * s1
1704 char * s2
1705
a89d8a78
DH
1706void
1707strtod(str)
1708 char * str
1709 PREINIT:
1710 double num;
1711 char *unparsed;
1712 PPCODE:
36477c24 1713 SET_NUMERIC_LOCAL();
a89d8a78
DH
1714 num = strtod(str, &unparsed);
1715 PUSHs(sv_2mortal(newSVnv(num)));
1716 if (GIMME == G_ARRAY) {
924508f0 1717 EXTEND(SP, 1);
a89d8a78
DH
1718 if (unparsed)
1719 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1720 else
6b88bc9c 1721 PUSHs(&PL_sv_undef);
a89d8a78
DH
1722 }
1723
1724void
1725strtol(str, base = 0)
1726 char * str
1727 int base
1728 PREINIT:
1729 long num;
1730 char *unparsed;
1731 PPCODE:
1732 num = strtol(str, &unparsed, base);
42718184
RB
1733#if IVSIZE <= LONGSIZE
1734 if (num < IV_MIN || num > IV_MAX)
a89d8a78 1735 PUSHs(sv_2mortal(newSVnv((double)num)));
42718184
RB
1736 else
1737#endif
1738 PUSHs(sv_2mortal(newSViv((IV)num)));
a89d8a78 1739 if (GIMME == G_ARRAY) {
924508f0 1740 EXTEND(SP, 1);
a89d8a78
DH
1741 if (unparsed)
1742 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1743 else
6b88bc9c 1744 PUSHs(&PL_sv_undef);
a89d8a78
DH
1745 }
1746
1747void
1748strtoul(str, base = 0)
4b48cf39 1749 const char * str
a89d8a78
DH
1750 int base
1751 PREINIT:
1752 unsigned long num;
1753 char *unparsed;
1754 PPCODE:
1755 num = strtoul(str, &unparsed, base);
84c133a0
RB
1756#if IVSIZE <= LONGSIZE
1757 if (num > IV_MAX)
a89d8a78 1758 PUSHs(sv_2mortal(newSVnv((double)num)));
84c133a0
RB
1759 else
1760#endif
1761 PUSHs(sv_2mortal(newSViv((IV)num)));
a89d8a78 1762 if (GIMME == G_ARRAY) {
924508f0 1763 EXTEND(SP, 1);
a89d8a78
DH
1764 if (unparsed)
1765 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1766 else
6b88bc9c 1767 PUSHs(&PL_sv_undef);
a89d8a78
DH
1768 }
1769
8063af02 1770void
a0d0e21e
LW
1771strxfrm(src)
1772 SV * src
85e6fe83 1773 CODE:
a0d0e21e
LW
1774 {
1775 STRLEN srclen;
1776 STRLEN dstlen;
1777 char *p = SvPV(src,srclen);
1778 srclen++;
561b68a9 1779 ST(0) = sv_2mortal(newSV(srclen*4+1));
a0d0e21e
LW
1780 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1781 if (dstlen > srclen) {
1782 dstlen++;
1783 SvGROW(ST(0), dstlen);
1784 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1785 dstlen--;
1786 }
b162af07 1787 SvCUR_set(ST(0), dstlen);
a0d0e21e
LW
1788 SvPOK_only(ST(0));
1789 }
1790
1791SysRet
1792mkfifo(filename, mode)
1793 char * filename
1794 Mode_t mode
748a9306
LW
1795 CODE:
1796 TAINT_PROPER("mkfifo");
1797 RETVAL = mkfifo(filename, mode);
1798 OUTPUT:
1799 RETVAL
a0d0e21e
LW
1800
1801SysRet
1802tcdrain(fd)
1803 int fd
1804
1805
1806SysRet
1807tcflow(fd, action)
1808 int fd
1809 int action
7a004119
NC
1810 ALIAS:
1811 tcflush = 1
1812 tcsendbreak = 2
1813 CODE:
1814 RETVAL = ix == 1 ? tcflush(fd, action)
1815 : (ix < 1 ? tcflow(fd, action) : tcsendbreak(fd, action));
1816 OUTPUT:
1817 RETVAL
a0d0e21e
LW
1818
1819char *
c1646883 1820asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
a0d0e21e
LW
1821 int sec
1822 int min
1823 int hour
1824 int mday
1825 int mon
1826 int year
1827 int wday
1828 int yday
1829 int isdst
1830 CODE:
1831 {
1832 struct tm mytm;
7747499c 1833 init_tm(&mytm); /* XXX workaround - see init_tm() above */
a0d0e21e
LW
1834 mytm.tm_sec = sec;
1835 mytm.tm_min = min;
1836 mytm.tm_hour = hour;
1837 mytm.tm_mday = mday;
1838 mytm.tm_mon = mon;
1839 mytm.tm_year = year;
1840 mytm.tm_wday = wday;
1841 mytm.tm_yday = yday;
1842 mytm.tm_isdst = isdst;
1843 RETVAL = asctime(&mytm);
1844 }
1845 OUTPUT:
1846 RETVAL
1847
1848long
1849clock()
1850
1851char *
1852ctime(time)
748a9306 1853 Time_t &time
8990e307 1854
37120919
AD
1855void
1856times()
1857 PPCODE:
1858 struct tms tms;
1859 clock_t realtime;
1860 realtime = times( &tms );
924508f0 1861 EXTEND(SP,5);
9607fc9c
PP
1862 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1863 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1864 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1865 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1866 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
37120919 1867
a0d0e21e
LW
1868double
1869difftime(time1, time2)
1870 Time_t time1
1871 Time_t time2
1872
1873SysRetLong
c1646883 1874mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
a0d0e21e
LW
1875 int sec
1876 int min
1877 int hour
1878 int mday
1879 int mon
1880 int year
1881 int wday
1882 int yday
1883 int isdst
1884 CODE:
1885 {
1886 struct tm mytm;
7747499c 1887 init_tm(&mytm); /* XXX workaround - see init_tm() above */
a0d0e21e
LW
1888 mytm.tm_sec = sec;
1889 mytm.tm_min = min;
1890 mytm.tm_hour = hour;
1891 mytm.tm_mday = mday;
1892 mytm.tm_mon = mon;
1893 mytm.tm_year = year;
1894 mytm.tm_wday = wday;
1895 mytm.tm_yday = yday;
1896 mytm.tm_isdst = isdst;
aebaba0b 1897 RETVAL = (SysRetLong) mktime(&mytm);
a0d0e21e 1898 }
85e6fe83
LW
1899 OUTPUT:
1900 RETVAL
a0d0e21e 1901
8063af02
DM
1902#XXX: if $xsubpp::WantOptimize is always the default
1903# sv_setpv(TARG, ...) could be used rather than
1904# ST(0) = sv_2mortal(newSVpv(...))
1905void
e44f695e 1906strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
dc57de01 1907 SV * fmt
a0d0e21e
LW
1908 int sec
1909 int min
1910 int hour
1911 int mday
1912 int mon
1913 int year
1914 int wday
1915 int yday
1916 int isdst
1917 CODE:
1918 {
dc57de01 1919 char *buf = my_strftime(SvPV_nolen(fmt), sec, min, hour, mday, mon, year, wday, yday, isdst);
2a74cb2d 1920 if (buf) {
8dbe7cf7
NC
1921 SV *const sv = sv_newmortal();
1922 sv_usepvn_flags(sv, buf, strlen(buf), SV_HAS_TRAILING_NUL);
1923 if (SvUTF8(fmt)) {
1924 SvUTF8_on(sv);
1925 }
1926 ST(0) = sv;
2a74cb2d 1927 }
a0d0e21e
LW
1928 }
1929
1930void
1931tzset()
81ab4c44
SH
1932 PPCODE:
1933 my_tzset(aTHX);
a0d0e21e
LW
1934
1935void
1936tzname()
1937 PPCODE:
924508f0 1938 EXTEND(SP,2);
d3d34884
NC
1939 PUSHs(newSVpvn_flags(tzname[0], strlen(tzname[0]), SVs_TEMP));
1940 PUSHs(newSVpvn_flags(tzname[1], strlen(tzname[1]), SVs_TEMP));
a0d0e21e
LW
1941
1942SysRet
1943access(filename, mode)
1944 char * filename
1945 Mode_t mode
1946
1947char *
1948ctermid(s = 0)
3ab23a19
RGS
1949 char * s = 0;
1950 CODE:
1951#ifdef HAS_CTERMID_R
e02b9112 1952 s = (char *) safemalloc((size_t) L_ctermid);
3ab23a19
RGS
1953#endif
1954 RETVAL = ctermid(s);
1955 OUTPUT:
1956 RETVAL
d1fd7089 1957 CLEANUP:
3ab23a19 1958#ifdef HAS_CTERMID_R
d1fd7089 1959 Safefree(s);
3ab23a19 1960#endif
a0d0e21e
LW
1961
1962char *
1963cuserid(s = 0)
1964 char * s = 0;
56f4542c
TJ
1965 CODE:
1966#ifdef HAS_CUSERID
1967 RETVAL = cuserid(s);
1968#else
1969 RETVAL = 0;
1970 not_here("cuserid");
1971#endif
1972 OUTPUT:
1973 RETVAL
a0d0e21e
LW
1974
1975SysRetLong
1976fpathconf(fd, name)
1977 int fd
1978 int name
1979
1980SysRetLong
1981pathconf(filename, name)
1982 char * filename
1983 int name
1984
1985SysRet
1986pause()
1987
a043a685
GW
1988SysRet
1989setgid(gid)
1990 Gid_t gid
13ec70af 1991 CLEANUP:
e9df3e1a 1992#ifndef WIN32
13ec70af
RGS
1993 if (RETVAL >= 0) {
1994 PL_gid = getgid();
1995 PL_egid = getegid();
1996 }
e9df3e1a 1997#endif
a043a685
GW
1998
1999SysRet
2000setuid(uid)
2001 Uid_t uid
13ec70af 2002 CLEANUP:
e9df3e1a 2003#ifndef WIN32
13ec70af
RGS
2004 if (RETVAL >= 0) {
2005 PL_uid = getuid();
2006 PL_euid = geteuid();
2007 }
e9df3e1a 2008#endif
a043a685 2009
a0d0e21e
LW
2010SysRetLong
2011sysconf(name)
2012 int name
2013
2014char *
2015ttyname(fd)
2016 int fd
a043a685 2017
c6c619a9 2018void
b5846a0b 2019getcwd()
8f95b30d
JH
2020 PPCODE:
2021 {
2022 dXSTARG;
89423764 2023 getcwd_sv(TARG);
8f95b30d
JH
2024 XSprePUSH; PUSHTARG;
2025 }
2026
0d7021f5
RGS
2027SysRet
2028lchown(uid, gid, path)
2029 Uid_t uid
2030 Gid_t gid
2031 char * path
2032 CODE:
2033#ifdef HAS_LCHOWN
2034 /* yes, the order of arguments is different,
2035 * but consistent with CORE::chown() */
2036 RETVAL = lchown(path, uid, gid);
2037#else
2038 RETVAL = not_here("lchown");
2039#endif
2040 OUTPUT:
2041 RETVAL