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