UTF8 output prework.

 - Store $\ and $, as SVs so they can have SvUTF8 flag
 - use do_print() rather than raw PerlIO_write() to print them.

p4raw-id: //depot/perlio@8049

diff --git a/embedvar.h b/embedvar.h
index 729389c..fddcd12 100644 (file)
--- 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 07ec33e..e9c3797 100644 (file)
--- 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

diff --git a/mg.c b/mg.c
index 52e1b0d..f97c6ce 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -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)

diff --git a/perl.c b/perl.c
index 7064e2b..eabe43c 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -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':

diff --git a/perlapi.h b/perlapi.h
index 2d210ee..a856dde 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -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

diff --git a/pp_hot.c b/pp_hot.c
index 4020f20..979d111 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -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)

diff --git a/sv.c b/sv.c
index 2691430..87da8f7 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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);

diff --git a/thrdvar.h b/thrdvar.h
index 06cfe72..7f591d9 100644 (file)
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -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 *)

diff --git a/util.c b/util.c
index d0ea96c..0dd9fad 100644 (file)
--- a/util.c
+++ b/util.c
@@ -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",