void*
Perl_get_arena(pTHX_ int arena_size)
{
+ dVAR;
struct arena_desc* adesc;
struct arena_set *newroot, **aroot = (struct arena_set**) &PL_body_arenas;
int curr;
newroot->set_size = ARENAS_PER_SET;
newroot->next = *aroot;
*aroot = newroot;
- DEBUG_m(PerlIO_printf(Perl_debug_log, "new arenaset %p\n", *aroot));
+ DEBUG_m(PerlIO_printf(Perl_debug_log, "new arenaset %p\n", (void*)*aroot));
}
/* ok, now have arena-set with at least 1 empty/available arena-desc */
#define new_NOARENAZ(details) \
my_safecalloc((details)->body_size + (details)->offset)
-#ifdef DEBUGGING
+#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
static bool done_sanity_check;
#endif
assert(bdp->arena_size);
-#ifdef DEBUGGING
+#if defined(DEBUGGING) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
+ /* PERL_GLOBAL_STRUCT_PRIVATE cannot coexist with global
+ * variables like done_sanity_check. */
if (!done_sanity_check) {
unsigned int i = SVt_LAST;
/* computed count doesnt reflect the 1st slot reservation */
DEBUG_m(PerlIO_printf(Perl_debug_log,
"arena %p end %p arena-size %d type %d size %d ct %d\n",
- start, end, bdp->arena_size, sv_type, body_size,
- bdp->arena_size / body_size));
+ start, end,
+ (int)bdp->arena_size, sv_type, (int)body_size,
+ (int)bdp->arena_size / (int)body_size));
*root = (void *)start;
STMT_START { \
void ** const r3wt = &PL_body_roots[sv_type]; \
LOCK_SV_MUTEX; \
- xpv = *((void **)(r3wt)) \
- ? *((void **)(r3wt)) : more_bodies(sv_type); \
+ xpv = (PTR_TBL_ENT_t*) (*((void **)(r3wt)) \
+ ? *((void **)(r3wt)) : more_bodies(sv_type)); \
*(r3wt) = *(void**)(xpv); \
UNLOCK_SV_MUTEX; \
} STMT_END
*/
void
-Perl_sv_upgrade(pTHX_ register SV *sv, U32 new_type)
+Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
{
dVAR;
void* old_body;
void* new_body;
- const U32 old_type = SvTYPE(sv);
+ const svtype old_type = SvTYPE(sv);
const struct body_details *new_type_details;
const struct body_details *const old_type_details
= bodies_by_type + old_type;
return s;
} else
#endif
- s = saferealloc(s, newlen);
+ s = (char*)saferealloc(s, newlen);
}
else {
- s = safemalloc(newlen);
+ s = (char*)safemalloc(newlen);
if (SvPVX_const(sv) && SvCUR(sv)) {
Move(SvPVX_const(sv), s, (newlen < SvCUR(sv)) ? newlen : SvCUR(sv), char);
}
case SVt_PVIO:
Perl_croak(aTHX_ "Can't coerce %s to integer in %s", sv_reftype(sv,0),
OP_DESC(PL_op));
+ default: NOOP;
}
(void)SvIOK_only(sv); /* validate number */
SvIV_set(sv, i);
case SVt_PVIO:
Perl_croak(aTHX_ "Can't coerce %s to number in %s", sv_reftype(sv,0),
OP_NAME(PL_op));
+ default: NOOP;
}
SvNV_set(sv, num);
(void)SvNOK_only(sv); /* validate number */
SvFLAGS(gv) |= wasfake;
assert(SvPOK(buffer));
- *len = SvCUR(buffer);
+ if (len) {
+ *len = SvCUR(buffer);
+ }
return SvPVX(buffer);
}
STRLEN len;
if (SvIOKp(sv)) {
- len = SvIsUV(sv) ? my_sprintf(tbuf,"%"UVuf, (UV)SvUVX(sv))
- : my_sprintf(tbuf,"%"IVdf, (IV)SvIVX(sv));
+ len = SvIsUV(sv)
+ ? my_snprintf(tbuf, sizeof(tbuf), "%"UVuf, (UV)SvUVX(sv))
+ : my_snprintf(tbuf, sizeof(tbuf), "%"IVdf, (IV)SvIVX(sv));
} else {
Gconvert(SvNVX(sv), NV_DIG, 0, tbuf);
len = strlen(tbuf);
s = SvGROW_mutable(sv, len + 1);
SvCUR_set(sv, len);
SvPOKp_on(sv);
- return memcpy(s, tbuf, len + 1);
+ return (char*)memcpy(s, tbuf, len + 1);
}
}
if (SvROK(sv)) {
/* some Xenix systems wipe out errno here */
#ifdef apollo
if (SvNVX(sv) == 0.0)
- (void)strcpy(s,"0");
+ my_strlcpy(s, "0", SvLEN(sv));
else
#endif /*apollo*/
{
errno = olderrno;
#ifdef FIXNEGATIVEZERO
if (*s == '-' && s[1] == '0' && !s[2])
- strcpy(s,"0");
+ my_strlcpy(s, "0", SvLEN(s));
#endif
while (*s) s++;
#ifdef hcx
void
Perl_sv_utf8_encode(pTHX_ register SV *sv)
{
- (void) sv_utf8_upgrade(sv);
if (SvIsCOW(sv)) {
sv_force_normal_flags(sv, 0);
}
if (SvREADONLY(sv)) {
Perl_croak(aTHX_ PL_no_modify);
}
+ (void) sv_utf8_upgrade(sv);
SvUTF8_off(sv);
}
|| sv_cmp(cv_const_sv(cv),
cv_const_sv((CV*)sref))))) {
Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
- CvCONST(cv)
- ? "Constant subroutine %s::%s redefined"
- : "Subroutine %s::%s redefined",
+ (const char *)
+ (CvCONST(cv)
+ ? "Constant subroutine %s::%s redefined"
+ : "Subroutine %s::%s redefined"),
HvNAME_get(GvSTASH((GV*)dstr)),
GvENAME((GV*)dstr));
}
dVAR;
register U32 sflags;
register int dtype;
- register int stype;
+ register svtype stype;
if (sstr == dstr)
return;
if (stype == SVt_PVLV)
SvUPGRADE(dstr, SVt_PVNV);
else
- SvUPGRADE(dstr, (U32)stype);
+ SvUPGRADE(dstr, (svtype)stype);
}
/* dstr may have been upgraded. */
SvFLAGS(dstr) |= sflags & (SVf_IOK|SVp_IOK|SVf_NOK|SVp_NOK|SVf_UTF8
|SVf_AMAGIC);
{
- const MAGIC * const smg = SvVOK(sstr);
+ const MAGIC * const smg = SvVSTRING_mg(sstr);
if (smg) {
sv_magic(dstr, NULL, PERL_MAGIC_vstring,
smg->mg_ptr, smg->mg_len);
if (SvPVX_const(sv))
SvPV_free(sv);
+#ifdef DEBUGGING
if (flags & SV_HAS_TRAILING_NUL)
assert(ptr[len] == '\0');
+#endif
allocate = (flags & SV_HAS_TRAILING_NUL)
? len + 1: PERL_STRLEN_ROUNDUP(len + 1);
} else {
#ifdef DEBUGGING
/* Force a move to shake out bugs in callers. */
- char *new_ptr = safemalloc(allocate);
+ char *new_ptr = (char*)safemalloc(allocate);
Copy(ptr, new_ptr, len, char);
PoisonFree(ptr,len,char);
Safefree(ptr);
ptr = new_ptr;
#else
- ptr = saferealloc (ptr, allocate);
+ ptr = (char*) saferealloc (ptr, allocate);
#endif
}
SvPV_set(sv, ptr);
Weaken a reference: set the C<SvWEAKREF> flag on this RV; give the
referred-to SV C<PERL_MAGIC_backref> magic if it hasn't already; and
push a back-reference to this RV onto the array of backreferences
-associated with that magic.
+associated with that magic. If the RV is magical, set magic will be
+called after the RV is cleared.
=cut
*/
SvRV_set(referrer, 0);
SvOK_off(referrer);
SvWEAKREF_off(referrer);
+ SvSETMAGIC(referrer);
} else if (SvTYPE(referrer) == SVt_PVGV ||
SvTYPE(referrer) == SVt_PVLV) {
/* You lookin' at me? */
}
}
if (type >= SVt_PVMG) {
- HV *ourstash;
- if ((type == SVt_PVMG || type == SVt_PVGV) &&
- (ourstash = OURSTASH(sv))) {
- SvREFCNT_dec(ourstash);
+ if ((type == SVt_PVMG || type == SVt_PVGV) && SvPAD_OUR(sv)) {
+ SvREFCNT_dec(OURSTASH(sv));
} else if (SvMAGIC(sv))
mg_free(sv);
if (type == SVt_PVMG && SvPAD_TYPED(sv))
*/
SAVEI8(PL_utf8cache);
PL_utf8cache = 0;
- Perl_croak(aTHX_ "panic: sv_len_utf8 cache %"UVf
- " real %"UVf" for %"SVf,
- (UV) ulen, (UV) real, sv);
+ Perl_croak(aTHX_ "panic: sv_len_utf8 cache %"UVuf
+ " real %"UVuf" for %"SVf,
+ (UV) ulen, (UV) real, (void*)sv);
}
}
}
/* Walk forwards to find the byte corresponding to the passed in UTF-8
offset. */
static STRLEN
-S_sv_pos_u2b_forwards(pTHX_ const U8 *const start, const U8 *const send,
+S_sv_pos_u2b_forwards(const U8 *const start, const U8 *const send,
STRLEN uoffset)
{
const U8 *s = start;
- PERL_UNUSED_CONTEXT;
-
while (s < send && uoffset--)
s += UTF8SKIP(s);
if (s > send) {
whether to walk forwards or backwards to find the byte corresponding to
the passed in UTF-8 offset. */
static STRLEN
-S_sv_pos_u2b_midway(pTHX_ const U8 *const start, const U8 *send,
+S_sv_pos_u2b_midway(const U8 *const start, const U8 *send,
STRLEN uoffset, STRLEN uend)
{
STRLEN backw = uend - uoffset;
/* The assumption is that going forwards is twice the speed of going
forward (that's where the 2 * backw comes from).
(The real figure of course depends on the UTF-8 data.) */
- return S_sv_pos_u2b_forwards(aTHX_ start, send, uoffset);
+ return sv_pos_u2b_forwards(start, send, uoffset);
}
while (backw--) {
if ((*mgp)->mg_len != -1) {
/* And we know the end too. */
boffset = boffset0
- + S_sv_pos_u2b_midway(aTHX_ start + boffset0, send,
+ + sv_pos_u2b_midway(start + boffset0, send,
uoffset - uoffset0,
(*mgp)->mg_len - uoffset0);
} else {
boffset = boffset0
- + S_sv_pos_u2b_forwards(aTHX_ start + boffset0,
+ + sv_pos_u2b_forwards(start + boffset0,
send, uoffset - uoffset0);
}
}
}
boffset = boffset0
- + S_sv_pos_u2b_midway(aTHX_ start + boffset0,
+ + sv_pos_u2b_midway(start + boffset0,
start + cache[1],
uoffset - uoffset0,
cache[0] - uoffset0);
} else {
boffset = boffset0
- + S_sv_pos_u2b_midway(aTHX_ start + boffset0,
+ + sv_pos_u2b_midway(start + boffset0,
start + cache[3],
uoffset - uoffset0,
cache[2] - uoffset0);
/* In fact, offset0 is either 0, or less than offset, so don't
need to worry about the other possibility. */
boffset = boffset0
- + S_sv_pos_u2b_midway(aTHX_ start + boffset0, send,
+ + sv_pos_u2b_midway(start + boffset0, send,
uoffset - uoffset0,
(*mgp)->mg_len - uoffset0);
found = TRUE;
if (!found || PL_utf8cache < 0) {
const STRLEN real_boffset
- = boffset0 + S_sv_pos_u2b_forwards(aTHX_ start + boffset0,
+ = boffset0 + sv_pos_u2b_forwards(start + boffset0,
send, uoffset - uoffset0);
if (found && PL_utf8cache < 0) {
infinitely while printing error messages. */
SAVEI8(PL_utf8cache);
PL_utf8cache = 0;
- Perl_croak(aTHX_ "panic: sv_pos_u2b_cache cache %"UVf
- " real %"UVf" for %"SVf,
- (UV) boffset, (UV) real_boffset, sv);
+ Perl_croak(aTHX_ "panic: sv_pos_u2b_cache cache %"UVuf
+ " real %"UVuf" for %"SVf,
+ (UV) boffset, (UV) real_boffset, (void*)sv);
}
}
boffset = real_boffset;
STRLEN uoffset = (STRLEN) *offsetp;
const U8 * const send = start + len;
MAGIC *mg = NULL;
- STRLEN boffset = S_sv_pos_u2b_cached(aTHX_ sv, &mg, start, send,
+ const STRLEN boffset = sv_pos_u2b_cached(sv, &mg, start, send,
uoffset, 0, 0);
*offsetp = (I32) boffset;
if (lenp) {
/* Convert the relative offset to absolute. */
- STRLEN uoffset2 = uoffset + (STRLEN) *lenp;
- STRLEN boffset2
- = S_sv_pos_u2b_cached(aTHX_ sv, &mg, start, send, uoffset2,
+ const STRLEN uoffset2 = uoffset + (STRLEN) *lenp;
+ const STRLEN boffset2
+ = sv_pos_u2b_cached(sv, &mg, start, send, uoffset2,
uoffset, boffset) - boffset;
*lenp = boffset2;
infinitely while printing error messages. */
SAVEI8(PL_utf8cache);
PL_utf8cache = 0;
- Perl_croak(aTHX_ "panic: utf8_mg_pos_cache_update cache %"UVf
- " real %"UVf" for %"SVf, (UV) utf8, (UV) realutf8, sv);
+ Perl_croak(aTHX_ "panic: utf8_mg_pos_cache_update cache %"UVuf
+ " real %"UVuf" for %"SVf, (UV) utf8, (UV) realutf8, (void*)sv);
}
}
infinitely while printing error messages. */
SAVEI8(PL_utf8cache);
PL_utf8cache = 0;
- Perl_croak(aTHX_ "panic: sv_pos_b2u cache %"UVf
- " real %"UVf" for %"SVf,
- (UV) len, (UV) real_len, sv);
+ Perl_croak(aTHX_ "panic: sv_pos_b2u cache %"UVuf
+ " real %"UVuf" for %"SVf,
+ (UV) len, (UV) real_len, (void*)sv);
}
}
len = real_len;
pv1 = "";
cur1 = 0;
}
- else
+ else {
+ /* if pv1 and pv2 are the same, second SvPV_const call may
+ * invalidate pv1, so we may need to make a copy */
+ if (sv1 == sv2 && (SvTHINKFIRST(sv1) || SvGMAGICAL(sv1))) {
+ pv1 = SvPV_const(sv1, cur1);
+ sv1 = sv_2mortal(newSVpvn(pv1, cur1));
+ if (SvUTF8(sv2)) SvUTF8_on(sv1);
+ }
pv1 = SvPV_const(sv1, cur1);
+ }
if (!sv2){
pv2 = "";
register SV *sv;
new_SV(sv);
- sv_setpvn(sv,s,len ? len : strlen(s));
+ sv_setpvn(sv, s, len || s == NULL ? len : strlen(s));
return sv;
}
SvUTF8_on (sv);
Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */
return sv;
- } else if (flags & HVhek_REHASH) {
+ } else if (flags & (HVhek_REHASH|HVhek_UNSHARED)) {
/* We don't have a pointer to the hv, so we have to replicate the
flag into every HEK. This hv is using custom a hasing
algorithm. Hence we can't return a shared string scalar, as
that would contain the (wrong) hash value, and might get passed
- into an hv routine with a regular hash */
+ into an hv routine with a regular hash.
+ Similarly, a hash that isn't using shared hash keys has to have
+ the flag in every key so that we know not to try to call
+ share_hek_kek on it. */
SV * const sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek));
if (HEK_UTF8(hek))
else
io = 0;
if (!io)
- Perl_croak(aTHX_ "Bad filehandle: %"SVf, sv);
+ Perl_croak(aTHX_ "Bad filehandle: %"SVf, (void*)sv);
break;
}
return io;
LEAVE;
if (!GvCVu(gv))
Perl_croak(aTHX_ "Unable to create sub named \"%"SVf"\"",
- sv);
+ (void*)sv);
}
return GvCVu(gv);
}
integer:
{
char *ptr = ebuf + sizeof ebuf;
+ bool tempalt = uv ? alt : FALSE; /* Vectors can't change alt */
+ zeros = 0;
+
switch (base) {
unsigned dig;
case 16:
- if (!uv)
- alt = FALSE;
p = (char*)((c == 'X')
? "0123456789ABCDEF" : "0123456789abcdef");
do {
dig = uv & 15;
*--ptr = p[dig];
} while (uv >>= 4);
- if (alt) {
+ if (tempalt) {
esignbuf[esignlen++] = '0';
esignbuf[esignlen++] = c; /* 'x' or 'X' */
}
*--ptr = '0';
break;
case 2:
- if (!uv)
- alt = FALSE;
do {
dig = uv & 1;
*--ptr = '0' + dig;
} while (uv >>= 1);
- if (alt) {
+ if (tempalt) {
esignbuf[esignlen++] = '0';
esignbuf[esignlen++] = 'b';
}
* --jhi */
#if defined(HAS_LONG_DOUBLE)
elen = ((intsize == 'q')
- ? my_sprintf(PL_efloatbuf, ptr, nv)
- : my_sprintf(PL_efloatbuf, ptr, (double)nv));
+ ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, nv)
+ : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)nv));
#else
elen = my_sprintf(PL_efloatbuf, ptr, nv);
#endif
(UV)c & 0xFF);
} else
sv_catpvs(msg, "end of string");
- Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, msg); /* yes, this is reentrant */
+ Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, (void*)msg); /* yes, this is reentrant */
}
/* output mangled stuff ... */
continue; /* not "break" */
}
- /* calculate width before utf8_upgrade changes it */
+ if (is_utf8 != has_utf8) {
+ if (is_utf8) {
+ if (SvCUR(sv))
+ sv_utf8_upgrade(sv);
+ }
+ else {
+ const STRLEN old_elen = elen;
+ SV * const nsv = sv_2mortal(newSVpvn(eptr, elen));
+ sv_utf8_upgrade(nsv);
+ eptr = SvPVX_const(nsv);
+ elen = SvCUR(nsv);
+
+ if (width) { /* fudge width (can't fudge elen) */
+ width += elen - old_elen;
+ }
+ is_utf8 = TRUE;
+ }
+ }
+
have = esignlen + zeros + elen;
if (have < zeros)
Perl_croak_nocontext(PL_memory_wrap);
- if (is_utf8 != has_utf8) {
- if (is_utf8) {
- if (SvCUR(sv))
- sv_utf8_upgrade(sv);
- }
- else {
- SV * const nsv = sv_2mortal(newSVpvn(eptr, elen));
- sv_utf8_upgrade(nsv);
- eptr = SvPVX_const(nsv);
- elen = SvCUR(nsv);
- }
- SvGROW(sv, SvCUR(sv) + elen + 1);
- p = SvEND(sv);
- *p = '\0';
- }
-
need = (have > width ? have : width);
gap = need - have;
for (s = ret->substrs->data, i = 0; i < 3; i++, s++) {
s->min_offset = r->substrs->data[i].min_offset;
s->max_offset = r->substrs->data[i].max_offset;
+ s->end_shift = r->substrs->data[i].end_shift;
s->substr = sv_dup_inc(r->substrs->data[i].substr, param);
s->utf8_substr = sv_dup_inc(r->substrs->data[i].utf8_substr, param);
}
((reg_trie_data*)d->data[i])->refcount++;
OP_REFCNT_UNLOCK;
break;
+ case 'T':
+ d->data[i] = r->data->data[i];
+ OP_REFCNT_LOCK;
+ ((reg_ac_data*)d->data[i])->refcount++;
+ OP_REFCNT_UNLOCK;
+ /* Trie stclasses are readonly and can thus be shared
+ * without duplication. We free the stclass in pregfree
+ * when the corresponding reg_ac_data struct is freed.
+ */
+ ret->regstclass= r->regstclass;
+ break;
default:
Perl_croak(aTHX_ "panic: re_dup unknown data code '%c'", r->data->what[i]);
}
ret->gp_cv = cv_dup_inc(gp->gp_cv, param);
ret->gp_cvgen = gp->gp_cvgen;
ret->gp_line = gp->gp_line;
- ret->gp_file = gp->gp_file; /* points to COP.cop_file */
+ ret->gp_file_hek = hek_dup(gp->gp_file_hek, param);
return ret;
}
missing by always going for the destination.
FIXME - instrument and check that assumption */
if (sv_type >= SVt_PVMG) {
- HV *ourstash;
- if ((sv_type == SVt_PVMG) && (ourstash = OURSTASH(dstr))) {
- OURSTASH_set(dstr, hv_dup_inc(ourstash, param));
+ if ((sv_type == SVt_PVMG) && SvPAD_OUR(dstr)) {
+ OURSTASH_set(dstr, hv_dup_inc(OURSTASH(dstr), param));
} else if (SvMAGIC(dstr))
SvMAGIC_set(dstr, mg_dup(SvMAGIC(dstr), param));
if (SvSTASH(dstr))
}
break;
case SVt_PVHV:
- {
- HEK *hvname = NULL;
-
- if (HvARRAY((HV*)sstr)) {
- STRLEN i = 0;
- const bool sharekeys = !!HvSHAREKEYS(sstr);
- XPVHV * const dxhv = (XPVHV*)SvANY(dstr);
- XPVHV * const sxhv = (XPVHV*)SvANY(sstr);
- char *darray;
- Newx(darray, PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1)
- + (SvOOK(sstr) ? sizeof(struct xpvhv_aux) : 0),
- char);
- HvARRAY(dstr) = (HE**)darray;
- while (i <= sxhv->xhv_max) {
- const HE *source = HvARRAY(sstr)[i];
- HvARRAY(dstr)[i] = source
- ? he_dup(source, sharekeys, param) : 0;
- ++i;
- }
- if (SvOOK(sstr)) {
- struct xpvhv_aux * const saux = HvAUX(sstr);
- struct xpvhv_aux * const daux = HvAUX(dstr);
- /* This flag isn't copied. */
- /* SvOOK_on(hv) attacks the IV flags. */
- SvFLAGS(dstr) |= SVf_OOK;
-
- hvname = saux->xhv_name;
- daux->xhv_name
- = hvname ? hek_dup(hvname, param) : hvname;
-
- daux->xhv_riter = saux->xhv_riter;
- daux->xhv_eiter = saux->xhv_eiter
- ? he_dup(saux->xhv_eiter,
- (bool)!!HvSHAREKEYS(sstr), param) : 0;
- daux->xhv_backreferences = saux->xhv_backreferences
+ if (HvARRAY((HV*)sstr)) {
+ STRLEN i = 0;
+ const bool sharekeys = !!HvSHAREKEYS(sstr);
+ XPVHV * const dxhv = (XPVHV*)SvANY(dstr);
+ XPVHV * const sxhv = (XPVHV*)SvANY(sstr);
+ char *darray;
+ Newx(darray, PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1)
+ + (SvOOK(sstr) ? sizeof(struct xpvhv_aux) : 0),
+ char);
+ HvARRAY(dstr) = (HE**)darray;
+ while (i <= sxhv->xhv_max) {
+ const HE * const source = HvARRAY(sstr)[i];
+ HvARRAY(dstr)[i] = source
+ ? he_dup(source, sharekeys, param) : 0;
+ ++i;
+ }
+ if (SvOOK(sstr)) {
+ HEK *hvname;
+ const struct xpvhv_aux * const saux = HvAUX(sstr);
+ struct xpvhv_aux * const daux = HvAUX(dstr);
+ /* This flag isn't copied. */
+ /* SvOOK_on(hv) attacks the IV flags. */
+ SvFLAGS(dstr) |= SVf_OOK;
+
+ hvname = saux->xhv_name;
+ daux->xhv_name = hvname ? hek_dup(hvname, param) : hvname;
+
+ daux->xhv_riter = saux->xhv_riter;
+ daux->xhv_eiter = saux->xhv_eiter
+ ? he_dup(saux->xhv_eiter,
+ (bool)!!HvSHAREKEYS(sstr), param) : 0;
+ daux->xhv_backreferences =
+ saux->xhv_backreferences
? (AV*) SvREFCNT_inc(
- sv_dup((SV*)saux->
- xhv_backreferences,
- param))
+ sv_dup((SV*)saux->xhv_backreferences, param))
: 0;
- }
- }
- else {
- SvPV_set(dstr, NULL);
+ /* Record stashes for possible cloning in Perl_clone(). */
+ if (hvname)
+ av_push(param->stashes, dstr);
}
- /* Record stashes for possible cloning in Perl_clone(). */
- if(hvname)
- av_push(param->stashes, dstr);
}
+ else
+ SvPV_set(dstr, NULL);
break;
case SVt_PVCV:
if (!(param->flags & CLONEf_COPY_STACKS)) {
ncx->blk_sub.cv = (cx->blk_sub.olddepth == 0
? cv_dup_inc(cx->blk_sub.cv, param)
: cv_dup(cx->blk_sub.cv,param));
- ncx->blk_sub.argarray = (cx->blk_sub.hasargs
+ ncx->blk_sub.argarray = (CX_SUB_HASARGS_GET(cx)
? av_dup_inc(cx->blk_sub.argarray, param)
: NULL);
ncx->blk_sub.savearray = av_dup_inc(cx->blk_sub.savearray, param);
ncx->blk_sub.olddepth = cx->blk_sub.olddepth;
- ncx->blk_sub.hasargs = cx->blk_sub.hasargs;
- ncx->blk_sub.lval = cx->blk_sub.lval;
+ CX_SUB_HASARGS_SET(ncx, CX_SUB_HASARGS_GET(cx));
+ CX_SUB_LVAL_SET(ncx, CX_SUB_LVAL(cx));
ncx->blk_sub.retop = cx->blk_sub.retop;
+ ncx->blk_sub.oldcomppad = (PAD*)ptr_table_fetch(PL_ptr_table,
+ cx->blk_sub.oldcomppad);
break;
case CXt_EVAL:
ncx->blk_eval.old_in_eval = cx->blk_eval.old_in_eval;
ncx->blk_sub.cv = cv_dup(cx->blk_sub.cv, param);
ncx->blk_sub.gv = gv_dup(cx->blk_sub.gv, param);
ncx->blk_sub.dfoutgv = gv_dup_inc(cx->blk_sub.dfoutgv, param);
- ncx->blk_sub.hasargs = cx->blk_sub.hasargs;
+ CX_SUB_HASARGS_SET(ncx, CX_SUB_HASARGS_GET(cx));
ncx->blk_sub.retop = cx->blk_sub.retop;
break;
case CXt_BLOCK:
break;
case SAVEt_HV: /* hash reference */
case SAVEt_AV: /* array reference */
- sv = POPPTR(ss,ix);
+ sv = (SV*) POPPTR(ss,ix);
TOPPTR(nss,ix) = sv_dup_inc(sv, param);
gv = (GV*)POPPTR(ss,ix);
TOPPTR(nss,ix) = gv_dup(gv, param);
new_state->re_state_regeol
= pv_dup(old_state->re_state_regeol);
new_state->re_state_regstartp
- = any_dup(old_state->re_state_regstartp, proto_perl);
+ = (I32*) any_dup(old_state->re_state_regstartp, proto_perl);
new_state->re_state_regendp
- = any_dup(old_state->re_state_regendp, proto_perl);
+ = (I32*) any_dup(old_state->re_state_regendp, proto_perl);
new_state->re_state_reglastparen
- = any_dup(old_state->re_state_reglastparen, proto_perl);
+ = (U32*) any_dup(old_state->re_state_reglastparen,
+ proto_perl);
new_state->re_state_reglastcloseparen
- = any_dup(old_state->re_state_reglastcloseparen,
+ = (U32*)any_dup(old_state->re_state_reglastcloseparen,
proto_perl);
/* XXX This just has to be broken. The old save_re_context
code did SAVEGENERICPV(PL_reg_start_tmp);
= sv_dup(old_state->re_state_nrs, param);
#endif
new_state->re_state_reg_magic
- = any_dup(old_state->re_state_reg_magic, proto_perl);
+ = (MAGIC*) any_dup(old_state->re_state_reg_magic,
+ proto_perl);
new_state->re_state_reg_oldcurpm
- = any_dup(old_state->re_state_reg_oldcurpm, proto_perl);
+ = (PMOP*) any_dup(old_state->re_state_reg_oldcurpm,
+ proto_perl);
new_state->re_state_reg_curpm
- = any_dup(old_state->re_state_reg_curpm, proto_perl);
+ = (PMOP*) any_dup(old_state->re_state_reg_curpm,
+ proto_perl);
new_state->re_state_reg_oldsaved
= pv_dup(old_state->re_state_reg_oldsaved);
new_state->re_state_reg_poscache
ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling);
PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings);
- if (!specialCopIO(PL_compiling.cop_io))
- PL_compiling.cop_io = sv_dup_inc(PL_compiling.cop_io, param);
- if (PL_compiling.cop_hints) {
+ if (PL_compiling.cop_hints_hash) {
HINTS_REFCNT_LOCK;
- PL_compiling.cop_hints->refcounted_he_refcnt++;
+ PL_compiling.cop_hints_hash->refcounted_he_refcnt++;
HINTS_REFCNT_UNLOCK;
}
PL_curcop = (COP*)any_dup(proto_perl->Tcurcop, proto_perl);
PL_glob_index = proto_perl->Iglob_index;
PL_srand_called = proto_perl->Isrand_called;
- PL_uudmap['M'] = 0; /* reinits on demand */
+ PL_uudmap[(U32) 'M'] = 0; /* reinits on demand */
PL_bitcount = NULL; /* reinits on demand */
if (proto_perl->Ipsig_pend) {
S_find_array_subscript(pTHX_ AV *av, SV* val)
{
dVAR;
- SV** svp;
- I32 i;
if (!av || SvMAGICAL(av) || !AvARRAY(av) ||
(AvFILLp(av) > FUV_MAX_SEARCH_SIZE))
return -1;
- svp = AvARRAY(av);
- for (i=AvFILLp(av); i>=0; i--) {
- if (svp[i] == val && svp[i] != &PL_sv_undef)
- return i;
+ if (val != &PL_sv_undef) {
+ SV ** const svp = AvARRAY(av);
+ I32 i;
+
+ for (i=AvFILLp(av); i>=0; i--)
+ if (svp[i] == val)
+ return i;
}
return -1;
}