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>
73 #ifdef MACOS_TRADITIONAL
79 # if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__)
80 extern char *tzname[];
83 #if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname))
84 char *tzname[] = { "" , "" };
88 #ifndef PERL_UNUSED_DECL
90 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
91 # define PERL_UNUSED_DECL
93 # define PERL_UNUSED_DECL __attribute__((unused))
96 # define PERL_UNUSED_DECL
101 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL
108 #if defined(__VMS) && !defined(__POSIX_SOURCE)
109 # include <libdef.h> /* LIB$_INVARG constant */
110 # include <lib$routines.h> /* prototype for lib$ediv() */
111 # include <starlet.h> /* prototype for sys$gettim() */
112 # if DECC_VERSION < 50000000
113 # define pid_t int /* old versions of DECC miss this in types.h */
117 # define mkfifo(a,b) (not_here("mkfifo"),-1)
118 # define tzset() not_here("tzset")
120 #if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
121 # define HAS_TZNAME /* shows up in VMS 7.0 or Dec C 5.6 */
122 # include <utsname.h>
123 # endif /* __VMS_VER >= 70000000 or Dec C 5.6 */
125 /* The POSIX notion of ttyname() is better served by getname() under VMS */
126 static char ttnambuf[64];
127 # define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
129 /* The non-POSIX CRTL times() has void return type, so we just get the
130 current time directly */
131 clock_t vms_times(struct tms *bufptr) {
134 /* Get wall time and convert to 10 ms intervals to
135 * produce the return value that the POSIX standard expects */
136 # if defined(__DECC) && defined (__ALPHA)
139 _ckvmssts(sys$gettim(&vmstime));
141 retval = vmstime & 0x7fffffff;
143 /* (Older hw or ccs don't have an atomic 64-bit type, so we
144 * juggle 32-bit ints (and a float) to produce a time_t result
145 * with minimal loss of information.) */
146 long int vmstime[2],remainder,divisor = 100000;
147 _ckvmssts(sys$gettim((unsigned long int *)vmstime));
148 vmstime[1] &= 0x7fff; /* prevent overflow in EDIV */
149 _ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder));
151 /* Fill in the struct tms using the CRTL routine . . .*/
152 times((tbuffer_t *)bufptr);
153 return (clock_t) retval;
155 # define times(t) vms_times(t)
157 #if defined (__CYGWIN__)
158 # define tzname _tzname
160 #if defined (WIN32) || defined (NETWARE)
162 # define mkfifo(a,b) not_here("mkfifo")
163 # define ttyname(a) (char*)not_here("ttyname")
164 # define sigset_t long
167 # define tzname _tzname
170 # define mode_t short
173 # define mode_t short
175 # define tzset() not_here("tzset")
177 # ifndef _POSIX_OPEN_MAX
178 # define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */
181 # define sigaction(a,b,c) not_here("sigaction")
182 # define sigpending(a) not_here("sigpending")
183 # define sigprocmask(a,b,c) not_here("sigprocmask")
184 # define sigsuspend(a) not_here("sigsuspend")
185 # define sigemptyset(a) not_here("sigemptyset")
186 # define sigaddset(a,b) not_here("sigaddset")
187 # define sigdelset(a,b) not_here("sigdelset")
188 # define sigfillset(a) not_here("sigfillset")
189 # define sigismember(a,b) not_here("sigismember")
193 # define setuid(a) not_here("setuid")
194 # define setgid(a) not_here("setgid")
199 # if defined(OS2) || defined(MACOS_TRADITIONAL)
200 # define mkfifo(a,b) not_here("mkfifo")
201 # else /* !( defined OS2 ) */
203 # define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
206 # endif /* !HAS_MKFIFO */
208 # ifdef MACOS_TRADITIONAL
209 # define ttyname(a) (char*)not_here("ttyname")
210 # define tzset() not_here("tzset")
215 # include <sys/times.h>
217 # include <sys/utsname.h>
219 # include <sys/wait.h>
224 #endif /* WIN32 || NETWARE */
228 typedef long SysRetLong;
229 typedef sigset_t* POSIX__SigSet;
230 typedef HV* POSIX__SigAction;
232 typedef struct termios* POSIX__Termios;
233 #else /* Define termios types to int, and call not_here for the functions.*/
234 #define POSIX__Termios int
238 #define cfgetispeed(x) not_here("cfgetispeed")
239 #define cfgetospeed(x) not_here("cfgetospeed")
240 #define tcdrain(x) not_here("tcdrain")
241 #define tcflush(x,y) not_here("tcflush")
242 #define tcsendbreak(x,y) not_here("tcsendbreak")
243 #define cfsetispeed(x,y) not_here("cfsetispeed")
244 #define cfsetospeed(x,y) not_here("cfsetospeed")
245 #define ctermid(x) (char *) not_here("ctermid")
246 #define tcflow(x,y) not_here("tcflow")
247 #define tcgetattr(x,y) not_here("tcgetattr")
248 #define tcsetattr(x,y,z) not_here("tcsetattr")
251 /* Possibly needed prototypes */
252 char *cuserid (char *);
254 double strtod (const char *, char **);
255 long strtol (const char *, char **, int);
256 unsigned long strtoul (const char *, char **, int);
260 #define cuserid(a) (char *) not_here("cuserid")
264 #define difftime(a,b) not_here("difftime")
267 #ifndef HAS_FPATHCONF
268 #define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
271 #define mktime(a) not_here("mktime")
274 #define nice(a) not_here("nice")
277 #define pathconf(f,n) (SysRetLong) not_here("pathconf")
280 #define sysconf(n) (SysRetLong) not_here("sysconf")
283 #define readlink(a,b,c) not_here("readlink")
286 #define setpgid(a,b) not_here("setpgid")
289 #define setsid() not_here("setsid")
292 #define strcoll(s1,s2) not_here("strcoll")
295 #define strtod(s1,s2) not_here("strtod")
298 #define strtol(s1,s2,b) not_here("strtol")
301 #define strtoul(s1,s2,b) not_here("strtoul")
304 #define strxfrm(s1,s2,n) not_here("strxfrm")
306 #ifndef HAS_TCGETPGRP
307 #define tcgetpgrp(a) not_here("tcgetpgrp")
309 #ifndef HAS_TCSETPGRP
310 #define tcsetpgrp(a,b) not_here("tcsetpgrp")
314 #define times(a) not_here("times")
318 #define uname(a) not_here("uname")
321 #define waitpid(a,b,c) not_here("waitpid")
326 #define mblen(a,b) not_here("mblen")
330 #define mbstowcs(s, pwcs, n) not_here("mbstowcs")
333 #define mbtowc(pwc, s, n) not_here("mbtowc")
336 #define wcstombs(s, pwcs, n) not_here("wcstombs")
339 #define wctomb(s, wchar) not_here("wcstombs")
341 #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
342 /* If we don't have these functions, then we wouldn't have gotten a typedef
343 for wchar_t, the wide character type. Defining wchar_t allows the
344 functions referencing it to compile. Its actual type is then meaningless,
345 since without the above functions, all sections using it end up calling
346 not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
352 #ifndef HAS_LOCALECONV
353 #define localeconv() not_here("localeconv")
356 #ifdef HAS_LONG_DOUBLE
357 # if LONG_DOUBLESIZE > NVSIZE
358 # undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
362 #ifndef HAS_LONG_DOUBLE
374 /* Background: in most systems the low byte of the wait status
375 * is the signal (the lowest 7 bits) and the coredump flag is
376 * the eight bit, and the second lowest byte is the exit status.
377 * BeOS bucks the trend and has the bytes in different order.
378 * See beos/beos.c for how the reality is bent even in BeOS
379 * to follow the traditional. However, to make the POSIX
380 * wait W*() macros to work in BeOS, we need to unbend the
381 * reality back in place. --jhi */
383 # define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
385 # define WMUNGE(x) (x)
391 croak("POSIX::%s not implemented on this architecture", s);
395 #include "const-c.inc"
397 /* These were implemented in the old "constant" subroutine. They are actually
398 macros that take an integer argument and return an integer result. */
400 int_macro_int (const char *name, STRLEN len, IV *arg_result) {
401 /* Initially switch on the length of the name. */
402 /* This code has been edited from a "constant" function generated by:
404 use ExtUtils::Constant qw (constant_types C_constant XS_constant);
406 my $types = {map {($_, 1)} qw(IV)};
407 my @names = (qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS WIFEXITED
408 WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
410 print constant_types(); # macro defs
411 foreach (C_constant ("POSIX", 'int_macro_int', 'IV', $types, undef, 5, @names) ) {
412 print $_, "\n"; # C constant subs
414 print "#### XS Section:\n";
415 print XS_constant ("POSIX", $types);
420 /* Names all of length 7. */
421 /* S_ISBLK S_ISCHR S_ISDIR S_ISREG */
422 /* Offset 5 gives the best switch position. */
425 if (memEQ(name, "S_ISREG", 7)) {
428 *arg_result = S_ISREG(*arg_result);
429 return PERL_constant_ISIV;
431 return PERL_constant_NOTDEF;
436 if (memEQ(name, "S_ISCHR", 7)) {
439 *arg_result = S_ISCHR(*arg_result);
440 return PERL_constant_ISIV;
442 return PERL_constant_NOTDEF;
447 if (memEQ(name, "S_ISDIR", 7)) {
450 *arg_result = S_ISDIR(*arg_result);
451 return PERL_constant_ISIV;
453 return PERL_constant_NOTDEF;
458 if (memEQ(name, "S_ISBLK", 7)) {
461 *arg_result = S_ISBLK(*arg_result);
462 return PERL_constant_ISIV;
464 return PERL_constant_NOTDEF;
471 /* Names all of length 8. */
472 /* S_ISFIFO WSTOPSIG WTERMSIG */
473 /* Offset 3 gives the best switch position. */
476 if (memEQ(name, "WSTOPSIG", 8)) {
480 *arg_result = WSTOPSIG(WMUNGE(i));
481 return PERL_constant_ISIV;
483 return PERL_constant_NOTDEF;
488 if (memEQ(name, "WTERMSIG", 8)) {
492 *arg_result = WTERMSIG(WMUNGE(i));
493 return PERL_constant_ISIV;
495 return PERL_constant_NOTDEF;
500 if (memEQ(name, "S_ISFIFO", 8)) {
503 *arg_result = S_ISFIFO(*arg_result);
504 return PERL_constant_ISIV;
506 return PERL_constant_NOTDEF;
513 if (memEQ(name, "WIFEXITED", 9)) {
516 *arg_result = WIFEXITED(WMUNGE(i));
517 return PERL_constant_ISIV;
519 return PERL_constant_NOTDEF;
524 if (memEQ(name, "WIFSTOPPED", 10)) {
527 *arg_result = WIFSTOPPED(WMUNGE(i));
528 return PERL_constant_ISIV;
530 return PERL_constant_NOTDEF;
535 /* Names all of length 11. */
536 /* WEXITSTATUS WIFSIGNALED */
537 /* Offset 1 gives the best switch position. */
540 if (memEQ(name, "WEXITSTATUS", 11)) {
544 *arg_result = WEXITSTATUS(WMUNGE(i));
545 return PERL_constant_ISIV;
547 return PERL_constant_NOTDEF;
552 if (memEQ(name, "WIFSIGNALED", 11)) {
556 *arg_result = WIFSIGNALED(WMUNGE(i));
557 return PERL_constant_ISIV;
559 return PERL_constant_NOTDEF;
566 return PERL_constant_NOTFOUND;
570 restore_sigmask(pTHX_ SV *osset_sv)
572 /* Fortunately, restoring the signal mask can't fail, because
573 * there's nothing we can do about it if it does -- we're not
574 * supposed to return -1 from sigaction unless the disposition
577 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
578 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
581 MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
584 new(packname = "POSIX::SigSet", ...)
585 const char * packname
589 Newx(RETVAL, 1, sigset_t);
591 for (i = 1; i < items; i++)
592 sigaddset(RETVAL, SvIV(ST(i)));
604 sigaddset(sigset, sig)
609 sigdelset(sigset, sig)
622 sigismember(sigset, sig)
626 MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
629 new(packname = "POSIX::Termios", ...)
630 const char * packname
634 Newx(RETVAL, 1, struct termios);
645 POSIX::Termios termios_ref
648 Safefree(termios_ref);
654 getattr(termios_ref, fd = 0)
655 POSIX::Termios termios_ref
658 RETVAL = tcgetattr(fd, termios_ref);
663 setattr(termios_ref, fd = 0, optional_actions = 0)
664 POSIX::Termios termios_ref
668 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
673 cfgetispeed(termios_ref)
674 POSIX::Termios termios_ref
677 cfgetospeed(termios_ref)
678 POSIX::Termios termios_ref
681 getiflag(termios_ref)
682 POSIX::Termios termios_ref
684 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
685 RETVAL = termios_ref->c_iflag;
687 not_here("getiflag");
694 getoflag(termios_ref)
695 POSIX::Termios termios_ref
697 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
698 RETVAL = termios_ref->c_oflag;
700 not_here("getoflag");
707 getcflag(termios_ref)
708 POSIX::Termios termios_ref
710 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
711 RETVAL = termios_ref->c_cflag;
713 not_here("getcflag");
720 getlflag(termios_ref)
721 POSIX::Termios termios_ref
723 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
724 RETVAL = termios_ref->c_lflag;
726 not_here("getlflag");
733 getcc(termios_ref, ccix)
734 POSIX::Termios termios_ref
737 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
739 croak("Bad getcc subscript");
740 RETVAL = termios_ref->c_cc[ccix];
749 cfsetispeed(termios_ref, speed)
750 POSIX::Termios termios_ref
754 cfsetospeed(termios_ref, speed)
755 POSIX::Termios termios_ref
759 setiflag(termios_ref, iflag)
760 POSIX::Termios termios_ref
763 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
764 termios_ref->c_iflag = iflag;
766 not_here("setiflag");
770 setoflag(termios_ref, oflag)
771 POSIX::Termios termios_ref
774 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
775 termios_ref->c_oflag = oflag;
777 not_here("setoflag");
781 setcflag(termios_ref, cflag)
782 POSIX::Termios termios_ref
785 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
786 termios_ref->c_cflag = cflag;
788 not_here("setcflag");
792 setlflag(termios_ref, lflag)
793 POSIX::Termios termios_ref
796 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
797 termios_ref->c_lflag = lflag;
799 not_here("setlflag");
803 setcc(termios_ref, ccix, cc)
804 POSIX::Termios termios_ref
808 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
810 croak("Bad setcc subscript");
811 termios_ref->c_cc[ccix] = cc;
817 MODULE = POSIX PACKAGE = POSIX
819 INCLUDE: const-xs.inc
822 int_macro_int(sv, iv)
829 const char * s = SvPV(sv, len);
832 /* Change this to int_macro_int(s, len, &iv, &nv);
833 if you need to return both NVs and IVs */
834 type = int_macro_int(s, len, &iv);
835 /* Return 1 or 2 items. First is error message, or undef if no error.
836 Second, if present, is found value */
838 case PERL_constant_NOTFOUND:
839 sv = sv_2mortal(newSVpvf("%s is not a valid POSIX macro", s));
844 case PERL_constant_NOTDEF:
845 sv = sv_2mortal(newSVpvf(
846 "Your vendor has not defined POSIX macro %s, used", s));
851 case PERL_constant_ISIV:
855 sv = sv_2mortal(newSVpvf(
856 "Unexpected return type %d while processing POSIX macro %s, used",
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++)
981 unsigned char *s = (unsigned char *) SvPV(charstring, len);
982 unsigned char *e = s + len;
983 for (RETVAL = 1; RETVAL && s < e; s++)
995 unsigned char *s = (unsigned char *) SvPV(charstring, len);
996 unsigned char *e = s + len;
997 for (RETVAL = 1; RETVAL && s < e; s++)
1004 isxdigit(charstring)
1009 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1010 unsigned char *e = s + len;
1011 for (RETVAL = 1; RETVAL && s < e; s++)
1018 open(filename, flags = O_RDONLY, mode = 0666)
1023 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
1024 TAINT_PROPER("open");
1025 RETVAL = open(filename, flags, mode);
1033 #ifdef HAS_LOCALECONV
1034 struct lconv *lcbuf;
1036 sv_2mortal((SV*)RETVAL);
1037 if ((lcbuf = localeconv())) {
1039 if (lcbuf->decimal_point && *lcbuf->decimal_point)
1040 hv_store(RETVAL, "decimal_point", 13,
1041 newSVpv(lcbuf->decimal_point, 0), 0);
1042 if (lcbuf->thousands_sep && *lcbuf->thousands_sep)
1043 hv_store(RETVAL, "thousands_sep", 13,
1044 newSVpv(lcbuf->thousands_sep, 0), 0);
1045 #ifndef NO_LOCALECONV_GROUPING
1046 if (lcbuf->grouping && *lcbuf->grouping)
1047 hv_store(RETVAL, "grouping", 8,
1048 newSVpv(lcbuf->grouping, 0), 0);
1050 if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol)
1051 hv_store(RETVAL, "int_curr_symbol", 15,
1052 newSVpv(lcbuf->int_curr_symbol, 0), 0);
1053 if (lcbuf->currency_symbol && *lcbuf->currency_symbol)
1054 hv_store(RETVAL, "currency_symbol", 15,
1055 newSVpv(lcbuf->currency_symbol, 0), 0);
1056 if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
1057 hv_store(RETVAL, "mon_decimal_point", 17,
1058 newSVpv(lcbuf->mon_decimal_point, 0), 0);
1059 #ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
1060 if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
1061 hv_store(RETVAL, "mon_thousands_sep", 17,
1062 newSVpv(lcbuf->mon_thousands_sep, 0), 0);
1064 #ifndef NO_LOCALECONV_MON_GROUPING
1065 if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
1066 hv_store(RETVAL, "mon_grouping", 12,
1067 newSVpv(lcbuf->mon_grouping, 0), 0);
1069 if (lcbuf->positive_sign && *lcbuf->positive_sign)
1070 hv_store(RETVAL, "positive_sign", 13,
1071 newSVpv(lcbuf->positive_sign, 0), 0);
1072 if (lcbuf->negative_sign && *lcbuf->negative_sign)
1073 hv_store(RETVAL, "negative_sign", 13,
1074 newSVpv(lcbuf->negative_sign, 0), 0);
1076 if (lcbuf->int_frac_digits != CHAR_MAX)
1077 hv_store(RETVAL, "int_frac_digits", 15,
1078 newSViv(lcbuf->int_frac_digits), 0);
1079 if (lcbuf->frac_digits != CHAR_MAX)
1080 hv_store(RETVAL, "frac_digits", 11,
1081 newSViv(lcbuf->frac_digits), 0);
1082 if (lcbuf->p_cs_precedes != CHAR_MAX)
1083 hv_store(RETVAL, "p_cs_precedes", 13,
1084 newSViv(lcbuf->p_cs_precedes), 0);
1085 if (lcbuf->p_sep_by_space != CHAR_MAX)
1086 hv_store(RETVAL, "p_sep_by_space", 14,
1087 newSViv(lcbuf->p_sep_by_space), 0);
1088 if (lcbuf->n_cs_precedes != CHAR_MAX)
1089 hv_store(RETVAL, "n_cs_precedes", 13,
1090 newSViv(lcbuf->n_cs_precedes), 0);
1091 if (lcbuf->n_sep_by_space != CHAR_MAX)
1092 hv_store(RETVAL, "n_sep_by_space", 14,
1093 newSViv(lcbuf->n_sep_by_space), 0);
1094 if (lcbuf->p_sign_posn != CHAR_MAX)
1095 hv_store(RETVAL, "p_sign_posn", 11,
1096 newSViv(lcbuf->p_sign_posn), 0);
1097 if (lcbuf->n_sign_posn != CHAR_MAX)
1098 hv_store(RETVAL, "n_sign_posn", 11,
1099 newSViv(lcbuf->n_sign_posn), 0);
1102 localeconv(); /* A stub to call not_here(). */
1108 setlocale(category, locale = 0)
1114 retval = setlocale(category, locale);
1116 /* Save retval since subsequent setlocale() calls
1117 * may overwrite it. */
1118 RETVAL = savepv(retval);
1119 #ifdef USE_LOCALE_CTYPE
1120 if (category == LC_CTYPE
1122 || category == LC_ALL
1128 if (category == LC_ALL)
1129 newctype = setlocale(LC_CTYPE, NULL);
1133 new_ctype(newctype);
1135 #endif /* USE_LOCALE_CTYPE */
1136 #ifdef USE_LOCALE_COLLATE
1137 if (category == LC_COLLATE
1139 || category == LC_ALL
1145 if (category == LC_ALL)
1146 newcoll = setlocale(LC_COLLATE, NULL);
1150 new_collate(newcoll);
1152 #endif /* USE_LOCALE_COLLATE */
1153 #ifdef USE_LOCALE_NUMERIC
1154 if (category == LC_NUMERIC
1156 || category == LC_ALL
1162 if (category == LC_ALL)
1163 newnum = setlocale(LC_NUMERIC, NULL);
1167 new_numeric(newnum);
1169 #endif /* USE_LOCALE_NUMERIC */
1213 /* (We already know stack is long enough.) */
1214 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1215 PUSHs(sv_2mortal(newSViv(expvar)));
1231 /* (We already know stack is long enough.) */
1232 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
1233 PUSHs(sv_2mortal(newSVnv(intvar)));
1248 sigaction(sig, optaction, oldaction = 0)
1251 POSIX::SigAction oldaction
1253 #if defined(WIN32) || defined(NETWARE)
1254 RETVAL = not_here("sigaction");
1256 # This code is really grody because we're trying to make the signal
1257 # interface look beautiful, which is hard.
1261 POSIX__SigAction action;
1262 GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
1263 struct sigaction act;
1264 struct sigaction oact;
1268 POSIX__SigSet sigset;
1273 croak("Negative signals are not allowed");
1276 if (sig == 0 && SvPOK(ST(0))) {
1277 const char *s = SvPVX_const(ST(0));
1278 int i = whichsig(s);
1280 if (i < 0 && memEQ(s, "SIG", 3))
1281 i = whichsig(s + 3);
1283 if (ckWARN(WARN_SIGNAL))
1284 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1285 "No such signal: SIG%s", s);
1292 if (sig > NSIG) { /* NSIG - 1 is still okay. */
1293 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1294 "No such signal: %d", sig);
1298 sigsvp = hv_fetch(GvHVn(siggv),
1300 strlen(PL_sig_name[sig]),
1303 /* Check optaction and set action */
1304 if(SvTRUE(optaction)) {
1305 if(sv_isa(optaction, "POSIX::SigAction"))
1306 action = (HV*)SvRV(optaction);
1308 croak("action is not of type POSIX::SigAction");
1314 /* sigaction() is supposed to look atomic. In particular, any
1315 * signal handler invoked during a sigaction() call should
1316 * see either the old or the new disposition, and not something
1317 * in between. We use sigprocmask() to make it so.
1320 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1324 /* Restore signal mask no matter how we exit this block. */
1325 osset_sv = newSVpv((char *)(&osset), sizeof(sigset_t));
1326 SAVEFREESV( osset_sv );
1327 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1329 RETVAL=-1; /* In case both oldaction and action are 0. */
1331 /* Remember old disposition if desired. */
1333 svp = hv_fetchs(oldaction, "HANDLER", TRUE);
1335 croak("Can't supply an oldaction without a HANDLER");
1336 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1337 sv_setsv(*svp, *sigsvp);
1340 sv_setpv(*svp, "DEFAULT");
1342 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
1345 /* Get back the mask. */
1346 svp = hv_fetchs(oldaction, "MASK", TRUE);
1347 if (sv_isa(*svp, "POSIX::SigSet")) {
1348 IV tmp = SvIV((SV*)SvRV(*svp));
1349 sigset = INT2PTR(sigset_t*, tmp);
1352 Newx(sigset, 1, sigset_t);
1353 sv_setptrobj(*svp, sigset, "POSIX::SigSet");
1355 *sigset = oact.sa_mask;
1357 /* Get back the flags. */
1358 svp = hv_fetchs(oldaction, "FLAGS", TRUE);
1359 sv_setiv(*svp, oact.sa_flags);
1361 /* Get back whether the old handler used safe signals. */
1362 svp = hv_fetchs(oldaction, "SAFE", TRUE);
1364 /* compare incompatible pointers by casting to integer */
1365 PTR2nat(oact.sa_handler) == PTR2nat(PL_csighandlerp));
1369 /* Safe signals use "csighandler", which vectors through the
1370 PL_sighandlerp pointer when it's safe to do so.
1371 (BTW, "csighandler" is very different from "sighandler".) */
1372 svp = hv_fetchs(action, "SAFE", FALSE);
1376 (*svp && SvTRUE(*svp))
1377 ? PL_csighandlerp : PL_sighandlerp
1380 /* Vector new Perl handler through %SIG.
1381 (The core signal handlers read %SIG to dispatch.) */
1382 svp = hv_fetchs(action, "HANDLER", FALSE);
1384 croak("Can't supply an action without a HANDLER");
1385 sv_setsv(*sigsvp, *svp);
1387 /* This call actually calls sigaction() with almost the
1388 right settings, including appropriate interpretation
1389 of DEFAULT and IGNORE. However, why are we doing
1390 this when we're about to do it again just below? XXX */
1393 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1395 const char *s=SvPVX_const(*svp);
1396 if(strEQ(s,"IGNORE")) {
1397 act.sa_handler = SIG_IGN;
1399 else if(strEQ(s,"DEFAULT")) {
1400 act.sa_handler = SIG_DFL;
1404 /* Set up any desired mask. */
1405 svp = hv_fetchs(action, "MASK", FALSE);
1406 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
1407 IV tmp = SvIV((SV*)SvRV(*svp));
1408 sigset = INT2PTR(sigset_t*, tmp);
1409 act.sa_mask = *sigset;
1412 sigemptyset(& act.sa_mask);
1414 /* Set up any desired flags. */
1415 svp = hv_fetchs(action, "FLAGS", FALSE);
1416 act.sa_flags = svp ? SvIV(*svp) : 0;
1418 /* Don't worry about cleaning up *sigsvp if this fails,
1419 * because that means we tried to disposition a
1420 * nonblockable signal, in which case *sigsvp is
1421 * essentially meaningless anyway.
1423 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
1436 POSIX::SigSet sigset
1439 sigprocmask(how, sigset, oldsigset = 0)
1441 POSIX::SigSet sigset = NO_INIT
1442 POSIX::SigSet oldsigset = NO_INIT
1444 if (! SvOK(ST(1))) {
1446 } else if (sv_isa(ST(1), "POSIX::SigSet")) {
1447 IV tmp = SvIV((SV*)SvRV(ST(1)));
1448 sigset = INT2PTR(POSIX__SigSet,tmp);
1450 croak("sigset is not of type POSIX::SigSet");
1453 if (items < 3 || ! SvOK(ST(2))) {
1455 } else if (sv_isa(ST(2), "POSIX::SigSet")) {
1456 IV tmp = SvIV((SV*)SvRV(ST(2)));
1457 oldsigset = INT2PTR(POSIX__SigSet,tmp);
1459 croak("oldsigset is not of type POSIX::SigSet");
1463 sigsuspend(signal_mask)
1464 POSIX::SigSet signal_mask
1484 lseek(fd, offset, whence)
1489 Off_t pos = PerlLIO_lseek(fd, offset, whence);
1490 RETVAL = sizeof(Off_t) > sizeof(IV)
1491 ? newSVnv((NV)pos) : newSViv((IV)pos);
1500 if ((incr = nice(incr)) != -1 || errno == 0) {
1502 XPUSHs(sv_2mortal(newSVpvn("0 but true", 10)));
1504 XPUSHs(sv_2mortal(newSViv(incr)));
1511 if (pipe(fds) != -1) {
1513 PUSHs(sv_2mortal(newSViv(fds[0])));
1514 PUSHs(sv_2mortal(newSViv(fds[1])));
1518 read(fd, buffer, nbytes)
1520 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1524 char * buffer = sv_grow( sv_buffer, nbytes+1 );
1527 SvCUR_set(sv_buffer, RETVAL);
1528 SvPOK_only(sv_buffer);
1529 *SvEND(sv_buffer) = '\0';
1530 SvTAINTED_on(sv_buffer);
1546 tcsetpgrp(fd, pgrp_id)
1555 if (uname(&buf) >= 0) {
1557 PUSHs(sv_2mortal(newSVpv(buf.sysname, 0)));
1558 PUSHs(sv_2mortal(newSVpv(buf.nodename, 0)));
1559 PUSHs(sv_2mortal(newSVpv(buf.release, 0)));
1560 PUSHs(sv_2mortal(newSVpv(buf.version, 0)));
1561 PUSHs(sv_2mortal(newSVpv(buf.machine, 0)));
1564 uname((char *) 0); /* A stub to call not_here(). */
1568 write(fd, buffer, nbytes)
1579 RETVAL = newSVpvn("", 0);
1580 SvGROW(RETVAL, L_tmpnam);
1581 len = strlen(tmpnam(SvPV(RETVAL, i)));
1582 SvCUR_set(RETVAL, len);
1595 mbstowcs(s, pwcs, n)
1607 wcstombs(s, pwcs, n)
1629 SET_NUMERIC_LOCAL();
1630 num = strtod(str, &unparsed);
1631 PUSHs(sv_2mortal(newSVnv(num)));
1632 if (GIMME == G_ARRAY) {
1635 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1637 PUSHs(&PL_sv_undef);
1641 strtol(str, base = 0)
1648 num = strtol(str, &unparsed, base);
1649 #if IVSIZE <= LONGSIZE
1650 if (num < IV_MIN || num > IV_MAX)
1651 PUSHs(sv_2mortal(newSVnv((double)num)));
1654 PUSHs(sv_2mortal(newSViv((IV)num)));
1655 if (GIMME == G_ARRAY) {
1658 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1660 PUSHs(&PL_sv_undef);
1664 strtoul(str, base = 0)
1671 num = strtoul(str, &unparsed, base);
1672 #if IVSIZE <= LONGSIZE
1674 PUSHs(sv_2mortal(newSVnv((double)num)));
1677 PUSHs(sv_2mortal(newSViv((IV)num)));
1678 if (GIMME == G_ARRAY) {
1681 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1683 PUSHs(&PL_sv_undef);
1693 char *p = SvPV(src,srclen);
1695 ST(0) = sv_2mortal(newSV(srclen*4+1));
1696 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1697 if (dstlen > srclen) {
1699 SvGROW(ST(0), dstlen);
1700 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1703 SvCUR_set(ST(0), dstlen);
1708 mkfifo(filename, mode)
1712 TAINT_PROPER("mkfifo");
1713 RETVAL = mkfifo(filename, mode);
1729 tcflush(fd, queue_selector)
1734 tcsendbreak(fd, duration)
1739 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
1752 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1755 mytm.tm_hour = hour;
1756 mytm.tm_mday = mday;
1758 mytm.tm_year = year;
1759 mytm.tm_wday = wday;
1760 mytm.tm_yday = yday;
1761 mytm.tm_isdst = isdst;
1762 RETVAL = asctime(&mytm);
1779 realtime = times( &tms );
1781 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1782 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1783 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1784 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1785 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
1788 difftime(time1, time2)
1793 mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = -1)
1806 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1809 mytm.tm_hour = hour;
1810 mytm.tm_mday = mday;
1812 mytm.tm_year = year;
1813 mytm.tm_wday = wday;
1814 mytm.tm_yday = yday;
1815 mytm.tm_isdst = isdst;
1816 RETVAL = (SysRetLong) mktime(&mytm);
1821 #XXX: if $xsubpp::WantOptimize is always the default
1822 # sv_setpv(TARG, ...) could be used rather than
1823 # ST(0) = sv_2mortal(newSVpv(...))
1825 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
1838 char *buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst);
1840 ST(0) = sv_2mortal(newSVpv(buf, 0));
1852 PUSHs(sv_2mortal(newSVpvn(tzname[0],strlen(tzname[0]))));
1853 PUSHs(sv_2mortal(newSVpvn(tzname[1],strlen(tzname[1]))));
1856 access(filename, mode)
1864 #ifdef HAS_CTERMID_R
1865 s = (char *) safemalloc((size_t) L_ctermid);
1867 RETVAL = ctermid(s);
1871 #ifdef HAS_CTERMID_R
1885 pathconf(filename, name)
1899 PL_egid = getegid();
1910 PL_euid = geteuid();
1928 XSprePUSH; PUSHTARG;
1932 lchown(uid, gid, path)
1938 /* yes, the order of arguments is different,
1939 * but consistent with CORE::chown() */
1940 RETVAL = lchown(path, uid, gid);
1942 RETVAL = not_here("lchown");