diff options
| -rw-r--r-- | embedvar.h | 24 | ||||
| -rw-r--r-- | intrpvar.h | 11 | ||||
| -rw-r--r-- | mg.c | 27 | ||||
| -rw-r--r-- | perl.c | 28 | ||||
| -rw-r--r-- | perlapi.h | 12 | ||||
| -rw-r--r-- | pp_hot.c | 10 | ||||
| -rw-r--r-- | sv.c | 10 | ||||
| -rw-r--r-- | thrdvar.h | 3 | ||||
| -rw-r--r-- | util.c | 5 |
9 files changed, 55 insertions, 75 deletions
diff --git a/embedvar.h b/embedvar.h index 729389c17a..fddcd12733 100644 --- a/embedvar.h +++ b/embedvar.h @@ -70,8 +70,7 @@ #define PL_modcount (vTHX->Tmodcount) #define PL_na (vTHX->Tna) #define PL_nrs (vTHX->Tnrs) -#define PL_ofs (vTHX->Tofs) -#define PL_ofslen (vTHX->Tofslen) +#define PL_ofs_sv (vTHX->Tofs_sv) #define PL_op (vTHX->Top) #define PL_opsave (vTHX->Topsave) #define PL_protect (vTHX->Tprotect) @@ -341,8 +340,7 @@ #define PL_origargv (PERL_GET_INTERP->Iorigargv) #define PL_origenviron (PERL_GET_INTERP->Iorigenviron) #define PL_origfilename (PERL_GET_INTERP->Iorigfilename) -#define PL_ors (PERL_GET_INTERP->Iors) -#define PL_orslen (PERL_GET_INTERP->Iorslen) +#define PL_ors_sv (PERL_GET_INTERP->Iors_sv) #define PL_osname (PERL_GET_INTERP->Iosname) #define PL_pad_reset_pending (PERL_GET_INTERP->Ipad_reset_pending) #define PL_padix (PERL_GET_INTERP->Ipadix) @@ -621,8 +619,7 @@ #define PL_origargv (vTHX->Iorigargv) #define PL_origenviron (vTHX->Iorigenviron) #define PL_origfilename (vTHX->Iorigfilename) -#define PL_ors (vTHX->Iors) -#define PL_orslen (vTHX->Iorslen) +#define PL_ors_sv (vTHX->Iors_sv) #define PL_osname (vTHX->Iosname) #define PL_pad_reset_pending (vTHX->Ipad_reset_pending) #define PL_padix (vTHX->Ipadix) @@ -775,8 +772,7 @@ #define PL_modcount (aTHXo->interp.Tmodcount) #define PL_na (aTHXo->interp.Tna) #define PL_nrs (aTHXo->interp.Tnrs) -#define PL_ofs (aTHXo->interp.Tofs) -#define PL_ofslen (aTHXo->interp.Tofslen) +#define PL_ofs_sv (aTHXo->interp.Tofs_sv) #define PL_op (aTHXo->interp.Top) #define PL_opsave (aTHXo->interp.Topsave) #define PL_protect (aTHXo->interp.Tprotect) @@ -1038,8 +1034,7 @@ #define PL_origargv (aTHXo->interp.Iorigargv) #define PL_origenviron (aTHXo->interp.Iorigenviron) #define PL_origfilename (aTHXo->interp.Iorigfilename) -#define PL_ors (aTHXo->interp.Iors) -#define PL_orslen (aTHXo->interp.Iorslen) +#define PL_ors_sv (aTHXo->interp.Iors_sv) #define PL_osname (aTHXo->interp.Iosname) #define PL_pad_reset_pending (aTHXo->interp.Ipad_reset_pending) #define PL_padix (aTHXo->interp.Ipadix) @@ -1319,8 +1314,7 @@ #define PL_Iorigargv PL_origargv #define PL_Iorigenviron PL_origenviron #define PL_Iorigfilename PL_origfilename -#define PL_Iors PL_ors -#define PL_Iorslen PL_orslen +#define PL_Iors_sv PL_ors_sv #define PL_Iosname PL_osname #define PL_Ipad_reset_pending PL_pad_reset_pending #define PL_Ipadix PL_padix @@ -1469,8 +1463,7 @@ #define PL_modcount (aTHX->Tmodcount) #define PL_na (aTHX->Tna) #define PL_nrs (aTHX->Tnrs) -#define PL_ofs (aTHX->Tofs) -#define PL_ofslen (aTHX->Tofslen) +#define PL_ofs_sv (aTHX->Tofs_sv) #define PL_op (aTHX->Top) #define PL_opsave (aTHX->Topsave) #define PL_protect (aTHX->Tprotect) @@ -1606,8 +1599,7 @@ #define PL_Tmodcount PL_modcount #define PL_Tna PL_na #define PL_Tnrs PL_nrs -#define PL_Tofs PL_ofs -#define PL_Tofslen PL_ofslen +#define PL_Tofs_sv PL_ofs_sv #define PL_Top PL_op #define PL_Topsave PL_opsave #define PL_Tprotect PL_protect diff --git a/intrpvar.h b/intrpvar.h index 07ec33ede6..e9c3797be7 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -97,7 +97,7 @@ C<PL_DBsingle>. =for apidoc Amn|SV *|PL_DBsingle When Perl is run in debugging mode, with the B<-d> switch, this SV is a -boolean which indicates whether subs are being single-stepped. +boolean which indicates whether subs are being single-stepped. Single-stepping is automatically turned on after every step. This is the C variable which corresponds to Perl's $DB::single variable. See C<PL_DBsub>. @@ -169,8 +169,7 @@ PERLVARI(Ilaststype, I32, OP_STAT) PERLVAR(Imess_sv, SV *) /* XXX shouldn't these be per-thread? --GSAR */ -PERLVAR(Iors, char *) /* output record separator $\ */ -PERLVAR(Iorslen, STRLEN) +PERLVAR(Iors_sv, SV *) /* output record separator $\ */ PERLVAR(Iofmt, char *) /* output format for numbers $# */ /* interpreter atexit processing */ @@ -181,10 +180,10 @@ PERLVARI(Iexitlistlen, I32, 0) /* length of same */ /* =for apidoc Amn|HV*|PL_modglobal -C<PL_modglobal> is a general purpose, interpreter global HV for use by +C<PL_modglobal> is a general purpose, interpreter global HV for use by extensions that need to keep information on a per-interpreter basis. -In a pinch, it can also be used as a symbol table for extensions -to share data among each other. It is a good idea to use keys +In a pinch, it can also be used as a symbol table for extensions +to share data among each other. It is a good idea to use keys prefixed by the package name of the extension that owns the data. =cut @@ -444,10 +444,6 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg) } } return 0; - case ',': - return (STRLEN)PL_ofslen; - case '\\': - return (STRLEN)PL_orslen; } magic_get(sv,mg); if (!SvPOK(sv) && SvNIOK(sv)) { @@ -719,10 +715,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setiv(sv, (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0 ); break; case ',': - sv_setpvn(sv,PL_ofs,PL_ofslen); break; case '\\': - sv_setpvn(sv,PL_ors,PL_orslen); break; case '#': sv_setpv(sv,PL_ofmt); @@ -1817,21 +1811,24 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_rs = SvREFCNT_inc(PL_nrs); break; case '\\': - if (PL_ors) - Safefree(PL_ors); + if (PL_ors_sv) + SvREFCNT_dec(PL_ors_sv); if (SvOK(sv) || SvGMAGICAL(sv)) { - s = SvPV(sv,PL_orslen); - PL_ors = savepvn(s,PL_orslen); + PL_ors_sv = newSVsv(sv); } else { - PL_ors = Nullch; - PL_orslen = 0; + PL_ors_sv = Nullsv; } break; case ',': - if (PL_ofs) - Safefree(PL_ofs); - PL_ofs = savepv(SvPV(sv, PL_ofslen)); + if (PL_ofs_sv) + SvREFCNT_dec(PL_ofs_sv); + if (SvOK(sv) || SvGMAGICAL(sv)) { + PL_ofs_sv = newSVsv(sv); + } + else { + PL_ofs_sv = Nullsv; + } break; case '#': if (PL_ofmt) @@ -473,11 +473,11 @@ perl_destruct(pTHXx) /* magical thingies */ - Safefree(PL_ofs); /* $, */ - PL_ofs = Nullch; + SvREFCNT_dec(PL_ofs_sv); /* $, */ + PL_ofs_sv = Nullsv; - Safefree(PL_ors); /* $\ */ - PL_ors = Nullch; + SvREFCNT_dec(PL_ors_sv); /* $\ */ + PL_ors_sv = Nullsv; SvREFCNT_dec(PL_rs); /* $/ */ PL_rs = Nullsv; @@ -2157,23 +2157,23 @@ Perl_moreswitches(pTHX_ char *s) case 'l': PL_minus_l = TRUE; s++; - if (PL_ors) - Safefree(PL_ors); + if (PL_ors_sv) { + SvREFCNT_dec(PL_ors_sv); + PL_ors_sv = Nullsv; + } if (isDIGIT(*s)) { - PL_ors = savepv("\n"); - PL_orslen = 1; + PL_ors_sv = newSVpvn("\n",1); numlen = 0; /* disallow underscores */ - *PL_ors = (char)scan_oct(s, 3 + (*s == '0'), &numlen); + *SvPVX(PL_ors_sv) = (char)scan_oct(s, 3 + (*s == '0'), &numlen); s += numlen; } else { if (RsPARA(PL_nrs)) { - PL_ors = "\n\n"; - PL_orslen = 2; + PL_ors_sv = newSVpvn("\n\n",2); + } + else { + PL_ors_sv = newSVsv(PL_nrs); } - else - PL_ors = SvPV(PL_nrs, PL_orslen); - PL_ors = savepvn(PL_ors, PL_orslen); } return s; case 'M': @@ -420,10 +420,8 @@ START_EXTERN_C #define PL_origenviron (*Perl_Iorigenviron_ptr(aTHXo)) #undef PL_origfilename #define PL_origfilename (*Perl_Iorigfilename_ptr(aTHXo)) -#undef PL_ors -#define PL_ors (*Perl_Iors_ptr(aTHXo)) -#undef PL_orslen -#define PL_orslen (*Perl_Iorslen_ptr(aTHXo)) +#undef PL_ors_sv +#define PL_ors_sv (*Perl_Iors_sv_ptr(aTHXo)) #undef PL_osname #define PL_osname (*Perl_Iosname_ptr(aTHXo)) #undef PL_pad_reset_pending @@ -712,10 +710,8 @@ START_EXTERN_C #define PL_na (*Perl_Tna_ptr(aTHXo)) #undef PL_nrs #define PL_nrs (*Perl_Tnrs_ptr(aTHXo)) -#undef PL_ofs -#define PL_ofs (*Perl_Tofs_ptr(aTHXo)) -#undef PL_ofslen -#define PL_ofslen (*Perl_Tofslen_ptr(aTHXo)) +#undef PL_ofs_sv +#define PL_ofs_sv (*Perl_Tofs_sv_ptr(aTHXo)) #undef PL_op #define PL_op (*Perl_Top_ptr(aTHXo)) #undef PL_opsave @@ -152,7 +152,7 @@ PP(pp_concat) left_utf8 = DO_UTF8(left); right_utf8 = DO_UTF8(right); - + if (left_utf8 != right_utf8) { if (TARG == right && !right_utf8) { sv_utf8_upgrade(TARG); /* Now straight binary copy */ @@ -425,13 +425,13 @@ PP(pp_print) } else { MARK++; - if (PL_ofslen) { + if (PL_ofs_sv && SvOK(PL_ofs_sv)) { while (MARK <= SP) { if (!do_print(*MARK, fp)) break; MARK++; if (MARK <= SP) { - if (PerlIO_write(fp, PL_ofs, PL_ofslen) == 0 || PerlIO_error(fp)) { + if (!do_print(PL_ofs_sv, fp)) { /* $, */ MARK--; break; } @@ -448,8 +448,8 @@ PP(pp_print) if (MARK <= SP) goto just_say_no; else { - if (PL_orslen) - if (PerlIO_write(fp, PL_ors, PL_orslen) == 0 || PerlIO_error(fp)) + if (PL_ors_sv && SvOK(PL_ors_sv)) + if (!do_print(PL_ors_sv, fp)) /* $\ */ goto just_say_no; if (IoFLAGS(io) & IOf_FLUSH) @@ -5706,7 +5706,7 @@ as a reversal of C<newSVrv>. The C<cflags> argument can contain C<SV_IMMEDIATE_UNREF> to force the reference count to be decremented (otherwise the decrementing is conditional on the reference count being different from one or the reference being a readonly SV). -See C<SvROK_off>. +See C<SvROK_off>. =cut */ @@ -5736,7 +5736,7 @@ Perl_sv_unref_flags(pTHX_ SV *sv, U32 flags) Unsets the RV status of the SV, and decrements the reference count of whatever was being referenced by the RV. This can almost be thought of as a reversal of C<newSVrv>. This is C<sv_unref_flags> with the C<flag> -being zero. See C<SvROK_off>. +being zero. See C<SvROK_off>. =cut */ @@ -7948,8 +7948,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_laststype = proto_perl->Ilaststype; PL_mess_sv = Nullsv; - PL_orslen = proto_perl->Iorslen; - PL_ors = SAVEPVN(proto_perl->Iors, PL_orslen); + PL_ors_sv = sv_dup_inc(proto_perl->Iors_sv); PL_ofmt = SAVEPV(proto_perl->Iofmt); /* interpreter atexit processing */ @@ -8232,8 +8231,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_nrs = sv_dup_inc(proto_perl->Tnrs); PL_rs = sv_dup_inc(proto_perl->Trs); PL_last_in_gv = gv_dup(proto_perl->Tlast_in_gv); - PL_ofslen = proto_perl->Tofslen; - PL_ofs = SAVEPVN(proto_perl->Tofs, PL_ofslen); + PL_ofs_sv = sv_dup_inc(proto_perl->Tofs_sv); PL_defoutgv = gv_dup_inc(proto_perl->Tdefoutgv); PL_chopset = proto_perl->Tchopset; /* XXX never deallocated */ PL_toptarget = sv_dup_inc(proto_perl->Ttoptarget); @@ -84,8 +84,7 @@ PERLVAR(Tcurpm, PMOP *) /* what to do \ interps in REs from */ PERLVAR(Tnrs, SV *) PERLVAR(Trs, SV *) /* input record separator $/ */ PERLVAR(Tlast_in_gv, GV *) /* GV used in last <FH> */ -PERLVAR(Tofs, char *) /* output field separator $, */ -PERLVAR(Tofslen, STRLEN) +PERLVAR(Tofs_sv, SV *) /* output field separator $, */ PERLVAR(Tdefoutgv, GV *) /* default FH for output */ PERLVARI(Tchopset, char *, " \n-") /* $: */ PERLVAR(Tformtarget, SV *) @@ -3643,8 +3643,7 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t) PL_nrs = newSVsv(t->Tnrs); PL_rs = SvREFCNT_inc(PL_nrs); PL_last_in_gv = Nullgv; - PL_ofslen = t->Tofslen; - PL_ofs = savepvn(t->Tofs, PL_ofslen); + PL_ofs_sv = SvREFCNT_inc(PL_ofs_sv); PL_defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv); PL_chopset = t->Tchopset; PL_bodytarget = newSVsv(t->Tbodytarget); @@ -3961,7 +3960,7 @@ Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op) if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) { if (name && *name) Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for %sput", - name, + name, (op == OP_phoney_INPUT_ONLY ? "in" : "out")); else Perl_warner(aTHX_ WARN_IO, "Filehandle opened only for %sput", |