*
*/
+/* If we have ActivePerl-like PERL_IMPLICIT_SYS then we need
+ a dTHX to get at the dispatch tables, even when we do not
+ need it for other reasons.
+ Invent a dSYS macro to abstract this out
+*/
+#ifdef PERL_IMPLICIT_SYS
+#define dSYS dTHX
+#else
+#define dSYS dNOOP
+#endif
+
#define VOIDUSED 1
#ifdef PERL_MICRO
# include "uconfig.h"
void
PerlIO_debug(const char *fmt,...)
{
- dTHX;
static int dbg = 0;
va_list ap;
+ dSYS;
va_start(ap,fmt);
if (!dbg)
{
return Nullsv;
}
+#ifdef USE_ATTRIBUTES_FOR_PERLIO
static int
perlio_mg_set(pTHX_ SV *sv, MAGIC *mg)
perlio_mg_get,
perlio_mg_set,
NULL, /* len */
- NULL,
+ perlio_mg_clear,
perlio_mg_free
};
XSRETURN(count);
}
+#endif /* USE_ATTIBUTES_FOR_PERLIO */
+
SV *
PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab)
{
return INT2PTR(PerlIO_funcs *, SvIV(layer));
}
if (!def)
- Perl_croak(aTHX_ "panic:PerlIO layer array corrupt");
+ Perl_croak(aTHX_ "panic: PerlIO layer array corrupt");
return def;
}
{
const char *s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO");
PerlIO_layer_av = get_av("open::layers",GV_ADD|GV_ADDMULTI);
-#if 0
+
+#ifdef USE_ATTRIBUTES_FOR_PERLIO
newXS("io::MODIFY_SCALAR_ATTRIBUTES",XS_io_MODIFY_SCALAR_ATTRIBUTES,__FILE__);
#endif
+
PerlIO_define_layer(aTHX_ &PerlIO_raw);
PerlIO_define_layer(aTHX_ &PerlIO_unix);
PerlIO_define_layer(aTHX_ &PerlIO_perlio);
return -1;
}
}
- else
- {
+ else
+ {
/* Is it good API design to do flush-all on NULL,
* a potentially errorneous input? Maybe some magical
* value (PerlIO* PERLIO_FLUSH_ALL = (PerlIO*)-1;)?
{
SETERRNO(EBADF,SS$_IVCHAN);
return -1;
- }
+ }
}
#undef PerlIO_isutf8
IV
PerlIOUnix_seek(PerlIO *f, Off_t offset, int whence)
{
- dTHX;
+ dSYS;
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;
+ dSYS;
return PerlLIO_lseek(PerlIOSelf(f,PerlIOUnix)->fd,0,SEEK_CUR);
}
IV
PerlIOStdio_fileno(PerlIO *f)
{
- dTHX;
+ dSYS;
return PerlSIO_fileno(PerlIOSelf(f,PerlIOStdio)->stdio);
}
IV
PerlIOStdio_pushed(PerlIO *f, const char *mode, SV *arg)
{
- dTHX;
if (*PerlIONext(f))
{
+ dSYS;
PerlIOStdio *s = PerlIOSelf(f,PerlIOStdio);
char tmode[8];
FILE *stdio = PerlSIO_fdopen(PerlIO_fileno(PerlIONext(f)),mode = PerlIOStdio_mode(mode,tmode));
SSize_t
PerlIOStdio_read(PerlIO *f, void *vbuf, Size_t count)
{
- dTHX;
+ dSYS;
FILE *s = PerlIOSelf(f,PerlIOStdio)->stdio;
SSize_t got = 0;
if (count == 1)
SSize_t
PerlIOStdio_unread(PerlIO *f, const void *vbuf, Size_t count)
{
- dTHX;
+ dSYS;
FILE *s = PerlIOSelf(f,PerlIOStdio)->stdio;
STDCHAR *buf = ((STDCHAR *)vbuf)+count-1;
SSize_t unread = 0;
SSize_t
PerlIOStdio_write(PerlIO *f, const void *vbuf, Size_t count)
{
- dTHX;
+ dSYS;
return PerlSIO_fwrite(vbuf,1,count,PerlIOSelf(f,PerlIOStdio)->stdio);
}
IV
PerlIOStdio_seek(PerlIO *f, Off_t offset, int whence)
{
- dTHX;
+ dSYS;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
return PerlSIO_fseek(stdio,offset,whence);
}
Off_t
PerlIOStdio_tell(PerlIO *f)
{
- dTHX;
+ dSYS;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
return PerlSIO_ftell(stdio);
}
IV
PerlIOStdio_close(PerlIO *f)
{
- dTHX;
+ dSYS;
#ifdef SOCKS5_VERSION_NAME
int optval;
Sock_size_t optlen = sizeof(int);
IV
PerlIOStdio_flush(PerlIO *f)
{
- dTHX;
+ dSYS;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
{
IV
PerlIOStdio_fill(PerlIO *f)
{
- dTHX;
+ dSYS;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
int c;
/* fflush()ing read-only streams can cause trouble on some stdio-s */
IV
PerlIOStdio_eof(PerlIO *f)
{
- dTHX;
+ dSYS;
return PerlSIO_feof(PerlIOSelf(f,PerlIOStdio)->stdio);
}
IV
PerlIOStdio_error(PerlIO *f)
{
- dTHX;
+ dSYS;
return PerlSIO_ferror(PerlIOSelf(f,PerlIOStdio)->stdio);
}
void
PerlIOStdio_clearerr(PerlIO *f)
{
- dTHX;
+ dSYS;
PerlSIO_clearerr(PerlIOSelf(f,PerlIOStdio)->stdio);
}
void
PerlIOStdio_setlinebuf(PerlIO *f)
{
- dTHX;
+ dSYS;
#ifdef HAS_SETLINEBUF
PerlSIO_setlinebuf(PerlIOSelf(f,PerlIOStdio)->stdio);
#else
STDCHAR *
PerlIOStdio_get_base(PerlIO *f)
{
- dTHX;
+ dSYS;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
return PerlSIO_get_base(stdio);
}
Size_t
PerlIOStdio_get_bufsiz(PerlIO *f)
{
- dTHX;
+ dSYS;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
return PerlSIO_get_bufsiz(stdio);
}
STDCHAR *
PerlIOStdio_get_ptr(PerlIO *f)
{
- dTHX;
+ dSYS;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
return PerlSIO_get_ptr(stdio);
}
SSize_t
PerlIOStdio_get_cnt(PerlIO *f)
{
- dTHX;
+ dSYS;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
return PerlSIO_get_cnt(stdio);
}
void
PerlIOStdio_set_ptrcnt(PerlIO *f,STDCHAR *ptr,SSize_t cnt)
{
- dTHX;
FILE *stdio = PerlIOSelf(f,PerlIOStdio)->stdio;
+ dSYS;
if (ptr != NULL)
{
#ifdef STDIO_PTR_LVALUE
IV
PerlIOBuf_pushed(PerlIO *f, const char *mode, SV *arg)
{
+ dSYS;
PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
int fd = PerlIO_fileno(f);
Off_t posn;
- dTHX;
if (fd >= 0 && PerlLIO_isatty(fd))
{
PerlIOBase(f)->flags |= PERLIO_F_LINEBUF|PERLIO_F_TTY;
IV
PerlIOBuf_close(PerlIO *f)
{
- dTHX;
IV code = PerlIOBase_close(f);
PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
if (b->buf && b->buf != (STDCHAR *) &b->oneword)
PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
if (!b->buf)
{
- dTHX;
if (!b->bufsiz)
b->bufsiz = 4096;
b->buf = PerlMemShared_calloc(b->bufsiz,sizeof(STDCHAR));
else
{
int code;
- dTHX;
b->ptr++; /* say we have read it as far as flush() is concerned */
b->buf++; /* Leave space an front of buffer */
b->bufsiz--; /* Buffer is thus smaller */
PerlIO_init(void)
{
dTHX;
+#ifndef WIN32
call_atexit(PerlIO_cleanup_layers, NULL);
+#endif
if (!_perlio)
{
#ifndef WIN32
#endif
+
+
+