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.

3 files changed, 33 insertions, 0 deletions

diff --git a/perl.h b/perl.h
index 4f66da2cc3..1be51b2253 100644
--- 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 641241960f..4949e0afcc 100644
--- 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 d3053a1067..744ffc8870 100644
--- 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 */
 };
 
 /*--------------------------------------------------------------------------------------*/