#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)
#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)
#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)
#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)
#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)
#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
#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)
#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
=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>.
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 */
/*
=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
}
}
return 0;
- case ',':
- return (STRLEN)PL_ofslen;
- case '\\':
- return (STRLEN)PL_orslen;
}
magic_get(sv,mg);
if (!SvPOK(sv) && SvNIOK(sv)) {
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);
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)
/* 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;
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':
#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
#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
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 */
}
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;
}
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)
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
*/
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
*/
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 */
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);
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 *)
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);
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",
projects / p5sagit/p5-mst-13.2.git / commitdiff