X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FIO%2FIO.xs;h=b3125aa6017d7b3a7b717f9bcf31ff785ea7812b;hb=8ca60cef700efb73a84648ac3b19fd3a3eecd992;hp=4987b3d5552731f983614291e75d80c408ace71c;hpb=63a347c7a3ed87c3e11eda9e379b25371182e278;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs index 4987b3d..b3125aa 100644 --- a/ext/IO/IO.xs +++ b/ext/IO/IO.xs @@ -4,6 +4,8 @@ * modify it under the same terms as Perl itself. */ +#define PERL_EXT_IO + #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #define PERLIO_NOT_STDIO 1 @@ -24,6 +26,13 @@ #endif #ifdef PerlIO +#if defined(MACOS_TRADITIONAL) && defined(USE_SFIO) +#define PERLIO_IS_STDIO 1 +#undef setbuf +#undef setvbuf +#define setvbuf _stdsetvbuf +#define setbuf(f,b) ( __sf_setbuf(f,b) ) +#endif typedef int SysRet; typedef PerlIO * InputStream; typedef PerlIO * OutputStream; @@ -40,11 +49,12 @@ typedef FILE * OutputStream; #define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) #endif +static int not_here(const char *s) __attribute__noreturn__; static int -not_here(char *s) +not_here(const char *s) { croak("%s not implemented on this architecture", s); - return -1; + NORETURN_FUNCTION_END; } @@ -53,64 +63,35 @@ not_here(char *s) #endif static int -io_blocking(InputStream f, int block) +io_blocking(pTHX_ InputStream f, int block) { +#if defined(HAS_FCNTL) int RETVAL; if(!f) { errno = EBADF; return -1; } -#if defined(HAS_FCNTL) RETVAL = fcntl(PerlIO_fileno(f), F_GETFL, 0); if (RETVAL >= 0) { int mode = RETVAL; + int newmode = mode; #ifdef O_NONBLOCK /* POSIX style */ -#if defined(O_NDELAY) && O_NDELAY != O_NONBLOCK - /* Ooops has O_NDELAY too - make sure we don't - * get SysV behaviour by mistake. */ - /* E.g. In UNICOS and UNICOS/mk a F_GETFL returns an O_NDELAY +# ifndef O_NDELAY +# define O_NDELAY O_NONBLOCK +# endif + /* Note: UNICOS and UNICOS/mk a F_GETFL returns an O_NDELAY * after a successful F_SETFL of an O_NONBLOCK. */ RETVAL = RETVAL & (O_NONBLOCK | O_NDELAY) ? 0 : 1; - if (block >= 0) { - if ((mode & O_NDELAY) || ((block == 0) && !(mode & O_NONBLOCK))) { - int ret; - mode = (mode & ~O_NDELAY) | O_NONBLOCK; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } - else - if ((mode & O_NDELAY) || ((block > 0) && (mode & O_NONBLOCK))) { - int ret; - mode &= ~(O_NONBLOCK | O_NDELAY); - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } + if (block == 0) { + newmode &= ~O_NDELAY; + newmode |= O_NONBLOCK; + } else if (block > 0) { + newmode &= ~(O_NDELAY|O_NONBLOCK); } #else - /* Standard POSIX */ - RETVAL = RETVAL & O_NONBLOCK ? 0 : 1; - - if ((block == 0) && !(mode & O_NONBLOCK)) { - int ret; - mode |= O_NONBLOCK; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } - else if ((block > 0) && (mode & O_NONBLOCK)) { - int ret; - mode &= ~O_NONBLOCK; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } -#endif -#else /* Not POSIX - better have O_NDELAY or we can't cope. * for BSD-ish machines this is an acceptable alternative * for SysV we can't tell "would block" from EOF but that is @@ -118,25 +99,21 @@ io_blocking(InputStream f, int block) */ RETVAL = RETVAL & O_NDELAY ? 0 : 1; - if ((block == 0) && !(mode & O_NDELAY)) { - int ret; - mode |= O_NDELAY; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } - else if ((block > 0) && (mode & O_NDELAY)) { - int ret; - mode &= ~O_NDELAY; - ret = fcntl(PerlIO_fileno(f),F_SETFL,mode); - if(ret < 0) - RETVAL = ret; - } + if (block == 0) { + newmode |= O_NDELAY; + } else if (block > 0) { + newmode &= ~O_NDELAY; + } #endif + if (newmode != mode) { + const int ret = fcntl(PerlIO_fileno(f),F_SETFL,newmode); + if (ret < 0) + RETVAL = ret; + } } return RETVAL; #else - return -1; + return -1; #endif } @@ -196,7 +173,7 @@ MODULE = IO PACKAGE = IO::File PREFIX = f void new_tmpfile(packname = "IO::File") - char * packname + const char * packname PREINIT: OutputStream fp; GV *gv; @@ -226,14 +203,14 @@ _poll(timeout,...) PPCODE: { #ifdef HAS_POLL - int nfd = (items - 1) / 2; + const int nfd = (items - 1) / 2; SV *tmpsv = NEWSV(999,nfd * sizeof(struct pollfd)); struct pollfd *fds = (struct pollfd *)SvPVX(tmpsv); int i,j,ret; for(i=1, j=0 ; j < nfd ; j++) { fds[j].fd = SvIV(ST(i)); i++; - fds[j].events = SvIV(ST(i)); + fds[j].events = (short)SvIV(ST(i)); i++; fds[j].revents = 0; } @@ -259,7 +236,7 @@ io_blocking(handle,blk=-1) PROTOTYPE: $;$ CODE: { - int ret = io_blocking(handle, items == 1 ? -1 : blk ? 1 : 0); + const int ret = io_blocking(aTHX_ handle, items == 1 ? -1 : blk ? 1 : 0); if(ret >= 0) XSRETURN_IV(ret); else @@ -361,33 +338,47 @@ fflush(handle) RETVAL void -setbuf(handle, buf) +setbuf(handle, ...) OutputStream handle - char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0; CODE: if (handle) #ifdef PERLIO_IS_STDIO + { + char *buf = items == 2 && SvPOK(ST(1)) ? + sv_grow(ST(1), BUFSIZ) : 0; setbuf(handle, buf); + } #else not_here("IO::Handle::setbuf"); #endif SysRet -setvbuf(handle, buf, type, size) - OutputStream handle - char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; - int type - int size +setvbuf(...) CODE: + if (items != 4) + Perl_croak(aTHX_ "Usage: IO::Handle::setvbuf(handle, buf, type, size)"); #if defined(PERLIO_IS_STDIO) && defined(_IOFBF) && defined(HAS_SETVBUF) + { + OutputStream handle = 0; + char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; + int type; + int size; + + if (items == 4) { + handle = IoOFP(sv_2io(ST(0))); + buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; + type = (int)SvIV(ST(2)); + size = (int)SvIV(ST(3)); + } if (!handle) /* Try input stream. */ handle = IoIFP(sv_2io(ST(0))); - if (handle) + if (items == 4 && handle) RETVAL = setvbuf(handle, buf, type, size); else { RETVAL = -1; errno = EINVAL; } + } #else RETVAL = (SysRet) not_here("IO::Handle::setvbuf"); #endif @@ -420,20 +411,27 @@ sockatmark (sock) InputStream sock PROTOTYPE: $ PREINIT: - int fd,flag,result; + int fd; CODE: { fd = PerlIO_fileno(sock); #ifdef HAS_SOCKATMARK - flag = sockatmark(fd); + RETVAL = sockatmark(fd); #else + { + int flag = 0; # ifdef SIOCATMARK - if (ioctl(fd, SIOCATMARK, &flag) != 0) - XSRETURN_UNDEF; +# if defined(NETWARE) || defined(WIN32) + if (ioctl(fd, SIOCATMARK, (void*)&flag) != 0) +# else + if (ioctl(fd, SIOCATMARK, &flag) != 0) +# endif + XSRETURN_UNDEF; # else - not_here("IO::Socket::atmark"); -# endif - RETVAL = flag; + not_here("IO::Socket::atmark"); +# endif + RETVAL = flag; + } #endif } OUTPUT: