add 'head' field to PerlIOl struct

This allows any layer to find the top of the layer stack,
or more specifically, the entry in PL_perlio that points to
the top.

Needed for the next commit, which will implement a reference counting
scheme.

There's currently a bug in MakeMaker which causes several extensions to
miss the dependency on perliol.h having changed, so this commit includes
a gratuitous whitespace change to perl.h to hopefully force recompilation.

diff --git a/perl.h b/perl.h
index 4f66da2..1be51b2 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -8,6 +8,7 @@
  *
  */
 
+
 #ifndef H_PERL
 #define H_PERL 1
 

diff --git a/perlio.c b/perlio.c
index 6412419..4949e0a 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -527,6 +527,32 @@ PerlIO_debug(const char *fmt, ...)
  * Inner level routines
  */
 
+/* check that the head field of each layer points back to the head */
+
+#ifdef DEBUGGING
+#  define VERIFY_HEAD(f) PerlIO_verify_head(aTHX_ f)
+static void
+PerlIO_verify_head(pTHX_ PerlIO *f)
+{
+    PerlIOl *head, *p;
+    int seen = 0;
+    if (!PerlIOValid(f))
+       return;
+    p = head = PerlIOBase(f)->head;
+    assert(p);
+    do {
+       assert(p->head == head);
+       if (p == (PerlIOl*)f)
+           seen = 1;
+       p = p->next;
+    } while (p);
+    assert(seen);
+}
+#else
+#  define VERIFY_HEAD(f)
+#endif
+
+
 /*
  * Table of pointers to the PerlIO structs (malloc'ed)
  */
@@ -549,6 +575,7 @@ PerlIO_allocate(pTHX)
            if (!((++f)->next)) {
                f->flags = 0;
                f->tab = NULL;
+               f->head = f;
                return (PerlIO *)f;
            }
        }
@@ -560,6 +587,7 @@ PerlIO_allocate(pTHX)
     *last = (PerlIOl*) f++;
     f->flags = 0;
     f->tab = NULL;
+    f->head = f;
     return (PerlIO*) f;
 }
 
@@ -731,6 +759,7 @@ void
 PerlIO_pop(pTHX_ PerlIO *f)
 {
     const PerlIOl *l = *f;
+    VERIFY_HEAD(f);
     if (l) {
        PerlIO_debug("PerlIO_pop f=%p %s\n", (void*)f, l->tab->name);
        if (l->tab->Popped) {
@@ -1214,6 +1243,7 @@ PerlIO_stdstreams(pTHX)
 PerlIO *
 PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab), const char *mode, SV *arg)
 {
+    VERIFY_HEAD(f);
     if (tab->fsize != sizeof(PerlIO_funcs)) {
        Perl_croak( aTHX_
            "%s (%d) does not match %s (%d)",
@@ -1236,6 +1266,7 @@ PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab), const char *mode, SV *arg)
            if (l) {
                l->next = *f;
                l->tab = (PerlIO_funcs*) tab;
+               l->head = ((PerlIOl*)f)->head;
                *f = l;
                PerlIO_debug("PerlIO_push f=%p %s %s %p\n",
                             (void*)f, tab->name,

diff --git a/perliol.h b/perliol.h
index d3053a1..744ffc8 100644 (file)
--- a/perliol.h
+++ b/perliol.h
@@ -67,6 +67,7 @@ struct _PerlIO {
     PerlIOl *next;             /* Lower layer */
     PerlIO_funcs *tab;         /* Functions for this layer */
     U32 flags;                 /* Various flags for state */
+    PerlIOl *head;             /* our ultimate parent pointer */
 };
 
 /*--------------------------------------------------------------------------------------*/