#endif
Renew(s,newlen,char);
}
- else
- New(703,s,newlen,char);
+ else {
+ /* sv_force_normal_flags() must not try to unshare the new
+ PVX we allocate below. AMS 20010713 */
+ if (SvREADONLY(sv) && SvFAKE(sv)) {
+ SvFAKE_off(sv);
+ SvREADONLY_off(sv);
+ }
+ New(703, s, newlen, char);
+ }
SvPV_set(sv, s);
SvLEN_set(sv, newlen);
}
) {
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)));
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)));
) {
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)));
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)));
if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTES) {
bool is_utf8 = TRUE;
/* UTF-8ness differs */
- if (PL_hints & HINT_UTF8_DISTINCT)
- return FALSE;
if (SvUTF8(sv1)) {
/* sv1 is the UTF-8 one , If is equal it must be downgrade-able */
/* do not utf8ize the comparands as a side-effect */
if (cur1 && cur2 && SvUTF8(sv1) != SvUTF8(sv2) && !IN_BYTES) {
- if (PL_hints & HINT_UTF8_DISTINCT)
- return SvUTF8(sv1) ? 1 : -1;
-
if (SvUTF8(sv1)) {
pv2 = (char*)bytes_to_utf8((U8*)pv2, &cur2);
pv2tmp = TRUE;
=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
*/
=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
*/
/*
=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
*/
register SV *sv;
bool is_utf8 = FALSE;
if (len < 0) {
- len = -len;
+ STRLEN tmplen = -len;
is_utf8 = TRUE;
- }
- if (is_utf8 && !(PL_hints & HINT_UTF8_DISTINCT)) {
- STRLEN tmplen = len;
/* See the note in hv.c:hv_fetch() --jhi */
src = (char*)bytes_from_utf8((U8*)src, &tmplen, &is_utf8);
len = tmplen;
New(0, ret->endp, npar, I32);
Copy(r->startp, ret->startp, npar, I32);
- if (r->regstclass) {
- New(0, ret->regstclass, 1, regnode);
- ret->regstclass->flags = r->regstclass->flags;
- }
- else
- ret->regstclass = NULL;
-
New(0, ret->substrs, 1, struct reg_substr_data);
for (s = ret->substrs->data, i = 0; i < 3; i++, s++) {
s->min_offset = r->substrs->data[i].min_offset;
s->substr = sv_dup_inc(r->substrs->data[i].substr, param);
}
+ ret->regstclass = NULL;
if (r->data) {
struct reg_data *d;
int count = r->data->count;
New(0, d->data[i], 1, struct regnode_charclass_class);
StructCopy(r->data->data[i], d->data[i],
struct regnode_charclass_class);
+ 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;
Copy(r->offsets, ret->offsets, 2*len+1, U32);
ret->precomp = SAVEPV(r->precomp);
- ret->subbeg = SAVEPV(r->subbeg);
- ret->sublen = r->sublen;
ret->refcnt = r->refcnt;
ret->minlen = r->minlen;
ret->prelen = r->prelen;
ret->lastcloseparen = r->lastcloseparen;
ret->reganch = r->reganch;
+ ret->sublen = r->sublen;
+
+ if (RX_MATCH_COPIED(ret))
+ ret->subbeg = SAVEPV(r->subbeg);
+ else
+ ret->subbeg = Nullch;
+
ptr_table_store(PL_ptr_table, r, ret);
return ret;
}
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);
GP *gp;
IV iv;
I32 i;
- char *c;
+ char *c = NULL;
void (*dptr) (void*);
void (*dxptr) (pTHXo_ void*);
OP *o;
*/
/* 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)
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;
#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;
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;
https://perl5.git.perl.org / perl5.git / blobdiff