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 */
244 char *cuserid (char *);
246 double strtod (const char *, char **);
247 long strtol (const char *, char **, int);
248 unsigned long strtoul (const char *, char **, int);
252 #define cuserid(a) (char *) not_here("cuserid")
256 #define difftime(a,b) not_here("difftime")
259 #ifndef HAS_FPATHCONF
260 #define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
263 #define mktime(a) not_here("mktime")
266 #define nice(a) not_here("nice")
269 #define pathconf(f,n) (SysRetLong) not_here("pathconf")
272 #define sysconf(n) (SysRetLong) not_here("sysconf")
275 #define readlink(a,b,c) not_here("readlink")
278 #define setpgid(a,b) not_here("setpgid")
281 #define setsid() not_here("setsid")
284 #define strcoll(s1,s2) not_here("strcoll")
287 #define strtod(s1,s2) not_here("strtod")
290 #define strtol(s1,s2,b) not_here("strtol")
293 #define strtoul(s1,s2,b) not_here("strtoul")
296 #define strxfrm(s1,s2,n) not_here("strxfrm")
298 #ifndef HAS_TCGETPGRP
299 #define tcgetpgrp(a) not_here("tcgetpgrp")
301 #ifndef HAS_TCSETPGRP
302 #define tcsetpgrp(a,b) not_here("tcsetpgrp")
306 #define times(a) not_here("times")
310 #define uname(a) not_here("uname")
313 #define waitpid(a,b,c) not_here("waitpid")
318 #define mblen(a,b) not_here("mblen")
322 #define mbstowcs(s, pwcs, n) not_here("mbstowcs")
325 #define mbtowc(pwc, s, n) not_here("mbtowc")
328 #define wcstombs(s, pwcs, n) not_here("wcstombs")
331 #define wctomb(s, wchar) not_here("wcstombs")
333 #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
334 /* If we don't have these functions, then we wouldn't have gotten a typedef
335 for wchar_t, the wide character type. Defining wchar_t allows the
336 functions referencing it to compile. Its actual type is then meaningless,
337 since without the above functions, all sections using it end up calling
338 not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
344 #ifndef HAS_LOCALECONV
345 #define localeconv() not_here("localeconv")
348 #ifdef HAS_LONG_DOUBLE
349 # if LONG_DOUBLESIZE > NVSIZE
350 # undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
354 #ifndef HAS_LONG_DOUBLE
366 /* Background: in most systems the low byte of the wait status
367 * is the signal (the lowest 7 bits) and the coredump flag is
368 * the eight bit, and the second lowest byte is the exit status.
369 * BeOS bucks the trend and has the bytes in different order.
370 * See beos/beos.c for how the reality is bent even in BeOS
371 * to follow the traditional. However, to make the POSIX
372 * wait W*() macros to work in BeOS, we need to unbend the
373 * reality back in place. --jhi */
374 /* In actual fact the code below is to blame here. Perl has an internal
375 * representation of the exit status ($?), which it re-composes from the
376 * OS's representation using the W*() POSIX macros. The code below
377 * incorrectly uses the W*() macros on the internal representation,
378 * which fails for OSs that have a different representation (namely BeOS
379 * and Haiku). WMUNGE() is a hack that converts the internal
380 * representation into the OS specific one, so that the W*() macros work
381 * as expected. The better solution would be not to use the W*() macros
382 * in the first place, though. -- Ingo Weinhold
384 #if defined(__BEOS__) || defined(__HAIKU__)
385 # define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
387 # define WMUNGE(x) (x)
391 not_here(const char *s)
393 croak("POSIX::%s not implemented on this architecture", s);
397 #include "const-c.inc"
400 restore_sigmask(pTHX_ SV *osset_sv)
402 /* Fortunately, restoring the signal mask can't fail, because
403 * there's nothing we can do about it if it does -- we're not
404 * supposed to return -1 from sigaction unless the disposition
407 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
408 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
414 * (1) The CRT maintains its own copy of the environment, separate from
417 * (2) CRT getenv() retrieves from this copy. CRT putenv() updates this
418 * copy, and then calls SetEnvironmentVariableA() to update the Win32API
421 * (3) win32_getenv() and win32_putenv() call GetEnvironmentVariableA() and
422 * SetEnvironmentVariableA() directly, bypassing the CRT copy of the
425 * (4) The CRT strftime() "%Z" implementation calls __tzset(). That
426 * calls CRT tzset(), but only the first time it is called, and in turn
427 * that uses CRT getenv("TZ") to retrieve the timezone info from the CRT
428 * local copy of the environment and hence gets the original setting as
429 * perl never updates the CRT copy when assigning to $ENV{TZ}.
431 * Therefore, we need to retrieve the value of $ENV{TZ} and call CRT
432 * putenv() to update the CRT copy of the environment (if it is different)
433 * whenever we're about to call tzset().
435 * In addition to all that, when perl is built with PERL_IMPLICIT_SYS
438 * (a) Each interpreter has its own copy of the environment inside the
439 * perlhost structure. That allows applications that host multiple
440 * independent Perl interpreters to isolate environment changes from
441 * each other. (This is similar to how the perlhost mechanism keeps a
442 * separate working directory for each Perl interpreter, so that calling
443 * chdir() will not affect other interpreters.)
445 * (b) Only the first Perl interpreter instantiated within a process will
446 * "write through" environment changes to the process environment.
448 * (c) Even the primary Perl interpreter won't update the CRT copy of the
449 * the environment, only the Win32API copy (it calls win32_putenv()).
451 * As with CPerlHost::Getenv() and CPerlHost::Putenv() themselves, it makes
452 * sense to only update the process environment when inside the main
453 * interpreter, but we don't have access to CPerlHost's m_bTopLevel member
454 * from here so we'll just have to check PL_curinterp instead.
456 * Therefore, we can simply #undef getenv() and putenv() so that those names
457 * always refer to the CRT functions, and explicitly call win32_getenv() to
458 * access perl's %ENV.
460 * We also #undef malloc() and free() to be sure we are using the CRT
461 * functions otherwise under PERL_IMPLICIT_SYS they are redefined to calls
462 * into VMem::Malloc() and VMem::Free() and all allocations will be freed
463 * when the Perl interpreter is being destroyed so we'd end up with a pointer
464 * into deallocated memory in environ[] if a program embedding a Perl
465 * interpreter continues to operate even after the main Perl interpreter has
468 * Note that we don't free() the malloc()ed memory unless and until we call
469 * malloc() again ourselves because the CRT putenv() function simply puts its
470 * pointer argument into the environ[] arrary (it doesn't make a copy of it)
471 * so this memory must otherwise be leaked.
480 fix_win32_tzenv(void)
482 static char* oldenv = NULL;
484 const char* perl_tz_env = win32_getenv("TZ");
485 const char* crt_tz_env = getenv("TZ");
486 if (perl_tz_env == NULL)
488 if (crt_tz_env == NULL)
490 if (strcmp(perl_tz_env, crt_tz_env) != 0) {
491 newenv = (char*)malloc((strlen(perl_tz_env) + 4) * sizeof(char));
492 if (newenv != NULL) {
493 sprintf(newenv, "TZ=%s", perl_tz_env);
505 * my_tzset - wrapper to tzset() with a fix to make it work (better) on Win32.
506 * This code is duplicated in the Time-Piece module, so any changes made here
507 * should be made there too.
513 #if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
514 if (PL_curinterp == aTHX)
521 MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
524 new(packname = "POSIX::SigSet", ...)
525 const char * packname
529 Newx(RETVAL, 1, sigset_t);
531 for (i = 1; i < items; i++)
532 sigaddset(RETVAL, SvIV(ST(i)));
544 sigaddset(sigset, sig)
549 sigdelset(sigset, sig)
562 sigismember(sigset, sig)
566 MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
569 new(packname = "POSIX::Termios", ...)
570 const char * packname
574 Newx(RETVAL, 1, struct termios);
585 POSIX::Termios termios_ref
588 Safefree(termios_ref);
594 getattr(termios_ref, fd = 0)
595 POSIX::Termios termios_ref
598 RETVAL = tcgetattr(fd, termios_ref);
603 setattr(termios_ref, fd = 0, optional_actions = 0)
604 POSIX::Termios termios_ref
608 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
613 cfgetispeed(termios_ref)
614 POSIX::Termios termios_ref
617 cfgetospeed(termios_ref)
618 POSIX::Termios termios_ref
621 getiflag(termios_ref)
622 POSIX::Termios termios_ref
624 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
625 RETVAL = termios_ref->c_iflag;
627 not_here("getiflag");
634 getoflag(termios_ref)
635 POSIX::Termios termios_ref
637 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
638 RETVAL = termios_ref->c_oflag;
640 not_here("getoflag");
647 getcflag(termios_ref)
648 POSIX::Termios termios_ref
650 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
651 RETVAL = termios_ref->c_cflag;
653 not_here("getcflag");
660 getlflag(termios_ref)
661 POSIX::Termios termios_ref
663 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
664 RETVAL = termios_ref->c_lflag;
666 not_here("getlflag");
673 getcc(termios_ref, ccix)
674 POSIX::Termios termios_ref
677 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
679 croak("Bad getcc subscript");
680 RETVAL = termios_ref->c_cc[ccix];
689 cfsetispeed(termios_ref, speed)
690 POSIX::Termios termios_ref
694 cfsetospeed(termios_ref, speed)
695 POSIX::Termios termios_ref
699 setiflag(termios_ref, iflag)
700 POSIX::Termios termios_ref
703 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
704 termios_ref->c_iflag = iflag;
706 not_here("setiflag");
710 setoflag(termios_ref, oflag)
711 POSIX::Termios termios_ref
714 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
715 termios_ref->c_oflag = oflag;
717 not_here("setoflag");
721 setcflag(termios_ref, cflag)
722 POSIX::Termios termios_ref
725 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
726 termios_ref->c_cflag = cflag;
728 not_here("setcflag");
732 setlflag(termios_ref, lflag)
733 POSIX::Termios termios_ref
736 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
737 termios_ref->c_lflag = lflag;
739 not_here("setlflag");
743 setcc(termios_ref, ccix, cc)
744 POSIX::Termios termios_ref
748 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
750 croak("Bad setcc subscript");
751 termios_ref->c_cc[ccix] = cc;
757 MODULE = POSIX PACKAGE = POSIX
759 INCLUDE: const-xs.inc
766 POSIX::WIFSIGNALED = 2
767 POSIX::WIFSTOPPED = 3
771 #if !(defined(WEXITSTATUS) || defined(WIFEXITED) || defined(WIFSIGNALED) \
772 || defined(WIFSTOPPED) || defined(WSTOPSIG) || defined (WTERMSIG))
773 RETVAL = 0; /* Silence compilers that notice this, but don't realise
774 that not_here() can't return. */
779 RETVAL = WEXITSTATUS(WMUNGE(status));
781 not_here("WEXITSTATUS");
786 RETVAL = WIFEXITED(WMUNGE(status));
788 not_here("WIFEXITED");
793 RETVAL = WIFSIGNALED(WMUNGE(status));
795 not_here("WIFSIGNALED");
800 RETVAL = WIFSTOPPED(WMUNGE(status));
802 not_here("WIFSTOPPED");
807 RETVAL = WSTOPSIG(WMUNGE(status));
809 not_here("WSTOPSIG");
814 RETVAL = WTERMSIG(WMUNGE(status));
816 not_here("WTERMSIG");
820 Perl_croak(aTHX_ "Illegal alias %d for POSIX::W*", ix);
831 unsigned char *s = (unsigned char *) SvPV(charstring, len);
832 unsigned char *e = s + len;
833 for (RETVAL = 1; RETVAL && s < e; s++)
845 unsigned char *s = (unsigned char *) SvPV(charstring, len);
846 unsigned char *e = s + len;
847 for (RETVAL = 1; RETVAL && s < e; s++)
859 unsigned char *s = (unsigned char *) SvPV(charstring, len);
860 unsigned char *e = s + len;
861 for (RETVAL = 1; RETVAL && s < e; s++)
873 unsigned char *s = (unsigned char *) SvPV(charstring, len);
874 unsigned char *e = s + len;
875 for (RETVAL = 1; RETVAL && s < e; s++)
887 unsigned char *s = (unsigned char *) SvPV(charstring, len);
888 unsigned char *e = s + len;
889 for (RETVAL = 1; RETVAL && s < e; s++)
901 unsigned char *s = (unsigned char *) SvPV(charstring, len);
902 unsigned char *e = s + len;
903 for (RETVAL = 1; RETVAL && s < e; s++)
915 unsigned char *s = (unsigned char *) SvPV(charstring, len);
916 unsigned char *e = s + len;
917 for (RETVAL = 1; RETVAL && s < e; s++)
929 unsigned char *s = (unsigned char *) SvPV(charstring, len);
930 unsigned char *e = s + len;
931 for (RETVAL = 1; RETVAL && s < e; s++)
943 unsigned char *s = (unsigned char *) SvPV(charstring, len);
944 unsigned char *e = s + len;
945 for (RETVAL = 1; RETVAL && s < e; s++)
957 unsigned char *s = (unsigned char *) SvPV(charstring, len);
958 unsigned char *e = s + len;
959 for (RETVAL = 1; RETVAL && s < e; s++)
971 unsigned char *s = (unsigned char *) SvPV(charstring, len);
972 unsigned char *e = s + len;
973 for (RETVAL = 1; RETVAL && s < e; s++)
980 open(filename, flags = O_RDONLY, mode = 0666)
985 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
986 TAINT_PROPER("open");
987 RETVAL = open(filename, flags, mode);
995 #ifdef HAS_LOCALECONV
998 sv_2mortal((SV*)RETVAL);
999 if ((lcbuf = localeconv())) {
1001 if (lcbuf->decimal_point && *lcbuf->decimal_point)
1002 hv_store(RETVAL, "decimal_point", 13,
1003 newSVpv(lcbuf->decimal_point, 0), 0);
1004 if (lcbuf->thousands_sep && *lcbuf->thousands_sep)
1005 hv_store(RETVAL, "thousands_sep", 13,
1006 newSVpv(lcbuf->thousands_sep, 0), 0);
1007 #ifndef NO_LOCALECONV_GROUPING
1008 if (lcbuf->grouping && *lcbuf->grouping)
1009 hv_store(RETVAL, "grouping", 8,
1010 newSVpv(lcbuf->grouping, 0), 0);
1012 if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol)
1013 hv_store(RETVAL, "int_curr_symbol", 15,
1014 newSVpv(lcbuf->int_curr_symbol, 0), 0);
1015 if (lcbuf->currency_symbol && *lcbuf->currency_symbol)
1016 hv_store(RETVAL, "currency_symbol", 15,
1017 newSVpv(lcbuf->currency_symbol, 0), 0);
1018 if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
1019 hv_store(RETVAL, "mon_decimal_point", 17,
1020 newSVpv(lcbuf->mon_decimal_point, 0), 0);
1021 #ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
1022 if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
1023 hv_store(RETVAL, "mon_thousands_sep", 17,
1024 newSVpv(lcbuf->mon_thousands_sep, 0), 0);
1026 #ifndef NO_LOCALECONV_MON_GROUPING
1027 if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
1028 hv_store(RETVAL, "mon_grouping", 12,
1029 newSVpv(lcbuf->mon_grouping, 0), 0);
1031 if (lcbuf->positive_sign && *lcbuf->positive_sign)
1032 hv_store(RETVAL, "positive_sign", 13,
1033 newSVpv(lcbuf->positive_sign, 0), 0);
1034 if (lcbuf->negative_sign && *lcbuf->negative_sign)
1035 hv_store(RETVAL, "negative_sign", 13,
1036 newSVpv(lcbuf->negative_sign, 0), 0);
1038 if (lcbuf->int_frac_digits != CHAR_MAX)
1039 hv_store(RETVAL, "int_frac_digits", 15,
1040 newSViv(lcbuf->int_frac_digits), 0);
1041 if (lcbuf->frac_digits != CHAR_MAX)
1042 hv_store(RETVAL, "frac_digits", 11,
1043 newSViv(lcbuf->frac_digits), 0);
1044 if (lcbuf->p_cs_precedes != CHAR_MAX)
1045 hv_store(RETVAL, "p_cs_precedes", 13,
1046 newSViv(lcbuf->p_cs_precedes), 0);
1047 if (lcbuf->p_sep_by_space != CHAR_MAX)
1048 hv_store(RETVAL, "p_sep_by_space", 14,
1049 newSViv(lcbuf->p_sep_by_space), 0);
1050 if (lcbuf->n_cs_precedes != CHAR_MAX)
1051 hv_store(RETVAL, "n_cs_precedes", 13,
1052 newSViv(lcbuf->n_cs_precedes), 0);
1053 if (lcbuf->n_sep_by_space != CHAR_MAX)
1054 hv_store(RETVAL, "n_sep_by_space", 14,
1055 newSViv(lcbuf->n_sep_by_space), 0);
1056 if (lcbuf->p_sign_posn != CHAR_MAX)
1057 hv_store(RETVAL, "p_sign_posn", 11,
1058 newSViv(lcbuf->p_sign_posn), 0);
1059 if (lcbuf->n_sign_posn != CHAR_MAX)
1060 hv_store(RETVAL, "n_sign_posn", 11,
1061 newSViv(lcbuf->n_sign_posn), 0);
1064 localeconv(); /* A stub to call not_here(). */
1070 setlocale(category, locale = 0)
1076 retval = setlocale(category, locale);
1078 /* Save retval since subsequent setlocale() calls
1079 * may overwrite it. */
1080 RETVAL = savepv(retval);
1081 #ifdef USE_LOCALE_CTYPE
1082 if (category == LC_CTYPE
1084 || category == LC_ALL
1090 if (category == LC_ALL)
1091 newctype = setlocale(LC_CTYPE, NULL);
1095 new_ctype(newctype);
1097 #endif /* USE_LOCALE_CTYPE */
1098 #ifdef USE_LOCALE_COLLATE
1099 if (category == LC_COLLATE
1101 || category == LC_ALL
1107 if (category == LC_ALL)
1108 newcoll = setlocale(LC_COLLATE, NULL);
1112 new_collate(newcoll);
1114 #endif /* USE_LOCALE_COLLATE */
1115 #ifdef USE_LOCALE_NUMERIC
1116 if (category == LC_NUMERIC
1118 || category == LC_ALL
1124 if (category == LC_ALL)
1125 newnum = setlocale(LC_NUMERIC, NULL);
1129 new_numeric(newnum);
1131 #endif /* USE_LOCALE_NUMERIC */
1175 /* (We already know stack is long enough.) */
1176 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1177 PUSHs(sv_2mortal(newSViv(expvar)));
1193 /* (We already know stack is long enough.) */
1194 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
1195 PUSHs(sv_2mortal(newSVnv(intvar)));
1210 sigaction(sig, optaction, oldaction = 0)
1213 POSIX::SigAction oldaction
1215 #if defined(WIN32) || defined(NETWARE)
1216 RETVAL = not_here("sigaction");
1218 # This code is really grody because we're trying to make the signal
1219 # interface look beautiful, which is hard.
1223 POSIX__SigAction action;
1224 GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
1225 struct sigaction act;
1226 struct sigaction oact;
1230 POSIX__SigSet sigset;
1235 croak("Negative signals are not allowed");
1238 if (sig == 0 && SvPOK(ST(0))) {
1239 const char *s = SvPVX_const(ST(0));
1240 int i = whichsig(s);
1242 if (i < 0 && memEQ(s, "SIG", 3))
1243 i = whichsig(s + 3);
1245 if (ckWARN(WARN_SIGNAL))
1246 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1247 "No such signal: SIG%s", s);
1254 if (sig > NSIG) { /* NSIG - 1 is still okay. */
1255 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1256 "No such signal: %d", sig);
1260 sigsvp = hv_fetch(GvHVn(siggv),
1262 strlen(PL_sig_name[sig]),
1265 /* Check optaction and set action */
1266 if(SvTRUE(optaction)) {
1267 if(sv_isa(optaction, "POSIX::SigAction"))
1268 action = (HV*)SvRV(optaction);
1270 croak("action is not of type POSIX::SigAction");
1276 /* sigaction() is supposed to look atomic. In particular, any
1277 * signal handler invoked during a sigaction() call should
1278 * see either the old or the new disposition, and not something
1279 * in between. We use sigprocmask() to make it so.
1282 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1286 /* Restore signal mask no matter how we exit this block. */
1287 osset_sv = newSVpv((char *)(&osset), sizeof(sigset_t));
1288 SAVEFREESV( osset_sv );
1289 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1291 RETVAL=-1; /* In case both oldaction and action are 0. */
1293 /* Remember old disposition if desired. */
1295 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
1297 croak("Can't supply an oldaction without a HANDLER");
1298 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1299 sv_setsv(*svp, *sigsvp);
1302 sv_setpv(*svp, "DEFAULT");
1304 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
1307 /* Get back the mask. */
1308 svp = hv_fetchs(oldaction, "MASK", TRUE);
1309 if (sv_isa(*svp, "POSIX::SigSet")) {
1310 IV tmp = SvIV((SV*)SvRV(*svp));
1311 sigset = INT2PTR(sigset_t*, tmp);
1314 Newx(sigset, 1, sigset_t);
1315 sv_setptrobj(*svp, sigset, "POSIX::SigSet");
1317 *sigset = oact.sa_mask;
1319 /* Get back the flags. */
1320 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
1321 sv_setiv(*svp, oact.sa_flags);
1323 /* Get back whether the old handler used safe signals. */
1324 svp = hv_fetchs(oldaction, "SAFE", TRUE);
1326 /* compare incompatible pointers by casting to integer */
1327 PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
1331 /* Safe signals use "csighandler", which vectors through the
1332 PL_sighandlerp pointer when it's safe to do so.
1333 (BTW, "csighandler" is very different from "sighandler".) */
1334 svp = hv_fetchs(action, "SAFE", FALSE);
1338 (*svp && SvTRUE(*svp))
1339 ? PL_csighandlerp : PL_sighandlerp
1342 /* Vector new Perl handler through %SIG.
1343 (The core signal handlers read %SIG to dispatch.) */
1344 svp = hv_fetchs(action, "HANDLER", FALSE);
1346 croak("Can't supply an action without a HANDLER");
1347 sv_setsv(*sigsvp, *svp);
1349 /* This call actually calls sigaction() with almost the
1350 right settings, including appropriate interpretation
1351 of DEFAULT and IGNORE. However, why are we doing
1352 this when we're about to do it again just below? XXX */
1355 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1357 const char *s=SvPVX_const(*svp);
1358 if(strEQ(s,"IGNORE")) {
1359 act.sa_handler = SIG_IGN;
1361 else if(strEQ(s,"DEFAULT")) {
1362 act.sa_handler = SIG_DFL;
1366 /* Set up any desired mask. */
1367 svp = hv_fetchs(action, "MASK", FALSE);
1368 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
1369 IV tmp = SvIV((SV*)SvRV(*svp));
1370 sigset = INT2PTR(sigset_t*, tmp);
1371 act.sa_mask = *sigset;
1374 sigemptyset(& act.sa_mask);
1376 /* Set up any desired flags. */
1377 svp = hv_fetchs(action, "FLAGS", FALSE);
1378 act.sa_flags = svp ? SvIV(*svp) : 0;
1380 /* Don't worry about cleaning up *sigsvp if this fails,
1381 * because that means we tried to disposition a
1382 * nonblockable signal, in which case *sigsvp is
1383 * essentially meaningless anyway.
1385 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
1398 POSIX::SigSet sigset
1401 sigprocmask(how, sigset, oldsigset = 0)
1403 POSIX::SigSet sigset = NO_INIT
1404 POSIX::SigSet oldsigset = NO_INIT
1406 if (! SvOK(ST(1))) {
1408 } else if (sv_isa(ST(1), "POSIX::SigSet")) {
1409 IV tmp = SvIV((SV*)SvRV(ST(1)));
1410 sigset = INT2PTR(POSIX__SigSet,tmp);
1412 croak("sigset is not of type POSIX::SigSet");
1415 if (items < 3 || ! SvOK(ST(2))) {
1417 } else if (sv_isa(ST(2), "POSIX::SigSet")) {
1418 IV tmp = SvIV((SV*)SvRV(ST(2)));
1419 oldsigset = INT2PTR(POSIX__SigSet,tmp);
1421 croak("oldsigset is not of type POSIX::SigSet");
1425 sigsuspend(signal_mask)
1426 POSIX::SigSet signal_mask
1446 lseek(fd, offset, whence)
1451 Off_t pos = PerlLIO_lseek(fd, offset, whence);
1452 RETVAL = sizeof(Off_t) > sizeof(IV)
1453 ? newSVnv((NV)pos) : newSViv((IV)pos);
1462 if ((incr = nice(incr)) != -1 || errno == 0) {
1464 XPUSHs(sv_2mortal(newSVpvn("0 but true", 10)));
1466 XPUSHs(sv_2mortal(newSViv(incr)));
1473 if (pipe(fds) != -1) {
1475 PUSHs(sv_2mortal(newSViv(fds[0])));
1476 PUSHs(sv_2mortal(newSViv(fds[1])));
1480 read(fd, buffer, nbytes)
1482 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1486 char * buffer = sv_grow( sv_buffer, nbytes+1 );
1489 SvCUR_set(sv_buffer, RETVAL);
1490 SvPOK_only(sv_buffer);
1491 *SvEND(sv_buffer) = '\0';
1492 SvTAINTED_on(sv_buffer);
1508 tcsetpgrp(fd, pgrp_id)
1517 if (uname(&buf) >= 0) {
1519 PUSHs(sv_2mortal(newSVpv(buf.sysname, 0)));
1520 PUSHs(sv_2mortal(newSVpv(buf.nodename, 0)));
1521 PUSHs(sv_2mortal(newSVpv(buf.release, 0)));
1522 PUSHs(sv_2mortal(newSVpv(buf.version, 0)));
1523 PUSHs(sv_2mortal(newSVpv(buf.machine, 0)));
1526 uname((char *) 0); /* A stub to call not_here(). */
1530 write(fd, buffer, nbytes)
1541 RETVAL = newSVpvn("", 0);
1542 SvGROW(RETVAL, L_tmpnam);
1543 len = strlen(tmpnam(SvPV(RETVAL, i)));
1544 SvCUR_set(RETVAL, len);
1557 mbstowcs(s, pwcs, n)
1569 wcstombs(s, pwcs, n)
1591 SET_NUMERIC_LOCAL();
1592 num = strtod(str, &unparsed);
1593 PUSHs(sv_2mortal(newSVnv(num)));
1594 if (GIMME == G_ARRAY) {
1597 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1599 PUSHs(&PL_sv_undef);
1603 strtol(str, base = 0)
1610 num = strtol(str, &unparsed, base);
1611 #if IVSIZE <= LONGSIZE
1612 if (num < IV_MIN || num > IV_MAX)
1613 PUSHs(sv_2mortal(newSVnv((double)num)));
1616 PUSHs(sv_2mortal(newSViv((IV)num)));
1617 if (GIMME == G_ARRAY) {
1620 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1622 PUSHs(&PL_sv_undef);
1626 strtoul(str, base = 0)
1633 num = strtoul(str, &unparsed, base);
1634 #if IVSIZE <= LONGSIZE
1636 PUSHs(sv_2mortal(newSVnv((double)num)));
1639 PUSHs(sv_2mortal(newSViv((IV)num)));
1640 if (GIMME == G_ARRAY) {
1643 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1645 PUSHs(&PL_sv_undef);
1655 char *p = SvPV(src,srclen);
1657 ST(0) = sv_2mortal(newSV(srclen*4+1));
1658 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1659 if (dstlen > srclen) {
1661 SvGROW(ST(0), dstlen);
1662 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1665 SvCUR_set(ST(0), dstlen);
1670 mkfifo(filename, mode)
1674 TAINT_PROPER("mkfifo");
1675 RETVAL = mkfifo(filename, mode);
1691 tcflush(fd, queue_selector)
1696 tcsendbreak(fd, duration)
1701 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
1714 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1717 mytm.tm_hour = hour;
1718 mytm.tm_mday = mday;
1720 mytm.tm_year = year;
1721 mytm.tm_wday = wday;
1722 mytm.tm_yday = yday;
1723 mytm.tm_isdst = isdst;
1724 RETVAL = asctime(&mytm);
1741 realtime = times( &tms );
1743 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1744 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1745 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1746 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1747 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
1750 difftime(time1, time2)
1755 mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
1768 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1771 mytm.tm_hour = hour;
1772 mytm.tm_mday = mday;
1774 mytm.tm_year = year;
1775 mytm.tm_wday = wday;
1776 mytm.tm_yday = yday;
1777 mytm.tm_isdst = isdst;
1778 RETVAL = (SysRetLong) mktime(&mytm);
1783 #XXX: if $xsubpp::WantOptimize is always the default
1784 # sv_setpv(TARG, ...) could be used rather than
1785 # ST(0) = sv_2mortal(newSVpv(...))
1787 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
1800 char *buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst);
1802 ST(0) = sv_2mortal(newSVpv(buf, 0));
1816 PUSHs(sv_2mortal(newSVpvn(tzname[0],strlen(tzname[0]))));
1817 PUSHs(sv_2mortal(newSVpvn(tzname[1],strlen(tzname[1]))));
1820 access(filename, mode)
1828 #ifdef HAS_CTERMID_R
1829 s = (char *) safemalloc((size_t) L_ctermid);
1831 RETVAL = ctermid(s);
1835 #ifdef HAS_CTERMID_R
1849 pathconf(filename, name)
1863 PL_egid = getegid();
1874 PL_euid = geteuid();
1892 XSprePUSH; PUSHTARG;
1896 lchown(uid, gid, path)
1902 /* yes, the order of arguments is different,
1903 * but consistent with CORE::chown() */
1904 RETVAL = lchown(path, uid, gid);
1906 RETVAL = not_here("lchown");