PerlIO layer table as PL_perlio (per-interpreter)

p4raw-id: //depot/perlio@12544

diff --git a/embed.h b/embed.h
index 58c3b59..b591206 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1197,6 +1197,7 @@
 #define ck_concat              Perl_ck_concat
 #define ck_defined             Perl_ck_defined
 #define ck_delete              Perl_ck_delete
+#define ck_die                 Perl_ck_die
 #define ck_eof                 Perl_ck_eof
 #define ck_eval                        Perl_ck_eval
 #define ck_exec                        Perl_ck_exec
@@ -2699,6 +2700,7 @@
 #define ck_concat(a)           Perl_ck_concat(aTHX_ a)
 #define ck_defined(a)          Perl_ck_defined(aTHX_ a)
 #define ck_delete(a)           Perl_ck_delete(aTHX_ a)
+#define ck_die(a)              Perl_ck_die(aTHX_ a)
 #define ck_eof(a)              Perl_ck_eof(aTHX_ a)
 #define ck_eval(a)             Perl_ck_eval(aTHX_ a)
 #define ck_exec(a)             Perl_ck_exec(aTHX_ a)

diff --git a/embedvar.h b/embedvar.h
index 26c0eb1..066bec4 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -350,6 +350,7 @@
 #define PL_pending_ident       (PERL_GET_INTERP->Ipending_ident)
 #define PL_perl_destruct_level (PERL_GET_INTERP->Iperl_destruct_level)
 #define PL_perldb              (PERL_GET_INTERP->Iperldb)
+#define PL_perlio              (PERL_GET_INTERP->Iperlio)
 #define PL_pidstatus           (PERL_GET_INTERP->Ipidstatus)
 #define PL_preambleav          (PERL_GET_INTERP->Ipreambleav)
 #define PL_preambled           (PERL_GET_INTERP->Ipreambled)
@@ -638,6 +639,7 @@
 #define PL_pending_ident       (vTHX->Ipending_ident)
 #define PL_perl_destruct_level (vTHX->Iperl_destruct_level)
 #define PL_perldb              (vTHX->Iperldb)
+#define PL_perlio              (vTHX->Iperlio)
 #define PL_pidstatus           (vTHX->Ipidstatus)
 #define PL_preambleav          (vTHX->Ipreambleav)
 #define PL_preambled           (vTHX->Ipreambled)
@@ -929,6 +931,7 @@
 #define PL_Ipending_ident      PL_pending_ident
 #define PL_Iperl_destruct_level        PL_perl_destruct_level
 #define PL_Iperldb             PL_perldb
+#define PL_Iperlio             PL_perlio
 #define PL_Ipidstatus          PL_pidstatus
 #define PL_Ipreambleav         PL_preambleav
 #define PL_Ipreambled          PL_preambled
@@ -1321,7 +1324,6 @@
 #define PL_do_undump           (PL_Vars.Gdo_undump)
 #define PL_hexdigit            (PL_Vars.Ghexdigit)
 #define PL_malloc_mutex                (PL_Vars.Gmalloc_mutex)
-#define PL_my_inv_rand_max     (PL_Vars.Gmy_inv_rand_max)
 #define PL_op_mutex            (PL_Vars.Gop_mutex)
 #define PL_patleave            (PL_Vars.Gpatleave)
 #define PL_sharedsv_space      (PL_Vars.Gsharedsv_space)
@@ -1336,7 +1338,6 @@
 #define PL_Gdo_undump          PL_do_undump
 #define PL_Ghexdigit           PL_hexdigit
 #define PL_Gmalloc_mutex       PL_malloc_mutex
-#define PL_Gmy_inv_rand_max    PL_my_inv_rand_max
 #define PL_Gop_mutex           PL_op_mutex
 #define PL_Gpatleave           PL_patleave
 #define PL_Gsharedsv_space     PL_sharedsv_space

diff --git a/intrpvar.h b/intrpvar.h
index 681fb6d..b6b4f07 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -493,6 +493,12 @@ PERLVAR(Isavebegin,     bool)      /* save BEGINs for compiler     */
 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)
