#endif
-#if !defined(PERL_IMPLICIT_SYS)
#ifdef PERLIO_IS_STDIO
void
PerlIO_debug(const char *fmt,...)
{
+ dTHX;
static int dbg = 0;
va_list ap;
va_start(ap,fmt);
PerlIO *ifp = IoIFP(io);
PerlIO *ofp = IoOFP(io);
AV *av = (AV *) mg->mg_obj;
- Perl_warn(aTHX_ "set %_ %p %p %p",sv,io,ifp,ofp);
+ Perl_warn(aTHX_ "set %"SVf" %p %p %p",sv,io,ifp,ofp);
}
return 0;
}
PerlIO *ifp = IoIFP(io);
PerlIO *ofp = IoOFP(io);
AV *av = (AV *) mg->mg_obj;
- Perl_warn(aTHX_ "get %_ %p %p %p",sv,io,ifp,ofp);
+ Perl_warn(aTHX_ "get %"SVf" %p %p %p",sv,io,ifp,ofp);
}
return 0;
}
static int
perlio_mg_clear(pTHX_ SV *sv, MAGIC *mg)
{
- Perl_warn(aTHX_ "clear %_",sv);
+ Perl_warn(aTHX_ "clear %"SVf,sv);
return 0;
}
static int
perlio_mg_free(pTHX_ SV *sv, MAGIC *mg)
{
- Perl_warn(aTHX_ "free %_",sv);
+ Perl_warn(aTHX_ "free %"SVf,sv);
return 0;
}
mg = mg_find(sv,'~');
mg->mg_virtual = &perlio_vtab;
mg_magical(sv);
- Perl_warn(aTHX_ "attrib %_",sv);
+ Perl_warn(aTHX_ "attrib %"SVf,sv);
for (i=2; i < items; i++)
{
STRLEN len;
}
}
#if 0
- PerlIO_debug("PerlIOBase_pushed f=%p %s %s fl=%08x (%s)\n",
+ PerlIO_debug("PerlIOBase_pushed f=%p %s %s fl=%08"UVxf" (%s)\n",
f,PerlIOBase(f)->tab->name,(omode) ? omode : "(Null)",
l->flags,PerlIO_modestr(f,temp));
#endif
PerlIO *
PerlIOUnix_open(PerlIO_funcs *self, const char *path,const char *mode)
{
+ dTHX;
PerlIO *f = NULL;
int oflags = PerlIOUnix_oflags(mode);
if (oflags != -1)
(*PerlIOBase(f)->tab->Close)(f);
if (oflags != -1)
{
+ dTHX;
int fd = PerlLIO_open3(path,oflags,0666);
if (fd >= 0)
{
SSize_t
PerlIOUnix_read(PerlIO *f, void *vbuf, Size_t count)
{
+ dTHX;
int fd = PerlIOSelf(f,PerlIOUnix)->fd;
if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD))
return 0;
SSize_t
PerlIOUnix_write(PerlIO *f, const void *vbuf, Size_t count)
{
+ dTHX;
int fd = PerlIOSelf(f,PerlIOUnix)->fd;
while (1)
{
IV
PerlIOUnix_seek(PerlIO *f, Off_t offset, int whence)
{
+ dTHX;
Off_t new = PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,offset,whence);
PerlIOBase(f)->flags &= ~PERLIO_F_EOF;
return (new == (Off_t) -1) ? -1 : 0;
Off_t
PerlIOUnix_tell(PerlIO *f)
{
+ dTHX;
return PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR);
}
IV
PerlIOUnix_close(PerlIO *f)
{
+ dTHX;
int fd = PerlIOSelf(f,PerlIOUnix)->fd;
int code = 0;
while (PerlLIO_close(fd) != 0)
IV
PerlIOStdio_fileno(PerlIO *f)
{
- return fileno(PerlIOSelf(f,PerlIOStdio)->stdio);
+ dTHX;
+ return PerlSIO_fileno(PerlIOSelf(f,PerlIOStdio)->stdio);
}
const char *
PerlIO *
PerlIOStdio_fdopen(PerlIO_funcs *self, int fd,const char *mode)
{
+ dTHX;
PerlIO *f = NULL;
int init = 0;
char tmode[8];
switch(fd)
{
case 0:
- stdio = stdin;
+ stdio = PerlSIO_stdin;
break;
case 1:
- stdio = stdout;
+ stdio = PerlSIO_stdout;
break;
case 2:
- stdio = stderr;
+ stdio = PerlSIO_stderr;
break;
}
}
else
{
- stdio = fdopen(fd,mode = PerlIOStdio_mode(mode,tmode));
+ stdio = PerlSIO_fdopen(fd,mode = PerlIOStdio_mode(mode,tmode));
}
if (stdio)
{
PerlIO *
PerlIOStdio_open(PerlIO_funcs *self, const char *path,const char *mode)
{
+ dTHX;
PerlIO *f = NULL;
- FILE *stdio = fopen(path,mode);
+ FILE *stdio = PerlSIO_fopen(path,mode);
if (stdio)
{
char tmode[8];
int
PerlIOStdio_reopen(const char *path, const char *mode, PerlIO *f)
{
+ dTHX;
PerlIOStdio *s = PerlIOSelf(f,PerlIOStdio);
char tmode[8];
- FILE *stdio = freopen(path,(mode = PerlIOStdio_mode(mode,tmode)),s->stdio);
+ FILE *stdio = PerlSIO_freopen(path,(mode = PerlIOStdio_mode(mode,tmode)),s->stdio);
if (!s->stdio)
return -1;
s->stdio = stdio;
SSize_t
PerlIOStdio_read(PerlIO *f, void *vbuf, Size_t count)
{
+ dTHX;
FILE *s = PerlIOSelf(f,PerlIOStdio)->stdio;
SSize_t got = 0;
if (count == 1)
/* Perl is expecting PerlIO_getc() to fill the buffer
* Linux's stdio does not do that for fread()
*/
- int ch = fgetc(s);
+ int ch = PerlSIO_fgetc(s);
if (ch != EOF)
{
*buf = ch;
}
}
else
- got = fread(vbuf,1,count,s);
+ got = PerlSIO_fread(vbuf,1,count,s);
return got;
}
SSize_t
PerlIOStdio_unread(PerlIO *f, const void *vbuf, Size_t count)
{
+ dTHX;
FILE *s = PerlIOSelf(f,PerlIOStdio)->stdio;
STDCHAR *buf = ((STDCHAR *)vbuf)+count-1;
SSize_t unread = 0;
while (count > 0)
{
int ch = *buf-- & 0xff;
- if (ungetc(ch,s) != ch)
+ if (PerlSIO_ungetc(ch,s) != ch)
break;
unread++;
count--;
SSize_t
PerlIOStdio_write(PerlIO *f, const void *vbuf, Size_t count)
{
- return fwrite(vbuf,1,count,PerlIOSelf(f,PerlIOStdio)->stdio);
+ dTHX;
+ return PerlSIO_fwrite(vbuf,1,count,PerlIOSelf(f,PerlIOStdio)->stdio);
}
IV
PerlIOStdio_seek(PerlIO *f, Off_t offset, int whence)
{
+ dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
- return fseek(stdio,offset,whence);
+ return PerlSIO_fseek(stdio,offset,whence);
}
Off_t
PerlIOStdio_tell(PerlIO *f)
{
+ dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
- return ftell(stdio);
+ return PerlSIO_ftell(stdio);
}
IV
PerlIOStdio_close(PerlIO *f)
{
+ dTHX;
+#ifdef HAS_SOCKET
int optval, optlen = sizeof(int);
+#endif
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
return(
+#ifdef HAS_SOCKET
(getsockopt(PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (char *)&optval, &optlen) < 0) ?
- fclose(stdio) :
- close(PerlIO_fileno(f)));
+ PerlSIO_fclose(stdio) :
+ close(PerlIO_fileno(f))
+#else
+ PerlSIO_fclose(stdio)
+#endif
+ );
+
}
IV
PerlIOStdio_flush(PerlIO *f)
{
+ dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
{
- return fflush(stdio);
+ return PerlSIO_fflush(stdio);
}
else
{
*/
/* Not writeable - sync by attempting a seek */
int err = errno;
- if (fseek(stdio,(Off_t) 0, SEEK_CUR) != 0)
+ if (PerlSIO_fseek(stdio,(Off_t) 0, SEEK_CUR) != 0)
errno = err;
#endif
}
IV
PerlIOStdio_fill(PerlIO *f)
{
+ dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
int c;
/* fflush()ing read-only streams can cause trouble on some stdio-s */
if ((PerlIOBase(f)->flags & PERLIO_F_CANWRITE))
{
- if (fflush(stdio) != 0)
+ if (PerlSIO_fflush(stdio) != 0)
return EOF;
}
- c = fgetc(stdio);
- if (c == EOF || ungetc(c,stdio) != c)
+ c = PerlSIO_fgetc(stdio);
+ if (c == EOF || PerlSIO_ungetc(c,stdio) != c)
return EOF;
return 0;
}
IV
PerlIOStdio_eof(PerlIO *f)
{
- return feof(PerlIOSelf(f,PerlIOStdio)->stdio);
+ dTHX;
+ return PerlSIO_feof(PerlIOSelf(f,PerlIOStdio)->stdio);
}
IV
PerlIOStdio_error(PerlIO *f)
{
- return ferror(PerlIOSelf(f,PerlIOStdio)->stdio);
+ dTHX;
+ return PerlSIO_ferror(PerlIOSelf(f,PerlIOStdio)->stdio);
}
void
PerlIOStdio_clearerr(PerlIO *f)
{
- clearerr(PerlIOSelf(f,PerlIOStdio)->stdio);
+ dTHX;
+ PerlSIO_clearerr(PerlIOSelf(f,PerlIOStdio)->stdio);
}
void
PerlIOStdio_setlinebuf(PerlIO *f)
{
+ dTHX;
#ifdef HAS_SETLINEBUF
- setlinebuf(PerlIOSelf(f,PerlIOStdio)->stdio);
+ PerlSIO_setlinebuf(PerlIOSelf(f,PerlIOStdio)->stdio);
#else
- setvbuf(PerlIOSelf(f,PerlIOStdio)->stdio, Nullch, _IOLBF, 0);
+ PerlSIO_setvbuf(PerlIOSelf(f,PerlIOStdio)->stdio, Nullch, _IOLBF, 0);
#endif
}
STDCHAR *
PerlIOStdio_get_base(PerlIO *f)
{
+ dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
- return FILE_base(stdio);
+ return PerlSIO_get_base(stdio);
}
Size_t
PerlIOStdio_get_bufsiz(PerlIO *f)
{
+ dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
- return FILE_bufsiz(stdio);
+ return PerlSIO_get_bufsiz(stdio);
}
#endif
STDCHAR *
PerlIOStdio_get_ptr(PerlIO *f)
{
+ dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
- return FILE_ptr(stdio);
+ return PerlSIO_get_ptr(stdio);
}
SSize_t
PerlIOStdio_get_cnt(PerlIO *f)
{
+ dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
- return FILE_cnt(stdio);
+ return PerlSIO_get_cnt(stdio);
}
void
PerlIOStdio_set_ptrcnt(PerlIO *f,STDCHAR *ptr,SSize_t cnt)
{
+ dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
if (ptr != NULL)
{
#ifdef STDIO_PTR_LVALUE
- FILE_ptr(stdio) = ptr;
+ PerlSIO_set_ptr(stdio,ptr);
#ifdef STDIO_PTR_LVAL_SETS_CNT
- if (FILE_cnt(stdio) != (cnt))
+ if (PerlSIO_get_cnt(stdio) != (cnt))
{
dTHX;
- assert(FILE_cnt(stdio) == (cnt));
+ assert(PerlSIO_get_cnt(stdio) == (cnt));
}
#endif
#if (!defined(STDIO_PTR_LVAL_NOCHANGE_CNT))
return;
#endif
#else /* STDIO_PTR_LVALUE */
- abort();
+ PerlProc_abort();
#endif /* STDIO_PTR_LVALUE */
}
/* Now (or only) set cnt */
#ifdef STDIO_CNT_LVALUE
- FILE_cnt(stdio) = cnt;
+ PerlSIO_set_cnt(stdio,cnt);
#else /* STDIO_CNT_LVALUE */
#if (defined(STDIO_PTR_LVALUE) && defined(STDIO_PTR_LVAL_SETS_CNT))
- FILE_ptr(stdio) = FILE_ptr(stdio)+(FILE_cnt(stdio)-cnt);
+ PerlSIO_set_ptr(stdio,PerlSIO_get_ptr(stdio)+(PerlSIO_get_cnt(stdio)-cnt));
#else /* STDIO_PTR_LVAL_SETS_CNT */
- abort();
+ PerlProc_abort();
#endif /* STDIO_PTR_LVAL_SETS_CNT */
#endif /* STDIO_CNT_LVALUE */
}
PerlIO *
PerlIOBuf_fdopen(PerlIO_funcs *self, int fd, const char *mode)
{
+ dTHX;
PerlIO_funcs *tab = PerlIO_default_btm();
int init = 0;
PerlIO *f;
PerlIOBase(f)->flags |= PERLIO_F_UNBUF;
}
#if 0
- PerlIO_debug("PerlIOBuf_fdopen %s f=%p fd=%d m=%s fl=%08x\n",
+ PerlIO_debug("PerlIOBuf_fdopen %s f=%p fd=%d m=%s fl=%08"UVxf"\n",
self->name,f,fd,mode,PerlIOBase(f)->flags);
#endif
}
PerlIOBase(f)->flags |= PERLIO_F_CRLF;
code = PerlIOBuf_pushed(f,mode);
#if 0
- PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08x\n",
+ PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08"UVxf"\n",
f,PerlIOBase(f)->tab->name,(mode) ? mode : "(Null)",
PerlIOBase(f)->flags);
#endif
if (ptr != chk)
{
dTHX;
- Perl_croak(aTHX_ "ptr wrong %p != %p fl=%08x nl=%p e=%p for %d",
+ Perl_croak(aTHX_ "ptr wrong %p != %p fl=%08"UVxf" nl=%p e=%p for %d",
ptr, chk, flags, c->nl, b->end, cnt);
}
}
{
/* I have no idea how portable mkstemp() is ... */
#if defined(WIN32) || !defined(HAVE_MKSTEMP)
+ dTHX;
PerlIO *f = NULL;
- FILE *stdio = tmpfile();
+ FILE *stdio = PerlSIO_tmpfile();
if (stdio)
{
PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_stdio,"w+"),PerlIOStdio);
}
#endif
-#endif /* !PERL_IMPLICIT_SYS */