make PL_perlio an array of PerlIOl, not PerlIO *
authorDavid Mitchell <davem@iabyn.com>
Mon, 15 Nov 2010 17:06:37 +0000 (17:06 +0000)
committerDavid Mitchell <davem@iabyn.com>
Fri, 26 Nov 2010 16:01:33 +0000 (16:01 +0000)
Layers in PerlIO are implemented as a linked list of PerlIOl structs;
eaxch one has a 'next' field pointing to the next layer. Now here's the
clever bit: When PerlIO* pointers are passed around to refer to a
particular handle, these are actually pointers to the 'next' field of the
*parent* layer (so to access the flags field say of a PerlIOl, you have to
double-defref it, e.g. (*f)->flags). The big advantage of this is that
it's easy for a layer to pop itself; when you call PerlIO_pop(f), f is a
pointer to the parent's 'next' field, so pop(f) can just do
*f = (*f)->next.

This means that there has to be a fake 'next' field above the topmost
layer. This is where PL_perlio comes in: it's a pointer to an arena of
arrays of pointers, each one capable of pointing to a PerlIOl structure.
When  a new handle is created, a spare arena slot is grabbed, and the
address of that slot is returned. This also allows for a handle with no
layers.

What this commit does is change PL_perlio from being an array of
PerlIO* into an array of PerlIOl structures - i.e. each element in the
array goes from being a single pointer, to having several fields. These
will be made used of in follow-up commits.

intrpvar.h
perlio.c
perliol.h

index d10feec..0c90a9f 100644 (file)
@@ -658,7 +658,7 @@ PERLVAR(Icustom_op_names, HV*)  /* Names of user defined ops */
 PERLVAR(Icustom_op_descs, HV*)  /* Descriptions of user defined ops */
 
 #ifdef PERLIO_LAYERS
-PERLVARI(Iperlio, PerlIO *,NULL)
+PERLVARI(Iperlio, PerlIOl *,NULL)
 PERLVARI(Iknown_layers, PerlIO_list_t *,NULL)
 PERLVARI(Idef_layerlist, PerlIO_list_t *,NULL)
 #endif
index 4620ecd..6412419 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -539,24 +539,28 @@ PerlIO_allocate(pTHX)
     /*
      * Find a free slot in the table, allocating new table as necessary
      */
-    PerlIO **last;
-    PerlIO *f;
+    PerlIOl **last;
+    PerlIOl *f;
     last = &PL_perlio;
     while ((f = *last)) {
        int i;
-       last = (PerlIO **) (f);
+       last = (PerlIOl **) (f);
        for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
-           if (!*++f) {
-               return f;
+           if (!((++f)->next)) {
+               f->flags = 0;
+               f->tab = NULL;
+               return (PerlIO *)f;
            }
        }
     }
-    Newxz(f,PERLIO_TABLE_SIZE,PerlIO);
+    Newxz(f,PERLIO_TABLE_SIZE,PerlIOl);
     if (!f) {
        return NULL;
     }
-    *last = f;
-    return f + 1;
+    *last = (PerlIOl*) f++;
+    f->flags = 0;
+    f->tab = NULL;
+    return (PerlIO*) f;
 }
 
 #undef PerlIO_fdupopen
@@ -579,16 +583,16 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
 }
 
 void
-PerlIO_cleantable(pTHX_ PerlIO **tablep)
+PerlIO_cleantable(pTHX_ PerlIOl **tablep)
 {
-    PerlIO * const table = *tablep;
+    PerlIOl * const table = *tablep;
     if (table) {
        int i;
-       PerlIO_cleantable(aTHX_(PerlIO **) & (table[0]));
+       PerlIO_cleantable(aTHX_(PerlIOl **) & (table[0]));
        for (i = PERLIO_TABLE_SIZE - 1; i > 0; i--) {
-           PerlIO * const f = table + i;
-           if (*f) {
-               PerlIO_close(f);
+           PerlIOl * const f = table + i;
+           if (f->next) {
+               PerlIO_close(&(f->next));
            }
        }
        Safefree(table);
@@ -669,8 +673,8 @@ void
 PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param)
 {
 #ifdef USE_ITHREADS
-    PerlIO **table = &proto->Iperlio;
-    PerlIO *f;
+    PerlIOl **table = &proto->Iperlio;
+    PerlIOl *f;
     PL_perlio = NULL;
     PL_known_layers = PerlIO_clone_list(aTHX_ proto->Iknown_layers, param);
     PL_def_layerlist = PerlIO_clone_list(aTHX_ proto->Idef_layerlist, param);
@@ -678,10 +682,10 @@ PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param)
     PerlIO_debug("Clone %p from %p\n",(void*)aTHX,(void*)proto);
     while ((f = *table)) {
            int i;
-           table = (PerlIO **) (f++);
+           table = (PerlIOl **) (f++);
            for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
-               if (*f) {
-                   (void) fp_dup(f, 0, param);
+               if (f->next) {
+                   (void) fp_dup(&(f->next), 0, param);
                }
                f++;
            }
@@ -697,16 +701,16 @@ void
 PerlIO_destruct(pTHX)
 {
     dVAR;
-    PerlIO **table = &PL_perlio;
-    PerlIO *f;
+    PerlIOl **table = &PL_perlio;
+    PerlIOl *f;
 #ifdef USE_ITHREADS
     PerlIO_debug("Destruct %p\n",(void*)aTHX);
 #endif
     while ((f = *table)) {
        int i;
-       table = (PerlIO **) (f++);
+       table = (PerlIOl **) (f++);
        for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
-           PerlIO *x = f;
+           PerlIO *x = &(f->next);
            const PerlIOl *l;
            while ((l = *x)) {
                if (l->tab->kind & PERLIO_K_DESTRUCT) {
@@ -1689,15 +1693,16 @@ Perl_PerlIO_flush(pTHX_ PerlIO *f)
         * things on fflush(NULL), but should we be bound by their design
         * decisions? --jhi
         */
-       PerlIO **table = &PL_perlio;
+       PerlIOl **table = &PL_perlio;
+       PerlIOl *ff;
        int code = 0;
-       while ((f = *table)) {
+       while ((ff = *table)) {
            int i;
-           table = (PerlIO **) (f++);
+           table = (PerlIOl **) (ff++);
            for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
-               if (*f && PerlIO_flush(f) != 0)
+               if (ff->next && PerlIO_flush(&(ff->next)) != 0)
                    code = -1;
-               f++;
+               ff++;
            }
        }
        return code;
@@ -1708,17 +1713,17 @@ void
 PerlIOBase_flush_linebuf(pTHX)
 {
     dVAR;
-    PerlIO **table = &PL_perlio;
-    PerlIO *f;
+    PerlIOl **table = &PL_perlio;
+    PerlIOl *f;
     while ((f = *table)) {
        int i;
-       table = (PerlIO **) (f++);
+       table = (PerlIOl **) (f++);
        for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
-           if (*f
-               && (PerlIOBase(f)->
+           if (f->next
+               && (PerlIOBase(&(f->next))->
                    flags & (PERLIO_F_LINEBUF | PERLIO_F_CANWRITE))
                == (PERLIO_F_LINEBUF | PERLIO_F_CANWRITE))
-               PerlIO_flush(f);
+               PerlIO_flush(&(f->next));
            f++;
        }
     }
@@ -4988,7 +4993,7 @@ Perl_PerlIO_stdin(pTHX)
     if (!PL_perlio) {
        PerlIO_stdstreams(aTHX);
     }
-    return &PL_perlio[1];
+    return (PerlIO*)&PL_perlio[1];
 }
 
 PerlIO *
@@ -4998,7 +5003,7 @@ Perl_PerlIO_stdout(pTHX)
     if (!PL_perlio) {
        PerlIO_stdstreams(aTHX);
     }
-    return &PL_perlio[2];
+    return (PerlIO*)&PL_perlio[2];
 }
 
 PerlIO *
@@ -5008,7 +5013,7 @@ Perl_PerlIO_stderr(pTHX)
     if (!PL_perlio) {
        PerlIO_stdstreams(aTHX);
     }
-    return &PL_perlio[3];
+    return (PerlIO*)&PL_perlio[3];
 }
 
 /*--------------------------------------------------------------------------------------*/
index 6b714bb..d3053a1 100644 (file)
--- a/perliol.h
+++ b/perliol.h
@@ -150,7 +150,7 @@ PERL_EXPORT_C PerlIO_funcs *PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, Pe
 
 
 PERL_EXPORT_C SV *PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param);
-PERL_EXPORT_C void PerlIO_cleantable(pTHX_ PerlIO **tablep);
+PERL_EXPORT_C void PerlIO_cleantable(pTHX_ PerlIOl **tablep);
 PERL_EXPORT_C SV * PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab);
 PERL_EXPORT_C void PerlIO_default_buffer(pTHX_ PerlIO_list_t *av);
 PERL_EXPORT_C void PerlIO_stdstreams(pTHX);