5 #define PERL_NO_GET_CONTEXT
8 #define PERLIO_NOT_STDIO 1
11 #if defined(PERL_OBJECT) || defined(PERL_CAPI) || defined(PERL_IMPLICIT_SYS)
15 # define open PerlLIO_open3
18 #ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */
45 /* XXX This comment is just to make I_TERMIO and I_SGTTY visible to
46 metaconfig for future extension writers. We don't use them in POSIX.
47 (This is really sneaky :-) --AD
49 #if defined(I_TERMIOS)
57 #include <sys/types.h>
62 #ifdef MACOS_TRADITIONAL
68 # if !defined(WIN32) && !defined(__CYGWIN__)
69 extern char *tzname[];
72 #if !defined(WIN32) || (defined(__MINGW32__) && !defined(tzname))
73 char *tzname[] = { "" , "" };
77 #if defined(__VMS) && !defined(__POSIX_SOURCE)
78 # include <libdef.h> /* LIB$_INVARG constant */
79 # include <lib$routines.h> /* prototype for lib$ediv() */
80 # include <starlet.h> /* prototype for sys$gettim() */
81 # if DECC_VERSION < 50000000
82 # define pid_t int /* old versions of DECC miss this in types.h */
86 # define mkfifo(a,b) (not_here("mkfifo"),-1)
87 # define tzset() not_here("tzset")
89 #if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
90 # define HAS_TZNAME /* shows up in VMS 7.0 or Dec C 5.6 */
92 # endif /* __VMS_VER >= 70000000 or Dec C 5.6 */
94 /* The POSIX notion of ttyname() is better served by getname() under VMS */
95 static char ttnambuf[64];
96 # define ttyname(fd) (isatty(fd) > 0 ? getname(fd,ttnambuf,0) : NULL)
98 /* The non-POSIX CRTL times() has void return type, so we just get the
99 current time directly */
100 clock_t vms_times(struct tms *bufptr) {
103 /* Get wall time and convert to 10 ms intervals to
104 * produce the return value that the POSIX standard expects */
105 # if defined(__DECC) && defined (__ALPHA)
108 _ckvmssts(sys$gettim(&vmstime));
110 retval = vmstime & 0x7fffffff;
112 /* (Older hw or ccs don't have an atomic 64-bit type, so we
113 * juggle 32-bit ints (and a float) to produce a time_t result
114 * with minimal loss of information.) */
115 long int vmstime[2],remainder,divisor = 100000;
116 _ckvmssts(sys$gettim((unsigned long int *)vmstime));
117 vmstime[1] &= 0x7fff; /* prevent overflow in EDIV */
118 _ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder));
120 /* Fill in the struct tms using the CRTL routine . . .*/
121 times((tbuffer_t *)bufptr);
122 return (clock_t) retval;
124 # define times(t) vms_times(t)
126 #if defined (__CYGWIN__)
127 # define tzname _tzname
131 # define mkfifo(a,b) not_here("mkfifo")
132 # define ttyname(a) (char*)not_here("ttyname")
133 # define sigset_t long
136 # define tzname _tzname
139 # define mode_t short
142 # define mode_t short
144 # define tzset() not_here("tzset")
146 # ifndef _POSIX_OPEN_MAX
147 # define _POSIX_OPEN_MAX FOPEN_MAX /* XXX bogus ? */
150 # define sigaction(a,b,c) not_here("sigaction")
151 # define sigpending(a) not_here("sigpending")
152 # define sigprocmask(a,b,c) not_here("sigprocmask")
153 # define sigsuspend(a) not_here("sigsuspend")
154 # define sigemptyset(a) not_here("sigemptyset")
155 # define sigaddset(a,b) not_here("sigaddset")
156 # define sigdelset(a,b) not_here("sigdelset")
157 # define sigfillset(a) not_here("sigfillset")
158 # define sigismember(a,b) not_here("sigismember")
162 # if defined(OS2) || defined(MACOS_TRADITIONAL)
163 # define mkfifo(a,b) not_here("mkfifo")
164 # else /* !( defined OS2 ) */
166 # define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
169 # endif /* !HAS_MKFIFO */
171 # ifdef MACOS_TRADITIONAL
172 # define ttyname(a) (char*)not_here("ttyname")
173 # define tzset() not_here("tzset")
176 # include <sys/times.h>
178 # include <sys/utsname.h>
180 # include <sys/wait.h>
189 typedef long SysRetLong;
190 typedef sigset_t* POSIX__SigSet;
191 typedef HV* POSIX__SigAction;
193 typedef struct termios* POSIX__Termios;
194 #else /* Define termios types to int, and call not_here for the functions.*/
195 #define POSIX__Termios int
199 #define cfgetispeed(x) not_here("cfgetispeed")
200 #define cfgetospeed(x) not_here("cfgetospeed")
201 #define tcdrain(x) not_here("tcdrain")
202 #define tcflush(x,y) not_here("tcflush")
203 #define tcsendbreak(x,y) not_here("tcsendbreak")
204 #define cfsetispeed(x,y) not_here("cfsetispeed")
205 #define cfsetospeed(x,y) not_here("cfsetospeed")
206 #define ctermid(x) (char *) not_here("ctermid")
207 #define tcflow(x,y) not_here("tcflow")
208 #define tcgetattr(x,y) not_here("tcgetattr")
209 #define tcsetattr(x,y,z) not_here("tcsetattr")
212 /* Possibly needed prototypes */
213 char *cuserid (char *);
214 double strtod (const char *, char **);
215 long strtol (const char *, char **, int);
216 unsigned long strtoul (const char *, char **, int);
219 #define cuserid(a) (char *) not_here("cuserid")
223 #define difftime(a,b) not_here("difftime")
226 #ifndef HAS_FPATHCONF
227 #define fpathconf(f,n) (SysRetLong) not_here("fpathconf")
230 #define mktime(a) not_here("mktime")
233 #define nice(a) not_here("nice")
236 #define pathconf(f,n) (SysRetLong) not_here("pathconf")
239 #define sysconf(n) (SysRetLong) not_here("sysconf")
242 #define readlink(a,b,c) not_here("readlink")
245 #define setpgid(a,b) not_here("setpgid")
248 #define setsid() not_here("setsid")
251 #define strcoll(s1,s2) not_here("strcoll")
254 #define strtod(s1,s2) not_here("strtod")
257 #define strtol(s1,s2,b) not_here("strtol")
260 #define strtoul(s1,s2,b) not_here("strtoul")
263 #define strxfrm(s1,s2,n) not_here("strxfrm")
265 #ifndef HAS_TCGETPGRP
266 #define tcgetpgrp(a) not_here("tcgetpgrp")
268 #ifndef HAS_TCSETPGRP
269 #define tcsetpgrp(a,b) not_here("tcsetpgrp")
272 #define times(a) not_here("times")
275 #define uname(a) not_here("uname")
278 #define waitpid(a,b,c) not_here("waitpid")
283 #define mblen(a,b) not_here("mblen")
287 #define mbstowcs(s, pwcs, n) not_here("mbstowcs")
290 #define mbtowc(pwc, s, n) not_here("mbtowc")
293 #define wcstombs(s, pwcs, n) not_here("wcstombs")
296 #define wctomb(s, wchar) not_here("wcstombs")
298 #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB)
299 /* If we don't have these functions, then we wouldn't have gotten a typedef
300 for wchar_t, the wide character type. Defining wchar_t allows the
301 functions referencing it to compile. Its actual type is then meaningless,
302 since without the above functions, all sections using it end up calling
303 not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */
309 #ifndef HAS_LOCALECONV
310 #define localeconv() not_here("localeconv")
313 #ifdef HAS_LONG_DOUBLE
314 # if LONG_DOUBLESIZE > NVSIZE
315 # undef HAS_LONG_DOUBLE /* XXX until we figure out how to use them */
319 #ifndef HAS_LONG_DOUBLE
334 croak("POSIX::%s not implemented on this architecture", s);
338 #define PERL_constant_NOTFOUND 1
339 #define PERL_constant_NOTDEF 2
340 #define PERL_constant_ISIV 3
341 #define PERL_constant_ISNO 4
342 #define PERL_constant_ISNV 5
343 #define PERL_constant_ISPV 6
344 #define PERL_constant_ISPVN 7
345 #define PERL_constant_ISUNDEF 8
346 #define PERL_constant_ISUV 9
347 #define PERL_constant_ISYES 10
349 /* These were implemented in the old "constant" subroutine. They are actually
350 macros that take an integer argument and return an integer result. */
352 int_macro_int (const char *name, STRLEN len, IV *arg_result) {
353 /* Initially switch on the length of the name. */
354 /* This code has been edited from a "constant" function generated by:
356 use ExtUtils::Constant qw (constant_types C_constant XS_constant);
358 my $types = {map {($_, 1)} qw(IV)};
359 my @names = (qw(S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG WEXITSTATUS WIFEXITED
360 WIFSIGNALED WIFSTOPPED WSTOPSIG WTERMSIG));
362 print constant_types(); # macro defs
363 foreach (C_constant ("POSIX", 'int_macro_int', 'IV', $types, undef, 5, @names) ) {
364 print $_, "\n"; # C constant subs
366 print "#### XS Section:\n";
367 print XS_constant ("POSIX", $types);
373 /* Names all of length 7. */
374 /* S_ISBLK S_ISCHR S_ISDIR S_ISREG */
375 /* Offset 5 gives the best switch position. */
378 if (memEQ(name, "S_ISREG", 7)) {
381 *arg_result = S_ISREG(*arg_result);
382 return PERL_constant_ISIV;
384 return PERL_constant_NOTDEF;
389 if (memEQ(name, "S_ISCHR", 7)) {
392 *arg_result = S_ISCHR(*arg_result);
393 return PERL_constant_ISIV;
395 return PERL_constant_NOTDEF;
400 if (memEQ(name, "S_ISDIR", 7)) {
403 *arg_result = S_ISDIR(*arg_result);
404 return PERL_constant_ISIV;
406 return PERL_constant_NOTDEF;
411 if (memEQ(name, "S_ISBLK", 7)) {
414 *arg_result = S_ISBLK(*arg_result);
415 return PERL_constant_ISIV;
417 return PERL_constant_NOTDEF;
424 /* Names all of length 8. */
425 /* S_ISFIFO WSTOPSIG WTERMSIG */
426 /* Offset 3 gives the best switch position. */
429 if (memEQ(name, "WSTOPSIG", 8)) {
432 *arg_result = WSTOPSIG(*arg_result);
433 return PERL_constant_ISIV;
435 return PERL_constant_NOTDEF;
440 if (memEQ(name, "WTERMSIG", 8)) {
443 *arg_result = WTERMSIG(*arg_result);
444 return PERL_constant_ISIV;
446 return PERL_constant_NOTDEF;
451 if (memEQ(name, "S_ISFIFO", 8)) {
454 *arg_result = S_ISFIFO(*arg_result);
455 return PERL_constant_ISIV;
457 return PERL_constant_NOTDEF;
464 if (memEQ(name, "WIFEXITED", 9)) {
466 *arg_result = WIFEXITED(*arg_result);
467 return PERL_constant_ISIV;
469 return PERL_constant_NOTDEF;
474 if (memEQ(name, "WIFSTOPPED", 10)) {
476 *arg_result = WIFSTOPPED(*arg_result);
477 return PERL_constant_ISIV;
479 return PERL_constant_NOTDEF;
484 /* Names all of length 11. */
485 /* WEXITSTATUS WIFSIGNALED */
486 /* Offset 1 gives the best switch position. */
489 if (memEQ(name, "WEXITSTATUS", 11)) {
492 *arg_result = WEXITSTATUS(*arg_result);
493 return PERL_constant_ISIV;
495 return PERL_constant_NOTDEF;
500 if (memEQ(name, "WIFSIGNALED", 11)) {
503 *arg_result = WIFSIGNALED(*arg_result);
504 return PERL_constant_ISIV;
506 return PERL_constant_NOTDEF;
513 return PERL_constant_NOTFOUND;
516 #include "constants.c"
519 restore_sigmask(sigset_t *ossetp)
521 /* Fortunately, restoring the signal mask can't fail, because
522 * there's nothing we can do about it if it does -- we're not
523 * supposed to return -1 from sigaction unless the disposition
526 (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
529 MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig
532 new(packname = "POSIX::SigSet", ...)
537 New(0, RETVAL, 1, sigset_t);
539 for (i = 1; i < items; i++)
540 sigaddset(RETVAL, SvIV(ST(i)));
552 sigaddset(sigset, sig)
557 sigdelset(sigset, sig)
570 sigismember(sigset, sig)
575 MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf
578 new(packname = "POSIX::Termios", ...)
583 New(0, RETVAL, 1, struct termios);
594 POSIX::Termios termios_ref
597 Safefree(termios_ref);
603 getattr(termios_ref, fd = 0)
604 POSIX::Termios termios_ref
607 RETVAL = tcgetattr(fd, termios_ref);
612 setattr(termios_ref, fd = 0, optional_actions = 0)
613 POSIX::Termios termios_ref
617 RETVAL = tcsetattr(fd, optional_actions, termios_ref);
622 cfgetispeed(termios_ref)
623 POSIX::Termios termios_ref
626 cfgetospeed(termios_ref)
627 POSIX::Termios termios_ref
630 getiflag(termios_ref)
631 POSIX::Termios termios_ref
633 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
634 RETVAL = termios_ref->c_iflag;
636 not_here("getiflag");
643 getoflag(termios_ref)
644 POSIX::Termios termios_ref
646 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
647 RETVAL = termios_ref->c_oflag;
649 not_here("getoflag");
656 getcflag(termios_ref)
657 POSIX::Termios termios_ref
659 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
660 RETVAL = termios_ref->c_cflag;
662 not_here("getcflag");
669 getlflag(termios_ref)
670 POSIX::Termios termios_ref
672 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
673 RETVAL = termios_ref->c_lflag;
675 not_here("getlflag");
682 getcc(termios_ref, ccix)
683 POSIX::Termios termios_ref
686 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
688 croak("Bad getcc subscript");
689 RETVAL = termios_ref->c_cc[ccix];
698 cfsetispeed(termios_ref, speed)
699 POSIX::Termios termios_ref
703 cfsetospeed(termios_ref, speed)
704 POSIX::Termios termios_ref
708 setiflag(termios_ref, iflag)
709 POSIX::Termios termios_ref
712 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
713 termios_ref->c_iflag = iflag;
715 not_here("setiflag");
719 setoflag(termios_ref, oflag)
720 POSIX::Termios termios_ref
723 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
724 termios_ref->c_oflag = oflag;
726 not_here("setoflag");
730 setcflag(termios_ref, cflag)
731 POSIX::Termios termios_ref
734 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
735 termios_ref->c_cflag = cflag;
737 not_here("setcflag");
741 setlflag(termios_ref, lflag)
742 POSIX::Termios termios_ref
745 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
746 termios_ref->c_lflag = lflag;
748 not_here("setlflag");
752 setcc(termios_ref, ccix, cc)
753 POSIX::Termios termios_ref
757 #ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */
759 croak("Bad setcc subscript");
760 termios_ref->c_cc[ccix] = cc;
766 MODULE = POSIX PACKAGE = POSIX
768 INCLUDE: constants.xs
771 int_macro_int(sv, iv)
778 const char * s = SvPV(sv, len);
781 /* Change this to int_macro_int(s, len, &iv, &nv);
782 if you need to return both NVs and IVs */
783 type = int_macro_int(s, len, &iv);
784 /* Return 1 or 2 items. First is error message, or undef if no error.
785 Second, if present, is found value */
787 case PERL_constant_NOTFOUND:
788 sv = sv_2mortal(newSVpvf("%s is not a valid POSIX macro", s));
793 case PERL_constant_NOTDEF:
794 sv = sv_2mortal(newSVpvf(
795 "Your vendor has not defined POSIX macro %s, used", s));
800 case PERL_constant_ISIV:
804 sv = sv_2mortal(newSVpvf(
805 "Unexpected return type %d while processing POSIX macro %s, used",
814 unsigned char * charstring
816 unsigned char *s = charstring;
817 unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
818 for (RETVAL = 1; RETVAL && s < e; s++)
826 unsigned char * charstring
828 unsigned char *s = charstring;
829 unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
830 for (RETVAL = 1; RETVAL && s < e; s++)
838 unsigned char * charstring
840 unsigned char *s = charstring;
841 unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
842 for (RETVAL = 1; RETVAL && s < e; s++)
850 unsigned char * charstring
852 unsigned char *s = charstring;
853 unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
854 for (RETVAL = 1; RETVAL && s < e; s++)
862 unsigned char * charstring
864 unsigned char *s = charstring;
865 unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
866 for (RETVAL = 1; RETVAL && s < e; s++)
874 unsigned char * charstring
876 unsigned char *s = charstring;
877 unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
878 for (RETVAL = 1; RETVAL && s < e; s++)
886 unsigned char * charstring
888 unsigned char *s = charstring;
889 unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
890 for (RETVAL = 1; RETVAL && s < e; s++)
898 unsigned char * charstring
900 unsigned char *s = charstring;
901 unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
902 for (RETVAL = 1; RETVAL && s < e; s++)
910 unsigned char * charstring
912 unsigned char *s = charstring;
913 unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
914 for (RETVAL = 1; RETVAL && s < e; s++)
922 unsigned char * charstring
924 unsigned char *s = charstring;
925 unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
926 for (RETVAL = 1; RETVAL && s < e; s++)
934 unsigned char * charstring
936 unsigned char *s = charstring;
937 unsigned char *e = s + PL_na; /* "PL_na" set by typemap side effect */
938 for (RETVAL = 1; RETVAL && s < e; s++)
945 open(filename, flags = O_RDONLY, mode = 0666)
950 if (flags & (O_APPEND|O_CREAT|O_TRUNC|O_RDWR|O_WRONLY|O_EXCL))
951 TAINT_PROPER("open");
952 RETVAL = open(filename, flags, mode);
960 #ifdef HAS_LOCALECONV
963 if ((lcbuf = localeconv())) {
965 if (lcbuf->decimal_point && *lcbuf->decimal_point)
966 hv_store(RETVAL, "decimal_point", 13,
967 newSVpv(lcbuf->decimal_point, 0), 0);
968 if (lcbuf->thousands_sep && *lcbuf->thousands_sep)
969 hv_store(RETVAL, "thousands_sep", 13,
970 newSVpv(lcbuf->thousands_sep, 0), 0);
971 #ifndef NO_LOCALECONV_GROUPING
972 if (lcbuf->grouping && *lcbuf->grouping)
973 hv_store(RETVAL, "grouping", 8,
974 newSVpv(lcbuf->grouping, 0), 0);
976 if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol)
977 hv_store(RETVAL, "int_curr_symbol", 15,
978 newSVpv(lcbuf->int_curr_symbol, 0), 0);
979 if (lcbuf->currency_symbol && *lcbuf->currency_symbol)
980 hv_store(RETVAL, "currency_symbol", 15,
981 newSVpv(lcbuf->currency_symbol, 0), 0);
982 if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point)
983 hv_store(RETVAL, "mon_decimal_point", 17,
984 newSVpv(lcbuf->mon_decimal_point, 0), 0);
985 #ifndef NO_LOCALECONV_MON_THOUSANDS_SEP
986 if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep)
987 hv_store(RETVAL, "mon_thousands_sep", 17,
988 newSVpv(lcbuf->mon_thousands_sep, 0), 0);
990 #ifndef NO_LOCALECONV_MON_GROUPING
991 if (lcbuf->mon_grouping && *lcbuf->mon_grouping)
992 hv_store(RETVAL, "mon_grouping", 12,
993 newSVpv(lcbuf->mon_grouping, 0), 0);
995 if (lcbuf->positive_sign && *lcbuf->positive_sign)
996 hv_store(RETVAL, "positive_sign", 13,
997 newSVpv(lcbuf->positive_sign, 0), 0);
998 if (lcbuf->negative_sign && *lcbuf->negative_sign)
999 hv_store(RETVAL, "negative_sign", 13,
1000 newSVpv(lcbuf->negative_sign, 0), 0);
1002 if (lcbuf->int_frac_digits != CHAR_MAX)
1003 hv_store(RETVAL, "int_frac_digits", 15,
1004 newSViv(lcbuf->int_frac_digits), 0);
1005 if (lcbuf->frac_digits != CHAR_MAX)
1006 hv_store(RETVAL, "frac_digits", 11,
1007 newSViv(lcbuf->frac_digits), 0);
1008 if (lcbuf->p_cs_precedes != CHAR_MAX)
1009 hv_store(RETVAL, "p_cs_precedes", 13,
1010 newSViv(lcbuf->p_cs_precedes), 0);
1011 if (lcbuf->p_sep_by_space != CHAR_MAX)
1012 hv_store(RETVAL, "p_sep_by_space", 14,
1013 newSViv(lcbuf->p_sep_by_space), 0);
1014 if (lcbuf->n_cs_precedes != CHAR_MAX)
1015 hv_store(RETVAL, "n_cs_precedes", 13,
1016 newSViv(lcbuf->n_cs_precedes), 0);
1017 if (lcbuf->n_sep_by_space != CHAR_MAX)
1018 hv_store(RETVAL, "n_sep_by_space", 14,
1019 newSViv(lcbuf->n_sep_by_space), 0);
1020 if (lcbuf->p_sign_posn != CHAR_MAX)
1021 hv_store(RETVAL, "p_sign_posn", 11,
1022 newSViv(lcbuf->p_sign_posn), 0);
1023 if (lcbuf->n_sign_posn != CHAR_MAX)
1024 hv_store(RETVAL, "n_sign_posn", 11,
1025 newSViv(lcbuf->n_sign_posn), 0);
1028 localeconv(); /* A stub to call not_here(). */
1034 setlocale(category, locale = 0)
1038 RETVAL = setlocale(category, locale);
1040 #ifdef USE_LOCALE_CTYPE
1041 if (category == LC_CTYPE
1043 || category == LC_ALL
1049 if (category == LC_ALL)
1050 newctype = setlocale(LC_CTYPE, NULL);
1054 new_ctype(newctype);
1056 #endif /* USE_LOCALE_CTYPE */
1057 #ifdef USE_LOCALE_COLLATE
1058 if (category == LC_COLLATE
1060 || category == LC_ALL
1066 if (category == LC_ALL)
1067 newcoll = setlocale(LC_COLLATE, NULL);
1071 new_collate(newcoll);
1073 #endif /* USE_LOCALE_COLLATE */
1074 #ifdef USE_LOCALE_NUMERIC
1075 if (category == LC_NUMERIC
1077 || category == LC_ALL
1083 if (category == LC_ALL)
1084 newnum = setlocale(LC_NUMERIC, NULL);
1088 new_numeric(newnum);
1090 #endif /* USE_LOCALE_NUMERIC */
1130 /* (We already know stack is long enough.) */
1131 PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar))));
1132 PUSHs(sv_2mortal(newSViv(expvar)));
1148 /* (We already know stack is long enough.) */
1149 PUSHs(sv_2mortal(newSVnv(Perl_modf(x,&intvar))));
1150 PUSHs(sv_2mortal(newSVnv(intvar)));
1165 sigaction(sig, optaction, oldaction = 0)
1168 POSIX::SigAction oldaction
1171 RETVAL = not_here("sigaction");
1173 # This code is really grody because we're trying to make the signal
1174 # interface look beautiful, which is hard.
1177 POSIX__SigAction action;
1178 GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV);
1179 struct sigaction act;
1180 struct sigaction oact;
1183 POSIX__SigSet sigset;
1185 SV** sigsvp = hv_fetch(GvHVn(siggv),
1187 strlen(PL_sig_name[sig]),
1190 /* Check optaction and set action */
1191 if(SvTRUE(optaction)) {
1192 if(sv_isa(optaction, "POSIX::SigAction"))
1193 action = (HV*)SvRV(optaction);
1195 croak("action is not of type POSIX::SigAction");
1201 /* sigaction() is supposed to look atomic. In particular, any
1202 * signal handler invoked during a sigaction() call should
1203 * see either the old or the new disposition, and not something
1204 * in between. We use sigprocmask() to make it so.
1207 RETVAL=sigprocmask(SIG_BLOCK, &sset, &osset);
1211 /* Restore signal mask no matter how we exit this block. */
1212 SAVEDESTRUCTOR(restore_sigmask, &osset);
1214 RETVAL=-1; /* In case both oldaction and action are 0. */
1216 /* Remember old disposition if desired. */
1218 svp = hv_fetch(oldaction, "HANDLER", 7, TRUE);
1220 croak("Can't supply an oldaction without a HANDLER");
1221 if(SvTRUE(*sigsvp)) { /* TBD: what if "0"? */
1222 sv_setsv(*svp, *sigsvp);
1225 sv_setpv(*svp, "DEFAULT");
1227 RETVAL = sigaction(sig, (struct sigaction *)0, & oact);
1230 /* Get back the mask. */
1231 svp = hv_fetch(oldaction, "MASK", 4, TRUE);
1232 if (sv_isa(*svp, "POSIX::SigSet")) {
1233 IV tmp = SvIV((SV*)SvRV(*svp));
1234 sigset = INT2PTR(sigset_t*, tmp);
1237 New(0, sigset, 1, sigset_t);
1238 sv_setptrobj(*svp, sigset, "POSIX::SigSet");
1240 *sigset = oact.sa_mask;
1242 /* Get back the flags. */
1243 svp = hv_fetch(oldaction, "FLAGS", 5, TRUE);
1244 sv_setiv(*svp, oact.sa_flags);
1248 /* Vector new handler through %SIG. (We always use sighandler
1249 for the C signal handler, which reads %SIG to dispatch.) */
1250 svp = hv_fetch(action, "HANDLER", 7, FALSE);
1252 croak("Can't supply an action without a HANDLER");
1253 sv_setsv(*sigsvp, *svp);
1254 mg_set(*sigsvp); /* handles DEFAULT and IGNORE */
1256 char *s=SvPVX(*svp);
1257 if(strEQ(s,"IGNORE")) {
1258 act.sa_handler = SIG_IGN;
1260 else if(strEQ(s,"DEFAULT")) {
1261 act.sa_handler = SIG_DFL;
1264 act.sa_handler = PL_sighandlerp;
1268 act.sa_handler = PL_sighandlerp;
1271 /* Set up any desired mask. */
1272 svp = hv_fetch(action, "MASK", 4, FALSE);
1273 if (svp && sv_isa(*svp, "POSIX::SigSet")) {
1274 IV tmp = SvIV((SV*)SvRV(*svp));
1275 sigset = INT2PTR(sigset_t*, tmp);
1276 act.sa_mask = *sigset;
1279 sigemptyset(& act.sa_mask);
1281 /* Set up any desired flags. */
1282 svp = hv_fetch(action, "FLAGS", 5, FALSE);
1283 act.sa_flags = svp ? SvIV(*svp) : 0;
1285 /* Don't worry about cleaning up *sigsvp if this fails,
1286 * because that means we tried to disposition a
1287 * nonblockable signal, in which case *sigsvp is
1288 * essentially meaningless anyway.
1290 RETVAL = sigaction(sig, & act, (struct sigaction *)0);
1301 POSIX::SigSet sigset
1304 sigprocmask(how, sigset, oldsigset = 0)
1306 POSIX::SigSet sigset
1307 POSIX::SigSet oldsigset = NO_INIT
1312 else if (sv_derived_from(ST(2), "POSIX::SigSet")) {
1313 IV tmp = SvIV((SV*)SvRV(ST(2)));
1314 oldsigset = INT2PTR(POSIX__SigSet,tmp);
1317 New(0, oldsigset, 1, sigset_t);
1318 sigemptyset(oldsigset);
1319 sv_setref_pv(ST(2), "POSIX::SigSet", (void*)oldsigset);
1323 sigsuspend(signal_mask)
1324 POSIX::SigSet signal_mask
1344 lseek(fd, offset, whence)
1357 if (pipe(fds) != -1) {
1359 PUSHs(sv_2mortal(newSViv(fds[0])));
1360 PUSHs(sv_2mortal(newSViv(fds[1])));
1364 read(fd, buffer, nbytes)
1366 SV *sv_buffer = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1);
1370 char * buffer = sv_grow( sv_buffer, nbytes+1 );
1373 SvCUR(sv_buffer) = RETVAL;
1374 SvPOK_only(sv_buffer);
1375 *SvEND(sv_buffer) = '\0';
1376 SvTAINTED_on(sv_buffer);
1392 tcsetpgrp(fd, pgrp_id)
1401 if (uname(&buf) >= 0) {
1403 PUSHs(sv_2mortal(newSVpv(buf.sysname, 0)));
1404 PUSHs(sv_2mortal(newSVpv(buf.nodename, 0)));
1405 PUSHs(sv_2mortal(newSVpv(buf.release, 0)));
1406 PUSHs(sv_2mortal(newSVpv(buf.version, 0)));
1407 PUSHs(sv_2mortal(newSVpv(buf.machine, 0)));
1410 uname((char *) 0); /* A stub to call not_here(). */
1414 write(fd, buffer, nbytes)
1425 RETVAL = newSVpvn("", 0);
1426 SvGROW(RETVAL, L_tmpnam);
1427 len = strlen(tmpnam(SvPV(RETVAL, i)));
1428 SvCUR_set(RETVAL, len);
1441 mbstowcs(s, pwcs, n)
1453 wcstombs(s, pwcs, n)
1475 SET_NUMERIC_LOCAL();
1476 num = strtod(str, &unparsed);
1477 PUSHs(sv_2mortal(newSVnv(num)));
1478 if (GIMME == G_ARRAY) {
1481 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1483 PUSHs(&PL_sv_undef);
1487 strtol(str, base = 0)
1494 num = strtol(str, &unparsed, base);
1495 #if IVSIZE <= LONGSIZE
1496 if (num < IV_MIN || num > IV_MAX)
1497 PUSHs(sv_2mortal(newSVnv((double)num)));
1500 PUSHs(sv_2mortal(newSViv((IV)num)));
1501 if (GIMME == G_ARRAY) {
1504 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1506 PUSHs(&PL_sv_undef);
1510 strtoul(str, base = 0)
1517 num = strtoul(str, &unparsed, base);
1519 PUSHs(sv_2mortal(newSViv((IV)num)));
1521 PUSHs(sv_2mortal(newSVnv((double)num)));
1522 if (GIMME == G_ARRAY) {
1525 PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
1527 PUSHs(&PL_sv_undef);
1537 char *p = SvPV(src,srclen);
1539 ST(0) = sv_2mortal(NEWSV(800,srclen));
1540 dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen);
1541 if (dstlen > srclen) {
1543 SvGROW(ST(0), dstlen);
1544 strxfrm(SvPVX(ST(0)), p, (size_t)dstlen);
1547 SvCUR(ST(0)) = dstlen;
1552 mkfifo(filename, mode)
1556 TAINT_PROPER("mkfifo");
1557 RETVAL = mkfifo(filename, mode);
1573 tcflush(fd, queue_selector)
1578 tcsendbreak(fd, duration)
1583 asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
1596 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1599 mytm.tm_hour = hour;
1600 mytm.tm_mday = mday;
1602 mytm.tm_year = year;
1603 mytm.tm_wday = wday;
1604 mytm.tm_yday = yday;
1605 mytm.tm_isdst = isdst;
1606 RETVAL = asctime(&mytm);
1623 realtime = times( &tms );
1625 PUSHs( sv_2mortal( newSViv( (IV) realtime ) ) );
1626 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_utime ) ) );
1627 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_stime ) ) );
1628 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cutime ) ) );
1629 PUSHs( sv_2mortal( newSViv( (IV) tms.tms_cstime ) ) );
1632 difftime(time1, time2)
1637 mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0)
1650 init_tm(&mytm); /* XXX workaround - see init_tm() above */
1653 mytm.tm_hour = hour;
1654 mytm.tm_mday = mday;
1656 mytm.tm_year = year;
1657 mytm.tm_wday = wday;
1658 mytm.tm_yday = yday;
1659 mytm.tm_isdst = isdst;
1660 RETVAL = mktime(&mytm);
1665 #XXX: if $xsubpp::WantOptimize is always the default
1666 # sv_setpv(TARG, ...) could be used rather than
1667 # ST(0) = sv_2mortal(newSVpv(...))
1669 strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1)
1682 char *buf = my_strftime(fmt, sec, min, hour, mday, mon, year, wday, yday, isdst);
1684 ST(0) = sv_2mortal(newSVpv(buf, 0));
1696 PUSHs(sv_2mortal(newSVpvn(tzname[0],strlen(tzname[0]))));
1697 PUSHs(sv_2mortal(newSVpvn(tzname[1],strlen(tzname[1]))));
1700 access(filename, mode)
1718 pathconf(filename, name)
1741 #XXX: use sv_getcwd()
1749 New(0, buf, buflen, char);
1750 /* Many getcwd()s know how to automatically allocate memory
1751 * for the directory if the buffer argument is NULL but...
1752 * (1) we cannot assume all getcwd()s do that
1753 * (2) this may interfere with Perl's malloc
1754 * So let's not. --jhi */
1755 while ((getcwd(buf, buflen) == NULL) && errno == ERANGE) {
1757 if (buflen > MAXPATHLEN) {
1762 Renew(buf, buflen, char);
1765 PUSHs(sv_2mortal(newSVpv(buf, 0)));
1769 PUSHs(&PL_sv_undef);
1771 require_pv("Cwd.pm");
1772 /* Module require may have grown the stack */
1776 XSRETURN(call_pv("Cwd::cwd", GIMME_V));