SvTEMP_off(sv);
(void)SvREFCNT_inc(sv);
}
- else if (SvPADTMP(sv))
- sv = newSVsv(sv);
+ else if (SvPADTMP(sv) && !IS_PADGV(sv))
+ sv = newSVsv(sv);
else {
SvTEMP_off(sv);
(void)SvREFCNT_inc(sv);
/* 2s complement assumption that (UV)-IV_MIN is correct. */
/* -ve result, which could overflow an IV */
SP--;
- SETi( -product );
+ SETi( -(IV)product );
RETURN;
} /* else drop to NVs below. */
} else {
/* 2s complement assumption again */
/* -ve result, which could overflow an IV */
SP--;
- SETi( -product_low );
+ SETi( -(IV)product_low );
RETURN;
} /* else drop to NVs below. */
}
PP(pp_divide)
{
dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
- {
- dPOPPOPnnrl;
- NV value;
- if (right == 0.0)
- DIE(aTHX_ "Illegal division by zero");
+ /* Only try to do UV divide first
+ if ((SLOPPYDIVIDE is true) or
+ (PERL_PRESERVE_IVUV is true and one or both SV is a UV too large
+ to preserve))
+ The assumption is that it is better to use floating point divide
+ whenever possible, only doing integer divide first if we can't be sure.
+ If NV_PRESERVES_UV is true then we know at compile time that no UV
+ can be too large to preserve, so don't need to compile the code to
+ test the size of UVs. */
+
#ifdef SLOPPYDIVIDE
- /* insure that 20./5. == 4. */
- {
- IV k;
- if ((NV)I_V(left) == left &&
- (NV)I_V(right) == right &&
- (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
- value = k;
- }
- else {
- value = left / right;
- }
- }
+# define PERL_TRY_UV_DIVIDE
+ /* ensure that 20./5. == 4. */
#else
- value = left / right;
+# ifdef PERL_PRESERVE_IVUV
+# ifndef NV_PRESERVES_UV
+# define PERL_TRY_UV_DIVIDE
+# endif
+# endif
#endif
- PUSHn( value );
- RETURN;
+
+#ifdef PERL_TRY_UV_DIVIDE
+ SvIV_please(TOPs);
+ if (SvIOK(TOPs)) {
+ SvIV_please(TOPm1s);
+ if (SvIOK(TOPm1s)) {
+ bool left_non_neg = SvUOK(TOPm1s);
+ bool right_non_neg = SvUOK(TOPs);
+ UV left;
+ UV right;
+
+ if (right_non_neg) {
+ right = SvUVX(TOPs);
+ }
+ else {
+ IV biv = SvIVX(TOPs);
+ if (biv >= 0) {
+ right = biv;
+ right_non_neg = TRUE; /* effectively it's a UV now */
+ }
+ else {
+ right = -biv;
+ }
+ }
+ /* historically undef()/0 gives a "Use of uninitialized value"
+ warning before dieing, hence this test goes here.
+ If it were immediately before the second SvIV_please, then
+ DIE() would be invoked before left was even inspected, so
+ no inpsection would give no warning. */
+ if (right == 0)
+ DIE(aTHX_ "Illegal division by zero");
+
+ if (left_non_neg) {
+ left = SvUVX(TOPm1s);
+ }
+ else {
+ IV aiv = SvIVX(TOPm1s);
+ if (aiv >= 0) {
+ left = aiv;
+ left_non_neg = TRUE; /* effectively it's a UV now */
+ }
+ else {
+ left = -aiv;
+ }
+ }
+
+ if (left >= right
+#ifdef SLOPPYDIVIDE
+ /* For sloppy divide we always attempt integer division. */
+#else
+ /* Otherwise we only attempt it if either or both operands
+ would not be preserved by an NV. If both fit in NVs
+ we fall through to the NV divide code below. */
+ && ((left > ((UV)1 << NV_PRESERVES_UV_BITS))
+ || (right > ((UV)1 << NV_PRESERVES_UV_BITS)))
+#endif
+ ) {
+ /* Integer division can't overflow, but it can be imprecise. */
+ UV result = left / right;
+ if (result * right == left) {
+ SP--; /* result is valid */
+ if (left_non_neg == right_non_neg) {
+ /* signs identical, result is positive. */
+ SETu( result );
+ RETURN;
+ }
+ /* 2s complement assumption */
+ if (result <= (UV)IV_MIN)
+ SETi( -result );
+ else {
+ /* It's exact but too negative for IV. */
+ SETn( -(NV)result );
+ }
+ RETURN;
+ } /* tried integer divide but it was not an integer result */
+ } /* else (abs(result) < 1.0) or (both UVs in range for NV) */
+ } /* left wasn't SvIOK */
+ } /* right wasn't SvIOK */
+#endif /* PERL_TRY_UV_DIVIDE */
+ {
+ dPOPPOPnnrl;
+ if (right == 0.0)
+ DIE(aTHX_ "Illegal division by zero");
+ PUSHn( left / right );
+ RETURN;
}
}
MEXTEND(MARK, max);
if (count > 1) {
while (SP > MARK) {
- if (*SP)
- SvTEMP_off((*SP));
+ if (*SP) {
+ *SP = sv_2mortal(newSVsv(*SP));
+ SvREADONLY_on(*SP);
+ }
SP--;
}
MARK++;
dSP; dMARK; dORIGMARK; dTARGET;
do_sprintf(TARG, SP-MARK, MARK+1);
TAINT_IF(SvTAINTED(TARG));
+ if (DO_UTF8(*(MARK+1)))
+ SvUTF8_on(TARG);
SP = ORIGMARK;
PUSHTARG;
RETURN;
SvTAINTED_on(sv);
uv = toTITLE_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
}
- else
- uv = toTITLE_utf8(s);
+ else {
+ uv = toTITLE_utf8(s);
+ ulen = UNISKIP(uv);
+ }
tend = uvchr_to_utf8(tmpbuf, uv);
SvTAINTED_on(sv);
uv = toLOWER_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
}
- else
- uv = toLOWER_utf8(s);
+ else {
+ uv = toLOWER_utf8(s);
+ ulen = UNISKIP(uv);
+ }
tend = uvchr_to_utf8(tmpbuf, uv);
TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
(pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
+ PL_reg_sv_utf8 = do_utf8;
+
if (pm->op_pmreplroot) {
#ifdef USE_ITHREADS
ary = GvAVn((GV*)PL_curpad[(PADOFFSET)pm->op_pmreplroot]);
for (i = 1; i <= rx->nparens; i++) {
s = rx->startp[i] + orig;
m = rx->endp[i] + orig;
- if (m && s) {
+
+ /* japhy (07/27/01) -- the (m && s) test doesn't catch
+ parens that didn't match -- they should be set to
+ undef, not the empty string */
+ if (m >= orig && s >= orig) {
dstr = NEWSV(33, m-s);
sv_setpvn(dstr, s, m-s);
}
else
- dstr = NEWSV(33, 0);
+ dstr = &PL_sv_undef; /* undef, not "" */
if (make_mortal)
sv_2mortal(dstr);
if (do_utf8)
MgOWNER(mg) = 0;
COND_SIGNAL(MgOWNERCONDP(mg));
DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": unlock 0x%"UVxf"\n",
- PTR2UV(thr), PTR2UV(svv));)
+ PTR2UV(thr), PTR2UV(svv)));
MUTEX_UNLOCK(MgMUTEXP(mg));
}
#endif /* USE_THREADS */
#ifdef USE_THREADS
sv_lock(sv);
#endif /* USE_THREADS */
+#ifdef USE_ITHREADS
+ shared_sv *ssv = Perl_sharedsv_find(aTHX_ sv);
+ if(ssv)
+ Perl_sharedsv_lock(aTHX_ ssv);
+#endif /* USE_ITHREADS */
if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
|| SvTYPE(retsv) == SVt_PVCV) {
retsv = refto(retsv);
projects / p5sagit/p5-mst-13.2.git / blobdiff