Change 17332 by jhi@alpha on 2002/06/20 20:41:20
Retract #17331, something broke (e.g. t/io/utf8.t became unhappy)
Affected files ...
.... //depot/perl/ext/PerlIO/Scalar/Scalar.xs#21 edit
.... //depot/perl/ext/PerlIO/Via/Via.xs#16 edit
.... //depot/perl/ext/PerlIO/encoding/encoding.xs#17 edit
.... //depot/perl/perlio.c#185 edit
.... //depot/perl/perliol.h#34 edit
.... //depot/perl/pod/perliol.pod#17 edit
.... //depot/perl/win32/win32io.c#18 edit
Differences ...
==== //depot/perl/ext/PerlIO/Scalar/Scalar.xs#21 (text) ====
Index: perl/ext/PerlIO/Scalar/Scalar.xs
--- perl/ext/PerlIO/Scalar/Scalar.xs#20~17331~ Thu Jun 20 13:11:00 2002
+++ perl/ext/PerlIO/Scalar/Scalar.xs Thu Jun 20 13:41:20 2002
@@ -14,7 +14,7 @@
} PerlIOScalar;
IV
-PerlIOScalar_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOScalar_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
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,tab);
+ code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv);
if ((PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE)
SvCUR(s->var) = 0;
if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
@@ -263,7 +263,6 @@
}
PerlIO_funcs PerlIO_scalar = {
- sizeof(PerlIO_funcs),
"Scalar",
sizeof(PerlIOScalar),
PERLIO_K_BUFFERED|PERLIO_K_RAW,
==== //depot/perl/ext/PerlIO/Via/Via.xs#16 (text) ====
Index: perl/ext/PerlIO/Via/Via.xs
--- perl/ext/PerlIO/Via/Via.xs#15~17331~ Thu Jun 20 13:11:00 2002
+++ perl/ext/PerlIO/Via/Via.xs Thu Jun 20 13:41:20 2002
@@ -123,9 +123,9 @@
}
IV
-PerlIOVia_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOVia_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
- IV code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv,tab);
+ IV code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv);
if (code == 0)
{
PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
@@ -559,7 +559,6 @@
}
PerlIO_funcs PerlIO_object = {
- sizeof(PerlIO_funcs),
"Via",
sizeof(PerlIOVia),
PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT,
==== //depot/perl/ext/PerlIO/encoding/encoding.xs#17 (text) ====
Index: perl/ext/PerlIO/encoding/encoding.xs
--- perl/ext/PerlIO/encoding/encoding.xs#16~17331~ Thu Jun 20 13:11:00 2002
+++ perl/ext/PerlIO/encoding/encoding.xs Thu Jun 20 13:41:20 2002
@@ -80,11 +80,11 @@
}
IV
-PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs *tab)
+PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg)
{
PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
dSP;
- IV code = PerlIOBuf_pushed(aTHX_ f, mode, Nullsv,tab);
+ IV code = PerlIOBuf_pushed(aTHX_ f, mode, Nullsv);
SV *result = Nullsv;
PUSHSTACKi(PERLSI_MAGIC);
@@ -584,7 +584,6 @@
}
PerlIO_funcs PerlIO_encode = {
- sizeof(PerlIO_funcs),
"encoding",
sizeof(PerlIOEncode),
PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT,
==== //depot/perl/perlio.c#185 (text) ====
Index: perl/perlio.c
--- perl/perlio.c#184~17331~ Thu Jun 20 13:11:00 2002
+++ perl/perlio.c Thu Jun 20 13:41:20 2002
@@ -990,33 +990,17 @@
PerlIO *
PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
{
- 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) {
+ 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);
return NULL;
}
}
@@ -1024,7 +1008,7 @@
}
IV
-PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
PerlIO_pop(aTHX_ f);
if (*f) {
@@ -1054,12 +1038,13 @@
}
IV
-PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
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
@@ -1695,9 +1680,11 @@
*/
IV
-PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
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
@@ -1708,9 +1695,8 @@
}
PerlIO_funcs PerlIO_utf8 = {
- sizeof(PerlIO_funcs),
"utf8",
- 0,
+ sizeof(PerlIOl),
PERLIO_K_DUMMY | PERLIO_K_UTF8,
PerlIOUtf8_pushed,
NULL,
@@ -1737,9 +1723,8 @@
};
PerlIO_funcs PerlIO_byte = {
- sizeof(PerlIO_funcs),
"bytes",
- 0,
+ sizeof(PerlIOl),
PERLIO_K_DUMMY,
PerlIOUtf8_pushed,
NULL,
@@ -1776,9 +1761,8 @@
}
PerlIO_funcs PerlIO_raw = {
- sizeof(PerlIO_funcs),
"raw",
- 0,
+ sizeof(PerlIOl),
PERLIO_K_DUMMY,
PerlIORaw_pushed,
PerlIOBase_popped,
@@ -1846,13 +1830,14 @@
}
IV
-PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
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)
@@ -2210,9 +2195,9 @@
}
IV
-PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
- IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
+ IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
if (*PerlIONext(f)) {
/* We never call down so do any pending stuff now */
@@ -2380,7 +2365,6 @@
}
PerlIO_funcs PerlIO_unix = {
- sizeof(PerlIO_funcs),
"unix",
sizeof(PerlIOUnix),
PERLIO_K_RAW,
@@ -2452,7 +2436,7 @@
* This isn't used yet ...
*/
IV
-PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
if (*PerlIONext(f)) {
PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
@@ -2468,7 +2452,7 @@
else
return -1;
}
- return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
+ return PerlIOBase_pushed(aTHX_ f, mode, arg);
}
@@ -2939,7 +2923,6 @@
PerlIO_funcs PerlIO_stdio = {
- sizeof(PerlIO_funcs),
"stdio",
sizeof(PerlIOStdio),
PERLIO_K_BUFFERED|PERLIO_K_RAW,
@@ -3043,7 +3026,7 @@
*/
IV
-PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
int fd = PerlIO_fileno(f);
@@ -3056,7 +3039,7 @@
b->posn = posn;
}
}
- return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
+ return PerlIOBase_pushed(aTHX_ f, mode, arg);
}
PerlIO *
@@ -3069,7 +3052,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, self) !=
0) {
+ if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg) != 0) {
return NULL;
}
}
@@ -3491,7 +3474,6 @@
PerlIO_funcs PerlIO_perlio = {
- sizeof(PerlIO_funcs),
"perlio",
sizeof(PerlIOBuf),
PERLIO_K_BUFFERED|PERLIO_K_RAW,
@@ -3581,9 +3563,9 @@
}
IV
-PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
- IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
+ IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
PerlIOl *l = PerlIOBase(f);
/*
* Our PerlIO_fast_gets must match what we are pushed on, or sv_gets()
@@ -3614,7 +3596,6 @@
}
PerlIO_funcs PerlIO_pending = {
- sizeof(PerlIO_funcs),
"pending",
sizeof(PerlIOBuf),
PERLIO_K_BUFFERED|PERLIO_K_RAW, /* not sure about RAW here */
@@ -3660,11 +3641,11 @@
} PerlIOCrlf;
IV
-PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
IV code;
PerlIOBase(f)->flags |= PERLIO_F_CRLF;
- code = PerlIOBuf_pushed(aTHX_ f, mode, arg, tab);
+ code = PerlIOBuf_pushed(aTHX_ 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)",
@@ -3925,7 +3906,6 @@
}
PerlIO_funcs PerlIO_crlf = {
- sizeof(PerlIO_funcs),
"crlf",
sizeof(PerlIOCrlf),
PERLIO_K_BUFFERED | PERLIO_K_CANCRLF | PERLIO_K_RAW,
@@ -4242,7 +4222,6 @@
PerlIO_funcs PerlIO_mmap = {
- sizeof(PerlIO_funcs),
"mmap",
sizeof(PerlIOMmap),
PERLIO_K_BUFFERED|PERLIO_K_RAW,
==== //depot/perl/perliol.h#34 (text) ====
Index: perl/perliol.h
--- perl/perliol.h#33~17331~ Thu Jun 20 13:11:00 2002
+++ perl/perliol.h Thu Jun 20 13:41:20 2002
@@ -14,11 +14,10 @@
};
struct _PerlIO_funcs {
- Size_t fsize;
char *name;
Size_t size;
U32 kind;
- IV (*Pushed) (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
+ IV (*Pushed) (pTHX_ PerlIO *f, const char *mode, SV *arg);
IV (*Popped) (pTHX_ PerlIO *f);
PerlIO *(*Open) (pTHX_ PerlIO_funcs *tab,
PerlIO_list_t *layers, IV n,
@@ -125,7 +124,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, PerlIO_funcs
*tab);
+extern IV PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg);
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);
@@ -169,7 +168,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, PerlIO_funcs
*tab);
+extern IV PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg);
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#17 (text) ====
Index: perl/pod/perliol.pod
--- perl/pod/perliol.pod#16~17331~ Thu Jun 20 13:11:00 2002
+++ perl/pod/perliol.pod Thu Jun 20 13:41:20 2002
@@ -87,11 +87,10 @@
struct _PerlIO_funcs
{
- Size_t fsize;
char * name;
Size_t size;
IV kind;
- IV (*Pushed)(pTHX_ PerlIO *f,const char *mode,SV *arg, PerlIO_funcs *tab);
+ IV (*Pushed)(pTHX_ PerlIO *f,const char *mode,SV *arg);
IV (*Popped)(pTHX_ PerlIO *f);
PerlIO * (*Open)(pTHX_ PerlIO_funcs *tab,
AV *layers, IV n,
@@ -125,9 +124,9 @@
void (*Set_ptrcnt)(pTHX_ PerlIO *f,STDCHAR *ptr,SSize_t cnt);
};
-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
+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
layer), then follow the functions which fall into four basic groups:
=over 4
@@ -324,14 +323,6 @@
=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;
@@ -352,14 +343,6 @@
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;
@@ -509,18 +492,18 @@
C<PerlIOBase_fileno()> (which just asks next layer down) will suffice
for this.
-Returns -1 on error, which is considered to include the case where the layer cannot
-provide such a file descriptor.
+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.
=item Dup
PerlIO * (*Dup)(pTHX_ PerlIO *f, PerlIO *o,
CLONE_PARAMS *param, int flags);
-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>.
+XXX: not documented
Similar to C<Open>, returns PerlIO* on success, C<NULL> on failure.
==== //depot/perl/win32/win32io.c#18 (text) ====
Index: perl/win32/win32io.c
--- perl/win32/win32io.c#17~17331~ Thu Jun 20 13:11:00 2002
+++ perl/win32/win32io.c Thu Jun 20 13:41:20 2002
@@ -52,9 +52,9 @@
}
IV
-PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
- IV code = PerlIOBase_pushed(aTHX_ f,mode,arg,tab);
+ IV code = PerlIOBase_pushed(aTHX_ f,mode,arg);
if (*PerlIONext(f))
{
PerlIOWin32 *s = PerlIOSelf(f,PerlIOWin32);
@@ -341,7 +341,6 @@
}
PerlIO_funcs PerlIO_win32 = {
- sizeof(PerlIO_funcs),
"win32",
sizeof(PerlIOWin32),
PERLIO_K_RAW,
End of Patch.
