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);
421 /* Names all of length 7. */
422 /* S_ISBLK S_ISCHR S_ISDIR S_ISREG */
423 /* Offset 5 gives the best switch position. */
426 if (memEQ(name, "S_ISREG", 7)) {
429 *arg_result = S_ISREG(*arg_result);
430 return PERL_constant_ISIV;
432 return PERL_constant_NOTDEF;
437 if (memEQ(name, "S_ISCHR", 7)) {
440 *arg_result = S_ISCHR(*arg_result);
441 return PERL_constant_ISIV;
443 return PERL_constant_NOTDEF;
448 if (memEQ(name, "S_ISDIR", 7)) {
451 *arg_result = S_ISDIR(*arg_result);
452 return PERL_constant_ISIV;
454 return PERL_constant_NOTDEF;
459 if (memEQ(name, "S_ISBLK", 7)) {
462 *arg_result = S_ISBLK(*arg_result);
463 return PERL_constant_ISIV;
465 return PERL_constant_NOTDEF;
472 /* Names all of length 8. */
473 /* S_ISFIFO WSTOPSIG WTERMSIG */
474 /* Offset 3 gives the best switch position. */
477 if (memEQ(name, "WSTOPSIG", 8)) {
481 *arg_result = WSTOPSIG(WMUNGE(i));
482 return PERL_constant_ISIV;
484 return PERL_constant_NOTDEF;
489 if (memEQ(name, "WTERMSIG", 8)) {
493 *arg_result = WTERMSIG(WMUNGE(i));
494 return PERL_constant_ISIV;
496 return PERL_constant_NOTDEF;
501 if (memEQ(name, "S_ISFIFO", 8)) {
504 *arg_result = S_ISFIFO(*arg_result);
505 return PERL_constant_ISIV;
507 return PERL_constant_NOTDEF;
514 if (memEQ(name, "WIFEXITED", 9)) {
517 *arg_result = WIFEXITED(WMUNGE(i));
518 return PERL_constant_ISIV;
520 return PERL_constant_NOTDEF;
525 if (memEQ(name, "WIFSTOPPED", 10)) {
528 *arg_result = WIFSTOPPED(WMUNGE(i));
529 return PERL_constant_ISIV;
531 return PERL_constant_NOTDEF;
536 /* Names all of length 11. */
537 /* WEXITSTATUS WIFSIGNALED */
538 /* Offset 1 gives the best switch position. */
541 if (memEQ(name, "WEXITSTATUS", 11)) {
545 *arg_result = WEXITSTATUS(WMUNGE(i));
546 return PERL_constant_ISIV;
548 return PERL_constant_NOTDEF;
553 if (memEQ(name, "WIFSIGNALED", 11)) {
557 *arg_result = WIFSIGNALED(WMUNGE(i));
558 return PERL_constant_ISIV;
560 return PERL_constant_NOTDEF;
567 return PERL_constant_NOTFOUND;
571 restore_sigmask(pTHX_ SV *osset_sv)
573 /* Fortunately, restoring the signal mask can't fail, because
574 * there's nothing we can do about it if it does -- we're not
575 * supposed to return -1 from sigaction unless the disposition
578 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
579 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
582 MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
585 new(packname = "POSIX::SigSet", ...)
590 New(0, RETVAL, 1, sigset_t);
592 for (i = 1; i < items; i++)
593 sigaddset(RETVAL, SvIV(ST(i)));
605 sigaddset(sigset, sig)
610 sigdelset(sigset, sig)
623 sigismember(sigset, sig)
627 MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
630 new(packname = "POSIX::Termios", ...)
635 New(0, RETVAL, 1, struct termios);
646 POSIX::Termios termios_ref
649 Safefree(termios_ref);
655 getattr(termios_ref, fd = 0)
656 POSIX::Termios termios_ref
659 RETVAL = tcgetattr(fd, termios_ref);
664 setattr(termios_ref, fd = 0, optional_actions = 0)
665 POSIX::Termios termios_ref
669 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
674 cfgetispeed(termios_ref)
675 POSIX::Termios termios_ref
678 cfgetospeed(termios_ref)
679 POSIX::Termios termios_ref
682 getiflag(termios_ref)
683 POSIX::Termios termios_ref
685 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
686 RETVAL = termios_ref->c_iflag;
688 not_here("getiflag");
695 getoflag(termios_ref)
696 POSIX::Termios termios_ref
698 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
699 RETVAL = termios_ref->c_oflag;
701 not_here("getoflag");
708 getcflag(termios_ref)
709 POSIX::Termios termios_ref
711 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
712 RETVAL = termios_ref->c_cflag;
714 not_here("getcflag");
721 getlflag(termios_ref)
722 POSIX::Termios termios_ref
724 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
725 RETVAL = termios_ref->c_lflag;
727 not_here("getlflag");
734 getcc(termios_ref, ccix)
735 POSIX::Termios termios_ref
738 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
740 croak("Bad getcc subscript");
741 RETVAL = termios_ref->c_cc[ccix];
750 cfsetispeed(termios_ref, speed)
751 POSIX::Termios termios_ref
755 cfsetospeed(termios_ref, speed)
756 POSIX::Termios termios_ref
760 setiflag(termios_ref, iflag)
761 POSIX::Termios termios_ref
764 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
765 termios_ref->c_iflag = iflag;
767 not_here("setiflag");
771 setoflag(termios_ref, oflag)
772 POSIX::Termios termios_ref
775 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
776 termios_ref->c_oflag = oflag;
778 not_here("setoflag");
782 setcflag(termios_ref, cflag)
783 POSIX::Termios termios_ref
786 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
787 termios_ref->c_cflag = cflag;
789 not_here("setcflag");
793 setlflag(termios_ref, lflag)
794 POSIX::Termios termios_ref
797 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
798 termios_ref->c_lflag = lflag;
800 not_here("setlflag");
804 setcc(termios_ref, ccix, cc)
805 POSIX::Termios termios_ref
809 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
811 croak("Bad setcc subscript");
812 termios_ref->c_cc[ccix] = cc;
818 MODULE = POSIX PACKAGE = POSIX
820 INCLUDE: const-xs.inc
823 int_macro_int(sv, iv)
830 const char * s = SvPV(sv, len);
833 /* Change this to int_macro_int(s, len, &iv, &nv);
834 if you need to return both NVs and IVs */
835 type = int_macro_int(s, len, &iv);
836 /* Return 1 or 2 items. First is error message, or undef if no error.
837 Second, if present, is found value */
839 case PERL_constant_NOTFOUND:
840 sv = sv_2mortal(newSVpvf("%s is not a valid POSIX macro", s));
845 case PERL_constant_NOTDEF:
846 sv = sv_2mortal(newSVpvf(
847 "Your vendor has not defined POSIX macro %s, used", s));
852 case PERL_constant_ISIV:
856 sv = sv_2mortal(newSVpvf(
857 "Unexpected return type %d while processing POSIX macro %s, used",
870 unsigned char *s = (unsigned char *) SvPV(charstring, len);
871 unsigned char *e = s + len;
872 for (RETVAL = 1; RETVAL && s < e; s++)
884 unsigned char *s = (unsigned char *) SvPV(charstring, len);
885 unsigned char *e = s + len;
886 for (RETVAL = 1; RETVAL && s < e; s++)
898 unsigned char *s = (unsigned char *) SvPV(charstring, len);
899 unsigned char *e = s + len;
900 for (RETVAL = 1; RETVAL && s < e; s++)
912 unsigned char *s = (unsigned char *) SvPV(charstring, len);
913 unsigned char *e = s + len;
914 for (RETVAL = 1; RETVAL && s < e; s++)
926 unsigned char *s = (unsigned char *) SvPV(charstring, len);
927 unsigned char *e = s + len;
928 for (RETVAL = 1; RETVAL && s < e; s++)
940 unsigned char *s = (unsigned char *) SvPV(charstring, len);
941 unsigned char *e = s + len;
942 for (RETVAL = 1; RETVAL && s < e; s++)
954 unsigned char *s = (unsigned char *) SvPV(charstring, len);
955 unsigned char *e = s + len;
956 for (RETVAL = 1; RETVAL && s < e; s++)
968 unsigned char *s = (unsigned char *) SvPV(charstring, len);
969 unsigned char *e = s + len;
970 for (RETVAL = 1; RETVAL && s < e; s++)
982 unsigned char *s = (unsigned char *) SvPV(charstring, len);
983 unsigned char *e = s + len;
984 for (RETVAL = 1; RETVAL && s < e; s++)
996 unsigned char *s = (unsigned char *) SvPV(charstring, len);
997 unsigned char *e = s + len;
998 for (RETVAL = 1; RETVAL && s < e; s++)
1005 isxdigit(charstring)
1010 unsigned char *s = (unsigned char *) SvPV(charstring, len);
1011 unsigned char *e = s + len;
1012 for (RETVAL = 1; RETVAL && s < e; s++)
1019 open(filename, flags = O_RDONLY, mode = 0666)
1024 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
1025 TAINT_PROPER("open");
1026 RETVAL = open(filename, flags, mode);
1034 #ifdef HAS_LOCALECONV
1035 struct lconv *lcbuf;
1037 sv_2mortal((SV*)RETVAL);
1038 if ((lcbuf = localeconv())) {
1040 if (lcbuf->decimal_point && *lcbuf->decimal_point)
1041 hv_store(RETVAL, "decimal_point", 13,
1042 newSVpv(lcbuf->decimal_point, 0), 0);
1043 if (lcbuf->thousands_sep && *lcbuf->thousands_sep)
1044 hv_store(RETVAL, "thousands_sep", 13,
1045 newSVpv(lcbuf->thousands_sep, 0), 0);
1046 #ifndef NO_LOCALECONV_GROUPING
1047 if (lcbuf->grouping && *lcbuf->grouping)
1048 hv_store(RETVAL, "grouping", 8,
1049 newSVpv(lcbuf->grouping, 0), 0);
1051 if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol)
1052 hv_store(RETVAL, "int_curr_symbol", 15,
1053 newSVpv(lcbuf->int_curr_symbol, 0), 0);
1054 if (lcbuf->currency_symbol && *lcbuf->currency_symbol)
1055 hv_store(RETVAL, "currency_symbol", 15,
1056 newSVpv(lcbuf->currency_symbol, 0), 0);
1057 if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
1058 hv_store(RETVAL, "mon_decimal_point", 17,
1059 newSVpv(lcbuf->mon_decimal_point, 0), 0);
1060 #ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
1061 if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
1062 hv_store(RETVAL, "mon_thousands_sep", 17,
1063 newSVpv(lcbuf->mon_thousands_sep, 0), 0);
1065 #ifndef NO_LOCALECONV_MON_GROUPING
1066 if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
1067 hv_store(RETVAL, "mon_grouping", 12,
1068 newSVpv(lcbuf->mon_grouping, 0), 0);
1070 if (lcbuf->positive_sign && *lcbuf->positive_sign)
1071 hv_store(RETVAL, "positive_sign", 13,
1072 newSVpv(lcbuf->positive_sign, 0), 0);
1073 if (lcbuf->negative_sign && *lcbuf->negative_sign)
1074 hv_store(RETVAL, "negative_sign", 13,
1075 newSVpv(lcbuf->negative_sign, 0), 0);
1077 if (lcbuf->int_frac_digits != CHAR_MAX)
1078 hv_store(RETVAL, "int_frac_digits", 15,
1079 newSViv(lcbuf->int_frac_digits), 0);
1080 if (lcbuf->frac_digits != CHAR_MAX)
1081 hv_store(RETVAL, "frac_digits", 11,
1082 newSViv(lcbuf->frac_digits), 0);
1083 if (lcbuf->p_cs_precedes != CHAR_MAX)
1084 hv_store(RETVAL, "p_cs_precedes", 13,
1085 newSViv(lcbuf->p_cs_precedes), 0);
1086 if (lcbuf->p_sep_by_space != CHAR_MAX)
1087 hv_store(RETVAL, "p_sep_by_space", 14,
1088 newSViv(lcbuf->p_sep_by_space), 0);
1089 if (lcbuf->n_cs_precedes != CHAR_MAX)
1090 hv_store(RETVAL, "n_cs_precedes", 13,
1091 newSViv(lcbuf->n_cs_precedes), 0);
1092 if (lcbuf->n_sep_by_space != CHAR_MAX)
1093 hv_store(RETVAL, "n_sep_by_space", 14,
1094 newSViv(lcbuf->n_sep_by_space), 0);
1095 if (lcbuf->p_sign_posn != CHAR_MAX)
1096 hv_store(RETVAL, "p_sign_posn", 11,
1097 newSViv(lcbuf->p_sign_posn), 0);
1098 if (lcbuf->n_sign_posn != CHAR_MAX)
1099 hv_store(RETVAL, "n_sign_posn", 11,
1100 newSViv(lcbuf->n_sign_posn), 0);
1103 localeconv(); /* A stub to call not_here(). */
1109 setlocale(category, locale = 0)
1113 RETVAL = setlocale(category, locale);
1115 #ifdef USE_LOCALE_CTYPE
1116 if (category == LC_CTYPE
1118 || category == LC_ALL
1124 if (category == LC_ALL)
1125 newctype = setlocale(LC_CTYPE, NULL);
1129 new_ctype(newctype);
1131 #endif /* USE_LOCALE_CTYPE */
1132 #ifdef USE_LOCALE_COLLATE
1133 if (category == LC_COLLATE
1135 || category == LC_ALL
1141 if (category == LC_ALL)
1142 newcoll = setlocale(LC_COLLATE, NULL);
1146 new_collate(newcoll);
1148 #endif /* USE_LOCALE_COLLATE */
1149 #ifdef USE_LOCALE_NUMERIC
1150 if (category == LC_NUMERIC
1152 || category == LC_ALL
1158 if (category == LC_ALL)
1159 newnum = setlocale(LC_NUMERIC, NULL);
1163 new_numeric(newnum);
1165 #endif /* USE_LOCALE_NUMERIC */
1205 /* (We already know stack is long enough.) */
1206 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1207 PUSHs(sv_2mortal(newSViv(expvar)));
1223 /* (We already know stack is long enough.) */
1224 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
1225 PUSHs(sv_2mortal(newSVnv(intvar)));
1240 sigaction(sig, optaction, oldaction = 0)
1243 POSIX::SigAction oldaction
1245 #if defined(WIN32) || defined(NETWARE)
1246 RETVAL = not_here("sigaction");
1248 # This code is really grody because we're trying to make the signal
1249 # interface look beautiful, which is hard.
1253 POSIX__SigAction action;
1254 GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
1255 struct sigaction act;
1256 struct sigaction oact;
1260 POSIX__SigSet sigset;
1263 if (sig == 0 && SvPOK(ST(0))) {
1264 const char *s = SvPVX_const(ST(0));
1265 int i = whichsig(s);
1267 if (i < 0 && memEQ(s, "SIG", 3))
1268 i = whichsig(s + 3);
1270 if (ckWARN(WARN_SIGNAL))
1271 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1272 "No such signal: SIG%s", s);
1278 sigsvp = hv_fetch(GvHVn(siggv),
1280 strlen(PL_sig_name[sig]),
1283 /* Check optaction and set action */
1284 if(SvTRUE(optaction)) {
1285 if(sv_isa(optaction, "POSIX::SigAction"))
1286 action = (HV*)SvRV(optaction);
1288 croak("action is not of type POSIX::SigAction");
1294 /* sigaction() is supposed to look atomic. In particular, any
1295 * signal handler invoked during a sigaction() call should
1296 * see either the old or the new disposition, and not something
1297 * in between. We use sigprocmask() to make it so.
1300 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1304 /* Restore signal mask no matter how we exit this block. */
1305 osset_sv = newSVpv((char *)(&osset), sizeof(sigset_t));
1306 SAVEFREESV( osset_sv );
1307 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1309 RETVAL=-1; /* In case both oldaction and action are 0. */
1311 /* Remember old disposition if desired. */
1313 svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
1315 croak("Can't supply an oldaction without a HANDLER");
1316 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1317 sv_setsv(*svp, *sigsvp);
1320 sv_setpv(*svp, "DEFAULT");
1322 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
1325 /* Get back the mask. */
1326 svp = hv_fetch(oldaction, "MASK", 4, TRUE);
1327 if (sv_isa(*svp, "POSIX::SigSet")) {
1328 IV tmp = SvIV((SV*)SvRV(*svp));
1329 sigset = INT2PTR(sigset_t*, tmp);
1332 New(0, sigset, 1, sigset_t);
1333 sv_setptrobj(*svp, sigset, "POSIX::SigSet");
1335 *sigset = oact.sa_mask;
1337 /* Get back the flags. */
1338 svp = hv_fetch(oldaction, "FLAGS", 5, TRUE);
1339 sv_setiv(*svp, oact.sa_flags);
1341 /* Get back whether the old handler used safe signals. */
1342 svp = hv_fetch(oldaction, "SAFE", 4, TRUE);
1343 sv_setiv(*svp, oact.sa_handler == PL_csighandlerp);
1347 /* Safe signals use "csighandler", which vectors through the
1348 PL_sighandlerp pointer when it's safe to do so.
1349 (BTW, "csighandler" is very different from "sighandler".) */
1350 svp = hv_fetch(action, "SAFE", 4, FALSE);
1351 act.sa_handler = (*svp && SvTRUE(*svp))
1352 ? PL_csighandlerp : PL_sighandlerp;
1354 /* Vector new Perl handler through %SIG.
1355 (The core signal handlers read %SIG to dispatch.) */
1356 svp = hv_fetch(action, "HANDLER", 7, FALSE);
1358 croak("Can't supply an action without a HANDLER");
1359 sv_setsv(*sigsvp, *svp);
1361 /* This call actually calls sigaction() with almost the
1362 right settings, including appropriate interpretation
1363 of DEFAULT and IGNORE. However, why are we doing
1364 this when we're about to do it again just below? XXX */
1367 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1369 const char *s=SvPVX_const(*svp);
1370 if(strEQ(s,"IGNORE")) {
1371 act.sa_handler = SIG_IGN;
1373 else if(strEQ(s,"DEFAULT")) {
1374 act.sa_handler = SIG_DFL;
1378 /* Set up any desired mask. */
1379 svp = hv_fetch(action, "MASK", 4, FALSE);
1380 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
1381 IV tmp = SvIV((SV*)SvRV(*svp));
1382 sigset = INT2PTR(sigset_t*, tmp);
1383 act.sa_mask = *sigset;
1386 sigemptyset(& act.sa_mask);
1388 /* Set up any desired flags. */
1389 svp = hv_fetch(action, "FLAGS", 5, FALSE);
1390 act.sa_flags = svp ? SvIV(*svp) : 0;
1392 /* Don't worry about cleaning up *sigsvp if this fails,
1393 * because that means we tried to disposition a
1394 * nonblockable signal, in which case *sigsvp is
1395 * essentially meaningless anyway.
1397 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
1410 POSIX::SigSet sigset
1413 sigprocmask(how, sigset, oldsigset = 0)
1415 POSIX::SigSet sigset = NO_INIT
1416 POSIX::SigSet oldsigset = NO_INIT
1418 if (! SvOK(ST(1))) {
1420 } else if (sv_isa(ST(1), "POSIX::SigSet")) {
1421 IV tmp = SvIV((SV*)SvRV(ST(1)));
1422 sigset = INT2PTR(POSIX__SigSet,tmp);
1424 croak("sigset is not of type POSIX::SigSet");
1427 if (items < 3 || ! SvOK(ST(2))) {
1429 } else if (sv_isa(ST(2), "POSIX::SigSet")) {
1430 IV tmp = SvIV((SV*)SvRV(ST(2)));
1431 oldsigset = INT2PTR(POSIX__SigSet,tmp);
1433 croak("oldsigset is not of type POSIX::SigSet");
1437 sigsuspend(signal_mask)
1438 POSIX::SigSet signal_mask
1458 lseek(fd, offset, whence)
1463 Off_t pos = PerlLIO_lseek(fd, offset, whence);
1464 RETVAL = sizeof(Off_t) > sizeof(IV)
1465 ? newSVnv((NV)pos) : newSViv((IV)pos);
1474 if ((incr = nice(incr)) != -1 || errno == 0) {
1476 XPUSHs(sv_2mortal(newSVpvn("0 but true", 10)));
1478 XPUSHs(sv_2mortal(newSViv(incr)));
1485 if (pipe(fds) != -1) {
1487 PUSHs(sv_2mortal(newSViv(fds[0])));
1488 PUSHs(sv_2mortal(newSViv(fds[1])));
1492 read(fd, buffer, nbytes)
1494 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1498 char * buffer = sv_grow( sv_buffer, nbytes+1 );
1501 SvCUR_set(sv_buffer, RETVAL);
1502 SvPOK_only(sv_buffer);
1503 *SvEND(sv_buffer) = '\0';
1504 SvTAINTED_on(sv_buffer);
1520 tcsetpgrp(fd, pgrp_id)
1529 if (uname(&buf) >= 0) {
1531 PUSHs(sv_2mortal(newSVpv(buf.sysname, 0)));
1532 PUSHs(sv_2mortal(newSVpv(buf.nodename, 0)));
1533 PUSHs(sv_2mortal(newSVpv(buf.release, 0)));
1534 PUSHs(sv_2mortal(newSVpv(buf.version, 0)));
1535 PUSHs(sv_2mortal(newSVpv(buf.machine, 0)));
1538 uname((char *) 0); /* A stub to call not_here(). */
1542 write(fd, buffer, nbytes)
1553 RETVAL = newSVpvn("", 0);
1554 SvGROW(RETVAL, L_tmpnam);
1555 len = strlen(tmpnam(SvPV(RETVAL, i)));
1556 SvCUR_set(RETVAL, len);
1569 mbstowcs(s, pwcs, n)
1581 wcstombs(s, pwcs, n)
1603 SET_NUMERIC_LOCAL();
1604 num = strtod(str, &unparsed);
1605 PUSHs(sv_2mortal(newSVnv(num)));
1606 if (GIMME == G_ARRAY) {
1609 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1611 PUSHs(&PL_sv_undef);
1615 strtol(str, base = 0)
1622 num = strtol(str, &unparsed, base);
1623 #if IVSIZE <= LONGSIZE
1624 if (num < IV_MIN || num > IV_MAX)
1625 PUSHs(sv_2mortal(newSVnv((double)num)));
1628 PUSHs(sv_2mortal(newSViv((IV)num)));
1629 if (GIMME == G_ARRAY) {
1632 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1634 PUSHs(&PL_sv_undef);
1638 strtoul(str, base = 0)
1645 num = strtoul(str, &unparsed, base);
1646 #if IVSIZE <= LONGSIZE
1648 PUSHs(sv_2mortal(newSVnv((double)num)));
1651 PUSHs(sv_2mortal(newSViv((IV)num)));
1652 if (GIMME == G_ARRAY) {
1655 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1657 PUSHs(&PL_sv_undef);
1667 char *p = SvPV(src,srclen);
1669 ST(0) = sv_2mortal(NEWSV(800,srclen*4+1));
1670 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1671 if (dstlen > srclen) {
1673 SvGROW(ST(0), dstlen);
1674 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1677 SvCUR_set(ST(0), dstlen);
1682 mkfifo(filename, mode)
1686 TAINT_PROPER("mkfifo");
1687 RETVAL = mkfifo(filename, mode);
1703 tcflush(fd, queue_selector)
1708 tcsendbreak(fd, duration)
1713 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
1726 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1729 mytm.tm_hour = hour;
1730 mytm.tm_mday = mday;
1732 mytm.tm_year = year;
1733 mytm.tm_wday = wday;
1734 mytm.tm_yday = yday;
1735 mytm.tm_isdst = isdst;
1736 RETVAL = asctime(&mytm);
1753 realtime = times( &tms );
1755 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1756 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1757 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1758 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1759 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
1762 difftime(time1, time2)
1767 mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
1780 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1783 mytm.tm_hour = hour;
1784 mytm.tm_mday = mday;
1786 mytm.tm_year = year;
1787 mytm.tm_wday = wday;
1788 mytm.tm_yday = yday;
1789 mytm.tm_isdst = isdst;
1790 RETVAL = mktime(&mytm);
1795 #XXX: if $xsubpp::WantOptimize is always the default
1796 # sv_setpv(TARG, ...) could be used rather than
1797 # ST(0) = sv_2mortal(newSVpv(...))
1799 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
1812 char *buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst);
1814 ST(0) = sv_2mortal(newSVpv(buf, 0));
1826 PUSHs(sv_2mortal(newSVpvn(tzname[0],strlen(tzname[0]))));
1827 PUSHs(sv_2mortal(newSVpvn(tzname[1],strlen(tzname[1]))));
1830 access(filename, mode)
1838 #ifdef HAS_CTERMID_R
1839 s = safemalloc((size_t) L_ctermid);
1841 RETVAL = ctermid(s);
1845 #ifdef HAS_CTERMID_R
1859 pathconf(filename, name)
1873 PL_egid = getegid();
1884 PL_euid = geteuid();
1902 XSprePUSH; PUSHTARG;
1906 lchown(uid, gid, path)
1912 /* yes, the order of arguments is different,
1913 * but consistent with CORE::chown() */
1914 RETVAL = lchown(path, uid, gid);
1916 RETVAL = not_here("lchown");