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)
66 #include <sys/types.h>
71 #ifdef MACOS_TRADITIONAL
77 # if !defined(WIN32) && !defined(__CYGWIN__) && !defined(NETWARE) && !defined(__UWIN__)
78 extern char *tzname[];
81 #if !defined(WIN32) && !defined(__UWIN__) || (defined(__MINGW32__) && !defined(tzname))
82 char *tzname[] = { "" , "" };
86 #if defined(__VMS) && !defined(__POSIX_SOURCE)
87 # include <libdef.h> /* LIB$_INVARG constant */
88 # include <lib$routines.h> /* prototype for lib$ediv() */
89 # include <starlet.h> /* prototype for sys$gettim() */
90 # if DECC_VERSION < 50000000
91 # define pid_t int /* old versions of DECC miss this in types.h */
95 # define mkfifo(a,b) (not_here("mkfifo"),-1)
96 # define tzset() not_here("tzset")
98 #if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
99 # define HAS_TZNAME /* shows up in VMS 7.0 or Dec C 5.6 */
100 # include <utsname.h>
101 # endif /* __VMS_VER >= 70000000 or Dec C 5.6 */
103 /* The POSIX notion of ttyname() is better served by getname() under VMS */
104 static char ttnambuf[64];
105 # define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
107 /* The non-POSIX CRTL times() has void return type, so we just get the
108 current time directly */
109 clock_t vms_times(struct tms *bufptr) {
112 /* Get wall time and convert to 10 ms intervals to
113 * produce the return value that the POSIX standard expects */
114 # if defined(__DECC) && defined (__ALPHA)
117 _ckvmssts(sys$gettim(&vmstime));
119 retval = vmstime & 0x7fffffff;
121 /* (Older hw or ccs don't have an atomic 64-bit type, so we
122 * juggle 32-bit ints (and a float) to produce a time_t result
123 * with minimal loss of information.) */
124 long int vmstime[2],remainder,divisor = 100000;
125 _ckvmssts(sys$gettim((unsigned long int *)vmstime));
126 vmstime[1] &= 0x7fff; /* prevent overflow in EDIV */
127 _ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder));
129 /* Fill in the struct tms using the CRTL routine . . .*/
130 times((tbuffer_t *)bufptr);
131 return (clock_t) retval;
133 # define times(t) vms_times(t)
135 #if defined (__CYGWIN__)
136 # define tzname _tzname
138 #if defined (WIN32) || defined (NETWARE)
140 # define mkfifo(a,b) not_here("mkfifo")
141 # define ttyname(a) (char*)not_here("ttyname")
142 # define sigset_t long
145 # define tzname _tzname
148 # define mode_t short
151 # define mode_t short
153 # define tzset() not_here("tzset")
155 # ifndef _POSIX_OPEN_MAX
156 # define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */
159 # define sigaction(a,b,c) not_here("sigaction")
160 # define sigpending(a) not_here("sigpending")
161 # define sigprocmask(a,b,c) not_here("sigprocmask")
162 # define sigsuspend(a) not_here("sigsuspend")
163 # define sigemptyset(a) not_here("sigemptyset")
164 # define sigaddset(a,b) not_here("sigaddset")
165 # define sigdelset(a,b) not_here("sigdelset")
166 # define sigfillset(a) not_here("sigfillset")
167 # define sigismember(a,b) not_here("sigismember")
171 # define setuid(a) not_here("setuid")
172 # define setgid(a) not_here("setgid")
177 # if defined(OS2) || defined(MACOS_TRADITIONAL)
178 # define mkfifo(a,b) not_here("mkfifo")
179 # else /* !( defined OS2 ) */
181 # define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
184 # endif /* !HAS_MKFIFO */
186 # ifdef MACOS_TRADITIONAL
187 # define ttyname(a) (char*)not_here("ttyname")
188 # define tzset() not_here("tzset")
191 # include <sys/times.h>
193 # include <sys/utsname.h>
195 # include <sys/wait.h>
200 #endif /* WIN32 || NETWARE */
204 typedef long SysRetLong;
205 typedef sigset_t* POSIX__SigSet;
206 typedef HV* POSIX__SigAction;
208 typedef struct termios* POSIX__Termios;
209 #else /* Define termios types to int, and call not_here for the functions.*/
210 #define POSIX__Termios int
214 #define cfgetispeed(x) not_here("cfgetispeed")
215 #define cfgetospeed(x) not_here("cfgetospeed")
216 #define tcdrain(x) not_here("tcdrain")
217 #define tcflush(x,y) not_here("tcflush")
218 #define tcsendbreak(x,y) not_here("tcsendbreak")
219 #define cfsetispeed(x,y) not_here("cfsetispeed")
220 #define cfsetospeed(x,y) not_here("cfsetospeed")
221 #define ctermid(x) (char *) not_here("ctermid")
222 #define tcflow(x,y) not_here("tcflow")
223 #define tcgetattr(x,y) not_here("tcgetattr")
224 #define tcsetattr(x,y,z) not_here("tcsetattr")
227 /* Possibly needed prototypes */
228 char *cuserid (char *);
230 double strtod (const char *, char **);
231 long strtol (const char *, char **, int);
232 unsigned long strtoul (const char *, char **, int);
236 #define cuserid(a) (char *) not_here("cuserid")
240 #define difftime(a,b) not_here("difftime")
243 #ifndef HAS_FPATHCONF
244 #define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
247 #define mktime(a) not_here("mktime")
250 #define nice(a) not_here("nice")
253 #define pathconf(f,n) (SysRetLong) not_here("pathconf")
256 #define sysconf(n) (SysRetLong) not_here("sysconf")
259 #define readlink(a,b,c) not_here("readlink")
262 #define setpgid(a,b) not_here("setpgid")
265 #define setsid() not_here("setsid")
268 #define strcoll(s1,s2) not_here("strcoll")
271 #define strtod(s1,s2) not_here("strtod")
274 #define strtol(s1,s2,b) not_here("strtol")
277 #define strtoul(s1,s2,b) not_here("strtoul")
280 #define strxfrm(s1,s2,n) not_here("strxfrm")
282 #ifndef HAS_TCGETPGRP
283 #define tcgetpgrp(a) not_here("tcgetpgrp")
285 #ifndef HAS_TCSETPGRP
286 #define tcsetpgrp(a,b) not_here("tcsetpgrp")
290 #define times(a) not_here("times")
294 #define uname(a) not_here("uname")
297 #define waitpid(a,b,c) not_here("waitpid")
302 #define mblen(a,b) not_here("mblen")
306 #define mbstowcs(s, pwcs, n) not_here("mbstowcs")
309 #define mbtowc(pwc, s, n) not_here("mbtowc")
312 #define wcstombs(s, pwcs, n) not_here("wcstombs")
315 #define wctomb(s, wchar) not_here("wcstombs")
317 #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
318 /* If we don't have these functions, then we wouldn't have gotten a typedef
319 for wchar_t, the wide character type. Defining wchar_t allows the
320 functions referencing it to compile. Its actual type is then meaningless,
321 since without the above functions, all sections using it end up calling
322 not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
328 #ifndef HAS_LOCALECONV
329 #define localeconv() not_here("localeconv")
332 #ifdef HAS_LONG_DOUBLE
333 # if LONG_DOUBLESIZE > NVSIZE
334 # undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
338 #ifndef HAS_LONG_DOUBLE
350 /* Background: in most systems the low byte of the wait status
351 * is the signal (the lowest 7 bits) and the coredump flag is
352 * the eight bit, and the second lowest byte is the exit status.
353 * BeOS bucks the trend and has the bytes in different order.
354 * See beos/beos.c for how the reality is bent even in BeOS
355 * to follow the traditional. However, to make the POSIX
356 * wait W*() macros to work in BeOS, we need to unbend the
357 * reality back in place. --jhi */
359 # define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
361 # define WMUNGE(x) (x)
367 croak("POSIX::%s not implemented on this architecture", s);
371 #include "const-c.inc"
373 /* These were implemented in the old "constant" subroutine. They are actually
374 macros that take an integer argument and return an integer result. */
376 int_macro_int (const char *name, STRLEN len, IV *arg_result) {
377 /* Initially switch on the length of the name. */
378 /* This code has been edited from a "constant" function generated by:
380 use ExtUtils::Constant qw (constant_types C_constant XS_constant);
382 my $types = {map {($_, 1)} qw(IV)};
383 my @names = (qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS WIFEXITED
384 WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
386 print constant_types(); # macro defs
387 foreach (C_constant ("POSIX", 'int_macro_int', 'IV', $types, undef, 5, @names) ) {
388 print $_, "\n"; # C constant subs
390 print "#### XS Section:\n";
391 print XS_constant ("POSIX", $types);
397 /* Names all of length 7. */
398 /* S_ISBLK S_ISCHR S_ISDIR S_ISREG */
399 /* Offset 5 gives the best switch position. */
402 if (memEQ(name, "S_ISREG", 7)) {
405 *arg_result = S_ISREG(*arg_result);
406 return PERL_constant_ISIV;
408 return PERL_constant_NOTDEF;
413 if (memEQ(name, "S_ISCHR", 7)) {
416 *arg_result = S_ISCHR(*arg_result);
417 return PERL_constant_ISIV;
419 return PERL_constant_NOTDEF;
424 if (memEQ(name, "S_ISDIR", 7)) {
427 *arg_result = S_ISDIR(*arg_result);
428 return PERL_constant_ISIV;
430 return PERL_constant_NOTDEF;
435 if (memEQ(name, "S_ISBLK", 7)) {
438 *arg_result = S_ISBLK(*arg_result);
439 return PERL_constant_ISIV;
441 return PERL_constant_NOTDEF;
448 /* Names all of length 8. */
449 /* S_ISFIFO WSTOPSIG WTERMSIG */
450 /* Offset 3 gives the best switch position. */
453 if (memEQ(name, "WSTOPSIG", 8)) {
457 *arg_result = WSTOPSIG(WMUNGE(i));
458 return PERL_constant_ISIV;
460 return PERL_constant_NOTDEF;
465 if (memEQ(name, "WTERMSIG", 8)) {
469 *arg_result = WTERMSIG(WMUNGE(i));
470 return PERL_constant_ISIV;
472 return PERL_constant_NOTDEF;
477 if (memEQ(name, "S_ISFIFO", 8)) {
480 *arg_result = S_ISFIFO(*arg_result);
481 return PERL_constant_ISIV;
483 return PERL_constant_NOTDEF;
490 if (memEQ(name, "WIFEXITED", 9)) {
493 *arg_result = WIFEXITED(WMUNGE(i));
494 return PERL_constant_ISIV;
496 return PERL_constant_NOTDEF;
501 if (memEQ(name, "WIFSTOPPED", 10)) {
504 *arg_result = WIFSTOPPED(WMUNGE(i));
505 return PERL_constant_ISIV;
507 return PERL_constant_NOTDEF;
512 /* Names all of length 11. */
513 /* WEXITSTATUS WIFSIGNALED */
514 /* Offset 1 gives the best switch position. */
517 if (memEQ(name, "WEXITSTATUS", 11)) {
521 *arg_result = WEXITSTATUS(WMUNGE(i));
522 return PERL_constant_ISIV;
524 return PERL_constant_NOTDEF;
529 if (memEQ(name, "WIFSIGNALED", 11)) {
533 *arg_result = WIFSIGNALED(WMUNGE(i));
534 return PERL_constant_ISIV;
536 return PERL_constant_NOTDEF;
543 return PERL_constant_NOTFOUND;
547 restore_sigmask(pTHX_ SV *osset_sv)
549 /* Fortunately, restoring the signal mask can't fail, because
550 * there's nothing we can do about it if it does -- we're not
551 * supposed to return -1 from sigaction unless the disposition
554 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
555 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
558 MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
561 new(packname = "POSIX::SigSet", ...)
566 New(0, RETVAL, 1, sigset_t);
568 for (i = 1; i < items; i++)
569 sigaddset(RETVAL, SvIV(ST(i)));
581 sigaddset(sigset, sig)
586 sigdelset(sigset, sig)
599 sigismember(sigset, sig)
604 MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
607 new(packname = "POSIX::Termios", ...)
612 New(0, RETVAL, 1, struct termios);
623 POSIX::Termios termios_ref
626 Safefree(termios_ref);
632 getattr(termios_ref, fd = 0)
633 POSIX::Termios termios_ref
636 RETVAL = tcgetattr(fd, termios_ref);
641 setattr(termios_ref, fd = 0, optional_actions = 0)
642 POSIX::Termios termios_ref
646 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
651 cfgetispeed(termios_ref)
652 POSIX::Termios termios_ref
655 cfgetospeed(termios_ref)
656 POSIX::Termios termios_ref
659 getiflag(termios_ref)
660 POSIX::Termios termios_ref
662 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
663 RETVAL = termios_ref->c_iflag;
665 not_here("getiflag");
672 getoflag(termios_ref)
673 POSIX::Termios termios_ref
675 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
676 RETVAL = termios_ref->c_oflag;
678 not_here("getoflag");
685 getcflag(termios_ref)
686 POSIX::Termios termios_ref
688 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
689 RETVAL = termios_ref->c_cflag;
691 not_here("getcflag");
698 getlflag(termios_ref)
699 POSIX::Termios termios_ref
701 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
702 RETVAL = termios_ref->c_lflag;
704 not_here("getlflag");
711 getcc(termios_ref, ccix)
712 POSIX::Termios termios_ref
715 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
717 croak("Bad getcc subscript");
718 RETVAL = termios_ref->c_cc[ccix];
727 cfsetispeed(termios_ref, speed)
728 POSIX::Termios termios_ref
732 cfsetospeed(termios_ref, speed)
733 POSIX::Termios termios_ref
737 setiflag(termios_ref, iflag)
738 POSIX::Termios termios_ref
741 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
742 termios_ref->c_iflag = iflag;
744 not_here("setiflag");
748 setoflag(termios_ref, oflag)
749 POSIX::Termios termios_ref
752 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
753 termios_ref->c_oflag = oflag;
755 not_here("setoflag");
759 setcflag(termios_ref, cflag)
760 POSIX::Termios termios_ref
763 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
764 termios_ref->c_cflag = cflag;
766 not_here("setcflag");
770 setlflag(termios_ref, lflag)
771 POSIX::Termios termios_ref
774 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
775 termios_ref->c_lflag = lflag;
777 not_here("setlflag");
781 setcc(termios_ref, ccix, cc)
782 POSIX::Termios termios_ref
786 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
788 croak("Bad setcc subscript");
789 termios_ref->c_cc[ccix] = cc;
795 MODULE = POSIX PACKAGE = POSIX
797 INCLUDE: const-xs.inc
800 int_macro_int(sv, iv)
807 const char * s = SvPV(sv, len);
810 /* Change this to int_macro_int(s, len, &iv, &nv);
811 if you need to return both NVs and IVs */
812 type = int_macro_int(s, len, &iv);
813 /* Return 1 or 2 items. First is error message, or undef if no error.
814 Second, if present, is found value */
816 case PERL_constant_NOTFOUND:
817 sv = sv_2mortal(newSVpvf("%s is not a valid POSIX macro", s));
822 case PERL_constant_NOTDEF:
823 sv = sv_2mortal(newSVpvf(
824 "Your vendor has not defined POSIX macro %s, used", s));
829 case PERL_constant_ISIV:
833 sv = sv_2mortal(newSVpvf(
834 "Unexpected return type %d while processing POSIX macro %s, used",
843 unsigned char * charstring
845 unsigned char *s = charstring;
846 unsigned char *e = s + SvCUR(ST(0));
847 for (RETVAL = 1; RETVAL && s < e; s++)
855 unsigned char * charstring
857 unsigned char *s = charstring;
858 unsigned char *e = s + SvCUR(ST(0));
859 for (RETVAL = 1; RETVAL && s < e; s++)
867 unsigned char * charstring
869 unsigned char *s = charstring;
870 unsigned char *e = s + SvCUR(ST(0));
871 for (RETVAL = 1; RETVAL && s < e; s++)
879 unsigned char * charstring
881 unsigned char *s = charstring;
882 unsigned char *e = s + SvCUR(ST(0));
883 for (RETVAL = 1; RETVAL && s < e; s++)
891 unsigned char * charstring
893 unsigned char *s = charstring;
894 unsigned char *e = s + SvCUR(ST(0));
895 for (RETVAL = 1; RETVAL && s < e; s++)
903 unsigned char * charstring
905 unsigned char *s = charstring;
906 unsigned char *e = s + SvCUR(ST(0));
907 for (RETVAL = 1; RETVAL && s < e; s++)
915 unsigned char * charstring
917 unsigned char *s = charstring;
918 unsigned char *e = s + SvCUR(ST(0));
919 for (RETVAL = 1; RETVAL && s < e; s++)
927 unsigned char * charstring
929 unsigned char *s = charstring;
930 unsigned char *e = s + SvCUR(ST(0));
931 for (RETVAL = 1; RETVAL && s < e; s++)
939 unsigned char * charstring
941 unsigned char *s = charstring;
942 unsigned char *e = s + SvCUR(ST(0));
943 for (RETVAL = 1; RETVAL && s < e; s++)
951 unsigned char * charstring
953 unsigned char *s = charstring;
954 unsigned char *e = s + SvCUR(ST(0));
955 for (RETVAL = 1; RETVAL && s < e; s++)
963 unsigned char * charstring
965 unsigned char *s = charstring;
966 unsigned char *e = s + SvCUR(ST(0));
967 for (RETVAL = 1; RETVAL && s < e; s++)
974 open(filename, flags = O_RDONLY, mode = 0666)
979 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
980 TAINT_PROPER("open");
981 RETVAL = open(filename, flags, mode);
989 #ifdef HAS_LOCALECONV
992 if ((lcbuf = localeconv())) {
994 if (lcbuf->decimal_point && *lcbuf->decimal_point)
995 hv_store(RETVAL, "decimal_point", 13,
996 newSVpv(lcbuf->decimal_point, 0), 0);
997 if (lcbuf->thousands_sep && *lcbuf->thousands_sep)
998 hv_store(RETVAL, "thousands_sep", 13,
999 newSVpv(lcbuf->thousands_sep, 0), 0);
1000 #ifndef NO_LOCALECONV_GROUPING
1001 if (lcbuf->grouping && *lcbuf->grouping)
1002 hv_store(RETVAL, "grouping", 8,
1003 newSVpv(lcbuf->grouping, 0), 0);
1005 if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol)
1006 hv_store(RETVAL, "int_curr_symbol", 15,
1007 newSVpv(lcbuf->int_curr_symbol, 0), 0);
1008 if (lcbuf->currency_symbol && *lcbuf->currency_symbol)
1009 hv_store(RETVAL, "currency_symbol", 15,
1010 newSVpv(lcbuf->currency_symbol, 0), 0);
1011 if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
1012 hv_store(RETVAL, "mon_decimal_point", 17,
1013 newSVpv(lcbuf->mon_decimal_point, 0), 0);
1014 #ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
1015 if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
1016 hv_store(RETVAL, "mon_thousands_sep", 17,
1017 newSVpv(lcbuf->mon_thousands_sep, 0), 0);
1019 #ifndef NO_LOCALECONV_MON_GROUPING
1020 if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
1021 hv_store(RETVAL, "mon_grouping", 12,
1022 newSVpv(lcbuf->mon_grouping, 0), 0);
1024 if (lcbuf->positive_sign && *lcbuf->positive_sign)
1025 hv_store(RETVAL, "positive_sign", 13,
1026 newSVpv(lcbuf->positive_sign, 0), 0);
1027 if (lcbuf->negative_sign && *lcbuf->negative_sign)
1028 hv_store(RETVAL, "negative_sign", 13,
1029 newSVpv(lcbuf->negative_sign, 0), 0);
1031 if (lcbuf->int_frac_digits != CHAR_MAX)
1032 hv_store(RETVAL, "int_frac_digits", 15,
1033 newSViv(lcbuf->int_frac_digits), 0);
1034 if (lcbuf->frac_digits != CHAR_MAX)
1035 hv_store(RETVAL, "frac_digits", 11,
1036 newSViv(lcbuf->frac_digits), 0);
1037 if (lcbuf->p_cs_precedes != CHAR_MAX)
1038 hv_store(RETVAL, "p_cs_precedes", 13,
1039 newSViv(lcbuf->p_cs_precedes), 0);
1040 if (lcbuf->p_sep_by_space != CHAR_MAX)
1041 hv_store(RETVAL, "p_sep_by_space", 14,
1042 newSViv(lcbuf->p_sep_by_space), 0);
1043 if (lcbuf->n_cs_precedes != CHAR_MAX)
1044 hv_store(RETVAL, "n_cs_precedes", 13,
1045 newSViv(lcbuf->n_cs_precedes), 0);
1046 if (lcbuf->n_sep_by_space != CHAR_MAX)
1047 hv_store(RETVAL, "n_sep_by_space", 14,
1048 newSViv(lcbuf->n_sep_by_space), 0);
1049 if (lcbuf->p_sign_posn != CHAR_MAX)
1050 hv_store(RETVAL, "p_sign_posn", 11,
1051 newSViv(lcbuf->p_sign_posn), 0);
1052 if (lcbuf->n_sign_posn != CHAR_MAX)
1053 hv_store(RETVAL, "n_sign_posn", 11,
1054 newSViv(lcbuf->n_sign_posn), 0);
1057 localeconv(); /* A stub to call not_here(). */
1063 setlocale(category, locale = 0)
1067 RETVAL = setlocale(category, locale);
1069 #ifdef USE_LOCALE_CTYPE
1070 if (category == LC_CTYPE
1072 || category == LC_ALL
1078 if (category == LC_ALL)
1079 newctype = setlocale(LC_CTYPE, NULL);
1083 new_ctype(newctype);
1085 #endif /* USE_LOCALE_CTYPE */
1086 #ifdef USE_LOCALE_COLLATE
1087 if (category == LC_COLLATE
1089 || category == LC_ALL
1095 if (category == LC_ALL)
1096 newcoll = setlocale(LC_COLLATE, NULL);
1100 new_collate(newcoll);
1102 #endif /* USE_LOCALE_COLLATE */
1103 #ifdef USE_LOCALE_NUMERIC
1104 if (category == LC_NUMERIC
1106 || category == LC_ALL
1112 if (category == LC_ALL)
1113 newnum = setlocale(LC_NUMERIC, NULL);
1117 new_numeric(newnum);
1119 #endif /* USE_LOCALE_NUMERIC */
1159 /* (We already know stack is long enough.) */
1160 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1161 PUSHs(sv_2mortal(newSViv(expvar)));
1177 /* (We already know stack is long enough.) */
1178 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
1179 PUSHs(sv_2mortal(newSVnv(intvar)));
1194 sigaction(sig, optaction, oldaction = 0)
1197 POSIX::SigAction oldaction
1199 #if defined(WIN32) || defined(NETWARE)
1200 RETVAL = not_here("sigaction");
1202 # This code is really grody because we're trying to make the signal
1203 # interface look beautiful, which is hard.
1206 POSIX__SigAction action;
1207 GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
1208 struct sigaction act;
1209 struct sigaction oact;
1213 POSIX__SigSet sigset;
1216 if (sig == 0 && SvPOK(ST(0))) {
1217 char *s = SvPVX(ST(0));
1218 int i = whichsig(s);
1220 if (i < 0 && memEQ(s, "SIG", 3))
1221 i = whichsig(s + 3);
1223 if (ckWARN(WARN_SIGNAL))
1224 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1225 "No such signal: SIG%s", s);
1231 sigsvp = hv_fetch(GvHVn(siggv),
1233 strlen(PL_sig_name[sig]),
1236 /* Check optaction and set action */
1237 if(SvTRUE(optaction)) {
1238 if(sv_isa(optaction, "POSIX::SigAction"))
1239 action = (HV*)SvRV(optaction);
1241 croak("action is not of type POSIX::SigAction");
1247 /* sigaction() is supposed to look atomic. In particular, any
1248 * signal handler invoked during a sigaction() call should
1249 * see either the old or the new disposition, and not something
1250 * in between. We use sigprocmask() to make it so.
1253 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1257 /* Restore signal mask no matter how we exit this block. */
1258 osset_sv = newSVpv((char *)(&osset), sizeof(sigset_t));
1259 SAVEFREESV( osset_sv );
1260 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1262 RETVAL=-1; /* In case both oldaction and action are 0. */
1264 /* Remember old disposition if desired. */
1266 svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
1268 croak("Can't supply an oldaction without a HANDLER");
1269 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1270 sv_setsv(*svp, *sigsvp);
1273 sv_setpv(*svp, "DEFAULT");
1275 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
1278 /* Get back the mask. */
1279 svp = hv_fetch(oldaction, "MASK", 4, TRUE);
1280 if (sv_isa(*svp, "POSIX::SigSet")) {
1281 IV tmp = SvIV((SV*)SvRV(*svp));
1282 sigset = INT2PTR(sigset_t*, tmp);
1285 New(0, sigset, 1, sigset_t);
1286 sv_setptrobj(*svp, sigset, "POSIX::SigSet");
1288 *sigset = oact.sa_mask;
1290 /* Get back the flags. */
1291 svp = hv_fetch(oldaction, "FLAGS", 5, TRUE);
1292 sv_setiv(*svp, oact.sa_flags);
1294 /* Get back whether the old handler used safe signals. */
1295 svp = hv_fetch(oldaction, "SAFE", 4, TRUE);
1296 sv_setiv(*svp, oact.sa_handler == PL_csighandlerp);
1300 /* Safe signals use "csighandler", which vectors through the
1301 PL_sighandlerp pointer when it's safe to do so.
1302 (BTW, "csighandler" is very different from "sighandler".) */
1303 svp = hv_fetch(action, "SAFE", 4, FALSE);
1304 act.sa_handler = (*svp && SvTRUE(*svp))
1305 ? PL_csighandlerp : PL_sighandlerp;
1307 /* Vector new Perl handler through %SIG.
1308 (The core signal handlers read %SIG to dispatch.) */
1309 svp = hv_fetch(action, "HANDLER", 7, FALSE);
1311 croak("Can't supply an action without a HANDLER");
1312 sv_setsv(*sigsvp, *svp);
1314 /* This call actually calls sigaction() with almost the
1315 right settings, including appropriate interpretation
1316 of DEFAULT and IGNORE. However, why are we doing
1317 this when we're about to do it again just below? XXX */
1320 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1322 char *s=SvPVX(*svp);
1323 if(strEQ(s,"IGNORE")) {
1324 act.sa_handler = SIG_IGN;
1326 else if(strEQ(s,"DEFAULT")) {
1327 act.sa_handler = SIG_DFL;
1331 /* Set up any desired mask. */
1332 svp = hv_fetch(action, "MASK", 4, FALSE);
1333 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
1334 IV tmp = SvIV((SV*)SvRV(*svp));
1335 sigset = INT2PTR(sigset_t*, tmp);
1336 act.sa_mask = *sigset;
1339 sigemptyset(& act.sa_mask);
1341 /* Set up any desired flags. */
1342 svp = hv_fetch(action, "FLAGS", 5, FALSE);
1343 act.sa_flags = svp ? SvIV(*svp) : 0;
1345 /* Don't worry about cleaning up *sigsvp if this fails,
1346 * because that means we tried to disposition a
1347 * nonblockable signal, in which case *sigsvp is
1348 * essentially meaningless anyway.
1350 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
1363 POSIX::SigSet sigset
1366 sigprocmask(how, sigset, oldsigset = 0)
1368 POSIX::SigSet sigset
1369 POSIX::SigSet oldsigset = NO_INIT
1374 else if (sv_derived_from(ST(2), "POSIX::SigSet")) {
1375 IV tmp = SvIV((SV*)SvRV(ST(2)));
1376 oldsigset = INT2PTR(POSIX__SigSet,tmp);
1379 New(0, oldsigset, 1, sigset_t);
1380 sigemptyset(oldsigset);
1381 sv_setref_pv(ST(2), "POSIX::SigSet", (void*)oldsigset);
1385 sigsuspend(signal_mask)
1386 POSIX::SigSet signal_mask
1406 lseek(fd, offset, whence)
1411 Off_t pos = PerlLIO_lseek(fd, offset, whence);
1412 RETVAL = sizeof(Off_t) > sizeof(IV)
1413 ? newSVnv((NV)pos) : newSViv((IV)pos);
1422 if ((incr = nice(incr)) != -1 || errno == 0) {
1424 XPUSHs(sv_2mortal(newSVpvn("0 but true", 10)));
1426 XPUSHs(sv_2mortal(newSViv(incr)));
1433 if (pipe(fds) != -1) {
1435 PUSHs(sv_2mortal(newSViv(fds[0])));
1436 PUSHs(sv_2mortal(newSViv(fds[1])));
1440 read(fd, buffer, nbytes)
1442 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1446 char * buffer = sv_grow( sv_buffer, nbytes+1 );
1449 SvCUR(sv_buffer) = RETVAL;
1450 SvPOK_only(sv_buffer);
1451 *SvEND(sv_buffer) = '\0';
1452 SvTAINTED_on(sv_buffer);
1468 tcsetpgrp(fd, pgrp_id)
1477 if (uname(&buf) >= 0) {
1479 PUSHs(sv_2mortal(newSVpv(buf.sysname, 0)));
1480 PUSHs(sv_2mortal(newSVpv(buf.nodename, 0)));
1481 PUSHs(sv_2mortal(newSVpv(buf.release, 0)));
1482 PUSHs(sv_2mortal(newSVpv(buf.version, 0)));
1483 PUSHs(sv_2mortal(newSVpv(buf.machine, 0)));
1486 uname((char *) 0); /* A stub to call not_here(). */
1490 write(fd, buffer, nbytes)
1501 RETVAL = newSVpvn("", 0);
1502 SvGROW(RETVAL, L_tmpnam);
1503 len = strlen(tmpnam(SvPV(RETVAL, i)));
1504 SvCUR_set(RETVAL, len);
1517 mbstowcs(s, pwcs, n)
1529 wcstombs(s, pwcs, n)
1551 SET_NUMERIC_LOCAL();
1552 num = strtod(str, &unparsed);
1553 PUSHs(sv_2mortal(newSVnv(num)));
1554 if (GIMME == G_ARRAY) {
1557 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1559 PUSHs(&PL_sv_undef);
1563 strtol(str, base = 0)
1570 num = strtol(str, &unparsed, base);
1571 #if IVSIZE <= LONGSIZE
1572 if (num < IV_MIN || num > IV_MAX)
1573 PUSHs(sv_2mortal(newSVnv((double)num)));
1576 PUSHs(sv_2mortal(newSViv((IV)num)));
1577 if (GIMME == G_ARRAY) {
1580 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1582 PUSHs(&PL_sv_undef);
1586 strtoul(str, base = 0)
1593 num = strtoul(str, &unparsed, base);
1594 #if IVSIZE <= LONGSIZE
1596 PUSHs(sv_2mortal(newSVnv((double)num)));
1599 PUSHs(sv_2mortal(newSViv((IV)num)));
1600 if (GIMME == G_ARRAY) {
1603 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1605 PUSHs(&PL_sv_undef);
1615 char *p = SvPV(src,srclen);
1617 ST(0) = sv_2mortal(NEWSV(800,srclen*4+1));
1618 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1619 if (dstlen > srclen) {
1621 SvGROW(ST(0), dstlen);
1622 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1625 SvCUR(ST(0)) = dstlen;
1630 mkfifo(filename, mode)
1634 TAINT_PROPER("mkfifo");
1635 RETVAL = mkfifo(filename, mode);
1651 tcflush(fd, queue_selector)
1656 tcsendbreak(fd, duration)
1661 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
1674 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1677 mytm.tm_hour = hour;
1678 mytm.tm_mday = mday;
1680 mytm.tm_year = year;
1681 mytm.tm_wday = wday;
1682 mytm.tm_yday = yday;
1683 mytm.tm_isdst = isdst;
1684 RETVAL = asctime(&mytm);
1701 realtime = times( &tms );
1703 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1704 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1705 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1706 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1707 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
1710 difftime(time1, time2)
1715 mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
1728 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1731 mytm.tm_hour = hour;
1732 mytm.tm_mday = mday;
1734 mytm.tm_year = year;
1735 mytm.tm_wday = wday;
1736 mytm.tm_yday = yday;
1737 mytm.tm_isdst = isdst;
1738 RETVAL = mktime(&mytm);
1743 #XXX: if $xsubpp::WantOptimize is always the default
1744 # sv_setpv(TARG, ...) could be used rather than
1745 # ST(0) = sv_2mortal(newSVpv(...))
1747 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
1760 char *buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst);
1762 ST(0) = sv_2mortal(newSVpv(buf, 0));
1774 PUSHs(sv_2mortal(newSVpvn(tzname[0],strlen(tzname[0]))));
1775 PUSHs(sv_2mortal(newSVpvn(tzname[1],strlen(tzname[1]))));
1778 access(filename, mode)
1796 pathconf(filename, name)
1825 XSprePUSH; PUSHTARG;