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 #if defined(__VMS) && !defined(__POSIX_SOURCE)
89 # include <libdef.h> /* LIB$_INVARG constant */
90 # include <lib$routines.h> /* prototype for lib$ediv() */
91 # include <starlet.h> /* prototype for sys$gettim() */
92 # if DECC_VERSION < 50000000
93 # define pid_t int /* old versions of DECC miss this in types.h */
97 # define mkfifo(a,b) (not_here("mkfifo"),-1)
98 # define tzset() not_here("tzset")
100 #if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
101 # define HAS_TZNAME /* shows up in VMS 7.0 or Dec C 5.6 */
102 # include <utsname.h>
103 # endif /* __VMS_VER >= 70000000 or Dec C 5.6 */
105 /* The POSIX notion of ttyname() is better served by getname() under VMS */
106 static char ttnambuf[64];
107 # define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
109 /* The non-POSIX CRTL times() has void return type, so we just get the
110 current time directly */
111 clock_t vms_times(struct tms *bufptr) {
114 /* Get wall time and convert to 10 ms intervals to
115 * produce the return value that the POSIX standard expects */
116 # if defined(__DECC) && defined (__ALPHA)
119 _ckvmssts(sys$gettim(&vmstime));
121 retval = vmstime & 0x7fffffff;
123 /* (Older hw or ccs don't have an atomic 64-bit type, so we
124 * juggle 32-bit ints (and a float) to produce a time_t result
125 * with minimal loss of information.) */
126 long int vmstime[2],remainder,divisor = 100000;
127 _ckvmssts(sys$gettim((unsigned long int *)vmstime));
128 vmstime[1] &= 0x7fff; /* prevent overflow in EDIV */
129 _ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder));
131 /* Fill in the struct tms using the CRTL routine . . .*/
132 times((tbuffer_t *)bufptr);
133 return (clock_t) retval;
135 # define times(t) vms_times(t)
137 #if defined (__CYGWIN__)
138 # define tzname _tzname
140 #if defined (WIN32) || defined (NETWARE)
142 # define mkfifo(a,b) not_here("mkfifo")
143 # define ttyname(a) (char*)not_here("ttyname")
144 # define sigset_t long
147 # define tzname _tzname
150 # define mode_t short
153 # define mode_t short
155 # define tzset() not_here("tzset")
157 # ifndef _POSIX_OPEN_MAX
158 # define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */
161 # define sigaction(a,b,c) not_here("sigaction")
162 # define sigpending(a) not_here("sigpending")
163 # define sigprocmask(a,b,c) not_here("sigprocmask")
164 # define sigsuspend(a) not_here("sigsuspend")
165 # define sigemptyset(a) not_here("sigemptyset")
166 # define sigaddset(a,b) not_here("sigaddset")
167 # define sigdelset(a,b) not_here("sigdelset")
168 # define sigfillset(a) not_here("sigfillset")
169 # define sigismember(a,b) not_here("sigismember")
173 # define setuid(a) not_here("setuid")
174 # define setgid(a) not_here("setgid")
179 # if defined(OS2) || defined(MACOS_TRADITIONAL)
180 # define mkfifo(a,b) not_here("mkfifo")
181 # else /* !( defined OS2 ) */
183 # define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
186 # endif /* !HAS_MKFIFO */
188 # ifdef MACOS_TRADITIONAL
189 # define ttyname(a) (char*)not_here("ttyname")
190 # define tzset() not_here("tzset")
193 # include <sys/times.h>
195 # include <sys/utsname.h>
197 # include <sys/wait.h>
202 #endif /* WIN32 || NETWARE */
206 typedef long SysRetLong;
207 typedef sigset_t* POSIX__SigSet;
208 typedef HV* POSIX__SigAction;
210 typedef struct termios* POSIX__Termios;
211 #else /* Define termios types to int, and call not_here for the functions.*/
212 #define POSIX__Termios int
216 #define cfgetispeed(x) not_here("cfgetispeed")
217 #define cfgetospeed(x) not_here("cfgetospeed")
218 #define tcdrain(x) not_here("tcdrain")
219 #define tcflush(x,y) not_here("tcflush")
220 #define tcsendbreak(x,y) not_here("tcsendbreak")
221 #define cfsetispeed(x,y) not_here("cfsetispeed")
222 #define cfsetospeed(x,y) not_here("cfsetospeed")
223 #define ctermid(x) (char *) not_here("ctermid")
224 #define tcflow(x,y) not_here("tcflow")
225 #define tcgetattr(x,y) not_here("tcgetattr")
226 #define tcsetattr(x,y,z) not_here("tcsetattr")
229 /* Possibly needed prototypes */
230 char *cuserid (char *);
232 double strtod (const char *, char **);
233 long strtol (const char *, char **, int);
234 unsigned long strtoul (const char *, char **, int);
238 #define cuserid(a) (char *) not_here("cuserid")
242 #define difftime(a,b) not_here("difftime")
245 #ifndef HAS_FPATHCONF
246 #define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
249 #define mktime(a) not_here("mktime")
252 #define nice(a) not_here("nice")
255 #define pathconf(f,n) (SysRetLong) not_here("pathconf")
258 #define sysconf(n) (SysRetLong) not_here("sysconf")
261 #define readlink(a,b,c) not_here("readlink")
264 #define setpgid(a,b) not_here("setpgid")
267 #define setsid() not_here("setsid")
270 #define strcoll(s1,s2) not_here("strcoll")
273 #define strtod(s1,s2) not_here("strtod")
276 #define strtol(s1,s2,b) not_here("strtol")
279 #define strtoul(s1,s2,b) not_here("strtoul")
282 #define strxfrm(s1,s2,n) not_here("strxfrm")
284 #ifndef HAS_TCGETPGRP
285 #define tcgetpgrp(a) not_here("tcgetpgrp")
287 #ifndef HAS_TCSETPGRP
288 #define tcsetpgrp(a,b) not_here("tcsetpgrp")
292 #define times(a) not_here("times")
296 #define uname(a) not_here("uname")
299 #define waitpid(a,b,c) not_here("waitpid")
304 #define mblen(a,b) not_here("mblen")
308 #define mbstowcs(s, pwcs, n) not_here("mbstowcs")
311 #define mbtowc(pwc, s, n) not_here("mbtowc")
314 #define wcstombs(s, pwcs, n) not_here("wcstombs")
317 #define wctomb(s, wchar) not_here("wcstombs")
319 #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
320 /* If we don't have these functions, then we wouldn't have gotten a typedef
321 for wchar_t, the wide character type. Defining wchar_t allows the
322 functions referencing it to compile. Its actual type is then meaningless,
323 since without the above functions, all sections using it end up calling
324 not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
330 #ifndef HAS_LOCALECONV
331 #define localeconv() not_here("localeconv")
334 #ifdef HAS_LONG_DOUBLE
335 # if LONG_DOUBLESIZE > NVSIZE
336 # undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
340 #ifndef HAS_LONG_DOUBLE
352 /* Background: in most systems the low byte of the wait status
353 * is the signal (the lowest 7 bits) and the coredump flag is
354 * the eight bit, and the second lowest byte is the exit status.
355 * BeOS bucks the trend and has the bytes in different order.
356 * See beos/beos.c for how the reality is bent even in BeOS
357 * to follow the traditional. However, to make the POSIX
358 * wait W*() macros to work in BeOS, we need to unbend the
359 * reality back in place. --jhi */
361 # define WMUNGE(x) (((x) & 0xFF00) >> 8 | ((x) & 0x00FF) << 8)
363 # define WMUNGE(x) (x)
369 croak("POSIX::%s not implemented on this architecture", s);
373 #include "const-c.inc"
375 /* These were implemented in the old "constant" subroutine. They are actually
376 macros that take an integer argument and return an integer result. */
378 int_macro_int (const char *name, STRLEN len, IV *arg_result) {
379 /* Initially switch on the length of the name. */
380 /* This code has been edited from a "constant" function generated by:
382 use ExtUtils::Constant qw (constant_types C_constant XS_constant);
384 my $types = {map {($_, 1)} qw(IV)};
385 my @names = (qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS WIFEXITED
386 WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
388 print constant_types(); # macro defs
389 foreach (C_constant ("POSIX", 'int_macro_int', 'IV', $types, undef, 5, @names) ) {
390 print $_, "\n"; # C constant subs
392 print "#### XS Section:\n";
393 print XS_constant ("POSIX", $types);
399 /* Names all of length 7. */
400 /* S_ISBLK S_ISCHR S_ISDIR S_ISREG */
401 /* Offset 5 gives the best switch position. */
404 if (memEQ(name, "S_ISREG", 7)) {
407 *arg_result = S_ISREG(*arg_result);
408 return PERL_constant_ISIV;
410 return PERL_constant_NOTDEF;
415 if (memEQ(name, "S_ISCHR", 7)) {
418 *arg_result = S_ISCHR(*arg_result);
419 return PERL_constant_ISIV;
421 return PERL_constant_NOTDEF;
426 if (memEQ(name, "S_ISDIR", 7)) {
429 *arg_result = S_ISDIR(*arg_result);
430 return PERL_constant_ISIV;
432 return PERL_constant_NOTDEF;
437 if (memEQ(name, "S_ISBLK", 7)) {
440 *arg_result = S_ISBLK(*arg_result);
441 return PERL_constant_ISIV;
443 return PERL_constant_NOTDEF;
450 /* Names all of length 8. */
451 /* S_ISFIFO WSTOPSIG WTERMSIG */
452 /* Offset 3 gives the best switch position. */
455 if (memEQ(name, "WSTOPSIG", 8)) {
459 *arg_result = WSTOPSIG(WMUNGE(i));
460 return PERL_constant_ISIV;
462 return PERL_constant_NOTDEF;
467 if (memEQ(name, "WTERMSIG", 8)) {
471 *arg_result = WTERMSIG(WMUNGE(i));
472 return PERL_constant_ISIV;
474 return PERL_constant_NOTDEF;
479 if (memEQ(name, "S_ISFIFO", 8)) {
482 *arg_result = S_ISFIFO(*arg_result);
483 return PERL_constant_ISIV;
485 return PERL_constant_NOTDEF;
492 if (memEQ(name, "WIFEXITED", 9)) {
495 *arg_result = WIFEXITED(WMUNGE(i));
496 return PERL_constant_ISIV;
498 return PERL_constant_NOTDEF;
503 if (memEQ(name, "WIFSTOPPED", 10)) {
506 *arg_result = WIFSTOPPED(WMUNGE(i));
507 return PERL_constant_ISIV;
509 return PERL_constant_NOTDEF;
514 /* Names all of length 11. */
515 /* WEXITSTATUS WIFSIGNALED */
516 /* Offset 1 gives the best switch position. */
519 if (memEQ(name, "WEXITSTATUS", 11)) {
523 *arg_result = WEXITSTATUS(WMUNGE(i));
524 return PERL_constant_ISIV;
526 return PERL_constant_NOTDEF;
531 if (memEQ(name, "WIFSIGNALED", 11)) {
535 *arg_result = WIFSIGNALED(WMUNGE(i));
536 return PERL_constant_ISIV;
538 return PERL_constant_NOTDEF;
545 return PERL_constant_NOTFOUND;
549 restore_sigmask(pTHX_ SV *osset_sv)
551 /* Fortunately, restoring the signal mask can't fail, because
552 * there's nothing we can do about it if it does -- we're not
553 * supposed to return -1 from sigaction unless the disposition
556 sigset_t *ossetp = (sigset_t *) SvPV_nolen( osset_sv );
557 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
560 MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
563 new(packname = "POSIX::SigSet", ...)
568 New(0, RETVAL, 1, sigset_t);
570 for (i = 1; i < items; i++)
571 sigaddset(RETVAL, SvIV(ST(i)));
583 sigaddset(sigset, sig)
588 sigdelset(sigset, sig)
601 sigismember(sigset, sig)
606 MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
609 new(packname = "POSIX::Termios", ...)
614 New(0, RETVAL, 1, struct termios);
625 POSIX::Termios termios_ref
628 Safefree(termios_ref);
634 getattr(termios_ref, fd = 0)
635 POSIX::Termios termios_ref
638 RETVAL = tcgetattr(fd, termios_ref);
643 setattr(termios_ref, fd = 0, optional_actions = 0)
644 POSIX::Termios termios_ref
648 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
653 cfgetispeed(termios_ref)
654 POSIX::Termios termios_ref
657 cfgetospeed(termios_ref)
658 POSIX::Termios termios_ref
661 getiflag(termios_ref)
662 POSIX::Termios termios_ref
664 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
665 RETVAL = termios_ref->c_iflag;
667 not_here("getiflag");
674 getoflag(termios_ref)
675 POSIX::Termios termios_ref
677 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
678 RETVAL = termios_ref->c_oflag;
680 not_here("getoflag");
687 getcflag(termios_ref)
688 POSIX::Termios termios_ref
690 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
691 RETVAL = termios_ref->c_cflag;
693 not_here("getcflag");
700 getlflag(termios_ref)
701 POSIX::Termios termios_ref
703 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
704 RETVAL = termios_ref->c_lflag;
706 not_here("getlflag");
713 getcc(termios_ref, ccix)
714 POSIX::Termios termios_ref
717 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
719 croak("Bad getcc subscript");
720 RETVAL = termios_ref->c_cc[ccix];
729 cfsetispeed(termios_ref, speed)
730 POSIX::Termios termios_ref
734 cfsetospeed(termios_ref, speed)
735 POSIX::Termios termios_ref
739 setiflag(termios_ref, iflag)
740 POSIX::Termios termios_ref
743 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
744 termios_ref->c_iflag = iflag;
746 not_here("setiflag");
750 setoflag(termios_ref, oflag)
751 POSIX::Termios termios_ref
754 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
755 termios_ref->c_oflag = oflag;
757 not_here("setoflag");
761 setcflag(termios_ref, cflag)
762 POSIX::Termios termios_ref
765 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
766 termios_ref->c_cflag = cflag;
768 not_here("setcflag");
772 setlflag(termios_ref, lflag)
773 POSIX::Termios termios_ref
776 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
777 termios_ref->c_lflag = lflag;
779 not_here("setlflag");
783 setcc(termios_ref, ccix, cc)
784 POSIX::Termios termios_ref
788 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
790 croak("Bad setcc subscript");
791 termios_ref->c_cc[ccix] = cc;
797 MODULE = POSIX PACKAGE = POSIX
799 INCLUDE: const-xs.inc
802 int_macro_int(sv, iv)
809 const char * s = SvPV(sv, len);
812 /* Change this to int_macro_int(s, len, &iv, &nv);
813 if you need to return both NVs and IVs */
814 type = int_macro_int(s, len, &iv);
815 /* Return 1 or 2 items. First is error message, or undef if no error.
816 Second, if present, is found value */
818 case PERL_constant_NOTFOUND:
819 sv = sv_2mortal(newSVpvf("%s is not a valid POSIX macro", s));
824 case PERL_constant_NOTDEF:
825 sv = sv_2mortal(newSVpvf(
826 "Your vendor has not defined POSIX macro %s, used", s));
831 case PERL_constant_ISIV:
835 sv = sv_2mortal(newSVpvf(
836 "Unexpected return type %d while processing POSIX macro %s, used",
845 unsigned char * charstring
847 unsigned char *s = charstring;
848 unsigned char *e = s + SvCUR(ST(0));
849 for (RETVAL = 1; RETVAL && s < e; s++)
857 unsigned char * charstring
859 unsigned char *s = charstring;
860 unsigned char *e = s + SvCUR(ST(0));
861 for (RETVAL = 1; RETVAL && s < e; s++)
869 unsigned char * charstring
871 unsigned char *s = charstring;
872 unsigned char *e = s + SvCUR(ST(0));
873 for (RETVAL = 1; RETVAL && s < e; s++)
881 unsigned char * charstring
883 unsigned char *s = charstring;
884 unsigned char *e = s + SvCUR(ST(0));
885 for (RETVAL = 1; RETVAL && s < e; s++)
893 unsigned char * charstring
895 unsigned char *s = charstring;
896 unsigned char *e = s + SvCUR(ST(0));
897 for (RETVAL = 1; RETVAL && s < e; s++)
905 unsigned char * charstring
907 unsigned char *s = charstring;
908 unsigned char *e = s + SvCUR(ST(0));
909 for (RETVAL = 1; RETVAL && s < e; s++)
917 unsigned char * charstring
919 unsigned char *s = charstring;
920 unsigned char *e = s + SvCUR(ST(0));
921 for (RETVAL = 1; RETVAL && s < e; s++)
929 unsigned char * charstring
931 unsigned char *s = charstring;
932 unsigned char *e = s + SvCUR(ST(0));
933 for (RETVAL = 1; RETVAL && s < e; s++)
941 unsigned char * charstring
943 unsigned char *s = charstring;
944 unsigned char *e = s + SvCUR(ST(0));
945 for (RETVAL = 1; RETVAL && s < e; s++)
953 unsigned char * charstring
955 unsigned char *s = charstring;
956 unsigned char *e = s + SvCUR(ST(0));
957 for (RETVAL = 1; RETVAL && s < e; s++)
965 unsigned char * charstring
967 unsigned char *s = charstring;
968 unsigned char *e = s + SvCUR(ST(0));
969 for (RETVAL = 1; RETVAL && s < e; s++)
976 open(filename, flags = O_RDONLY, mode = 0666)
981 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
982 TAINT_PROPER("open");
983 RETVAL = open(filename, flags, mode);
991 #ifdef HAS_LOCALECONV
994 if ((lcbuf = localeconv())) {
996 if (lcbuf->decimal_point && *lcbuf->decimal_point)
997 hv_store(RETVAL, "decimal_point", 13,
998 newSVpv(lcbuf->decimal_point, 0), 0);
999 if (lcbuf->thousands_sep && *lcbuf->thousands_sep)
1000 hv_store(RETVAL, "thousands_sep", 13,
1001 newSVpv(lcbuf->thousands_sep, 0), 0);
1002 #ifndef NO_LOCALECONV_GROUPING
1003 if (lcbuf->grouping && *lcbuf->grouping)
1004 hv_store(RETVAL, "grouping", 8,
1005 newSVpv(lcbuf->grouping, 0), 0);
1007 if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol)
1008 hv_store(RETVAL, "int_curr_symbol", 15,
1009 newSVpv(lcbuf->int_curr_symbol, 0), 0);
1010 if (lcbuf->currency_symbol && *lcbuf->currency_symbol)
1011 hv_store(RETVAL, "currency_symbol", 15,
1012 newSVpv(lcbuf->currency_symbol, 0), 0);
1013 if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
1014 hv_store(RETVAL, "mon_decimal_point", 17,
1015 newSVpv(lcbuf->mon_decimal_point, 0), 0);
1016 #ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
1017 if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
1018 hv_store(RETVAL, "mon_thousands_sep", 17,
1019 newSVpv(lcbuf->mon_thousands_sep, 0), 0);
1021 #ifndef NO_LOCALECONV_MON_GROUPING
1022 if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
1023 hv_store(RETVAL, "mon_grouping", 12,
1024 newSVpv(lcbuf->mon_grouping, 0), 0);
1026 if (lcbuf->positive_sign && *lcbuf->positive_sign)
1027 hv_store(RETVAL, "positive_sign", 13,
1028 newSVpv(lcbuf->positive_sign, 0), 0);
1029 if (lcbuf->negative_sign && *lcbuf->negative_sign)
1030 hv_store(RETVAL, "negative_sign", 13,
1031 newSVpv(lcbuf->negative_sign, 0), 0);
1033 if (lcbuf->int_frac_digits != CHAR_MAX)
1034 hv_store(RETVAL, "int_frac_digits", 15,
1035 newSViv(lcbuf->int_frac_digits), 0);
1036 if (lcbuf->frac_digits != CHAR_MAX)
1037 hv_store(RETVAL, "frac_digits", 11,
1038 newSViv(lcbuf->frac_digits), 0);
1039 if (lcbuf->p_cs_precedes != CHAR_MAX)
1040 hv_store(RETVAL, "p_cs_precedes", 13,
1041 newSViv(lcbuf->p_cs_precedes), 0);
1042 if (lcbuf->p_sep_by_space != CHAR_MAX)
1043 hv_store(RETVAL, "p_sep_by_space", 14,
1044 newSViv(lcbuf->p_sep_by_space), 0);
1045 if (lcbuf->n_cs_precedes != CHAR_MAX)
1046 hv_store(RETVAL, "n_cs_precedes", 13,
1047 newSViv(lcbuf->n_cs_precedes), 0);
1048 if (lcbuf->n_sep_by_space != CHAR_MAX)
1049 hv_store(RETVAL, "n_sep_by_space", 14,
1050 newSViv(lcbuf->n_sep_by_space), 0);
1051 if (lcbuf->p_sign_posn != CHAR_MAX)
1052 hv_store(RETVAL, "p_sign_posn", 11,
1053 newSViv(lcbuf->p_sign_posn), 0);
1054 if (lcbuf->n_sign_posn != CHAR_MAX)
1055 hv_store(RETVAL, "n_sign_posn", 11,
1056 newSViv(lcbuf->n_sign_posn), 0);
1059 localeconv(); /* A stub to call not_here(). */
1065 setlocale(category, locale = 0)
1069 RETVAL = setlocale(category, locale);
1071 #ifdef USE_LOCALE_CTYPE
1072 if (category == LC_CTYPE
1074 || category == LC_ALL
1080 if (category == LC_ALL)
1081 newctype = setlocale(LC_CTYPE, NULL);
1085 new_ctype(newctype);
1087 #endif /* USE_LOCALE_CTYPE */
1088 #ifdef USE_LOCALE_COLLATE
1089 if (category == LC_COLLATE
1091 || category == LC_ALL
1097 if (category == LC_ALL)
1098 newcoll = setlocale(LC_COLLATE, NULL);
1102 new_collate(newcoll);
1104 #endif /* USE_LOCALE_COLLATE */
1105 #ifdef USE_LOCALE_NUMERIC
1106 if (category == LC_NUMERIC
1108 || category == LC_ALL
1114 if (category == LC_ALL)
1115 newnum = setlocale(LC_NUMERIC, NULL);
1119 new_numeric(newnum);
1121 #endif /* USE_LOCALE_NUMERIC */
1161 /* (We already know stack is long enough.) */
1162 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1163 PUSHs(sv_2mortal(newSViv(expvar)));
1179 /* (We already know stack is long enough.) */
1180 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
1181 PUSHs(sv_2mortal(newSVnv(intvar)));
1196 sigaction(sig, optaction, oldaction = 0)
1199 POSIX::SigAction oldaction
1201 #if defined(WIN32) || defined(NETWARE)
1202 RETVAL = not_here("sigaction");
1204 # This code is really grody because we're trying to make the signal
1205 # interface look beautiful, which is hard.
1208 POSIX__SigAction action;
1209 GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
1210 struct sigaction act;
1211 struct sigaction oact;
1215 POSIX__SigSet sigset;
1218 if (sig == 0 && SvPOK(ST(0))) {
1219 char *s = SvPVX(ST(0));
1220 int i = whichsig(s);
1222 if (i < 0 && memEQ(s, "SIG", 3))
1223 i = whichsig(s + 3);
1225 if (ckWARN(WARN_SIGNAL))
1226 Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
1227 "No such signal: SIG%s", s);
1233 sigsvp = hv_fetch(GvHVn(siggv),
1235 strlen(PL_sig_name[sig]),
1238 /* Check optaction and set action */
1239 if(SvTRUE(optaction)) {
1240 if(sv_isa(optaction, "POSIX::SigAction"))
1241 action = (HV*)SvRV(optaction);
1243 croak("action is not of type POSIX::SigAction");
1249 /* sigaction() is supposed to look atomic. In particular, any
1250 * signal handler invoked during a sigaction() call should
1251 * see either the old or the new disposition, and not something
1252 * in between. We use sigprocmask() to make it so.
1255 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1259 /* Restore signal mask no matter how we exit this block. */
1260 osset_sv = newSVpv((char *)(&osset), sizeof(sigset_t));
1261 SAVEFREESV( osset_sv );
1262 SAVEDESTRUCTOR_X(restore_sigmask, osset_sv);
1264 RETVAL=-1; /* In case both oldaction and action are 0. */
1266 /* Remember old disposition if desired. */
1268 svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
1270 croak("Can't supply an oldaction without a HANDLER");
1271 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1272 sv_setsv(*svp, *sigsvp);
1275 sv_setpv(*svp, "DEFAULT");
1277 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
1280 /* Get back the mask. */
1281 svp = hv_fetch(oldaction, "MASK", 4, TRUE);
1282 if (sv_isa(*svp, "POSIX::SigSet")) {
1283 IV tmp = SvIV((SV*)SvRV(*svp));
1284 sigset = INT2PTR(sigset_t*, tmp);
1287 New(0, sigset, 1, sigset_t);
1288 sv_setptrobj(*svp, sigset, "POSIX::SigSet");
1290 *sigset = oact.sa_mask;
1292 /* Get back the flags. */
1293 svp = hv_fetch(oldaction, "FLAGS", 5, TRUE);
1294 sv_setiv(*svp, oact.sa_flags);
1296 /* Get back whether the old handler used safe signals. */
1297 svp = hv_fetch(oldaction, "SAFE", 4, TRUE);
1298 sv_setiv(*svp, oact.sa_handler == PL_csighandlerp);
1302 /* Safe signals use "csighandler", which vectors through the
1303 PL_sighandlerp pointer when it's safe to do so.
1304 (BTW, "csighandler" is very different from "sighandler".) */
1305 svp = hv_fetch(action, "SAFE", 4, FALSE);
1306 act.sa_handler = (*svp && SvTRUE(*svp))
1307 ? PL_csighandlerp : PL_sighandlerp;
1309 /* Vector new Perl handler through %SIG.
1310 (The core signal handlers read %SIG to dispatch.) */
1311 svp = hv_fetch(action, "HANDLER", 7, FALSE);
1313 croak("Can't supply an action without a HANDLER");
1314 sv_setsv(*sigsvp, *svp);
1316 /* This call actually calls sigaction() with almost the
1317 right settings, including appropriate interpretation
1318 of DEFAULT and IGNORE. However, why are we doing
1319 this when we're about to do it again just below? XXX */
1322 /* And here again we duplicate -- DEFAULT/IGNORE checking. */
1324 char *s=SvPVX(*svp);
1325 if(strEQ(s,"IGNORE")) {
1326 act.sa_handler = SIG_IGN;
1328 else if(strEQ(s,"DEFAULT")) {
1329 act.sa_handler = SIG_DFL;
1333 /* Set up any desired mask. */
1334 svp = hv_fetch(action, "MASK", 4, FALSE);
1335 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
1336 IV tmp = SvIV((SV*)SvRV(*svp));
1337 sigset = INT2PTR(sigset_t*, tmp);
1338 act.sa_mask = *sigset;
1341 sigemptyset(& act.sa_mask);
1343 /* Set up any desired flags. */
1344 svp = hv_fetch(action, "FLAGS", 5, FALSE);
1345 act.sa_flags = svp ? SvIV(*svp) : 0;
1347 /* Don't worry about cleaning up *sigsvp if this fails,
1348 * because that means we tried to disposition a
1349 * nonblockable signal, in which case *sigsvp is
1350 * essentially meaningless anyway.
1352 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
1365 POSIX::SigSet sigset
1368 sigprocmask(how, sigset, oldsigset = 0)
1370 POSIX::SigSet sigset
1371 POSIX::SigSet oldsigset = NO_INIT
1376 else if (sv_derived_from(ST(2), "POSIX::SigSet")) {
1377 IV tmp = SvIV((SV*)SvRV(ST(2)));
1378 oldsigset = INT2PTR(POSIX__SigSet,tmp);
1381 New(0, oldsigset, 1, sigset_t);
1382 sigemptyset(oldsigset);
1383 sv_setref_pv(ST(2), "POSIX::SigSet", (void*)oldsigset);
1387 sigsuspend(signal_mask)
1388 POSIX::SigSet signal_mask
1408 lseek(fd, offset, whence)
1413 Off_t pos = PerlLIO_lseek(fd, offset, whence);
1414 RETVAL = sizeof(Off_t) > sizeof(IV)
1415 ? newSVnv((NV)pos) : newSViv((IV)pos);
1424 if ((incr = nice(incr)) != -1 || errno == 0) {
1426 XPUSHs(sv_2mortal(newSVpvn("0 but true", 10)));
1428 XPUSHs(sv_2mortal(newSViv(incr)));
1435 if (pipe(fds) != -1) {
1437 PUSHs(sv_2mortal(newSViv(fds[0])));
1438 PUSHs(sv_2mortal(newSViv(fds[1])));
1442 read(fd, buffer, nbytes)
1444 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1448 char * buffer = sv_grow( sv_buffer, nbytes+1 );
1451 SvCUR(sv_buffer) = RETVAL;
1452 SvPOK_only(sv_buffer);
1453 *SvEND(sv_buffer) = '\0';
1454 SvTAINTED_on(sv_buffer);
1470 tcsetpgrp(fd, pgrp_id)
1479 if (uname(&buf) >= 0) {
1481 PUSHs(sv_2mortal(newSVpv(buf.sysname, 0)));
1482 PUSHs(sv_2mortal(newSVpv(buf.nodename, 0)));
1483 PUSHs(sv_2mortal(newSVpv(buf.release, 0)));
1484 PUSHs(sv_2mortal(newSVpv(buf.version, 0)));
1485 PUSHs(sv_2mortal(newSVpv(buf.machine, 0)));
1488 uname((char *) 0); /* A stub to call not_here(). */
1492 write(fd, buffer, nbytes)
1503 RETVAL = newSVpvn("", 0);
1504 SvGROW(RETVAL, L_tmpnam);
1505 len = strlen(tmpnam(SvPV(RETVAL, i)));
1506 SvCUR_set(RETVAL, len);
1519 mbstowcs(s, pwcs, n)
1531 wcstombs(s, pwcs, n)
1553 SET_NUMERIC_LOCAL();
1554 num = strtod(str, &unparsed);
1555 PUSHs(sv_2mortal(newSVnv(num)));
1556 if (GIMME == G_ARRAY) {
1559 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1561 PUSHs(&PL_sv_undef);
1565 strtol(str, base = 0)
1572 num = strtol(str, &unparsed, base);
1573 #if IVSIZE <= LONGSIZE
1574 if (num < IV_MIN || num > IV_MAX)
1575 PUSHs(sv_2mortal(newSVnv((double)num)));
1578 PUSHs(sv_2mortal(newSViv((IV)num)));
1579 if (GIMME == G_ARRAY) {
1582 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1584 PUSHs(&PL_sv_undef);
1588 strtoul(str, base = 0)
1595 num = strtoul(str, &unparsed, base);
1596 #if IVSIZE <= LONGSIZE
1598 PUSHs(sv_2mortal(newSVnv((double)num)));
1601 PUSHs(sv_2mortal(newSViv((IV)num)));
1602 if (GIMME == G_ARRAY) {
1605 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1607 PUSHs(&PL_sv_undef);
1617 char *p = SvPV(src,srclen);
1619 ST(0) = sv_2mortal(NEWSV(800,srclen*4+1));
1620 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1621 if (dstlen > srclen) {
1623 SvGROW(ST(0), dstlen);
1624 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1627 SvCUR(ST(0)) = dstlen;
1632 mkfifo(filename, mode)
1636 TAINT_PROPER("mkfifo");
1637 RETVAL = mkfifo(filename, mode);
1653 tcflush(fd, queue_selector)
1658 tcsendbreak(fd, duration)
1663 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
1676 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1679 mytm.tm_hour = hour;
1680 mytm.tm_mday = mday;
1682 mytm.tm_year = year;
1683 mytm.tm_wday = wday;
1684 mytm.tm_yday = yday;
1685 mytm.tm_isdst = isdst;
1686 RETVAL = asctime(&mytm);
1703 realtime = times( &tms );
1705 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1706 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1707 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1708 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1709 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
1712 difftime(time1, time2)
1717 mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
1730 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1733 mytm.tm_hour = hour;
1734 mytm.tm_mday = mday;
1736 mytm.tm_year = year;
1737 mytm.tm_wday = wday;
1738 mytm.tm_yday = yday;
1739 mytm.tm_isdst = isdst;
1740 RETVAL = mktime(&mytm);
1745 #XXX: if $xsubpp::WantOptimize is always the default
1746 # sv_setpv(TARG, ...) could be used rather than
1747 # ST(0) = sv_2mortal(newSVpv(...))
1749 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
1762 char *buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst);
1764 ST(0) = sv_2mortal(newSVpv(buf, 0));
1776 PUSHs(sv_2mortal(newSVpvn(tzname[0],strlen(tzname[0]))));
1777 PUSHs(sv_2mortal(newSVpvn(tzname[1],strlen(tzname[1]))));
1780 access(filename, mode)
1798 pathconf(filename, name)
1827 XSprePUSH; PUSHTARG;