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
11 #include <sys/utsname.h>
14 #define PERL_NO_GET_CONTEXT
17 #define PERLIO_NOT_STDIO 1
20 #if defined(PERL_IMPLICIT_SYS)
24 # define open PerlLIO_open3
27 #ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */
54 /* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
55 metaconfig for future extension writers. We don't use them in POSIX.
56 (This is really sneaky :-) --AD
58 #if defined(I_TERMIOS)
68 #include <sys/types.h>
76 # if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__)
77 extern char *tzname[];
80 #if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname))
81 char *tzname[] = { "" , "" };
85 #ifndef PERL_UNUSED_DECL
87 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
88 # define PERL_UNUSED_DECL
90 # define PERL_UNUSED_DECL __attribute__((unused))
93 # define PERL_UNUSED_DECL
98 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL
105 #if defined(__VMS) && !defined(__POSIX_SOURCE)
106 # include <libdef.h> /* LIB$_INVARG constant */
107 # include <lib$routines.h> /* prototype for lib$ediv() */
108 # include <starlet.h> /* prototype for sys$gettim() */
109 # if DECC_VERSION < 50000000
110 # define pid_t int /* old versions of DECC miss this in types.h */
114 # define mkfifo(a,b) (not_here("mkfifo"),-1)
115 # define tzset() not_here("tzset")
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>
120 # endif /* __VMS_VER >= 70000000 or Dec C 5.6 */
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)
126 /* The non-POSIX CRTL times() has void return type, so we just get the
127 current time directly */
128 clock_t vms_times(struct tms *bufptr) {
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)
136 _ckvmssts(sys$gettim(&vmstime));
138 retval = vmstime & 0x7fffffff;
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));
148 /* Fill in the struct tms using the CRTL routine . . .*/
149 times((tbuffer_t *)bufptr);
150 return (clock_t) retval;
152 # define times(t) vms_times(t)
154 #if defined (__CYGWIN__)
155 # define tzname _tzname
157 #if defined (WIN32) || defined (NETWARE)
159 # define mkfifo(a,b) not_here("mkfifo")
160 # define ttyname(a) (char*)not_here("ttyname")
161 # define sigset_t long
164 # define tzname _tzname
167 # define mode_t short
170 # define mode_t short
172 # define tzset() not_here("tzset")
174 # ifndef _POSIX_OPEN_MAX
175 # define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */
178 # define sigaction(a,b,c) not_here("sigaction")
179 # define sigpending(a) not_here("sigpending")
180 # define sigprocmask(a,b,c) not_here("sigprocmask")
181 # define sigsuspend(a) not_here("sigsuspend")
182 # define sigemptyset(a) not_here("sigemptyset")
183 # define sigaddset(a,b) not_here("sigaddset")
184 # define sigdelset(a,b) not_here("sigdelset")
185 # define sigfillset(a) not_here("sigfillset")
186 # define sigismember(a,b) not_here("sigismember")
190 # define setuid(a) not_here("setuid")
191 # define setgid(a) not_here("setgid")
197 # define mkfifo(a,b) not_here("mkfifo")
198 # else /* !( defined OS2 ) */
200 # define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
203 # endif /* !HAS_MKFIFO */
208 # include <sys/times.h>
210 # include <sys/utsname.h>
212 # include <sys/wait.h>
216 #endif /* WIN32 || NETWARE */
220 typedef long SysRetLong;
221 typedef sigset_t* POSIX__SigSet;
222 typedef HV* POSIX__SigAction;
224 typedef struct termios* POSIX__Termios;
225 #else /* Define termios types to int, and call not_here for the functions.*/
226 #define POSIX__Termios int
230 #define cfgetispeed(x) not_here("cfgetispeed")
231 #define cfgetospeed(x) not_here("cfgetospeed")
232 #define tcdrain(x) not_here("tcdrain")
233 #define tcflush(x,y) not_here("tcflush")
234 #define tcsendbreak(x,y) not_here("tcsendbreak")
235 #define cfsetispeed(x,y) not_here("cfsetispeed")
236 #define cfsetospeed(x,y) not_here("cfsetospeed")
237 #define ctermid(x) (char *) not_here("ctermid")
238 #define tcflow(x,y) not_here("tcflow")
239 #define tcgetattr(x,y) not_here("tcgetattr")
240 #define tcsetattr(x,y,z) not_here("tcsetattr")
243 /* Possibly needed prototypes */
245 double strtod (const char *, char **);
246 long strtol (const char *, char **, int);
247 unsigned long strtoul (const char *, char **, int);
252 #define difftime(a,b) not_here("difftime")
255 #ifndef HAS_FPATHCONF
256 #define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
259 #define mktime(a) not_here("mktime")
262 #define nice(a) not_here("nice")
265 #define pathconf(f,n) (SysRetLong) not_here("pathconf")
268 #define sysconf(n) (SysRetLong) not_here("sysconf")
271 #define readlink(a,b,c) not_here("readlink")
274 #define setpgid(a,b) not_here("setpgid")
277 #define setsid() not_here("setsid")
280 #define strcoll(s1,s2) not_here("strcoll")
283 #define strtod(s1,s2) not_here("strtod")
286 #define strtol(s1,s2,b) not_here("strtol")
289 #define strtoul(s1,s2,b) not_here("strtoul")
292 #define strxfrm(s1,s2,n) not_here("strxfrm")
294 #ifndef HAS_TCGETPGRP
295 #define tcgetpgrp(a) not_here("tcgetpgrp")
297 #ifndef HAS_TCSETPGRP
298 #define tcsetpgrp(a,b) not_here("tcsetpgrp")
302 #define times(a) not_here("times")
306 #define uname(a) not_here("uname")
309 #define waitpid(a,b,c) not_here("waitpid")
314 #define mblen(a,b) not_here("mblen")
318 #define mbstowcs(s, pwcs, n) not_here("mbstowcs")
321 #define mbtowc(pwc, s, n) not_here("mbtowc")
324 #define wcstombs(s, pwcs, n) not_here("wcstombs")
327 #define wctomb(s, wchar) not_here("wcstombs")
329 #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
330 /* If we don't have these functions, then we wouldn't have gotten a typedef
331 for wchar_t, the wide character type. Defining wchar_t allows the
332 functions referencing it to compile. Its actual type is then meaningless,
333 since without the above functions, all sections using it end up calling
334 not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
340 #ifndef HAS_LOCALECONV
341 #define localeconv() not_here("localeconv")
344 #ifdef HAS_LONG_DOUBLE
345 # if LONG_DOUBLESIZE > NVSIZE
346 # undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
350 #ifndef HAS_LONG_DOUBLE
362 /* Background: in most systems the low byte of the wait status
363 * is the signal (the lowest 7 bits) and the coredump flag is
364 * the eight bit, and the second lowest byte is the exit status.
365 * BeOS bucks the trend and has the bytes in different order.
366 * See beos/beos.c for how the reality is bent even in BeOS
367 * to follow the traditional. However, to make the POSIX
368 * wait W*() macros to work in BeOS, we need to unbend the
369 * reality back in place. --jhi */
370 /* In actual fact the code below is to blame here. Perl has an internal
371 * representation of the exit status ($?), which it re-composes from the
372 * OS's representation using the W*() POSIX macros. The code below
373 * incorrectly uses the W*() macros on the internal representation,
374 * which fails for OSs that have a different representation (namely BeOS
375 * and Haiku). WMUNGE() is a hack that converts the internal
376 * representation into the OS specific one, so that the W*() macros work
377 * as expected. The better solution would be not to use the W*() macros
378 * in the first place, though. -- Ingo Weinhold
380 #if defined(__BEOS__) || defined(__HAIKU__)
381 # define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
383 # define WMUNGE(x) (x)
387 not_here(const char *s)
389 croak("POSIX::%s not implemented on this architecture", s);
393 #include "const-c.inc"
396 restore_sigmask(pTHX_ SV *osset_sv)
398 /* Fortunately, restoring the signal mask can't fail, because
399 * there's nothing we can do about it if it does -- we're not
400 * supposed to return -1 from sigaction unless the disposition
403 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
404 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
410 * (1) The CRT maintains its own copy of the environment, separate from
413 * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
414 * copy, and then calls SetEnvironmentVariableA() to update the Win32API
417 * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
418 * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
421 * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
422 * calls CRT tzset(), but only the first time it is called, and in turn
423 * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
424 * local copy of the environment and hence gets the original setting as
425 * perl never updates the CRT copy when assigning to $ENV{TZ}.
427 * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
428 * putenv() to update the CRT copy of the environment (if it is different)
429 * whenever we're about to call tzset().
431 * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
434 * (a) Each interpreter has its own copy of the environment inside the
435 * perlhost structure. That allows applications that host multiple
436 * independent Perl interpreters to isolate environment changes from
437 * each other. (This is similar to how the perlhost mechanism keeps a
438 * separate working directory for each Perl interpreter, so that calling
439 * chdir() will not affect other interpreters.)
441 * (b) Only the first Perl interpreter instantiated within a process will
442 * "write through" environment changes to the process environment.
444 * (c) Even the primary Perl interpreter won't update the CRT copy of the
445 * the environment, only the Win32API copy (it calls win32_putenv()).
447 * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
448 * sense to only update the process environment when inside the main
449 * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
450 * from here so we'll just have to check PL_curinterp instead.
452 * Therefore, we can simply #undef getenv() and putenv() so that those names
453 * always refer to the CRT functions, and explicitly call win32_getenv() to
454 * access perl's %ENV.
456 * We also #undef malloc() and free() to be sure we are using the CRT
457 * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
458 * into VMem::Malloc() and VMem::Free() and all allocations will be freed
459 * when the Perl interpreter is being destroyed so we'd end up with a pointer
460 * into deallocated memory in environ[] if a program embedding a Perl
461 * interpreter continues to operate even after the main Perl interpreter has
464 * Note that we don't free() the malloc()ed memory unless and until we call
465 * malloc() again ourselves because the CRT putenv() function simply puts its
466 * pointer argument into the environ[] arrary (it doesn't make a copy of it)
467 * so this memory must otherwise be leaked.
476 fix_win32_tzenv(void)
478 static char* oldenv = NULL;
480 const char* perl_tz_env = win32_getenv("TZ");
481 const char* crt_tz_env = getenv("TZ");
482 if (perl_tz_env == NULL)
484 if (crt_tz_env == NULL)
486 if (strcmp(perl_tz_env, crt_tz_env) != 0) {
487 newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
488 if (newenv != NULL) {
489 sprintf(newenv, "TZ=%s", perl_tz_env);
501 * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
502 * This code is duplicated in the Time-Piece module, so any changes made here
503 * should be made there too.
509 #if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
510 if (PL_curinterp == aTHX)
517 MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
520 new(packname = "POSIX::SigSet", ...)
521 const char * packname
525 Newx(RETVAL, 1, sigset_t);
527 for (i = 1; i < items; i++)
528 sigaddset(RETVAL, SvIV(ST(i)));
540 sigaddset(sigset, sig)
545 sigdelset(sigset, sig)
558 sigismember(sigset, sig)
562 MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
565 new(packname = "POSIX::Termios", ...)
566 const char * packname
570 Newx(RETVAL, 1, struct termios);
581 POSIX::Termios termios_ref
584 Safefree(termios_ref);
590 getattr(termios_ref, fd = 0)
591 POSIX::Termios termios_ref
594 RETVAL = tcgetattr(fd, termios_ref);
599 setattr(termios_ref, fd = 0, optional_actions = 0)
600 POSIX::Termios termios_ref
604 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
609 cfgetispeed(termios_ref)
610 POSIX::Termios termios_ref
613 cfgetospeed(termios_ref)
614 POSIX::Termios termios_ref
617 getiflag(termios_ref)
618 POSIX::Termios termios_ref
620 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
621 RETVAL = termios_ref->c_iflag;
623 not_here("getiflag");
630 getoflag(termios_ref)
631 POSIX::Termios termios_ref
633 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
634 RETVAL = termios_ref->c_oflag;
636 not_here("getoflag");
643 getcflag(termios_ref)
644 POSIX::Termios termios_ref
646 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
647 RETVAL = termios_ref->c_cflag;
649 not_here("getcflag");
656 getlflag(termios_ref)
657 POSIX::Termios termios_ref
659 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
660 RETVAL = termios_ref->c_lflag;
662 not_here("getlflag");
669 getcc(termios_ref, ccix)
670 POSIX::Termios termios_ref
673 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
675 croak("Bad getcc subscript");
676 RETVAL = termios_ref->c_cc[ccix];
685 cfsetispeed(termios_ref, speed)
686 POSIX::Termios termios_ref
690 cfsetospeed(termios_ref, speed)
691 POSIX::Termios termios_ref
695 setiflag(termios_ref, iflag)
696 POSIX::Termios termios_ref
699 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
700 termios_ref->c_iflag = iflag;
702 not_here("setiflag");
706 setoflag(termios_ref, oflag)
707 POSIX::Termios termios_ref
710 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
711 termios_ref->c_oflag = oflag;
713 not_here("setoflag");
717 setcflag(termios_ref, cflag)
718 POSIX::Termios termios_ref
721 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
722 termios_ref->c_cflag = cflag;
724 not_here("setcflag");
728 setlflag(termios_ref, lflag)
729 POSIX::Termios termios_ref
732 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
733 termios_ref->c_lflag = lflag;
735 not_here("setlflag");
739 setcc(termios_ref, ccix, cc)
740 POSIX::Termios termios_ref
744 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
746 croak("Bad setcc subscript");
747 termios_ref->c_cc[ccix] = cc;
753 MODULE = POSIX PACKAGE = POSIX
755 INCLUDE: const-xs.inc
762 POSIX::WIFSIGNALED = 2
763 POSIX::WIFSTOPPED = 3
767 #if !(defined(WEXITSTATUS) || defined(WIFEXITED) || defined(WIFSIGNALED) \
768 || defined(WIFSTOPPED) || defined(WSTOPSIG) || defined (WTERMSIG))
769 RETVAL = 0; /* Silence compilers that notice this, but don't realise
770 that not_here() can't return. */
775 RETVAL = WEXITSTATUS(WMUNGE(status));
777 not_here("WEXITSTATUS");
782 RETVAL = WIFEXITED(WMUNGE(status));
784 not_here("WIFEXITED");
789 RETVAL = WIFSIGNALED(WMUNGE(status));
791 not_here("WIFSIGNALED");
796 RETVAL = WIFSTOPPED(WMUNGE(status));
798 not_here("WIFSTOPPED");
803 RETVAL = WSTOPSIG(WMUNGE(status));
805 not_here("WSTOPSIG");
810 RETVAL = WTERMSIG(WMUNGE(status));
812 not_here("WTERMSIG");
816 Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", ix);
827 unsigned char *s = (unsigned char *) SvPV(charstring, len);
828 unsigned char *e = s + len;
829 for (RETVAL = 1; RETVAL && s < e; s++)
841 unsigned char *s = (unsigned char *) SvPV(charstring, len);
842 unsigned char *e = s + len;
843 for (RETVAL = 1; RETVAL && s < e; s++)
855 unsigned char *s = (unsigned char *) SvPV(charstring, len);
856 unsigned char *e = s + len;
857 for (RETVAL = 1; RETVAL && s < e; s++)
869 unsigned char *s = (unsigned char *) SvPV(charstring, len);
870 unsigned char *e = s + len;
871 for (RETVAL = 1; RETVAL && s < e; s++)
883 unsigned char *s = (unsigned char *) SvPV(charstring, len);
884 unsigned char *e = s + len;
885 for (RETVAL = 1; RETVAL && s < e; s++)
897 unsigned char *s = (unsigned char *) SvPV(charstring, len);
898 unsigned char *e = s + len;
899 for (RETVAL = 1; RETVAL && s < e; s++)
911 unsigned char *s = (unsigned char *) SvPV(charstring, len);
912 unsigned char *e = s + len;
913 for (RETVAL = 1; RETVAL && s < e; s++)
925 unsigned char *s = (unsigned char *) SvPV(charstring, len);
926 unsigned char *e = s + len;
927 for (RETVAL = 1; RETVAL && s < e; s++)
939 unsigned char *s = (unsigned char *) SvPV(charstring, len);
940 unsigned char *e = s + len;
941 for (RETVAL = 1; RETVAL && s < e; s++)
953 unsigned char *s = (unsigned char *) SvPV(charstring, len);
954 unsigned char *e = s + len;
955 for (RETVAL = 1; RETVAL && s < e; s++)
967 unsigned char *s = (unsigned char *) SvPV(charstring, len);
968 unsigned char *e = s + len;
969 for (RETVAL = 1; RETVAL && s < e; s++)
976 open(filename, flags = O_RDONLY, mode = 0666)
981 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
982 TAINT_PROPER("open");
983 RETVAL = open(filename, flags, mode);
991 #ifdef HAS_LOCALECONV
994 sv_2mortal((SV*)RETVAL);
995 if ((lcbuf = localeconv())) {
997 if (lcbuf->decimal_point && *lcbuf->decimal_point)
998 hv_store(RETVAL, "decimal_point", 13,
999 newSVpv(lcbuf->decimal_point, 0), 0);
1000 if (lcbuf->thousands_sep && *lcbuf->thousands_sep)
1001 hv_store(RETVAL, "thousands_sep", 13,
1002 newSVpv(lcbuf->thousands_sep, 0), 0);
1003 #ifndef NO_LOCALECONV_GROUPING
1004 if (lcbuf->grouping && *lcbuf->grouping)
1005 hv_store(RETVAL, "grouping", 8,
1006 newSVpv(lcbuf->grouping, 0), 0);
1008 if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol)
1009 hv_store(RETVAL, "int_curr_symbol", 15,
1010 newSVpv(lcbuf->int_curr_symbol, 0), 0);
1011 if (lcbuf->currency_symbol && *lcbuf->currency_symbol)
1012 hv_store(RETVAL, "currency_symbol", 15,
1013 newSVpv(lcbuf->currency_symbol, 0), 0);
1014 if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
1015 hv_store(RETVAL, "mon_decimal_point", 17,
1016 newSVpv(lcbuf->mon_decimal_point, 0), 0);
1017 #ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
1018 if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
1019 hv_store(RETVAL, "mon_thousands_sep", 17,
1020 newSVpv(lcbuf->mon_thousands_sep, 0), 0);
1022 #ifndef NO_LOCALECONV_MON_GROUPING
1023 if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
1024 hv_store(RETVAL, "mon_grouping", 12,
1025 newSVpv(lcbuf->mon_grouping, 0), 0);
1027 if (lcbuf->positive_sign && *lcbuf->positive_sign)
1028 hv_store(RETVAL, "positive_sign", 13,
1029 newSVpv(lcbuf->positive_sign, 0), 0);
1030 if (lcbuf->negative_sign && *lcbuf->negative_sign)
1031 hv_store(RETVAL, "negative_sign", 13,
1032 newSVpv(lcbuf->negative_sign, 0), 0);
1034 if (lcbuf->int_frac_digits != CHAR_MAX)
1035 hv_store(RETVAL, "int_frac_digits", 15,
1036 newSViv(lcbuf->int_frac_digits), 0);
1037 if (lcbuf->frac_digits != CHAR_MAX)
1038 hv_store(RETVAL, "frac_digits", 11,
1039 newSViv(lcbuf->frac_digits), 0);
1040 if (lcbuf->p_cs_precedes != CHAR_MAX)
1041 hv_store(RETVAL, "p_cs_precedes", 13,
1042 newSViv(lcbuf->p_cs_precedes), 0);
1043 if (lcbuf->p_sep_by_space != CHAR_MAX)
1044 hv_store(RETVAL, "p_sep_by_space", 14,
1045 newSViv(lcbuf->p_sep_by_space), 0);
1046 if (lcbuf->n_cs_precedes != CHAR_MAX)
1047 hv_store(RETVAL, "n_cs_precedes", 13,
1048 newSViv(lcbuf->n_cs_precedes), 0);
1049 if (lcbuf->n_sep_by_space != CHAR_MAX)
1050 hv_store(RETVAL, "n_sep_by_space", 14,
1051 newSViv(lcbuf->n_sep_by_space), 0);
1052 if (lcbuf->p_sign_posn != CHAR_MAX)
1053 hv_store(RETVAL, "p_sign_posn", 11,
1054 newSViv(lcbuf->p_sign_posn), 0);
1055 if (lcbuf->n_sign_posn != CHAR_MAX)
1056 hv_store(RETVAL, "n_sign_posn", 11,
1057 newSViv(lcbuf->n_sign_posn), 0);
1060 localeconv(); /* A stub to call not_here(). */
1066 setlocale(category, locale = 0)
1072 retval = setlocale(category, locale);
1074 /* Save retval since subsequent setlocale() calls
1075 * may overwrite it. */
1076 RETVAL = savepv(retval);
1077 #ifdef USE_LOCALE_CTYPE
1078 if (category == LC_CTYPE
1080 || category == LC_ALL
1086 if (category == LC_ALL)
1087 newctype = setlocale(LC_CTYPE, NULL);
1091 new_ctype(newctype);
1093 #endif /* USE_LOCALE_CTYPE */
1094 #ifdef USE_LOCALE_COLLATE
1095 if (category == LC_COLLATE
1097 || category == LC_ALL
1103 if (category == LC_ALL)
1104 newcoll = setlocale(LC_COLLATE, NULL);
1108 new_collate(newcoll);
1110 #endif /* USE_LOCALE_COLLATE */
1111 #ifdef USE_LOCALE_NUMERIC
1112 if (category == LC_NUMERIC
1114 || category == LC_ALL
1120 if (category == LC_ALL)
1121 newnum = setlocale(LC_NUMERIC, NULL);
1125 new_numeric(newnum);
1127 #endif /* USE_LOCALE_NUMERIC */
1171 /* (We already know stack is long enough.) */
1172 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1173 PUSHs(sv_2mortal(newSViv(expvar)));
1189 /* (We already know stack is long enough.) */
1190 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
1191 PUSHs(sv_2mortal(newSVnv(intvar)));
1206 sigaction(sig, optaction, oldaction = 0)
1209 POSIX::SigAction oldaction
1211 #if defined(WIN32) || defined(NETWARE)
1212 RETVAL = not_here("sigaction");
1214 # This code is really grody because we're trying to make the signal
1215 # interface look beautiful, which is hard.
1219 POSIX__SigAction action;
1220 GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
1221 struct sigaction act;
1222 struct sigaction oact;
1226 POSIX__SigSet sigset;
1231 croak("Negative signals are not allowed");
1234 if (sig == 0 && SvPOK(ST(0))) {
1235 const char *s = SvPVX_const(ST(0));
1236 int i = whichsig(s);
1238 if (i < 0 && memEQ(s, "SIG", 3))
1239 i = whichsig(s + 3);
1241 if (ckWARN(WARN_SIGNAL))
1242 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1243 "No such signal: SIG%s", s);
1250 if (sig > NSIG) { /* NSIG - 1 is still okay. */
1251 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1252 "No such signal: %d", sig);
1256 sigsvp = hv_fetch(GvHVn(siggv),
1258 strlen(PL_sig_name[sig]),
1261 /* Check optaction and set action */
1262 if(SvTRUE(optaction)) {
1263 if(sv_isa(optaction, "POSIX::SigAction"))
1264 action = (HV*)SvRV(optaction);
1266 croak("action is not of type POSIX::SigAction");
1272 /* sigaction() is supposed to look atomic. In particular, any
1273 * signal handler invoked during a sigaction() call should
1274 * see either the old or the new disposition, and not something
1275 * in between. We use sigprocmask() to make it so.
1278 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1282 /* Restore signal mask no matter how we exit this block. */
1283 osset_sv = newSVpv((char *)(&osset), sizeof(sigset_t));
1284 SAVEFREESV( osset_sv );
1285 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1287 RETVAL=-1; /* In case both oldaction and action are 0. */
1289 /* Remember old disposition if desired. */
1291 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
1293 croak("Can't supply an oldaction without a HANDLER");
1294 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1295 sv_setsv(*svp, *sigsvp);
1298 sv_setpv(*svp, "DEFAULT");
1300 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
1303 /* Get back the mask. */
1304 svp = hv_fetchs(oldaction, "MASK", TRUE);
1305 if (sv_isa(*svp, "POSIX::SigSet")) {
1306 IV tmp = SvIV((SV*)SvRV(*svp));
1307 sigset = INT2PTR(sigset_t*, tmp);
1310 Newx(sigset, 1, sigset_t);
1311 sv_setptrobj(*svp, sigset, "POSIX::SigSet");
1313 *sigset = oact.sa_mask;
1315 /* Get back the flags. */
1316 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
1317 sv_setiv(*svp, oact.sa_flags);
1319 /* Get back whether the old handler used safe signals. */
1320 svp = hv_fetchs(oldaction, "SAFE", TRUE);
1322 /* compare incompatible pointers by casting to integer */
1323 PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
1327 /* Safe signals use "csighandler", which vectors through the
1328 PL_sighandlerp pointer when it's safe to do so.
1329 (BTW, "csighandler" is very different from "sighandler".) */
1330 svp = hv_fetchs(action, "SAFE", FALSE);
1334 (*svp && SvTRUE(*svp))
1335 ? PL_csighandlerp : PL_sighandlerp
1338 /* Vector new Perl handler through %SIG.
1339 (The core signal handlers read %SIG to dispatch.) */
1340 svp = hv_fetchs(action, "HANDLER", FALSE);
1342 croak("Can't supply an action without a HANDLER");
1343 sv_setsv(*sigsvp, *svp);
1345 /* This call actually calls sigaction() with almost the
1346 right settings, including appropriate interpretation
1347 of DEFAULT and IGNORE. However, why are we doing
1348 this when we're about to do it again just below? XXX */
1351 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1353 const char *s=SvPVX_const(*svp);
1354 if(strEQ(s,"IGNORE")) {
1355 act.sa_handler = SIG_IGN;
1357 else if(strEQ(s,"DEFAULT")) {
1358 act.sa_handler = SIG_DFL;
1362 /* Set up any desired mask. */
1363 svp = hv_fetchs(action, "MASK", FALSE);
1364 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
1365 IV tmp = SvIV((SV*)SvRV(*svp));
1366 sigset = INT2PTR(sigset_t*, tmp);
1367 act.sa_mask = *sigset;
1370 sigemptyset(& act.sa_mask);
1372 /* Set up any desired flags. */
1373 svp = hv_fetchs(action, "FLAGS", FALSE);
1374 act.sa_flags = svp ? SvIV(*svp) : 0;
1376 /* Don't worry about cleaning up *sigsvp if this fails,
1377 * because that means we tried to disposition a
1378 * nonblockable signal, in which case *sigsvp is
1379 * essentially meaningless anyway.
1381 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
1394 POSIX::SigSet sigset
1397 sigprocmask(how, sigset, oldsigset = 0)
1399 POSIX::SigSet sigset = NO_INIT
1400 POSIX::SigSet oldsigset = NO_INIT
1402 if (! SvOK(ST(1))) {
1404 } else if (sv_isa(ST(1), "POSIX::SigSet")) {
1405 IV tmp = SvIV((SV*)SvRV(ST(1)));
1406 sigset = INT2PTR(POSIX__SigSet,tmp);
1408 croak("sigset is not of type POSIX::SigSet");
1411 if (items < 3 || ! SvOK(ST(2))) {
1413 } else if (sv_isa(ST(2), "POSIX::SigSet")) {
1414 IV tmp = SvIV((SV*)SvRV(ST(2)));
1415 oldsigset = INT2PTR(POSIX__SigSet,tmp);
1417 croak("oldsigset is not of type POSIX::SigSet");
1421 sigsuspend(signal_mask)
1422 POSIX::SigSet signal_mask
1442 lseek(fd, offset, whence)
1447 Off_t pos = PerlLIO_lseek(fd, offset, whence);
1448 RETVAL = sizeof(Off_t) > sizeof(IV)
1449 ? newSVnv((NV)pos) : newSViv((IV)pos);
1458 if ((incr = nice(incr)) != -1 || errno == 0) {
1460 XPUSHs(sv_2mortal(newSVpvn("0 but true", 10)));
1462 XPUSHs(sv_2mortal(newSViv(incr)));
1469 if (pipe(fds) != -1) {
1471 PUSHs(sv_2mortal(newSViv(fds[0])));
1472 PUSHs(sv_2mortal(newSViv(fds[1])));
1476 read(fd, buffer, nbytes)
1478 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1482 char * buffer = sv_grow( sv_buffer, nbytes+1 );
1485 SvCUR_set(sv_buffer, RETVAL);
1486 SvPOK_only(sv_buffer);
1487 *SvEND(sv_buffer) = '\0';
1488 SvTAINTED_on(sv_buffer);
1504 tcsetpgrp(fd, pgrp_id)
1513 if (uname(&buf) >= 0) {
1515 PUSHs(sv_2mortal(newSVpv(buf.sysname, 0)));
1516 PUSHs(sv_2mortal(newSVpv(buf.nodename, 0)));
1517 PUSHs(sv_2mortal(newSVpv(buf.release, 0)));
1518 PUSHs(sv_2mortal(newSVpv(buf.version, 0)));
1519 PUSHs(sv_2mortal(newSVpv(buf.machine, 0)));
1522 uname((char *) 0); /* A stub to call not_here(). */
1526 write(fd, buffer, nbytes)
1537 RETVAL = newSVpvn("", 0);
1538 SvGROW(RETVAL, L_tmpnam);
1539 len = strlen(tmpnam(SvPV(RETVAL, i)));
1540 SvCUR_set(RETVAL, len);
1553 mbstowcs(s, pwcs, n)
1565 wcstombs(s, pwcs, n)
1587 SET_NUMERIC_LOCAL();
1588 num = strtod(str, &unparsed);
1589 PUSHs(sv_2mortal(newSVnv(num)));
1590 if (GIMME == G_ARRAY) {
1593 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1595 PUSHs(&PL_sv_undef);
1599 strtol(str, base = 0)
1606 num = strtol(str, &unparsed, base);
1607 #if IVSIZE <= LONGSIZE
1608 if (num < IV_MIN || num > IV_MAX)
1609 PUSHs(sv_2mortal(newSVnv((double)num)));
1612 PUSHs(sv_2mortal(newSViv((IV)num)));
1613 if (GIMME == G_ARRAY) {
1616 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1618 PUSHs(&PL_sv_undef);
1622 strtoul(str, base = 0)
1629 num = strtoul(str, &unparsed, base);
1630 #if IVSIZE <= LONGSIZE
1632 PUSHs(sv_2mortal(newSVnv((double)num)));
1635 PUSHs(sv_2mortal(newSViv((IV)num)));
1636 if (GIMME == G_ARRAY) {
1639 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1641 PUSHs(&PL_sv_undef);
1651 char *p = SvPV(src,srclen);
1653 ST(0) = sv_2mortal(newSV(srclen*4+1));
1654 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1655 if (dstlen > srclen) {
1657 SvGROW(ST(0), dstlen);
1658 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1661 SvCUR_set(ST(0), dstlen);
1666 mkfifo(filename, mode)
1670 TAINT_PROPER("mkfifo");
1671 RETVAL = mkfifo(filename, mode);
1687 tcflush(fd, queue_selector)
1692 tcsendbreak(fd, duration)
1697 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
1710 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1713 mytm.tm_hour = hour;
1714 mytm.tm_mday = mday;
1716 mytm.tm_year = year;
1717 mytm.tm_wday = wday;
1718 mytm.tm_yday = yday;
1719 mytm.tm_isdst = isdst;
1720 RETVAL = asctime(&mytm);
1737 realtime = times( &tms );
1739 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1740 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1741 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1742 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1743 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
1746 difftime(time1, time2)
1751 mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
1764 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1767 mytm.tm_hour = hour;
1768 mytm.tm_mday = mday;
1770 mytm.tm_year = year;
1771 mytm.tm_wday = wday;
1772 mytm.tm_yday = yday;
1773 mytm.tm_isdst = isdst;
1774 RETVAL = (SysRetLong) mktime(&mytm);
1779 #XXX: if $xsubpp::WantOptimize is always the default
1780 # sv_setpv(TARG, ...) could be used rather than
1781 # ST(0) = sv_2mortal(newSVpv(...))
1783 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
1796 char *buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst);
1798 ST(0) = sv_2mortal(newSVpv(buf, 0));
1812 PUSHs(sv_2mortal(newSVpvn(tzname[0],strlen(tzname[0]))));
1813 PUSHs(sv_2mortal(newSVpvn(tzname[1],strlen(tzname[1]))));
1816 access(filename, mode)
1824 #ifdef HAS_CTERMID_R
1825 s = (char *) safemalloc((size_t) L_ctermid);
1827 RETVAL = ctermid(s);
1831 #ifdef HAS_CTERMID_R
1840 RETVAL = cuserid(s);
1843 not_here("cuserid");
1854 pathconf(filename, name)
1868 PL_egid = getegid();
1879 PL_euid = geteuid();
1897 XSprePUSH; PUSHTARG;
1901 lchown(uid, gid, path)
1907 /* yes, the order of arguments is different,
1908 * but consistent with CORE::chown() */
1909 RETVAL = lchown(path, uid, gid);
1911 RETVAL = not_here("lchown");