diff options
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | embedvar.h | 5 | ||||
| -rw-r--r-- | intrpvar.h | 6 | ||||
| -rw-r--r-- | perlapi.h | 4 | ||||
| -rw-r--r-- | perlio.c | 94 | ||||
| -rw-r--r-- | perlio.h | 1 | ||||
| -rw-r--r-- | pod/perlapi.pod | 40 | ||||
| -rw-r--r-- | sv.c | 5 |
8 files changed, 94 insertions, 63 deletions
@@ -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 26c0eb12a6..066bec428c 100644 --- 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 681fb6d3c7..b6b4f07388 100644 --- 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. */ + + @@ -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 @@ -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]; } /*--------------------------------------------------------------------------------------*/ @@ -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 6665191a81..75defb8929 100644 --- 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 @@ -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); |