diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2000-12-11 23:20:23 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2000-12-11 23:20:23 +0000 |
commit | 9a7a9ce3f48209ef438c0ee2beb9570325f7fd1e (patch) | |
tree | 519341d7c950df8188303fc77d510d142fb3b290 | |
parent | ac1855b3e7d7100eed1eddcfad6fb51e0f2e6351 (diff) | |
parent | 72e44f29ea535faa4a4afab64f5101668334125d (diff) | |
download | perl-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.xs | 310 | ||||
-rw-r--r-- | perlio.c | 110 | ||||
-rw-r--r-- | perlio.h | 2 | ||||
-rw-r--r-- | perliol.h | 5 |
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 +} @@ -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; @@ -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 */ @@ -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); |