+#endif
+
 /* New variables must be added to the very end for binary compatibility.
  * XSUB.h provides wrapper functions via perlapi.h that make this
  * irrelevant, but not all code may be expected to #include XSUB.h. */
+
+

diff --git a/perlapi.h b/perlapi.h
index 4d7a521..ffe9741 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -437,6 +437,8 @@ END_EXTERN_C
 #define PL_perl_destruct_level (*Perl_Iperl_destruct_level_ptr(aTHX))
 #undef  PL_perldb
 #define PL_perldb              (*Perl_Iperldb_ptr(aTHX))
+#undef  PL_perlio
+#define PL_perlio              (*Perl_Iperlio_ptr(aTHX))
 #undef  PL_pidstatus
 #define PL_pidstatus           (*Perl_Ipidstatus_ptr(aTHX))
 #undef  PL_preambleav
@@ -923,8 +925,6 @@ END_EXTERN_C
 #define PL_hexdigit            (*Perl_Ghexdigit_ptr(NULL))
 #undef  PL_malloc_mutex
 #define PL_malloc_mutex                (*Perl_Gmalloc_mutex_ptr(NULL))
-#undef  PL_my_inv_rand_max
-#define PL_my_inv_rand_max     (*Perl_Gmy_inv_rand_max_ptr(NULL))
 #undef  PL_op_mutex
 #define PL_op_mutex            (*Perl_Gop_mutex_ptr(NULL))
 #undef  PL_patleave

diff --git a/perlio.c b/perlio.c
index f1cddb3..793a4e8 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -405,11 +405,8 @@ PerlIO_debug(const char *fmt, ...)
 /*
  * Table of pointers to the PerlIO structs (malloc'ed)
  */
-PerlIO *_perlio = NULL;
 #define PERLIO_TABLE_SIZE 64
 
