Change 17331 by jhi@alpha on 2002/06/20 20:11:00
Integrate perlio:
[ 17330]
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
Affected files ...
.... //depot/perl/ext/PerlIO/Scalar/Scalar.xs#20 integrate
.... //depot/perl/ext/PerlIO/Via/Via.xs#15 integrate
.... //depot/perl/ext/PerlIO/encoding/encoding.xs#16 integrate
.... //depot/perl/perlio.c#184 integrate
.... //depot/perl/perliol.h#33 integrate
.... //depot/perl/pod/perliol.pod#16 integrate
.... //depot/perl/win32/win32io.c#17 integrate
Differences ...
==== //depot/perl/ext/PerlIO/Scalar/Scalar.xs#20 (text) ====
Index: perl/ext/PerlIO/Scalar/Scalar.xs
--- perl/ext/PerlIO/Scalar/Scalar.xs#19~17312~ Wed Jun 19 14:27:24 2002
+++ perl/ext/PerlIO/Scalar/Scalar.xs Thu Jun 20 13:11:00 2002
@@ -14,7 +14,7 @@
} 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 @@
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 @@
}
PerlIO_funcs PerlIO_scalar = {
+ sizeof(PerlIO_funcs),
"Scalar",
sizeof(PerlIOScalar),
PERLIO_K_BUFFERED|PERLIO_K_RAW,
==== //depot/perl/ext/PerlIO/Via/Via.xs#15 (text) ====
Index: perl/ext/PerlIO/Via/Via.xs
--- perl/ext/PerlIO/Via/Via.xs#14~17312~ Wed Jun 19 14:27:24 2002
+++ perl/ext/PerlIO/Via/Via.xs Thu Jun 20 13:11:00 2002
@@ -123,9 +123,9 @@
}
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 @@
}
PerlIO_funcs PerlIO_object = {
+ sizeof(PerlIO_funcs),
"Via",
sizeof(PerlIOVia),
PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT,
==== //depot/perl/ext/PerlIO/encoding/encoding.xs#16 (text) ====
Index: perl/ext/PerlIO/encoding/encoding.xs
--- perl/ext/PerlIO/encoding/encoding.xs#15~17312~ Wed Jun 19 14:27:24 2002
+++ perl/ext/PerlIO/encoding/encoding.xs Thu Jun 20 13:11:00 2002
@@ -80,11 +80,11 @@
}
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 @@
}
PerlIO_funcs PerlIO_encode = {
+ sizeof(PerlIO_funcs),
"encoding",
sizeof(PerlIOEncode),
PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT,
==== //depot/perl/perlio.c#184 (text) ====
Index: perl/perlio.c
--- perl/perlio.c#183~17328~ Thu Jun 20 10:41:42 2002
+++ perl/perlio.c Thu Jun 20 13:11:00 2002
@@ -990,17 +990,33 @@
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 @@
}
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 @@
}
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 @@
*/
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 @@
}
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_byte = {
+ sizeof(PerlIO_funcs),
"bytes",
- sizeof(PerlIOl),
+ 0,
PERLIO_K_DUMMY,
PerlIOUtf8_pushed,
NULL,
@@ -1761,8 +1776,9 @@
}
PerlIO_funcs PerlIO_raw = {
+ sizeof(PerlIO_funcs),
"raw",
- sizeof(PerlIOl),
+ 0,
PERLIO_K_DUMMY,
PerlIORaw_pushed,
PerlIOBase_popped,
@@ -1830,14 +1846,13 @@
}
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 @@
}
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 @@
}
PerlIO_funcs PerlIO_unix = {
+ sizeof(PerlIO_funcs),
"unix",
sizeof(PerlIOUnix),
PERLIO_K_RAW,
@@ -2436,7 +2452,7 @@
* 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 @@
else
return -1;
}
- return PerlIOBase_pushed(aTHX_ f, mode, arg);
+ return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
}
@@ -2923,6 +2939,7 @@
PerlIO_funcs PerlIO_stdio = {
+ sizeof(PerlIO_funcs),
"stdio",
sizeof(PerlIOStdio),
PERLIO_K_BUFFERED|PERLIO_K_RAW,
@@ -3026,7 +3043,7 @@
*/
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 @@
b->posn = posn;
}
}
- return PerlIOBase_pushed(aTHX_ f, mode, arg);
+ return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
}
PerlIO *
@@ -3052,7 +3069,7 @@
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 @@
PerlIO_funcs PerlIO_perlio = {
+ sizeof(PerlIO_funcs),
"perlio",
sizeof(PerlIOBuf),
PERLIO_K_BUFFERED|PERLIO_K_RAW,
@@ -3563,9 +3581,9 @@
}
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 @@
}
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 @@
} 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 @@
}
PerlIO_funcs PerlIO_crlf = {
+ sizeof(PerlIO_funcs),
"crlf",
sizeof(PerlIOCrlf),
PERLIO_K_BUFFERED | PERLIO_K_CANCRLF | PERLIO_K_RAW,
@@ -4222,6 +4242,7 @@
PerlIO_funcs PerlIO_mmap = {
+ sizeof(PerlIO_funcs),
"mmap",
sizeof(PerlIOMmap),
PERLIO_K_BUFFERED|PERLIO_K_RAW,
==== //depot/perl/perliol.h#33 (text) ====
Index: perl/perliol.h
--- perl/perliol.h#32~17312~ Wed Jun 19 14:27:24 2002
+++ perl/perliol.h Thu Jun 20 13:11:00 2002
@@ -14,10 +14,11 @@
};
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 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 @@
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);
==== //depot/perl/pod/perliol.pod#16 (text) ====
Index: perl/pod/perliol.pod
--- perl/pod/perliol.pod#15~17312~ Wed Jun 19 14:27:24 2002
+++ perl/pod/perliol.pod Thu Jun 20 13:11:00 2002
@@ -87,10 +87,11 @@
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 @@
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<malloc> 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<malloc> 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 @@
=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<may> be able to tolerate layers
+compiled against an old version of the headers.
+
=item name
char * name;
@@ -343,6 +352,14 @@
sizeof(PerlIOAPR)
+If this field is zero then C<PerlIO_pushed> 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<PerlIOl>,
+C<PerlIO_pushed> 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 @@
C<PerlIOBase_fileno()> (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<open>.
Similar to C<Open>, returns PerlIO* on success, C<NULL> on failure.
==== //depot/perl/win32/win32io.c#17 (text) ====
Index: perl/win32/win32io.c
--- perl/win32/win32io.c#16~17312~ Wed Jun 19 14:27:24 2002
+++ perl/win32/win32io.c Thu Jun 20 13:11:00 2002
@@ -52,9 +52,9 @@
}
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 @@
}
PerlIO_funcs PerlIO_win32 = {
+ sizeof(PerlIO_funcs),
"win32",
sizeof(PerlIOWin32),
PERLIO_K_RAW,
End of Patch.
