SVt_PVFM, TRUE, NONV, NOARENA, FIT_ARENA(20, sizeof(xpvfm_allocated)) },
/* XPVIO is 84 bytes, fits 48x */
- { sizeof(XPVIO), sizeof(XPVIO), 0, SVt_PVIO, TRUE, HADNV,
- HASARENA, FIT_ARENA(24, sizeof(XPVIO)) },
+ { sizeof(xpvio_allocated), sizeof(xpvio_allocated),
+ + relative_STRUCT_OFFSET(xpvio_allocated, XPVIO, xpv_cur),
+ SVt_PVIO, TRUE, NONV, HASARENA, FIT_ARENA(24, sizeof(xpvio_allocated)) },
};
#define new_body_type(sv_type) \
/* For sv_2nv these three cases are "SvNOK and don't bother casting" */
STATIC int
-S_sv_2iuv_non_preserve(pTHX_ register SV *sv, I32 numtype)
+S_sv_2iuv_non_preserve(pTHX_ register SV *sv
+# ifdef DEBUGGING
+ , I32 numtype
+# endif
+ )
{
dVAR;
- PERL_UNUSED_ARG(numtype); /* Used only under DEBUGGING? */
DEBUG_c(PerlIO_printf(Perl_debug_log,"sv_2iuv_non '%s', IV=0x%"UVxf" NV=%"NVgf" inttype=%"UVXf"\n", SvPVX_const(sv), SvIVX(sv), SvNVX(sv), (UV)numtype));
if (SvNVX(sv) < (NV)IV_MIN) {
(void)SvIOKp_on(sv);
1 1 already read UV.
so there's no point in sv_2iuv_non_preserve() attempting
to use atol, strtol, strtoul etc. */
+# ifdef DEBUGGING
sv_2iuv_non_preserve (sv, numtype);
+# else
+ sv_2iuv_non_preserve (sv);
+# endif
}
}
#endif /* NV_PRESERVES_UV */
}
}
if (SvREADONLY(sv) && !SvOK(sv)) {
- if (ckWARN(WARN_UNINITIALIZED))
- report_uninit(sv);
if (lp)
*lp = 0;
+ if (flags & SV_UNDEF_RETURNS_NULL)
+ return NULL;
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit(sv);
return (char *)"";
}
}
if (isGV_with_GP(sv))
return glob_2pv((GV *)sv, lp);
- if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
- report_uninit(sv);
if (lp)
*lp = 0;
+ if (flags & SV_UNDEF_RETURNS_NULL)
+ return NULL;
+ if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
+ report_uninit(sv);
if (SvTYPE(sv) < SVt_PV)
/* Typically the caller expects that sv_any is not NULL now. */
sv_upgrade(sv, SVt_PV);
Compares the strings in two SVs in a locale-aware manner. Is UTF-8 and
'use bytes' aware, handles get magic, and will coerce its args to strings
-if necessary. See also C<sv_cmp_locale>. See also C<sv_cmp>.
+if necessary. See also C<sv_cmp>.
=cut
*/
return;
}
if (flags & SVp_NOK) {
+ const NV was = SvNVX(sv);
+ if (NV_OVERFLOWS_INTEGERS_AT &&
+ was >= NV_OVERFLOWS_INTEGERS_AT && ckWARN(WARN_IMPRECISION)) {
+ Perl_warner(aTHX_ packWARN(WARN_IMPRECISION),
+ "Lost precision when incrementing %" NVff " by 1",
+ was);
+ }
(void)SvNOK_only(sv);
- SvNV_set(sv, SvNVX(sv) + 1.0);
+ SvNV_set(sv, was + 1.0);
return;
}
SvUV_set(sv, SvUVX(sv) - 1);
}
} else {
- if (SvIVX(sv) == IV_MIN)
- sv_setnv(sv, (NV)IV_MIN - 1.0);
+ if (SvIVX(sv) == IV_MIN) {
+ sv_setnv(sv, (NV)IV_MIN);
+ goto oops_its_num;
+ }
else {
(void)SvIOK_only(sv);
SvIV_set(sv, SvIVX(sv) - 1);
return;
}
if (flags & SVp_NOK) {
- SvNV_set(sv, SvNVX(sv) - 1.0);
- (void)SvNOK_only(sv);
- return;
+ oops_its_num:
+ {
+ const NV was = SvNVX(sv);
+ if (NV_OVERFLOWS_INTEGERS_AT &&
+ was <= -NV_OVERFLOWS_INTEGERS_AT && ckWARN(WARN_IMPRECISION)) {
+ Perl_warner(aTHX_ packWARN(WARN_IMPRECISION),
+ "Lost precision when decrementing %" NVff " by 1",
+ was);
+ }
+ (void)SvNOK_only(sv);
+ SvNV_set(sv, was - 1.0);
+ return;
+ }
}
if (!(flags & SVp_POK)) {
if ((flags & SVTYPEMASK) < SVt_PVIV)
return ncxs;
/* create anew and remember what it is */
- Newxz(ncxs, max + 1, PERL_CONTEXT);
+ Newx(ncxs, max + 1, PERL_CONTEXT);
ptr_table_store(PL_ptr_table, cxs, ncxs);
+ Copy(cxs, ncxs, max + 1, PERL_CONTEXT);
while (ix >= 0) {
- PERL_CONTEXT * const cx = &cxs[ix];
PERL_CONTEXT * const ncx = &ncxs[ix];
- ncx->cx_type = cx->cx_type;
- if (CxTYPE(cx) == CXt_SUBST) {
+ if (CxTYPE(ncx) == CXt_SUBST) {
Perl_croak(aTHX_ "Cloning substitution context is unimplemented");
}
else {
- ncx->blk_oldsp = cx->blk_oldsp;
- ncx->blk_oldcop = cx->blk_oldcop;
- ncx->blk_oldmarksp = cx->blk_oldmarksp;
- ncx->blk_oldscopesp = cx->blk_oldscopesp;
- ncx->blk_oldpm = cx->blk_oldpm;
- ncx->blk_gimme = cx->blk_gimme;
- switch (CxTYPE(cx)) {
+ switch (CxTYPE(ncx)) {
case CXt_SUB:
- 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
- ? av_dup_inc(cx->blk_sub.argarray, param)
+ ncx->blk_sub.cv = (ncx->blk_sub.olddepth == 0
+ ? cv_dup_inc(ncx->blk_sub.cv, param)
+ : cv_dup(ncx->blk_sub.cv,param));
+ ncx->blk_sub.argarray = (CxHASARGS(ncx)
+ ? av_dup_inc(ncx->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;
- ncx->blk_sub.retop = cx->blk_sub.retop;
+ ncx->blk_sub.savearray = av_dup_inc(ncx->blk_sub.savearray,
+ param);
ncx->blk_sub.oldcomppad = (PAD*)ptr_table_fetch(PL_ptr_table,
- cx->blk_sub.oldcomppad);
+ ncx->blk_sub.oldcomppad);
break;
case CXt_EVAL:
- ncx->blk_eval.old_in_eval = cx->blk_eval.old_in_eval;
- ncx->blk_eval.old_op_type = cx->blk_eval.old_op_type;
- ncx->blk_eval.old_namesv = sv_dup_inc(cx->blk_eval.old_namesv, param);
- ncx->blk_eval.old_eval_root = cx->blk_eval.old_eval_root;
- ncx->blk_eval.cur_text = sv_dup(cx->blk_eval.cur_text, param);
- ncx->blk_eval.retop = cx->blk_eval.retop;
+ ncx->blk_eval.old_namesv = sv_dup_inc(ncx->blk_eval.old_namesv,
+ param);
+ ncx->blk_eval.cur_text = sv_dup(ncx->blk_eval.cur_text, param);
break;
- case CXt_LOOP:
- ncx->blk_loop.label = cx->blk_loop.label;
- ncx->blk_loop.resetsp = cx->blk_loop.resetsp;
- ncx->blk_loop.my_op = cx->blk_loop.my_op;
- ncx->blk_loop.iterdata = (CxPADLOOP(cx)
- ? cx->blk_loop.iterdata
- : gv_dup((GV*)cx->blk_loop.iterdata, param));
- ncx->blk_loop.oldcomppad
- = (PAD*)ptr_table_fetch(PL_ptr_table,
- cx->blk_loop.oldcomppad);
- ncx->blk_loop.itersave = sv_dup_inc(cx->blk_loop.itersave, param);
- ncx->blk_loop.iterlval = sv_dup_inc(cx->blk_loop.iterlval, param);
- ncx->blk_loop.iterary = av_dup_inc(cx->blk_loop.iterary, param);
- ncx->blk_loop.iterix = cx->blk_loop.iterix;
- ncx->blk_loop.itermax = cx->blk_loop.itermax;
+ case CXt_LOOP_LAZYSV:
+ ncx->blk_loop.state_u.lazysv.end
+ = sv_dup_inc(ncx->blk_loop.state_u.lazysv.end, param);
+ /* We are taking advantage of av_dup_inc and sv_dup_inc
+ actually being the same function, and order equivalance of
+ the two unions.
+ We can assert the later [but only at run time :-(] */
+ assert ((void *) &ncx->blk_loop.state_u.ary.ary ==
+ (void *) &ncx->blk_loop.state_u.lazysv.cur);
+ case CXt_LOOP_FOR:
+ ncx->blk_loop.state_u.ary.ary
+ = av_dup_inc(ncx->blk_loop.state_u.ary.ary, param);
+ case CXt_LOOP_LAZYIV:
+ case CXt_LOOP_PLAIN:
+ if (CxPADLOOP(ncx)) {
+ ncx->blk_loop.oldcomppad
+ = (PAD*)ptr_table_fetch(PL_ptr_table,
+ ncx->blk_loop.oldcomppad);
+ } else {
+ ncx->blk_loop.oldcomppad
+ = (PAD*)gv_dup((GV*)ncx->blk_loop.oldcomppad, param);
+ }
break;
case CXt_FORMAT:
- 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;
- ncx->blk_sub.retop = cx->blk_sub.retop;
+ ncx->blk_format.cv = cv_dup(ncx->blk_format.cv, param);
+ ncx->blk_format.gv = gv_dup(ncx->blk_format.gv, param);
+ ncx->blk_format.dfoutgv = gv_dup_inc(ncx->blk_format.dfoutgv,
+ param);
break;
case CXt_BLOCK:
case CXt_NULL:
TOPPTR(nss,ix) = hv_dup_inc(hv, param);
}
break;
- case SAVEt_PADSV:
+ case SAVEt_PADSV_AND_MORTALIZE:
longval = (long)POPLONG(ss,ix);
TOPLONG(nss,ix) = longval;
ptr = POPPTR(ss,ix);
TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
sv = (SV*)POPPTR(ss,ix);
- TOPPTR(nss,ix) = sv_dup(sv, param);
+ TOPPTR(nss,ix) = sv_dup_inc(sv, param);
break;
case SAVEt_BOOL:
ptr = POPPTR(ss,ix);
PL_patchlevel = sv_dup_inc(proto_perl->Ipatchlevel, param);
PL_localpatches = proto_perl->Ilocalpatches;
PL_splitstr = proto_perl->Isplitstr;
- PL_preprocess = proto_perl->Ipreprocess;
PL_minus_n = proto_perl->Iminus_n;
PL_minus_p = proto_perl->Iminus_p;
PL_minus_l = proto_perl->Iminus_l;
projects / p5sagit/p5-mst-13.2.git / blobdiff