-
-
 PerlIO *
 PerlIO_allocate(pTHX)
 {
@@ -418,7 +415,7 @@ PerlIO_allocate(pTHX)
      */
     PerlIO **last;
     PerlIO *f;
-    last = &_perlio;
+    last = &PL_perlio;
     while ((f = *last)) {
        int i;
        last = (PerlIO **) (f);
@@ -436,6 +433,42 @@ PerlIO_allocate(pTHX)
     return f + 1;
 }
 
+#undef PerlIO_fdupopen
+PerlIO *
+PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
+{
+    if (f && *f) {
+       PerlIO_funcs *tab = PerlIOBase(f)->tab;
+       PerlIO *new;
+       PerlIO_debug("fdupopen f=%p param=%p\n",f,param);
+        new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param);
+       return new;
+    }
+    else {
+       SETERRNO(EBADF, SS$_IVCHAN);
+       return NULL;
+    }
+}
+
+void
+PerlIO_clone(pTHX_ PerlIO *proto, CLONE_PARAMS *param)
+{
+    PerlIO **table = &proto;
+    PerlIO *f;
+    PL_perlio = NULL;
+    PerlIO_allocate(aTHX); /* root slot is never used */
+    while ((f = *table)) {
+           int i;
+           table = (PerlIO **) (f++);
+           for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
+               if (*f) {
+                   PerlIO_fdupopen(aTHX_ f, param);
+               }
+               f++;
+           }
+       }
+}
+
 void
 PerlIO_cleantable(pTHX_ PerlIO **tablep)
 {
@@ -518,13 +551,13 @@ void
 PerlIO_cleanup()
 {
     dTHX;
-    PerlIO_cleantable(aTHX_ & _perlio);
+    PerlIO_cleantable(aTHX_ &PL_perlio);
 }
 
 void
 PerlIO_destruct(pTHX)
 {
-    PerlIO **table = &_perlio;
+    PerlIO **table = &PL_perlio;
     PerlIO *f;
     while ((f = *table)) {
        int i;
@@ -904,7 +937,7 @@ PerlIO_default_layer(pTHX_ I32 n)
 void
 PerlIO_stdstreams(pTHX)
 {
-    if (!_perlio) {
+    if (!PL_perlio) {
        PerlIO_allocate(aTHX);
        PerlIO_fdopen(0, "Ir" PERLIO_STDTEXT);
        PerlIO_fdopen(1, "Iw" PERLIO_STDTEXT);
@@ -1051,23 +1084,6 @@ PerlIO__close(PerlIO *f)
     }
 }
 
-#undef PerlIO_fdupopen
-PerlIO *
-PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
-{
-    if (f && *f) {
-       PerlIO_funcs *tab = PerlIOBase(f)->tab;
-       PerlIO *new;
-       PerlIO_debug("fdupopen f=%p param=%p\n",f,param);
-        new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param);
-       return new;
-    }
-    else {
-       SETERRNO(EBADF, SS$_IVCHAN);
-       return NULL;
-    }
-}
-
 #undef PerlIO_close
 int
 PerlIO_close(PerlIO *f)
@@ -1152,7 +1168,7 @@ PerlIO_resolve_layers(pTHX_ const char *layers,
 {
     PerlIO_list_t *def = PerlIO_default_layers(aTHX);
     int incdef = 1;
-    if (!_perlio)
+    if (!PL_perlio)
        PerlIO_stdstreams(aTHX);
     if (narg) {
        SV *arg = *args;
@@ -1389,7 +1405,8 @@ PerlIO_flush(PerlIO *f)
         * things on fflush(NULL), but should we be bound by their design
         * decisions? --jhi
         */
-       PerlIO **table = &_perlio;
+       dTHX;
+       PerlIO **table = &PL_perlio;
        int code = 0;
        while ((f = *table)) {
            int i;
@@ -1407,7 +1424,8 @@ PerlIO_flush(PerlIO *f)
 void
 PerlIOBase_flush_linebuf()
 {
-    PerlIO **table = &_perlio;
+    dTHX;
+    PerlIO **table = &PL_perlio;
     PerlIO *f;
     while ((f = *table)) {
        int i;
@@ -3093,7 +3111,7 @@ PerlIOBuf_get_base(PerlIO *f)
     if (!b->buf) {
        if (!b->bufsiz)
            b->bufsiz = 4096;
-       b->buf = 
+       b->buf =
        Newz('B',b->buf,b->bufsiz, STDCHAR);
        if (!b->buf) {
            b->buf = (STDCHAR *) & b->oneword;
@@ -3902,7 +3920,7 @@ PerlIO_init(void)
 #ifndef WIN32
     call_atexit(PerlIO_cleanup_layers, NULL);
 #endif
-    if (!_perlio) {
+    if (!PL_perlio) {
 #ifndef WIN32
        atexit(&PerlIO_cleanup);
 #endif
@@ -3913,33 +3931,33 @@ PerlIO_init(void)
 PerlIO *
 PerlIO_stdin(void)
 {
-    if (!_perlio) {
-       dTHX;
+    dTHX;
+    if (!PL_perlio) {
        PerlIO_stdstreams(aTHX);
     }
-    return &_perlio[1];
+    return &PL_perlio[1];
 }
 
 #undef PerlIO_stdout
 PerlIO *
 PerlIO_stdout(void)
 {
-    if (!_perlio) {
-       dTHX;
+    dTHX;
+    if (!PL_perlio) {
        PerlIO_stdstreams(aTHX);
     }
-    return &_perlio[2];
+    return &PL_perlio[2];
 }
 
 #undef PerlIO_stderr
 PerlIO *
 PerlIO_stderr(void)
 {
-    if (!_perlio) {
-       dTHX;
+    dTHX;
+    if (!PL_perlio) {
        PerlIO_stdstreams(aTHX);
     }
-    return &_perlio[3];
+    return &PL_perlio[3];
 }
 
 /*--------------------------------------------------------------------------------------*/

diff --git a/perlio.h b/perlio.h
index c5a25f3..7fa171b 100644 (file)
--- a/perlio.h
+++ b/perlio.h
@@ -93,6 +93,7 @@ extern PerlIO_funcs *PerlIO_find_layer(pTHX_ const char *name, STRLEN len,
 extern PerlIO *PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab,
                           const char *mode, SV *arg);
 extern void PerlIO_pop(pTHX_ PerlIO *f);
+extern void PerlIO_clone(pTHX_ PerlIO *proto, CLONE_PARAMS *param);
 
 #endif                         /* PerlIO */
 

diff --git a/pod/perlapi.pod b/pod/perlapi.pod
index 6665191..75defb8 100644 (file)
--- a/pod/perlapi.pod
+++ b/pod/perlapi.pod
@@ -329,7 +329,7 @@ L<perlsub/"Constant Functions">.
        SV*     cv_const_sv(CV* cv)
 
 =for hackers
-Found in file opmini.c
+Found in file op.c
 
 =item dAX
 
@@ -1234,7 +1234,7 @@ method, similar to C<use Foo::Bar VERSION LIST>.
        void    load_module(U32 flags, SV* name, SV* ver, ...)
 
 =for hackers
-Found in file opmini.c
+Found in file op.c
 
 =item looks_like_number
 
@@ -1373,7 +1373,7 @@ eligible for inlining at compile-time.
        CV*     newCONSTSUB(HV* stash, char* name, SV* sv)
 
 =for hackers
-Found in file opmini.c
+Found in file op.c
 
 =item newHV
 
@@ -1533,7 +1533,7 @@ Found in file sv.c
 Used by C<xsubpp> to hook up XSUBs as Perl subs.
 
 =for hackers
-Found in file opmini.c
+Found in file op.c
 
 =item newXSproto
 
@@ -2397,22 +2397,22 @@ which guarantees to evaluate sv only once.
 =for hackers
 Found in file sv.h
 
-=item SvNVx
+=item SvNVX
 
-Coerces the given SV to a double and returns it. Guarantees to evaluate
-sv only once. Use the more efficent C<SvNV> otherwise.
+Returns the raw value in the SV's NV slot, without checks or conversions.
+Only use when you are sure SvNOK is true. See also C<SvNV()>.
 
-       NV      SvNVx(SV* sv)
+       NV      SvNVX(SV* sv)
 
 =for hackers
 Found in file sv.h
 
-=item SvNVX
+=item SvNVx
 
-Returns the raw value in the SV's NV slot, without checks or conversions.
-Only use when you are sure SvNOK is true. See also C<SvNV()>.
+Coerces the given SV to a double and returns it. Guarantees to evaluate
+sv only once. Use the more efficent C<SvNV> otherwise.
 
-       NV      SvNVX(SV* sv)
+       NV      SvNVx(SV* sv)
 
 =for hackers
 Found in file sv.h
@@ -2950,22 +2950,22 @@ for a version which guarantees to evaluate sv only once.
 =for hackers
 Found in file sv.h
 
-=item SvUVX
+=item SvUVx
 
-Returns the raw value in the SV's UV slot, without checks or conversions.
-Only use when you are sure SvIOK is true. See also C<SvUV()>.
+Coerces the given SV to an unsigned integer and returns it. Guarantees to
+evaluate sv only once. Use the more efficent C<SvUV> otherwise.
 
-       UV      SvUVX(SV* sv)
+       UV      SvUVx(SV* sv)
 
 =for hackers
 Found in file sv.h
 
-=item SvUVx
+=item SvUVX
 
-Coerces the given SV to an unsigned integer and returns it. Guarantees to
-evaluate sv only once. Use the more efficent C<SvUV> otherwise.
+Returns the raw value in the SV's UV slot, without checks or conversions.
+Only use when you are sure SvIOK is true. See also C<SvUV()>.
 
-       UV      SvUVx(SV* sv)
+       UV      SvUVX(SV* sv)
 
 =for hackers
 Found in file sv.h

diff --git a/sv.c b/sv.c
index 8ddbfa9..3ab9f05 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -9765,9 +9765,12 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
        PL_origargv[i]  = SAVEPV(proto_perl->Iorigargv[i]);
     }
 
-
     param->stashes      = newAV();  /* Setup array of objects to call clone on */
 
+#ifdef PERLIO_LAYERS
+    /* Clone PerlIO table as soon as we can handle general xx_dup() */
+    PerlIO_clone(aTHX_ proto_perl->Iperlio, param);
+#endif
 
     PL_envgv           = gv_dup(proto_perl->Ienvgv, param);
     PL_incgv           = gv_dup(proto_perl->Iincgv, param);