From: Nick Ing-Simmons Date: Thu, 20 Jun 2002 20:04:01 +0000 (+0000) Subject: PerlIO Layer implementation future proofing. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2dc2558e5965ed21842375d8cc89de68e0c966e2;p=p5sagit%2Fp5-mst-13.2.git PerlIO Layer implementation future proofing. - Inspired by Nick C's suggestion add size of function table to the table as a validation check. - also optimize pseudo-layer code to avoid malloc/link of something destined to be immediately popped & freed. - Minor addition to pod/perliol.pod p4raw-id: //depot/perlio@17330 --- diff --git a/ext/PerlIO/Scalar/Scalar.xs b/ext/PerlIO/Scalar/Scalar.xs index 314c0f3..5bbc119 100644 --- a/ext/PerlIO/Scalar/Scalar.xs +++ b/ext/PerlIO/Scalar/Scalar.xs @@ -14,7 +14,7 @@ typedef struct } PerlIOScalar; IV -PerlIOScalar_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) +PerlIOScalar_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { IV code; PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); @@ -38,7 +38,7 @@ PerlIOScalar_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) s->var = newSVpvn("",0); } sv_upgrade(s->var,SVt_PV); - code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv); + code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv,tab); if ((PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE) SvCUR(s->var) = 0; if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND) @@ -263,6 +263,7 @@ PerlIOScalar_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) } PerlIO_funcs PerlIO_scalar = { + sizeof(PerlIO_funcs), "Scalar", sizeof(PerlIOScalar), PERLIO_K_BUFFERED|PERLIO_K_RAW, diff --git a/ext/PerlIO/Via/Via.xs b/ext/PerlIO/Via/Via.xs index d1ebab2..04c4d48 100644 --- a/ext/PerlIO/Via/Via.xs +++ b/ext/PerlIO/Via/Via.xs @@ -123,9 +123,9 @@ PerlIOVia_method(pTHX_ PerlIO *f,char *method,CV **save,int flags,...) } IV -PerlIOVia_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) +PerlIOVia_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { - IV code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv); + IV code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv,tab); if (code == 0) { PerlIOVia *s = PerlIOSelf(f,PerlIOVia); @@ -559,6 +559,7 @@ PerlIOVia_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) } PerlIO_funcs PerlIO_object = { + sizeof(PerlIO_funcs), "Via", sizeof(PerlIOVia), PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT, diff --git a/ext/PerlIO/encoding/encoding.xs b/ext/PerlIO/encoding/encoding.xs index df911ed..a714a3d 100644 --- a/ext/PerlIO/encoding/encoding.xs +++ b/ext/PerlIO/encoding/encoding.xs @@ -80,11 +80,11 @@ PerlIOEncode_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags) } IV -PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg) +PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs *tab) { PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode); dSP; - IV code = PerlIOBuf_pushed(aTHX_ f, mode, Nullsv); + IV code = PerlIOBuf_pushed(aTHX_ f, mode, Nullsv,tab); SV *result = Nullsv; PUSHSTACKi(PERLSI_MAGIC); @@ -584,6 +584,7 @@ PerlIOEncode_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) } PerlIO_funcs PerlIO_encode = { + sizeof(PerlIO_funcs), "encoding", sizeof(PerlIOEncode), PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT, diff --git a/perlio.c b/perlio.c index edfdf17..f8d6517 100644 --- a/perlio.c +++ b/perlio.c @@ -990,17 +990,33 @@ PerlIO_stdstreams(pTHX) PerlIO * PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg) { - PerlIOl *l = NULL; - Newc('L',l,tab->size,char,PerlIOl); - if (l && f) { - Zero(l, tab->size, char); - l->next = *f; - l->tab = tab; - *f = l; - PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name, - (mode) ? mode : "(Null)", (void*)arg); - if ((*l->tab->Pushed) (aTHX_ f, mode, arg) != 0) { - PerlIO_pop(aTHX_ f); + if (tab->fsize != sizeof(PerlIO_funcs)) { + mismatch: + Perl_croak(aTHX_ "Layer does not match this perl"); + } + if (tab->size) { + PerlIOl *l = NULL; + if (tab->size < sizeof(PerlIOl)) { + goto mismatch; + } + /* Real layer with a data area */ + Newc('L',l,tab->size,char,PerlIOl); + if (l && f) { + Zero(l, tab->size, char); + l->next = *f; + l->tab = tab; + *f = l; + PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name, + (mode) ? mode : "(Null)", (void*)arg); + if ((*l->tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) { + PerlIO_pop(aTHX_ f); + return NULL; + } + } + } + else if (f) { + /* Pseudo-layer where push does its own stack adjust */ + if ((*tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) { return NULL; } } @@ -1008,7 +1024,7 @@ PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg) } IV -PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) +PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { PerlIO_pop(aTHX_ f); if (*f) { @@ -1038,13 +1054,12 @@ PerlIOBase_binmode(pTHX_ PerlIO *f) } IV -PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) +PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { if (PerlIOValid(f)) { PerlIO *t; PerlIOl *l; - PerlIO_pop(aTHX_ f); /* Remove the dummy layer */ PerlIO_flush(f); /* * Strip all layers that are not suitable for a raw stream @@ -1680,11 +1695,9 @@ Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt) */ IV -PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) +PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { if (*PerlIONext(f)) { - PerlIO_funcs *tab = PerlIOBase(f)->tab; - PerlIO_pop(aTHX_ f); if (tab->kind & PERLIO_K_UTF8) PerlIOBase(f)->flags |= PERLIO_F_UTF8; else @@ -1695,8 +1708,9 @@ PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) } PerlIO_funcs PerlIO_utf8 = { + sizeof(PerlIO_funcs), "utf8", - sizeof(PerlIOl), + 0, PERLIO_K_DUMMY | PERLIO_K_UTF8, PerlIOUtf8_pushed, NULL, @@ -1723,8 +1737,9 @@ PerlIO_funcs PerlIO_utf8 = { }; PerlIO_funcs PerlIO_byte = { + sizeof(PerlIO_funcs), "bytes", - sizeof(PerlIOl), + 0, PERLIO_K_DUMMY, PerlIOUtf8_pushed, NULL, @@ -1761,8 +1776,9 @@ PerlIORaw_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, } PerlIO_funcs PerlIO_raw = { + sizeof(PerlIO_funcs), "raw", - sizeof(PerlIOl), + 0, PERLIO_K_DUMMY, PerlIORaw_pushed, PerlIOBase_popped, @@ -1830,14 +1846,13 @@ PerlIO_modestr(PerlIO *f, char *buf) } IV -PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) +PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { PerlIOl *l = PerlIOBase(f); #if 0 const char *omode = mode; char temp[8]; #endif - PerlIO_funcs *tab = PerlIOBase(f)->tab; l->flags &= ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_TRUNCATE | PERLIO_F_APPEND); if (tab->Set_ptrcnt != NULL) @@ -2195,9 +2210,9 @@ PerlIOUnix_fileno(pTHX_ PerlIO *f) } IV -PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) +PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { - IV code = PerlIOBase_pushed(aTHX_ f, mode, arg); + IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab); PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix); if (*PerlIONext(f)) { /* We never call down so do any pending stuff now */ @@ -2365,6 +2380,7 @@ PerlIOUnix_close(pTHX_ PerlIO *f) } PerlIO_funcs PerlIO_unix = { + sizeof(PerlIO_funcs), "unix", sizeof(PerlIOUnix), PERLIO_K_RAW, @@ -2436,7 +2452,7 @@ PerlIOStdio_mode(const char *mode, char *tmode) * This isn't used yet ... */ IV -PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) +PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { if (*PerlIONext(f)) { PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio); @@ -2452,7 +2468,7 @@ PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) else return -1; } - return PerlIOBase_pushed(aTHX_ f, mode, arg); + return PerlIOBase_pushed(aTHX_ f, mode, arg, tab); } @@ -2923,6 +2939,7 @@ PerlIOStdio_fill(pTHX_ PerlIO *f) PerlIO_funcs PerlIO_stdio = { + sizeof(PerlIO_funcs), "stdio", sizeof(PerlIOStdio), PERLIO_K_BUFFERED|PERLIO_K_RAW, @@ -3026,7 +3043,7 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f) */ IV -PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) +PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf); int fd = PerlIO_fileno(f); @@ -3039,7 +3056,7 @@ PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) b->posn = posn; } } - return PerlIOBase_pushed(aTHX_ f, mode, arg); + return PerlIOBase_pushed(aTHX_ f, mode, arg, tab); } PerlIO * @@ -3052,7 +3069,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab); next = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm, next, narg, args); - if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg) != 0) { + if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg, self) != 0) { return NULL; } } @@ -3474,6 +3491,7 @@ PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) PerlIO_funcs PerlIO_perlio = { + sizeof(PerlIO_funcs), "perlio", sizeof(PerlIOBuf), PERLIO_K_BUFFERED|PERLIO_K_RAW, @@ -3563,9 +3581,9 @@ PerlIOPending_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt) } IV -PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) +PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { - IV code = PerlIOBase_pushed(aTHX_ f, mode, arg); + IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab); PerlIOl *l = PerlIOBase(f); /* * Our PerlIO_fast_gets must match what we are pushed on, or sv_gets() @@ -3596,6 +3614,7 @@ PerlIOPending_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) } PerlIO_funcs PerlIO_pending = { + sizeof(PerlIO_funcs), "pending", sizeof(PerlIOBuf), PERLIO_K_BUFFERED|PERLIO_K_RAW, /* not sure about RAW here */ @@ -3641,11 +3660,11 @@ typedef struct { } PerlIOCrlf; IV -PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) +PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { IV code; PerlIOBase(f)->flags |= PERLIO_F_CRLF; - code = PerlIOBuf_pushed(aTHX_ f, mode, arg); + code = PerlIOBuf_pushed(aTHX_ f, mode, arg, tab); #if 0 PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08" UVxf "\n", f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)", @@ -3906,6 +3925,7 @@ PerlIOCrlf_binmode(pTHX_ PerlIO *f) } PerlIO_funcs PerlIO_crlf = { + sizeof(PerlIO_funcs), "crlf", sizeof(PerlIOCrlf), PERLIO_K_BUFFERED | PERLIO_K_CANCRLF | PERLIO_K_RAW, @@ -4222,6 +4242,7 @@ PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) PerlIO_funcs PerlIO_mmap = { + sizeof(PerlIO_funcs), "mmap", sizeof(PerlIOMmap), PERLIO_K_BUFFERED|PERLIO_K_RAW, diff --git a/perliol.h b/perliol.h index 76d74a7..fa399e6 100644 --- a/perliol.h +++ b/perliol.h @@ -14,10 +14,11 @@ struct PerlIO_list_s { }; struct _PerlIO_funcs { + Size_t fsize; char *name; Size_t size; U32 kind; - IV (*Pushed) (pTHX_ PerlIO *f, const char *mode, SV *arg); + IV (*Pushed) (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab); IV (*Popped) (pTHX_ PerlIO *f); PerlIO *(*Open) (pTHX_ PerlIO_funcs *tab, PerlIO_list_t *layers, IV n, @@ -124,7 +125,7 @@ extern SV *PerlIO_arg_fetch(PerlIO_list_t *av, IV n); extern IV PerlIOBase_fileno(pTHX_ PerlIO *f); extern PerlIO *PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags); -extern IV PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg); +extern IV PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab); extern IV PerlIOBase_popped(pTHX_ PerlIO *f); extern IV PerlIOBase_binmode(pTHX_ PerlIO *f); extern SSize_t PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count); @@ -168,7 +169,7 @@ extern PerlIO *PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, int perm, PerlIO *old, int narg, SV **args); -extern IV PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg); +extern IV PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab); extern IV PerlIOBuf_popped(pTHX_ PerlIO *f); extern PerlIO *PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags); extern SSize_t PerlIOBuf_read(pTHX_ PerlIO *f, void *vbuf, Size_t count); diff --git a/pod/perliol.pod b/pod/perliol.pod index 81cbab1..da4abe7 100644 --- a/pod/perliol.pod +++ b/pod/perliol.pod @@ -87,10 +87,11 @@ same as the public C functions: struct _PerlIO_funcs { + Size_t fsize; char * name; Size_t size; IV kind; - IV (*Pushed)(pTHX_ PerlIO *f,const char *mode,SV *arg); + IV (*Pushed)(pTHX_ PerlIO *f,const char *mode,SV *arg, PerlIO_funcs *tab); IV (*Popped)(pTHX_ PerlIO *f); PerlIO * (*Open)(pTHX_ PerlIO_funcs *tab, AV *layers, IV n, @@ -124,9 +125,9 @@ same as the public C functions: void (*Set_ptrcnt)(pTHX_ PerlIO *f,STDCHAR *ptr,SSize_t cnt); }; -The first few members of the struct give a "name" for the layer, the -size to C for the per-instance data, and some flags which are -attributes of the class as whole (such as whether it is a buffering +The first few members of the struct give a function table size for +compatibility check "name" for the layer, the size to C for the per-instance data, +and some flags which are attributes of the class as whole (such as whether it is a buffering layer), then follow the functions which fall into four basic groups: =over 4 @@ -323,6 +324,14 @@ to change during one "get".) =over 4 +=item size + + Size_t fsize; + +Size of the function table. This is compared against the value PerlIO code "knows" +as a compatibility check. Future versions I be able to tolerate layers +compiled against an old version of the headers. + =item name char * name; @@ -343,6 +352,14 @@ The size of the per-instance data structure, e.g.: sizeof(PerlIOAPR) +If this field is zero then C does not malloc anything and assumes +layer's Pushed function will do any required layer stack manipulation - used +to avoid malloc/free overhead for dummy layers. +If the field is non-zero it must be at least the size of C, +C will allocate memory for the layer's data structures +and link new layer onto the stream's stack. (If the layer's Pushed +method returns an error indication the layer is popped again.) + =item kind IV kind; @@ -492,18 +509,18 @@ Returns the Unix/Posix numeric file descriptor for the handle. Normally C (which just asks next layer down) will suffice for this. -Returns -1 if the layer cannot provide such a file descriptor, or in -the case of the error. - -XXX: two possible results end up in -1, one is an error the other is -not. +Returns -1 on error, which is considered to include the case where the layer cannot +provide such a file descriptor. =item Dup PerlIO * (*Dup)(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags); -XXX: not documented +XXX: Needs more docs. + +Used as part of the "clone" process when a thread is spawned (in which case +param will be non-NULL) and when a stream is being duplicated via '&' in the C. Similar to C, returns PerlIO* on success, C on failure. diff --git a/win32/win32io.c b/win32/win32io.c index 7997658..f0f71e7 100644 --- a/win32/win32io.c +++ b/win32/win32io.c @@ -52,9 +52,9 @@ PerlIOWin32_fileno(pTHX_ PerlIO *f) } IV -PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg) +PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { - IV code = PerlIOBase_pushed(aTHX_ f,mode,arg); + IV code = PerlIOBase_pushed(aTHX_ f,mode,arg,tab); if (*PerlIONext(f)) { PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32); @@ -341,6 +341,7 @@ PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params, int flags) } PerlIO_funcs PerlIO_win32 = { + sizeof(PerlIO_funcs), "win32", sizeof(PerlIOWin32), PERLIO_K_RAW,