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