From e3f3bf95bcb81efe35cb0f0d3e3528d5c002dcec Mon Sep 17 00:00:00 2001 From: Nick Ing-Simmons Date: Fri, 23 Mar 2001 20:49:02 +0000 Subject: [PATCH] Perlio internals re-organized. - open process creates AV of layer/arg pairs (appends layers from open() or open.pm to default list). - push arg is now an SV. - layer ->Open get passed the AV - open is no longer mandatory method. - topmost layer that has ->Open method does the open - any layers above are pushed once that returns. - vtable re-ordered so dummy layers need only provide push/pop methods. p4raw-id: //depot/perlio@9314 --- ext/Encode/Encode.xs | 38 ++++-- perlio.c | 320 ++++++++++++++++++++++++++++++++------------------- perlio.h | 2 +- perliol.h | 17 ++- 4 files changed, 245 insertions(+), 132 deletions(-) diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs index f0ee229..fea83ae 100644 --- a/ext/Encode/Encode.xs +++ b/ext/Encode/Encode.xs @@ -48,19 +48,41 @@ typedef struct SV * enc; } PerlIOEncode; +SV * +PerlIOEncode_getarg(PerlIO *f) +{ + PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode); + SV *sv = &PL_sv_undef; + if (e->enc) + { + dSP; + ENTER; + SAVETMPS; + PUSHMARK(sp); + XPUSHs(e->enc); + PUTBACK; + if (perl_call_method("name",G_SCALAR) == 1) + { + SPAGAIN; + sv = newSVsv(POPs); + PUTBACK; + } + } + return sv; +} IV -PerlIOEncode_pushed(PerlIO *f, const char *mode,const char *arg,STRLEN len) +PerlIOEncode_pushed(PerlIO *f, const char *mode, SV *arg) { PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode); dTHX; dSP; IV code; - code = PerlIOBuf_pushed(f,mode,Nullch,0); + code = PerlIOBuf_pushed(f,mode,Nullsv); ENTER; SAVETMPS; PUSHMARK(sp); - XPUSHs(sv_2mortal(newSVpvn(arg,len))); + XPUSHs(arg); PUTBACK; if (perl_call_pv("Encode::find_encoding",G_SCALAR) != 1) { @@ -75,7 +97,7 @@ PerlIOEncode_pushed(PerlIO *f, const char *mode,const char *arg,STRLEN len) { e->enc = Nullsv; errno = EINVAL; - Perl_warner(aTHX_ WARN_IO, "Cannot find encoding \"%.*s\"", (int) len, arg); + Perl_warner(aTHX_ WARN_IO, "Cannot find encoding \"%_\"", arg); return -1; } SvREFCNT_inc(e->enc); @@ -276,9 +298,8 @@ PerlIOEncode_tell(PerlIO *f) */ if ((PerlIOBase(f)->flags & PERLIO_F_RDBUF) && b->ptr < b->end) { - Size_t count = b->end - b->ptr; - PerlIO_push(aTHX_ f,&PerlIO_pending,"r",Nullch,0); + PerlIO_push(aTHX_ f,&PerlIO_pending,"r",Nullsv); /* Save what we have left to read */ PerlIOSelf(f,PerlIOBuf)->bufsiz = count; PerlIO_unread(f,b->ptr,count); @@ -302,10 +323,11 @@ PerlIO_funcs PerlIO_encode = { "encoding", sizeof(PerlIOEncode), PERLIO_K_BUFFERED, - PerlIOBase_fileno, - PerlIOBuf_open, PerlIOEncode_pushed, PerlIOEncode_popped, + PerlIOBuf_open, + PerlIOEncode_getarg, + PerlIOBase_fileno, PerlIOBuf_read, PerlIOBuf_unread, PerlIOBuf_write, diff --git a/perlio.c b/perlio.c index 57c54c8..e7aea6d 100644 --- a/perlio.c +++ b/perlio.c @@ -246,6 +246,8 @@ PerlIO_debug(const char *fmt,...) PerlIO *_perlio = NULL; #define PERLIO_TABLE_SIZE 64 + + PerlIO * PerlIO_allocate(pTHX) { @@ -453,16 +455,22 @@ XS(XS_io_MODIFY_SCALAR_ATTRIBUTES) XSRETURN(count); } -void -PerlIO_define_layer(pTHX_ PerlIO_funcs *tab) +SV * +PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab) { HV *stash = gv_stashpv("perlio::Layer", TRUE); SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))),stash); + return sv; +} + +void +PerlIO_define_layer(pTHX_ PerlIO_funcs *tab) +{ if (!PerlIO_layer_hv) { PerlIO_layer_hv = get_hv("open::layers",GV_ADD|GV_ADDMULTI); } - hv_store(PerlIO_layer_hv,tab->name,strlen(tab->name),sv,0); + hv_store(PerlIO_layer_hv,tab->name,strlen(tab->name),PerlIO_tab_sv(aTHX_ tab),0); PerlIO_debug("define %s %p\n",tab->name,tab); } @@ -569,13 +577,35 @@ PerlIO_default_buffer(pTHX_ AV *av) av_push(av,&PL_sv_undef); } +SV * +PerlIO_arg_fetch(pTHX_ AV *av,IV n) +{ + SV **svp = av_fetch(av,n,FALSE); + return (svp) ? *svp : Nullsv; +} + +#define MYARG PerlIO_arg_fetch(aTHX_ layers,n+1) + + PerlIO_funcs * -PerlIO_default_layer(pTHX_ I32 n) +PerlIO_layer_fetch(pTHX_ AV *av,IV n,PerlIO_funcs *def) { - SV **svp; + SV **svp = av_fetch(av,n,FALSE); SV *layer; - PerlIO_funcs *tab = &PerlIO_stdio; - int len; + if (svp && (layer = *svp) && SvROK(layer) && SvIOK((layer = SvRV(layer)))) + { + /* PerlIO_debug("Layer %d is %s\n",n/2,tab->name); */ + return INT2PTR(PerlIO_funcs *, SvIV(layer)); + } + if (!def) + Perl_croak(aTHX_ "panic:layer array corrupt"); + return def; +} + +AV * +PerlIO_default_layers(pTHX) +{ + IV len; if (!PerlIO_layer_av) { const char *s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO"); @@ -612,16 +642,18 @@ PerlIO_default_layer(pTHX_ I32 n) PerlIO_default_buffer(aTHX_ PerlIO_layer_av); len = av_len(PerlIO_layer_av); } + return PerlIO_layer_av; +} + + +PerlIO_funcs * +PerlIO_default_layer(pTHX_ I32 n) +{ + AV *av = PerlIO_default_layers(aTHX); n *= 2; if (n < 0) - n += len; - svp = av_fetch(PerlIO_layer_av,n,FALSE); - if (svp && (layer = *svp) && SvROK(layer) && SvIOK((layer = SvRV(layer)))) - { - tab = INT2PTR(PerlIO_funcs *, SvIV(layer)); - } - /* PerlIO_debug("Layer %d is %s\n",n/2,tab->name); */ - return tab; + n += av_len(PerlIO_layer_av)+1; + return PerlIO_layer_fetch(aTHX_ av,n, &PerlIO_stdio); } #define PerlIO_default_top() PerlIO_default_layer(aTHX_ -1) @@ -640,7 +672,7 @@ PerlIO_stdstreams(pTHX) } PerlIO * -PerlIO_push(pTHX_ PerlIO *f,PerlIO_funcs *tab,const char *mode,const char *arg,STRLEN len) +PerlIO_push(pTHX_ PerlIO *f,PerlIO_funcs *tab,const char *mode,SV *arg) { PerlIOl *l = NULL; l = PerlMemShared_calloc(tab->size,sizeof(char)); @@ -650,9 +682,9 @@ PerlIO_push(pTHX_ PerlIO *f,PerlIO_funcs *tab,const char *mode,const char *arg,S l->next = *f; l->tab = tab; *f = l; - PerlIO_debug("PerlIO_push f=%p %s %s '%.*s'\n", - f,tab->name,(mode) ? mode : "(Null)",(int) len,arg); - if ((*l->tab->Pushed)(f,mode,arg,len) != 0) + PerlIO_debug("PerlIO_push f=%p %s %s '%s'\n",f,tab->name, + (mode) ? mode : "(Null)",(arg) ? SvPV_nolen(arg) : "(Null)"); + if ((*l->tab->Pushed)(f,mode,arg) != 0) { PerlIO_pop(aTHX_ f); return NULL; @@ -662,7 +694,7 @@ PerlIO_push(pTHX_ PerlIO *f,PerlIO_funcs *tab,const char *mode,const char *arg,S } IV -PerlIOPop_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) +PerlIOPop_pushed(PerlIO *f, const char *mode, SV *arg) { dTHX; PerlIO_pop(aTHX_ f); @@ -676,7 +708,7 @@ PerlIOPop_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) } IV -PerlIORaw_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) +PerlIORaw_pushed(PerlIO *f, const char *mode, SV *arg) { /* Remove the dummy layer */ dTHX; @@ -695,7 +727,7 @@ PerlIORaw_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) else { /* Nothing bellow - push unix on top then remove it */ - if (PerlIO_push(aTHX_ f,PerlIO_default_btm(),mode,arg,len)) + if (PerlIO_push(aTHX_ f,PerlIO_default_btm(),mode,arg)) { PerlIO_pop(aTHX_ PerlIONext(f)); } @@ -709,6 +741,27 @@ PerlIORaw_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) } int +PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode, AV *layers, IV n) +{ + IV max = av_len(layers)+1; + int code = 0; + while (n < max) + { + PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers,n,NULL); + if (tab) + { + if (!PerlIO_push(aTHX_ f,tab,mode,MYARG)) + { + code -1; + break; + } + } + n += 2; + } + return code; +} + +int PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) { int code = 0; @@ -718,24 +771,7 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) code = PerlIO_parse_layers(aTHX_ layers,names); if (code == 0) { - IV max = av_len(layers)+1; - IV i; - for (i=0; i < max; i += 2) - { - SV *layer = *av_fetch(layers,i,FALSE); - PerlIO_funcs *tab = INT2PTR(PerlIO_funcs *, SvIV(SvRV(layer))); - if (tab) - { - SV **argp = av_fetch(layers,i+1,FALSE); - STRLEN alen = 0; - char *as = (argp && SvOK(*argp)) ? SvPV(*argp,alen) : Nullch; - if (!PerlIO_push(aTHX_ f,tab,mode,as,alen)) - { - code -1; - break; - } - } - } + code = PerlIO_apply_layera(aTHX_ f, mode, layers, 0); } SvREFCNT_dec((SV *) layers); } @@ -837,30 +873,85 @@ PerlIO_context_layers(pTHX_ const char *mode) return type; } -PerlIO_funcs * -PerlIO_top_layer(pTHX_ const char *layers,const char *mode,int narg, SV **args) +AV * +PerlIO_resolve_layers(pTHX_ const char *layers,const char *mode,int narg, SV **args) { + AV *def = PerlIO_default_layers(aTHX); + if (!_perlio) + PerlIO_stdstreams(aTHX); + /* FIXME !!! */ if (!layers) layers = PerlIO_context_layers(aTHX_ mode); - /* FIXME !!! */ - return PerlIO_default_top(); + if (layers && *layers) + { + AV *av = newAV(); + IV n = av_len(def)+1; + while (n-- > 0) + { + SV **svp = av_fetch(def,n,0); + av_store(av,n,(svp) ? SvREFCNT_inc(*svp) : &PL_sv_undef); + } + PerlIO_parse_layers(aTHX_ av,layers); + return av; + } + else + { + SvREFCNT_inc(def); + return def; + } } PerlIO * PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) { - PerlIO_funcs *tab = (f && *f) ? PerlIOBase(f)->tab - : PerlIO_top_layer(aTHX_ layers, mode, narg, args); - if (!_perlio) - PerlIO_stdstreams(aTHX); - PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n", - tab->name,layers,mode,fd,imode,perm,f,narg,args); - f = (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,f,narg,args); - if (f) + AV *layera; + IV n; + PerlIO_funcs *tab; + if (f && *f) { - if (layers && *layers) - PerlIO_apply_layers(aTHX_ f,mode,layers); + PerlIOl *l = *f; + layera = newAV(); + while (l) + { + SV *arg = (l->tab->Getarg) ? (*l->tab->Getarg)(&l) : &PL_sv_undef; + av_unshift(layera,2); + av_store(layera,0,PerlIO_tab_sv(aTHX_ l->tab)); + av_store(layera,1,arg); + l = *PerlIONext(&l); + } } + else + { + layera = PerlIO_resolve_layers(aTHX_ layers, mode, narg, args); + } + n = av_len(layera)-1; + while (n >= 0) + { + PerlIO_funcs *t = PerlIO_layer_fetch(aTHX_ layera,n,NULL); + if (t && t->Open) + { + tab = t; + break; + } + n -= 2; + } + if (tab) + { + PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n", + tab->name,layers,mode,fd,imode,perm,f,narg,args); + f = (*tab->Open)(aTHX_ tab, layera, n, mode,fd,imode,perm,f,narg,args); + if (f) + { + if (n+2 < av_len(layera)+1) + { + if (PerlIO_apply_layera(aTHX_ f, mode, layera, n+2) != 0) + { + f = NULL; + } + } + } + } + SvREFCNT_dec(layera); return f; } @@ -1111,7 +1202,7 @@ PerlIO_set_ptrcnt(PerlIO *f, STDCHAR *ptr, int cnt) /* utf8 and raw dummy layers */ IV -PerlIOUtf8_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) +PerlIOUtf8_pushed(PerlIO *f, const char *mode, SV *arg) { if (PerlIONext(f)) { @@ -1127,28 +1218,10 @@ PerlIOUtf8_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) return -1; } -PerlIO * -PerlIOUtf8_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args) -{ - PerlIO_funcs *tab = PerlIO_default_layer(aTHX_ -2); - PerlIO *f = (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,old,narg,args); - if (f) - { - PerlIOl *l = PerlIOBase(f); - if (tab->kind & PERLIO_K_UTF8) - l->flags |= PERLIO_F_UTF8; - else - l->flags &= ~PERLIO_F_UTF8; - } - return f; -} - PerlIO_funcs PerlIO_utf8 = { "utf8", sizeof(PerlIOl), PERLIO_K_DUMMY|PERLIO_F_UTF8, - NULL, - PerlIOUtf8_open, PerlIOUtf8_pushed, NULL, NULL, @@ -1157,6 +1230,9 @@ PerlIO_funcs PerlIO_utf8 = { NULL, NULL, NULL, + NULL, + NULL, + NULL, NULL, /* flush */ NULL, /* fill */ NULL, @@ -1174,8 +1250,6 @@ PerlIO_funcs PerlIO_byte = { "bytes", sizeof(PerlIOl), PERLIO_K_DUMMY, - NULL, - PerlIOUtf8_open, PerlIOUtf8_pushed, NULL, NULL, @@ -1184,6 +1258,9 @@ PerlIO_funcs PerlIO_byte = { NULL, NULL, NULL, + NULL, + NULL, + NULL, NULL, /* flush */ NULL, /* fill */ NULL, @@ -1198,20 +1275,21 @@ PerlIO_funcs PerlIO_byte = { }; PerlIO * -PerlIORaw_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args) +PerlIORaw_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n,const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args) { PerlIO_funcs *tab = PerlIO_default_btm(); - return (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,old,narg,args); + return (*tab->Open)(aTHX_ tab,layers,n-2,mode,fd,imode,perm,old,narg,args); } PerlIO_funcs PerlIO_raw = { "raw", sizeof(PerlIOl), PERLIO_K_DUMMY, - NULL, - PerlIORaw_open, PerlIORaw_pushed, PerlIOBase_popped, + PerlIORaw_open, + NULL, + NULL, NULL, NULL, NULL, @@ -1276,7 +1354,7 @@ PerlIO_modestr(PerlIO *f,char *buf) } IV -PerlIOBase_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) +PerlIOBase_pushed(PerlIO *f, const char *mode, SV *arg) { PerlIOl *l = PerlIOBase(f); const char *omode = mode; @@ -1350,7 +1428,7 @@ PerlIOBase_unread(PerlIO *f, const void *vbuf, Size_t count) dTHX; Off_t old = PerlIO_tell(f); SSize_t done; - PerlIO_push(aTHX_ f,&PerlIO_pending,"r",Nullch,0); + PerlIO_push(aTHX_ f,&PerlIO_pending,"r",Nullsv); done = PerlIOBuf_unread(f,vbuf,count); PerlIOSelf(f,PerlIOBuf)->posn = old - done; return done; @@ -1495,9 +1573,9 @@ PerlIOUnix_fileno(PerlIO *f) } IV -PerlIOUnix_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) +PerlIOUnix_pushed(PerlIO *f, const char *mode, SV *arg) { - IV code = PerlIOBase_pushed(f,mode,arg,len); + IV code = PerlIOBase_pushed(f,mode,arg); if (*PerlIONext(f)) { PerlIOUnix *s = PerlIOSelf(f,PerlIOUnix); @@ -1509,7 +1587,7 @@ PerlIOUnix_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) } PerlIO * -PerlIOUnix_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) +PerlIOUnix_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) { if (f) { @@ -1539,7 +1617,7 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, i if (!f) { f = PerlIO_allocate(aTHX); - s = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,Nullch,0),PerlIOUnix); + s = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,MYARG),PerlIOUnix); } else s = PerlIOSelf(f,PerlIOUnix); @@ -1641,10 +1719,11 @@ PerlIO_funcs PerlIO_unix = { "unix", sizeof(PerlIOUnix), PERLIO_K_RAW, - PerlIOUnix_fileno, - PerlIOUnix_open, PerlIOUnix_pushed, PerlIOBase_noop_ok, + PerlIOUnix_open, + NULL, + PerlIOUnix_fileno, PerlIOUnix_read, PerlIOBase_unread, PerlIOUnix_write, @@ -1698,7 +1777,7 @@ PerlIOStdio_mode(const char *mode,char *tmode) /* This isn't used yet ... */ IV -PerlIOStdio_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) +PerlIOStdio_pushed(PerlIO *f, const char *mode, SV *arg) { dTHX; if (*PerlIONext(f)) @@ -1711,7 +1790,7 @@ PerlIOStdio_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) else return -1; } - return PerlIOBase_pushed(f,mode,arg,len); + return PerlIOBase_pushed(f,mode,arg); } #undef PerlIO_importFILE @@ -1722,14 +1801,14 @@ PerlIO_importFILE(FILE *stdio, int fl) PerlIO *f = NULL; if (stdio) { - PerlIOStdio *s = PerlIOSelf(PerlIO_push(aTHX_ (f = PerlIO_allocate(aTHX)),&PerlIO_stdio,"r+",Nullch,0),PerlIOStdio); + PerlIOStdio *s = PerlIOSelf(PerlIO_push(aTHX_ (f = PerlIO_allocate(aTHX)),&PerlIO_stdio,"r+",Nullsv),PerlIOStdio); s->stdio = stdio; } return f; } PerlIO * -PerlIOStdio_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) +PerlIOStdio_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) { char tmode[8]; if (f) @@ -1758,7 +1837,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, if (stdio) { PerlIOStdio *s = PerlIOSelf(PerlIO_push(aTHX_ (f = PerlIO_allocate(aTHX)), self, - (mode = PerlIOStdio_mode(mode,tmode)),Nullch,0), + (mode = PerlIOStdio_mode(mode,tmode)),MYARG), PerlIOStdio); s->stdio = stdio; } @@ -1795,7 +1874,7 @@ PerlIOStdio_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, } if (stdio) { - PerlIOStdio *s = PerlIOSelf(PerlIO_push(aTHX_ (f = PerlIO_allocate(aTHX)),self,mode,Nullch,0),PerlIOStdio); + PerlIOStdio *s = PerlIOSelf(PerlIO_push(aTHX_ (f = PerlIO_allocate(aTHX)),self,mode,MYARG),PerlIOStdio); s->stdio = stdio; return f; } @@ -2042,10 +2121,11 @@ PerlIO_funcs PerlIO_stdio = { "stdio", sizeof(PerlIOStdio), PERLIO_K_BUFFERED, - PerlIOStdio_fileno, - PerlIOStdio_open, PerlIOBase_pushed, PerlIOBase_noop_ok, + PerlIOStdio_open, + NULL, + PerlIOStdio_fileno, PerlIOStdio_read, PerlIOStdio_unread, PerlIOStdio_write, @@ -2090,7 +2170,7 @@ PerlIO_exportFILE(PerlIO *f, int fl) if (stdio) { dTHX; - PerlIOStdio *s = PerlIOSelf(PerlIO_push(aTHX_ f,&PerlIO_stdio,"r+",Nullch,0),PerlIOStdio); + PerlIOStdio *s = PerlIOSelf(PerlIO_push(aTHX_ f,&PerlIO_stdio,"r+",Nullsv),PerlIOStdio); s->stdio = stdio; } return stdio; @@ -2123,7 +2203,7 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f) /* perlio buffer layer */ IV -PerlIOBuf_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) +PerlIOBuf_pushed(PerlIO *f, const char *mode, SV *arg) { PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); int fd = PerlIO_fileno(f); @@ -2137,35 +2217,35 @@ PerlIOBuf_pushed(PerlIO *f, const char *mode, const char *arg, STRLEN len) { b->posn = posn; } - return PerlIOBase_pushed(f,mode,arg,len); + return PerlIOBase_pushed(f,mode,arg); } PerlIO * -PerlIOBuf_open(pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) +PerlIOBuf_open(pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) { if (f) { PerlIO *next = PerlIONext(f); - PerlIO_funcs *tab = PerlIOBase(next)->tab; - next = (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,next,narg,args); - if (!next || (*PerlIOBase(f)->tab->Pushed)(f,mode,Nullch,0) != 0) + PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n-2, PerlIOBase(next)->tab); + next = (*tab->Open)(aTHX_ tab, layers, n-2, mode,fd,imode,perm,next,narg,args); + if (!next || (*PerlIOBase(f)->tab->Pushed)(f,mode,MYARG) != 0) { return NULL; } } else { - PerlIO_funcs *tab = PerlIO_default_btm(); + PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n-2, PerlIO_default_btm()); int init = 0; if (*mode == 'I') { init = 1; mode++; } - f = (*tab->Open)(aTHX_ tab,mode,fd,imode,perm,NULL,narg,args); + f = (*tab->Open)(aTHX_ tab, layers, n-2, mode,fd,imode,perm,NULL,narg,args); if (f) { - PerlIOBuf *b = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,Nullch,0),PerlIOBuf); + PerlIOBuf *b = PerlIOSelf(PerlIO_push(aTHX_ f,self,mode,MYARG),PerlIOBuf); fd = PerlIO_fileno(f); #if O_BINARY != O_TEXT /* do something about failing setmode()? --jhi */ @@ -2550,10 +2630,11 @@ PerlIO_funcs PerlIO_perlio = { "perlio", sizeof(PerlIOBuf), PERLIO_K_BUFFERED, - PerlIOBase_fileno, - PerlIOBuf_open, PerlIOBuf_pushed, PerlIOBase_noop_ok, + PerlIOBuf_open, + NULL, + PerlIOBase_fileno, PerlIOBuf_read, PerlIOBuf_unread, PerlIOBuf_write, @@ -2629,9 +2710,9 @@ PerlIOPending_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt) } IV -PerlIOPending_pushed(PerlIO *f,const char *mode,const char *arg,STRLEN len) +PerlIOPending_pushed(PerlIO *f,const char *mode,SV *arg) { - IV code = PerlIOBase_pushed(f,mode,arg,len); + IV code = PerlIOBase_pushed(f,mode,arg); 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 @@ -2664,10 +2745,11 @@ PerlIO_funcs PerlIO_pending = { "pending", sizeof(PerlIOBuf), PERLIO_K_BUFFERED, - PerlIOBase_fileno, - NULL, PerlIOPending_pushed, PerlIOBase_noop_ok, + NULL, + NULL, + PerlIOBase_fileno, PerlIOPending_read, PerlIOBuf_unread, PerlIOBuf_write, @@ -2703,11 +2785,11 @@ typedef struct } PerlIOCrlf; IV -PerlIOCrlf_pushed(PerlIO *f, const char *mode,const char *arg,STRLEN len) +PerlIOCrlf_pushed(PerlIO *f, const char *mode,SV *arg) { IV code; PerlIOBase(f)->flags |= PERLIO_F_CRLF; - code = PerlIOBuf_pushed(f,mode,arg,len); + code = PerlIOBuf_pushed(f,mode,arg); #if 0 PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08"UVxf"\n", f,PerlIOBase(f)->tab->name,(mode) ? mode : "(Null)", @@ -2969,10 +3051,11 @@ PerlIO_funcs PerlIO_crlf = { "crlf", sizeof(PerlIOCrlf), PERLIO_K_BUFFERED|PERLIO_K_CANCRLF, - PerlIOBase_fileno, - PerlIOBuf_open, PerlIOCrlf_pushed, PerlIOBase_noop_ok, /* popped */ + PerlIOBuf_open, + NULL, + PerlIOBase_fileno, PerlIOBuf_read, /* generic read works with ptr/cnt lies ... */ PerlIOCrlf_unread, /* Put CR,LF in buffer for each '\n' */ PerlIOCrlf_write, /* Put CR,LF in buffer for each '\n' */ @@ -3273,10 +3356,11 @@ PerlIO_funcs PerlIO_mmap = { "mmap", sizeof(PerlIOMmap), PERLIO_K_BUFFERED, - PerlIOBase_fileno, - PerlIOBuf_open, PerlIOBuf_pushed, PerlIOBase_noop_ok, + PerlIOBuf_open, + NULL, + PerlIOBase_fileno, PerlIOBuf_read, PerlIOMmap_unread, PerlIOMmap_write, @@ -3469,7 +3553,7 @@ PerlIO_tmpfile(void) FILE *stdio = PerlSIO_tmpfile(); if (stdio) { - PerlIOStdio *s = PerlIOSelf(PerlIO_push(aTHX_ (f = PerlIO_allocate(aTHX)),&PerlIO_stdio,"w+",Nullch,0),PerlIOStdio); + PerlIOStdio *s = PerlIOSelf(PerlIO_push(aTHX_ (f = PerlIO_allocate(aTHX)),&PerlIO_stdio,"w+",Nullsv),PerlIOStdio); s->stdio = stdio; } return f; diff --git a/perlio.h b/perlio.h index 49423aa..ce28c8d 100644 --- a/perlio.h +++ b/perlio.h @@ -82,7 +82,7 @@ typedef PerlIOl *PerlIO; extern void PerlIO_define_layer (pTHX_ PerlIO_funcs *tab); extern SV * PerlIO_find_layer (pTHX_ const char *name, STRLEN len); -extern PerlIO * PerlIO_push (pTHX_ PerlIO *f,PerlIO_funcs *tab,const char *mode,const char *arg,STRLEN len); +extern PerlIO * PerlIO_push (pTHX_ PerlIO *f,PerlIO_funcs *tab,const char *mode,SV *arg); extern void PerlIO_pop (pTHX_ PerlIO *f); #endif /* PerlIO */ diff --git a/perliol.h b/perliol.h index d97df31..78c80f4 100644 --- a/perliol.h +++ b/perliol.h @@ -6,10 +6,16 @@ struct _PerlIO_funcs char * name; Size_t size; IV kind; - IV (*Fileno)(PerlIO *f); - PerlIO * (*Open)(pTHX_ PerlIO_funcs *tab, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args); - IV (*Pushed)(PerlIO *f,const char *mode,const char *arg,STRLEN len); + IV (*Pushed)(PerlIO *f,const char *mode,SV *arg); IV (*Popped)(PerlIO *f); + PerlIO * (*Open)(pTHX_ PerlIO_funcs *tab, + AV *layers, IV n, + const char *mode, + int fd, int imode, int perm, + PerlIO *old, + int narg, SV **args); + SV * (*Getarg)(PerlIO *f); + IV (*Fileno)(PerlIO *f); /* Unix-like functions - cf sfio line disciplines */ SSize_t (*Read)(PerlIO *f, void *vbuf, Size_t count); SSize_t (*Unread)(PerlIO *f, const void *vbuf, Size_t count); @@ -98,7 +104,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,const char *arg,STRLEN len); +extern IV PerlIOBase_pushed (PerlIO *f, const char *mode,SV *arg); 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); @@ -129,7 +135,8 @@ typedef struct IV oneword; /* Emergency buffer */ } PerlIOBuf; -extern PerlIO * PerlIOBuf_open (pTHX_ PerlIO_funcs *self, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args); +extern PerlIO * PerlIOBuf_open (pTHX_ PerlIO_funcs *self, AV *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args); +extern IV PerlIOBuf_pushed (PerlIO *f, const char *mode,SV *arg); extern SSize_t PerlIOBuf_read (PerlIO *f, void *vbuf, Size_t count); extern SSize_t PerlIOBuf_unread (PerlIO *f, const void *vbuf, Size_t count); extern SSize_t PerlIOBuf_write (PerlIO *f, const void *vbuf, Size_t count); -- 2.7.4