summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2000-12-11 23:20:23 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2000-12-11 23:20:23 +0000
commit9a7a9ce3f48209ef438c0ee2beb9570325f7fd1e (patch)
tree519341d7c950df8188303fc77d510d142fb3b290
parentac1855b3e7d7100eed1eddcfad6fb51e0f2e6351 (diff)
parent72e44f29ea535faa4a4afab64f5101668334125d (diff)
downloadperl-9a7a9ce3f48209ef438c0ee2beb9570325f7fd1e.tar.gz
Integrate perlio:
[ 8085] Finish 1st pass of "encoding" layer e.g. : open($fh,"<encoding(iso8859-7)",$greek) || die; [ 8082] Restore mmap function (broken by tweaks to shared buffer layer for encode(xxxx)). [ 8076] Not merge worthy... Allow arg to layers e.g. open($fh,"<:encode(iso8859-15)",$name) syntax is modelled on attributes. Untested fix for io/utf8 on Win32 etc. Very clumsy start to the encode layer. p4raw-link: @8085 on //depot/perlio: 72e44f29ea535faa4a4afab64f5101668334125d p4raw-link: @8082 on //depot/perlio: a5262162c2c854ee96768d32ed06a8df25b95505 p4raw-link: @8076 on //depot/perlio: 33af2bc731cf870df7b094c6b3d116322b4b493f p4raw-id: //depot/perl@8087
-rw-r--r--ext/Encode/Encode.xs310
-rw-r--r--perlio.c110
-rw-r--r--perlio.h2
-rw-r--r--perliol.h5
4 files changed, 376 insertions, 51 deletions
diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs
index 9dea8d0bf5..f8901bb5c4 100644
--- a/ext/Encode/Encode.xs
+++ b/ext/Encode/Encode.xs
@@ -9,6 +9,310 @@
UNIMPLEMENTED(_encoded_utf8_to_bytes, I32)
UNIMPLEMENTED(_encoded_bytes_to_utf8, I32)
+#ifdef USE_PERLIO
+/* Define an encoding "layer" in the perliol.h sense.
+ The layer defined here "inherits" in an object-oriented sense from the
+ "perlio" layer with its PerlIOBuf_* "methods".
+ The implementation is particularly efficient as until Encode settles down
+ there is no point in tryint to tune it.
+
+ The layer works by overloading the "fill" and "flush" methods.
+
+ "fill" calls "SUPER::fill" in perl terms, then calls the encode OO perl API
+ to convert the encoded data to UTF-8 form, then copies it back to the
+ buffer. The "base class's" read methods then see the UTF-8 data.
+
+ "flush" transforms the UTF-8 data deposited by the "base class's write
+ method in the buffer back into the encoded form using the encode OO perl API,
+ then copies data back into the buffer and calls "SUPER::flush.
+
+ Note that "flush" is _also_ called for read mode - we still do the (back)-translate
+ so that the the base class's "flush" sees the correct number of encoded chars
+ for positioning the seek pointer. (This double translation is the worst performance
+ issue - particularly with all-perl encode engine.)
+
+*/
+
+
+#include "perliol.h"
+
+typedef struct
+{
+ PerlIOBuf base; /* PerlIOBuf stuff */
+ SV * bufsv;
+ SV * enc;
+} PerlIOEncode;
+
+
+IV
+PerlIOEncode_pushed(PerlIO *f, const char *mode,const char *arg,STRLEN len)
+{
+ PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
+ dTHX;
+ dSP;
+ IV code;
+ code = PerlIOBuf_pushed(f,mode,Nullch,0);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(sp);
+ XPUSHs(sv_2mortal(newSVpv("Encode",0)));
+ XPUSHs(sv_2mortal(newSVpvn(arg,len)));
+ PUTBACK;
+ if (perl_call_method("getEncoding",G_SCALAR) != 1)
+ return -1;
+ SPAGAIN;
+ e->enc = POPs;
+ PUTBACK;
+ if (!SvROK(e->enc))
+ return -1;
+ SvREFCNT_inc(e->enc);
+ FREETMPS;
+ LEAVE;
+ PerlIOBase(f)->flags |= PERLIO_F_UTF8;
+ return code;
+}
+
+IV
+PerlIOEncode_popped(PerlIO *f)
+{
+ PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
+ dTHX;
+ if (e->enc)
+ {
+ SvREFCNT_dec(e->enc);
+ e->enc = Nullsv;
+ }
+ if (e->bufsv)
+ {
+ SvREFCNT_dec(e->bufsv);
+ e->bufsv = Nullsv;
+ }
+ return 0;
+}
+
+STDCHAR *
+PerlIOEncode_get_base(PerlIO *f)
+{
+ PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
+ dTHX;
+ if (!e->base.bufsiz)
+ e->base.bufsiz = 1024;
+ if (!e->bufsv)
+ {
+ e->bufsv = newSV(e->base.bufsiz);
+ sv_setpvn(e->bufsv,"",0);
+ }
+ e->base.buf = SvPVX(e->bufsv);
+ if (!e->base.ptr)
+ e->base.ptr = e->base.buf;
+ if (!e->base.end)
+ e->base.end = e->base.buf;
+ if (e->base.ptr < e->base.buf || e->base.ptr > e->base.buf+SvLEN(e->bufsv))
+ {
+ Perl_warn(aTHX_ " ptr %p(%p)%p",
+ e->base.buf,e->base.ptr,e->base.buf+SvLEN(e->bufsv));
+ abort();
+ }
+ if (SvLEN(e->bufsv) < e->base.bufsiz)
+ {
+ SSize_t poff = e->base.ptr - e->base.buf;
+ SSize_t eoff = e->base.end - e->base.buf;
+ e->base.buf = SvGROW(e->bufsv,e->base.bufsiz);
+ e->base.ptr = e->base.buf + poff;
+ e->base.end = e->base.buf + eoff;
+ }
+ if (e->base.ptr < e->base.buf || e->base.ptr > e->base.buf+SvLEN(e->bufsv))
+ {
+ Perl_warn(aTHX_ " ptr %p(%p)%p",
+ e->base.buf,e->base.ptr,e->base.buf+SvLEN(e->bufsv));
+ abort();
+ }
+ return e->base.buf;
+}
+
+IV
+PerlIOEncode_fill(PerlIO *f)
+{
+ PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
+ dTHX;
+ dSP;
+ IV code;
+ code = PerlIOBuf_fill(f);
+ if (code == 0)
+ {
+ SV *uni;
+ STRLEN len;
+ char *s;
+ /* Set SV that is the buffer to be buf..ptr */
+ SvCUR_set(e->bufsv, e->base.end - e->base.buf);
+ SvUTF8_off(e->bufsv);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(sp);
+ XPUSHs(e->enc);
+ XPUSHs(e->bufsv);
+ XPUSHs(&PL_sv_yes);
+ PUTBACK;
+ if (perl_call_method("toUnicode",G_SCALAR) != 1)
+ code = -1;
+ SPAGAIN;
+ uni = POPs;
+ PUTBACK;
+ /* Now get translated string (forced to UTF-8) and copy back to buffer
+ don't use sv_setsv as that may "steal" PV from returned temp
+ and so free() our known-large-enough buffer.
+ sv_setpvn() should do but let us do it long hand.
+ */
+ s = SvPVutf8(uni,len);
+ if (s != SvPVX(e->bufsv))
+ {
+ e->base.buf = SvGROW(e->bufsv,len);
+ Move(s,e->base.buf,len,char);
+ SvCUR_set(e->bufsv,len);
+ }
+ SvUTF8_on(e->bufsv);
+ e->base.end = e->base.buf+len;
+ e->base.ptr = e->base.buf;
+ FREETMPS;
+ LEAVE;
+ }
+ return code;
+}
+
+IV
+PerlIOEncode_flush(PerlIO *f)
+{
+ PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
+ IV code = 0;
+ dTHX;
+ if (e->bufsv && (PerlIOBase(f)->flags & (PERLIO_F_RDBUF|PERLIO_F_WRBUF)))
+ {
+ dSP;
+ SV *str;
+ char *s;
+ STRLEN len;
+ SSize_t left = 0;
+ if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
+ {
+ /* This is really just a flag to see if we took all the data, if
+ we did PerlIOBase_flush avoids a seek to lower layer.
+ Need to revisit if we start getting clever with unreads or seeks-in-buffer
+ */
+ left = e->base.end - e->base.ptr;
+ }
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(sp);
+ XPUSHs(e->enc);
+ SvCUR_set(e->bufsv, e->base.ptr - e->base.buf);
+ SvUTF8_on(e->bufsv);
+ XPUSHs(e->bufsv);
+ XPUSHs(&PL_sv_yes);
+ PUTBACK;
+ if (perl_call_method("fromUnicode",G_SCALAR) != 1)
+ code = -1;
+ SPAGAIN;
+ str = POPs;
+ PUTBACK;
+ s = SvPV(str,len);
+ if (s != SvPVX(e->bufsv))
+ {
+ e->base.buf = SvGROW(e->bufsv,len);
+ Move(s,e->base.buf,len,char);
+ SvCUR_set(e->bufsv,len);
+ }
+ SvUTF8_off(e->bufsv);
+ e->base.ptr = e->base.buf+len;
+ /* restore end != ptr as inequality is used by PerlIOBuf_flush in read case */
+ e->base.end = e->base.ptr + left;
+ FREETMPS;
+ LEAVE;
+ if (PerlIOBuf_flush(f) != 0)
+ code = -1;
+ }
+ return code;
+}
+
+IV
+PerlIOEncode_close(PerlIO *f)
+{
+ PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
+ IV code = PerlIOBase_close(f);
+ dTHX;
+ if (e->bufsv)
+ {
+ SvREFCNT_dec(e->bufsv);
+ e->bufsv = Nullsv;
+ }
+ e->base.buf = NULL;
+ e->base.ptr = NULL;
+ e->base.end = NULL;
+ PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
+ return code;
+}
+
+Off_t
+PerlIOEncode_tell(PerlIO *f)
+{
+ PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
+ /* Unfortunately the only way to get a postion is to back-translate,
+ the UTF8-bytes we have buf..ptr and adjust accordingly.
+ But we will try and save any unread data in case stream
+ is un-seekable.
+ */
+ if ((PerlIOBase(f)->flags & PERLIO_F_RDBUF) && b->ptr < b->end)
+ {
+ Size_t count = b->end - b->ptr;
+ PerlIO_push(f,&PerlIO_pending,"r",Nullch,0);
+ /* Save what we have left to read */
+ PerlIOSelf(f,PerlIOBuf)->bufsiz = count;
+ PerlIO_unread(f,b->ptr,count);
+ /* There isn't any unread data - we just saved it - so avoid the lower seek */
+ b->end = b->ptr;
+ /* Flush ourselves - now one layer down,
+ this does the back translate and adjusts position
+ */
+ PerlIO_flush(PerlIONext(f));
+ /* Set position of the saved data */
+ PerlIOSelf(f,PerlIOBuf)->posn = b->posn;
+ }
+ else
+ {
+ PerlIO_flush(f);
+ }
+ return b->posn;
+}
+
+PerlIO_funcs PerlIO_encode = {
+ "encoding",
+ sizeof(PerlIOEncode),
+ PERLIO_K_BUFFERED,
+ PerlIOBase_fileno,
+ PerlIOBuf_fdopen,
+ PerlIOBuf_open,
+ PerlIOBuf_reopen,
+ PerlIOEncode_pushed,
+ PerlIOEncode_popped,
+ PerlIOBuf_read,
+ PerlIOBuf_unread,
+ PerlIOBuf_write,
+ PerlIOBuf_seek,
+ PerlIOEncode_tell,
+ PerlIOEncode_close,
+ PerlIOEncode_flush,
+ PerlIOEncode_fill,
+ PerlIOBase_eof,
+ PerlIOBase_error,
+ PerlIOBase_clearerr,
+ PerlIOBuf_setlinebuf,
+ PerlIOEncode_get_base,
+ PerlIOBuf_bufsiz,
+ PerlIOBuf_get_ptr,
+ PerlIOBuf_get_cnt,
+ PerlIOBuf_set_ptrcnt,
+};
+#endif
+
void call_failure (SV *routine, U8* done, U8* dest, U8* orig) {}
MODULE = Encode PACKAGE = Encode
@@ -239,3 +543,9 @@ _utf_to_utf(sv, from, to, ...)
OUTPUT:
RETVAL
+BOOT:
+{
+#ifdef USE_PERLIO
+ PerlIO_define_layer(&PerlIO_encode);
+#endif
+}
diff --git a/perlio.c b/perlio.c
index 89b8280f55..b8760e79b7 100644
--- a/perlio.c
+++ b/perlio.c
@@ -514,7 +514,7 @@ PerlIO_stdstreams()
}
PerlIO *
-PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode)
+PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode,const char *arg,STRLEN len)
{
dTHX;
PerlIOl *l = NULL;
@@ -526,7 +526,7 @@ PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode)
l->tab = tab;
*f = l;
PerlIO_debug("PerlIO_push f=%p %s %s\n",f,tab->name,(mode) ? mode : "(Null)");
- if ((*l->tab->Pushed)(f,mode) != 0)
+ if ((*l->tab->Pushed)(f,mode,arg,len) != 0)
{
PerlIO_pop(f);
return NULL;
@@ -550,8 +550,24 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
if (*s)
{
const char *e = s;
+ const char *as = Nullch;
+ const char *ae = Nullch;
+ int count = 0;
while (*e && *e != ':' && !isSPACE(*e))
- e++;
+ {
+ if (*e == '(')
+ {
+ if (!as)
+ as = e;
+ count++;
+ }
+ else if (*e == ')')
+ {
+ if (as && --count == 0)
+ ae = e;
+ }
+ e++;
+ }
if (e > s)
{
if ((e - s) == 3 && strncmp(s,"raw",3) == 0)
@@ -576,19 +592,20 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
}
else
{
- SV *layer = PerlIO_find_layer(s,e-s);
+ STRLEN len = ((as) ? as : e)-s;
+ SV *layer = PerlIO_find_layer(s,len);
if (layer)
{
PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer)));
if (tab)
{
- PerlIO *new = PerlIO_push(f,tab,mode);
- if (!new)
+ len = (as) ? (ae-(as++)-1) : 0;
+ if (!PerlIO_push(f,tab,mode,as,len))
return -1;
}
}
else
- Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(int)(e-s),s);
+ Perl_warn(aTHX_ "perlio: unknown layer \"%.*s\"",(int)len,s);
}
}
s = e;
@@ -608,7 +625,7 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names)
{
PerlIO_debug("PerlIO_binmode f=%p %s %c %x %s\n",
f,PerlIOBase(f)->tab->name,iotype,mode, (names) ? names : "(Null)");
- if (!names || (O_TEXT != O_BINARY && (mode & O_BINARY)))
+ if (!names && (O_TEXT != O_BINARY && (mode & O_BINARY)))
{
PerlIO *top = f;
PerlIOl *l;
@@ -698,7 +715,7 @@ PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
PerlIO_flush(f);
if ((*PerlIOBase(f)->tab->Reopen)(path,mode,f) == 0)
{
- if ((*PerlIOBase(f)->tab->Pushed)(f,mode) == 0)
+ if ((*PerlIOBase(f)->tab->Pushed)(f,mode,Nullch,0) == 0)
return f;
}
return NULL;
@@ -958,7 +975,7 @@ PerlIO_modestr(PerlIO *f,char *buf)
}
IV
-PerlIOBase_pushed(PerlIO *f, const char *mode)
+PerlIOBase_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len)
{
PerlIOl *l = PerlIOBase(f);
const char *omode = mode;
@@ -1026,26 +1043,15 @@ PerlIOBase_popped(PerlIO *f)
return 0;
}
-extern PerlIO_funcs PerlIO_pending;
-
SSize_t
PerlIOBase_unread(PerlIO *f, const void *vbuf, Size_t count)
{
-#if 0
Off_t old = PerlIO_tell(f);
- if (0 && PerlIO_seek(f,-((Off_t)count),SEEK_CUR) == 0)
- {
- Off_t new = PerlIO_tell(f);
- return old - new;
- }
- else
- {
- return 0;
- }
-#else
- PerlIO_push(f,&PerlIO_pending,"r");
- return PerlIOBuf_unread(f,vbuf,count);
-#endif
+ SSize_t done;
+ PerlIO_push(f,&PerlIO_pending,"r",Nullch,0);
+ done = PerlIOBuf_unread(f,vbuf,count);
+ PerlIOSelf(f,PerlIOBuf)->posn = old - done;
+ return done;
}
IV
@@ -1198,7 +1204,7 @@ PerlIOUnix_fdopen(PerlIO_funcs *self, int fd,const char *mode)
int oflags = PerlIOUnix_oflags(mode);
if (oflags != -1)
{
- PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode),PerlIOUnix);
+ PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode,Nullch,0),PerlIOUnix);
s->fd = fd;
s->oflags = oflags;
PerlIOBase(f)->flags |= PERLIO_F_OPEN;
@@ -1218,7 +1224,7 @@ PerlIOUnix_open(PerlIO_funcs *self, const char *path,const char *mode)
int fd = PerlLIO_open3(path,oflags,0666);
if (fd >= 0)
{
- PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode),PerlIOUnix);
+ PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode,Nullch,0),PerlIOUnix);
s->fd = fd;
s->oflags = oflags;
PerlIOBase(f)->flags |= PERLIO_F_OPEN;
@@ -1422,7 +1428,7 @@ PerlIOStdio_fdopen(PerlIO_funcs *self, int fd,const char *mode)
}
if (stdio)
{
- PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode),PerlIOStdio);
+ PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode,Nullch,0),PerlIOStdio);
s->stdio = stdio;
}
}
@@ -1437,7 +1443,7 @@ PerlIO_importFILE(FILE *stdio, int fl)
PerlIO *f = NULL;
if (stdio)
{
- PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),&PerlIO_stdio,"r+"),PerlIOStdio);
+ PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),&PerlIO_stdio,"r+",Nullch,0),PerlIOStdio);
s->stdio = stdio;
}
return f;
@@ -1453,7 +1459,7 @@ PerlIOStdio_open(PerlIO_funcs *self, const char *path,const char *mode)
{
char tmode[8];
PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX), self,
- (mode = PerlIOStdio_mode(mode,tmode))),
+ (mode = PerlIOStdio_mode(mode,tmode)),Nullch,0),
PerlIOStdio);
s->stdio = stdio;
}
@@ -1777,11 +1783,11 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f)
/* perlio buffer layer */
IV
-PerlIOBuf_pushed(PerlIO *f, const char *mode)
+PerlIOBuf_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len)
{
PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
b->posn = PerlIO_tell(PerlIONext(f));
- return PerlIOBase_pushed(f,mode);
+ return PerlIOBase_pushed(f,mode,arg,len);
}
PerlIO *
@@ -1803,7 +1809,7 @@ PerlIOBuf_fdopen(PerlIO_funcs *self, int fd, const char *mode)
f = (*tab->Fdopen)(tab,fd,mode);
if (f)
{
- PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,mode),PerlIOBuf);
+ PerlIOBuf *b = PerlIOSelf(PerlIO_push(f,self,mode,Nullch,0),PerlIOBuf);
if (init && fd == 2)
{
/* Initial stderr is unbuffered */
@@ -1824,7 +1830,7 @@ PerlIOBuf_open(PerlIO_funcs *self, const char *path, const char *mode)
PerlIO *f = (*tab->Open)(tab,path,mode);
if (f)
{
- PerlIO_push(f,self,mode);
+ PerlIO_push(f,self,mode,Nullch,0);
}
return f;
}
@@ -1835,7 +1841,7 @@ PerlIOBuf_reopen(const char *path, const char *mode, PerlIO *f)
PerlIO *next = PerlIONext(f);
int code = (*PerlIOBase(next)->tab->Reopen)(path,mode,next);
if (code = 0)
- code = (*PerlIOBase(f)->tab->Pushed)(f,mode);
+ code = (*PerlIOBase(f)->tab->Pushed)(f,mode,Nullch,0);
return code;
}
@@ -1850,7 +1856,8 @@ PerlIOBuf_flush(PerlIO *f)
if (PerlIOBase(f)->flags & PERLIO_F_WRBUF)
{
/* write() the buffer */
- STDCHAR *p = b->buf;
+ STDCHAR *buf = b->buf;
+ STDCHAR *p = buf;
int count;
PerlIO *n = PerlIONext(f);
while (p < b->ptr)
@@ -1867,12 +1874,13 @@ PerlIOBuf_flush(PerlIO *f)
break;
}
}
- b->posn += (p - b->buf);
+ b->posn += (p - buf);
}
else if (PerlIOBase(f)->flags & PERLIO_F_RDBUF)
{
+ STDCHAR *buf = PerlIO_get_base(f);
/* Note position change */
- b->posn += (b->ptr - b->buf);
+ b->posn += (b->ptr - buf);
if (b->ptr < b->end)
{
/* We did not consume all of it */
@@ -1907,6 +1915,9 @@ PerlIOBuf_fill(PerlIO *f)
if (PerlIO_flush(f) != 0)
return -1;
+ if (!b->buf)
+ PerlIO_get_base(f); /* allocate via vtable */
+
b->ptr = b->end = b->buf;
if (PerlIO_fast_gets(n))
{
@@ -2285,16 +2296,16 @@ PerlIOPending_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt)
}
IV
-PerlIOPending_pushed(PerlIO *f,const char *mode)
+PerlIOPending_pushed(PerlIO *f,const char *mode,const char *arg,STRLEN len)
{
- IV code = PerlIOBuf_pushed(f,mode);
+ IV code = PerlIOBase_pushed(f,mode,arg,len);
PerlIOl *l = PerlIOBase(f);
/* Our PerlIO_fast_gets must match what we are pushed on,
or sv_gets() etc. get muddled when it changes mid-string
when we auto-pop.
*/
- l->flags = (l->flags & ~PERLIO_F_FASTGETS) |
- (PerlIOBase(PerlIONext(f))->flags & PERLIO_F_FASTGETS);
+ l->flags = (l->flags & ~(PERLIO_F_FASTGETS|PERLIO_F_UTF8)) |
+ (PerlIOBase(PerlIONext(f))->flags & (PERLIO_F_FASTGETS|PERLIO_F_UTF8));
return code;
}
@@ -2358,11 +2369,11 @@ typedef struct
} PerlIOCrlf;
IV
-PerlIOCrlf_pushed(PerlIO *f, const char *mode)
+PerlIOCrlf_pushed(PerlIO *f, const char *mode,const char *arg,STRLEN len)
{
IV code;
PerlIOBase(f)->flags |= PERLIO_F_CRLF;
- code = PerlIOBuf_pushed(f,mode);
+ code = PerlIOBuf_pushed(f,mode,arg,len);
#if 0
PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08"UVxf"\n",
f,PerlIOBase(f)->tab->name,(mode) ? mode : "(Null)",
@@ -2726,12 +2737,15 @@ PerlIOMmap_map(PerlIO *f)
}
posn = (b->posn / page_size) * page_size;
len = st.st_size - posn;
- m->mptr = mmap(NULL, len, PROT_READ, MAP_PRIVATE, fd, posn);
+ m->mptr = mmap(NULL, len, PROT_READ, MAP_SHARED, fd, posn);
if (m->mptr && m->mptr != (Mmap_t) -1)
{
-#if defined(HAS_MADVISE) && defined(MADV_SEQUENTIAL)
+#if 0 && defined(HAS_MADVISE) && defined(MADV_SEQUENTIAL)
madvise(m->mptr, len, MADV_SEQUENTIAL);
#endif
+#if 0 && defined(HAS_MADVISE) && defined(MADV_WILLNEED)
+ madvise(m->mptr, len, MADV_WILLNEED);
+#endif
PerlIOBase(f)->flags = (flags & ~PERLIO_F_EOF) | PERLIO_F_RDBUF;
b->end = ((STDCHAR *)m->mptr) + len;
b->buf = ((STDCHAR *)m->mptr) + (b->posn - posn);
@@ -3113,7 +3127,7 @@ PerlIO_tmpfile(void)
FILE *stdio = PerlSIO_tmpfile();
if (stdio)
{
- PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),&PerlIO_stdio,"w+"),PerlIOStdio);
+ PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),&PerlIO_stdio,"w+",Nullch,0),PerlIOStdio);
s->stdio = stdio;
}
return f;
diff --git a/perlio.h b/perlio.h
index 7d4cdcd2dc..b2e5179470 100644
--- a/perlio.h
+++ b/perlio.h
@@ -82,7 +82,7 @@ typedef PerlIOl *PerlIO;
extern void PerlIO_define_layer (PerlIO_funcs *tab);
extern SV * PerlIO_find_layer (const char *name, STRLEN len);
-extern PerlIO * PerlIO_push (PerlIO *f,PerlIO_funcs *tab,const char *mode);
+extern PerlIO * PerlIO_push (PerlIO *f,PerlIO_funcs *tab,const char *mode,const char *arg,STRLEN len);
extern void PerlIO_pop (PerlIO *f);
#endif /* PerlIO */
diff --git a/perliol.h b/perliol.h
index 19cf95f620..429ddabc06 100644
--- a/perliol.h
+++ b/perliol.h
@@ -10,7 +10,7 @@ struct _PerlIO_funcs
PerlIO * (*Fdopen)(PerlIO_funcs *tab, int fd, const char *mode);
PerlIO * (*Open)(PerlIO_funcs *tab, const char *path, const char *mode);
int (*Reopen)(const char *path, const char *mode, PerlIO *f);
- IV (*Pushed)(PerlIO *f,const char *mode);
+ IV (*Pushed)(PerlIO *f,const char *mode,const char *arg,STRLEN len);
IV (*Popped)(PerlIO *f);
/* Unix-like functions - cf sfio line disciplines */
SSize_t (*Read)(PerlIO *f, void *vbuf, Size_t count);
@@ -78,6 +78,7 @@ extern PerlIO_funcs PerlIO_unix;
extern PerlIO_funcs PerlIO_perlio;
extern PerlIO_funcs PerlIO_stdio;
extern PerlIO_funcs PerlIO_crlf;
+extern PerlIO_funcs PerlIO_pending;
#ifdef HAS_MMAP
extern PerlIO_funcs PerlIO_mmap;
#endif
@@ -94,7 +95,7 @@ extern PerlIO *PerlIO_allocate(pTHX);
/* Generic, or stub layer functions */
extern IV PerlIOBase_fileno (PerlIO *f);
-extern IV PerlIOBase_pushed (PerlIO *f, const char *mode);
+extern IV PerlIOBase_pushed (PerlIO *f, const char *mode,const char *arg,STRLEN len);
extern IV PerlIOBase_popped (PerlIO *f);
extern SSize_t PerlIOBase_unread (PerlIO *f, const void *vbuf, Size_t count);
extern IV PerlIOBase_eof (PerlIO *f);