Document the bytes-to-Unicode upgrading.

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index f74adea..3426596 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2054,7 +2054,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
                ) {
                SvIOK_on(sv);  /* Can this go wrong with rounding? NWC */
                DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                     "0x%"UVxf" iv(%g => %"IVdf") (precise)\n",
+                                     "0x%"UVxf" iv(%"NVgf" => %"IVdf") (precise)\n",
                                      PTR2UV(sv),
                                      SvNVX(sv),
                                      SvIVX(sv)));
@@ -2065,7 +2065,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
                   that PV->IV would be better than PV->NV->IV
                   flags already correct - don't set public IOK.  */
                DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                     "0x%"UVxf" iv(%g => %"IVdf") (imprecise)\n",
+                                     "0x%"UVxf" iv(%"NVgf" => %"IVdf") (imprecise)\n",
                                      PTR2UV(sv),
                                      SvNVX(sv),
                                      SvIVX(sv)));
@@ -2348,7 +2348,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
                ) {
                SvIOK_on(sv);  /* Can this go wrong with rounding? NWC */
                DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                     "0x%"UVxf" uv(%g => %"IVdf") (precise)\n",
+                                     "0x%"UVxf" uv(%"NVgf" => %"IVdf") (precise)\n",
                                      PTR2UV(sv),
                                      SvNVX(sv),
                                      SvIVX(sv)));
@@ -2359,7 +2359,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
                   that PV->IV would be better than PV->NV->IV
                   flags already correct - don't set public IOK.  */
                DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                     "0x%"UVxf" uv(%g => %"IVdf") (imprecise)\n",
+                                     "0x%"UVxf" uv(%"NVgf" => %"IVdf") (imprecise)\n",
                                      PTR2UV(sv),
                                      SvNVX(sv),
                                      SvIVX(sv)));
@@ -6050,8 +6050,9 @@ Perl_sv_dec(pTHX_ register SV *sv)
 =for apidoc sv_mortalcopy
 
 Creates a new SV which is a copy of the original SV (using C<sv_setsv>).
-The new SV is marked as mortal. It will be destroyed when the current
-context ends.  See also C<sv_newmortal> and C<sv_2mortal>.
+The new SV is marked as mortal. It will be destroyed "soon", either by an
+explicit call to FREETMPS, or by an implicit call at places such as
+statement boundaries.  See also C<sv_newmortal> and C<sv_2mortal>.
 
 =cut
 */
@@ -6078,8 +6079,9 @@ Perl_sv_mortalcopy(pTHX_ SV *oldstr)
 =for apidoc sv_newmortal
 
 Creates a new null SV which is mortal.  The reference count of the SV is
-set to 1. It will be destroyed when the current context ends.  See
-also C<sv_mortalcopy> and C<sv_2mortal>.
+set to 1. It will be destroyed "soon", either by an explicit call to
+FREETMPS, or by an implicit call at places such as statement boundaries.
+See also C<sv_mortalcopy> and C<sv_2mortal>.
 
 =cut
 */
@@ -6099,8 +6101,9 @@ Perl_sv_newmortal(pTHX)
 /*
 =for apidoc sv_2mortal
 
-Marks an existing SV as mortal.  The SV will be destroyed when the current
-context ends. See also C<sv_newmortal> and C<sv_mortalcopy>.
+Marks an existing SV as mortal.  The SV will be destroyed "soon", either
+by an explicit call to FREETMPS, or by an implicit call at places such as
+statement boundaries.  See also C<sv_newmortal> and C<sv_mortalcopy>.
 
 =cut
 */
@@ -8400,6 +8403,10 @@ Perl_re_dup(pTHX_ REGEXP *r, clone_params *param)
                ret->regstclass = (regnode*)d->data[i];
                break;
            case 'o':
+               /* Compiled op trees are readonly, and can thus be
+                  shared without duplication. */
+               d->data[i] = (void*)OpREFCNT_inc((OP*)r->data->data[i]);
+               break;
            case 'n':
                d->data[i] = r->data->data[i];
                break;
@@ -9083,6 +9090,11 @@ Perl_sv_dup(pTHX_ SV *sstr, clone_params* param)
        CvROOT(dstr)    = OpREFCNT_inc(CvROOT(sstr));
        CvXSUB(dstr)    = CvXSUB(sstr);
        CvXSUBANY(dstr) = CvXSUBANY(sstr);
+       if (CvCONST(sstr)) {
+           CvXSUBANY(dstr).any_ptr = GvUNIQUE(CvGV(sstr)) ?
+                SvREFCNT_inc(CvXSUBANY(sstr).any_ptr) :
+                sv_dup_inc(CvXSUBANY(sstr).any_ptr, param);
+       }
        CvGV(dstr)      = gv_dup(CvGV(sstr), param);
        if (param->flags & CLONEf_COPY_STACKS) {
          CvDEPTH(dstr) = CvDEPTH(sstr);
@@ -9298,7 +9310,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, clone_params* param)
     GP *gp;
     IV iv;
     I32 i;
-    char *c;
+    char *c = NULL;
     void (*dptr) (void*);
     void (*dxptr) (pTHXo_ void*);
     OP *o;
@@ -9542,6 +9554,8 @@ Create and return a new interpreter by cloning the current one.
 */
 
 /* XXX the above needs expanding by someone who actually understands it ! */
+EXTERN_C PerlInterpreter *
+perl_clone_host(PerlInterpreter* proto_perl, UV flags);
 
 PerlInterpreter *
 perl_clone(PerlInterpreter *proto_perl, UV flags)
@@ -9924,7 +9938,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_origalen                = proto_perl->Iorigalen;
     PL_pidstatus       = newHV();                      /* XXX flag for cloning? */
     PL_osname          = SAVEPV(proto_perl->Iosname);
-    PL_sh_path         = SAVEPV(proto_perl->Ish_path);
+    PL_sh_path         = proto_perl->Ish_path; /* XXX never deallocated */
     PL_sighandlerp     = proto_perl->Isighandlerp;
 
 
@@ -9934,7 +9948,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
 #ifdef CSH
     PL_cshlen          = proto_perl->Icshlen;
-    PL_cshname         = SAVEPVN(proto_perl->Icshname, PL_cshlen);
+    PL_cshname         = proto_perl->Icshname; /* XXX never deallocated */
 #endif
 
     PL_lex_state       = proto_perl->Ilex_state;
@@ -10265,6 +10279,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_reginterp_cnt   = 0;
     PL_reg_starttry    = 0;
 
+    /* Pluggable optimizer */
+    PL_peepp           = proto_perl->Tpeepp;
+
     if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
         ptr_table_free(PL_ptr_table);
         PL_ptr_table = NULL;