/* variations on pp_null */
-#ifdef I_UNISTD
-#include <unistd.h>
-#endif
-
/* XXX I can't imagine anyone who doesn't have this actually _needs_
it, since pid_t is an integral type.
--AD 2/20/1998
PP(pp_rv2gv)
{
- djSP; dTOPss;
+ djSP; dTOPss;
if (SvROK(sv)) {
wasref:
goto wasref;
}
if (!SvOK(sv) && sv != &PL_sv_undef) {
- /* If this is a 'my' scalar and flag is set then vivify
+ /* If this is a 'my' scalar and flag is set then vivify
* NI-S 1999/05/07
- */
+ */
if (PL_op->op_private & OPpDEREF) {
char *name;
GV *gv;
name = CopSTASHPV(PL_curcop);
gv = newGVgen(name);
}
- sv_upgrade(sv, SVt_RV);
+ if (SvTYPE(sv) < SVt_RV)
+ sv_upgrade(sv, SVt_RV);
SvRV(sv) = (SV*)gv;
SvROK_on(sv);
SvSETMAGIC(sv);
if (cv) {
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
- if ((PL_op->op_private & OPpLVAL_INTRO) && !CvLVALUE(cv))
- DIE(aTHX_ "Can't modify non-lvalue subroutine call");
+ if ((PL_op->op_private & OPpLVAL_INTRO)) {
+ if (gv && GvCV(gv) == cv && (gv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), FALSE)))
+ cv = GvCV(gv);
+ if (!CvLVALUE(cv))
+ DIE(aTHX_ "Can't modify non-lvalue subroutine call");
+ }
}
else
cv = (CV*)&PL_sv_undef;
char *s = SvPVX(TOPs);
if (strnEQ(s, "CORE::", 6)) {
int code;
-
+
code = keyword(s + 6, SvCUR(TOPs) - 6);
if (code < 0) { /* Overridable. */
#define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
found:
oa = PL_opargs[i] >> OASHIFT;
while (oa) {
- if (oa & OA_OPTIONAL) {
+ if (oa & OA_OPTIONAL && !seen_question) {
seen_question = 1;
str[n++] = ';';
}
- else if (n && str[0] == ';' && seen_question)
+ else if (n && str[0] == ';' && seen_question)
goto set; /* XXXX system, exec */
- if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
+ if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
&& (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
str[n++] = '\\';
}
else {
SV *ssv = POPs;
STRLEN len;
- char *ptr = SvPV(ssv,len);
+ char *ptr;
+
+ if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
+ Perl_croak(aTHX_ "Attempt to bless into a reference");
+ ptr = SvPV(ssv,len);
if (ckWARN(WARN_MISC) && len == 0)
- Perl_warner(aTHX_ WARN_MISC,
+ Perl_warner(aTHX_ WARN_MISC,
"Explicit blessing to '' (assuming package main)");
stash = gv_stashpvn(ptr, len, TRUE);
}
char *elem;
djSP;
STRLEN n_a;
-
+
sv = POPs;
elem = SvPV(sv, n_a);
gv = (GV*)POPs;
case 'F':
if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
tmpRef = (SV*)GvIOp(gv);
+ else
+ if (strEQ(elem, "FORMAT"))
+ tmpRef = (SV*)GvFORM(gv);
break;
case 'G':
if (strEQ(elem, "GLOB"))
PP(pp_multiply)
{
djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+#ifdef PERL_PRESERVE_IVUV
+ SvIV_please(TOPs);
+ if (SvIOK(TOPs)) {
+ /* Unless the left argument is integer in range we are going to have to
+ use NV maths. Hence only attempt to coerce the right argument if
+ we know the left is integer. */
+ /* Left operand is defined, so is it IV? */
+ SvIV_please(TOPm1s);
+ if (SvIOK(TOPm1s)) {
+ bool auvok = SvUOK(TOPm1s);
+ bool buvok = SvUOK(TOPs);
+ const UV topmask = (~ (UV)0) << (4 * sizeof (UV));
+ const UV botmask = ~((~ (UV)0) << (4 * sizeof (UV)));
+ UV alow;
+ UV ahigh;
+ UV blow;
+ UV bhigh;
+
+ if (auvok) {
+ alow = SvUVX(TOPm1s);
+ } else {
+ IV aiv = SvIVX(TOPm1s);
+ if (aiv >= 0) {
+ alow = aiv;
+ auvok = TRUE; /* effectively it's a UV now */
+ } else {
+ alow = -aiv; /* abs, auvok == false records sign */
+ }
+ }
+ if (buvok) {
+ blow = SvUVX(TOPs);
+ } else {
+ IV biv = SvIVX(TOPs);
+ if (biv >= 0) {
+ blow = biv;
+ buvok = TRUE; /* effectively it's a UV now */
+ } else {
+ blow = -biv; /* abs, buvok == false records sign */
+ }
+ }
+
+ /* If this does sign extension on unsigned it's time for plan B */
+ ahigh = alow >> (4 * sizeof (UV));
+ alow &= botmask;
+ bhigh = blow >> (4 * sizeof (UV));
+ blow &= botmask;
+ if (ahigh && bhigh) {
+ /* eg 32 bit is at least 0x10000 * 0x10000 == 0x100000000
+ which is overflow. Drop to NVs below. */
+ } else if (!ahigh && !bhigh) {
+ /* eg 32 bit is at most 0xFFFF * 0xFFFF == 0xFFFE0001
+ so the unsigned multiply cannot overflow. */
+ UV product = alow * blow;
+ if (auvok == buvok) {
+ /* -ve * -ve or +ve * +ve gives a +ve result. */
+ SP--;
+ SETu( product );
+ RETURN;
+ } else if (product <= (UV)IV_MIN) {
+ /* 2s complement assumption that (UV)-IV_MIN is correct. */
+ /* -ve result, which could overflow an IV */
+ SP--;
+ SETi( -product );
+ RETURN;
+ } /* else drop to NVs below. */
+ } else {
+ /* One operand is large, 1 small */
+ UV product_middle;
+ if (bhigh) {
+ /* swap the operands */
+ ahigh = bhigh;
+ bhigh = blow; /* bhigh now the temp var for the swap */
+ blow = alow;
+ alow = bhigh;
+ }
+ /* now, ((ahigh * blow) << half_UV_len) + (alow * blow)
+ multiplies can't overflow. shift can, add can, -ve can. */
+ product_middle = ahigh * blow;
+ if (!(product_middle & topmask)) {
+ /* OK, (ahigh * blow) won't lose bits when we shift it. */
+ UV product_low;
+ product_middle <<= (4 * sizeof (UV));
+ product_low = alow * blow;
+
+ /* as for pp_add, UV + something mustn't get smaller.
+ IIRC ANSI mandates this wrapping *behaviour* for
+ unsigned whatever the actual representation*/
+ product_low += product_middle;
+ if (product_low >= product_middle) {
+ /* didn't overflow */
+ if (auvok == buvok) {
+ /* -ve * -ve or +ve * +ve gives a +ve result. */
+ SP--;
+ SETu( product_low );
+ RETURN;
+ } else if (product_low <= (UV)IV_MIN) {
+ /* 2s complement assumption again */
+ /* -ve result, which could overflow an IV */
+ SP--;
+ SETi( -product_low );
+ RETURN;
+ } /* else drop to NVs below. */
+ }
+ } /* product_middle too large */
+ } /* ahigh && bhigh */
+ } /* SvIOK(TOPm1s) */
+ } /* SvIOK(TOPs) */
+#endif
{
dPOPTOPnnrl;
SETn( left * right );
{
djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
{
- register I32 count = POPi;
+ register IV count = POPi;
if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
dMARK;
I32 items = SP - MARK;
PP(pp_subtract)
{
- djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
+ djSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN);
+ useleft = USE_LEFT(TOPm1s);
+#ifdef PERL_PRESERVE_IVUV
+ /* We must see if we can perform the addition with integers if possible,
+ as the integer code detects overflow while the NV code doesn't.
+ If either argument hasn't had a numeric conversion yet attempt to get
+ the IV. It's important to do this now, rather than just assuming that
+ it's not IOK as a PV of "9223372036854775806" may not take well to NV
+ addition, and an SV which is NOK, NV=6.0 ought to be coerced to
+ integer in case the second argument is IV=9223372036854775806
+ We can (now) rely on sv_2iv to do the right thing, only setting the
+ public IOK flag if the value in the NV (or PV) slot is truly integer.
+
+ A side effect is that this also aggressively prefers integer maths over
+ fp maths for integer values. */
+ SvIV_please(TOPs);
+ if (SvIOK(TOPs)) {
+ /* Unless the left argument is integer in range we are going to have to
+ use NV maths. Hence only attempt to coerce the right argument if
+ we know the left is integer. */
+ if (!useleft) {
+ /* left operand is undef, treat as zero. + 0 is identity. */
+ if (SvUOK(TOPs)) {
+ dPOPuv; /* Scary macros. Lets put a sequence point (;) here */
+ if (value <= (UV)IV_MIN) {
+ /* 2s complement assumption. */
+ SETi(-(IV)value);
+ RETURN;
+ } /* else drop through into NVs below */
+ } else {
+ dPOPiv;
+ SETu((UV)-value);
+ RETURN;
+ }
+ } else {
+ /* Left operand is defined, so is it IV? */
+ SvIV_please(TOPm1s);
+ if (SvIOK(TOPm1s)) {
+ bool auvok = SvUOK(TOPm1s);
+ bool buvok = SvUOK(TOPs);
+
+ if (!auvok && !buvok) { /* ## IV - IV ## */
+ IV aiv = SvIVX(TOPm1s);
+ IV biv = SvIVX(TOPs);
+ IV result = aiv - biv;
+
+ if (biv >= 0 ? (result < aiv) : (result >= aiv)) {
+ SP--;
+ SETi( result );
+ RETURN;
+ }
+ /* +ve - +ve can't overflow. (worst case 0 - IV_MAX) */
+ /* -ve - -ve can't overflow. (worst case -1 - IV_MIN) */
+ /* -ve - +ve can only overflow too negative. */
+ /* leaving +ve - -ve, which will go UV */
+ if (aiv >= 0 && biv < 0) { /* assert don't need biv <0 */
+ /* 2s complement assumption for IV_MIN */
+ UV result = (UV)aiv + (UV)-biv;
+ /* UV + UV must get bigger. +ve IV + +ve IV +1 can't
+ overflow UV (2s complement assumption */
+ assert (result >= (UV) aiv);
+ SP--;
+ SETu( result );
+ RETURN;
+ }
+ /* Overflow, drop through to NVs */
+ } else if (auvok && buvok) { /* ## UV - UV ## */
+ UV auv = SvUVX(TOPm1s);
+ UV buv = SvUVX(TOPs);
+ IV result;
+
+ if (auv >= buv) {
+ SP--;
+ SETu( auv - buv );
+ RETURN;
+ }
+ /* Blatant 2s complement assumption. */
+ result = (IV)(auv - buv);
+ if (result < 0) {
+ SP--;
+ SETi( result );
+ RETURN;
+ }
+ /* Overflow on IV - IV, drop through to NVs */
+ } else if (auvok) { /* ## Mixed UV - IV ## */
+ UV auv = SvUVX(TOPm1s);
+ IV biv = SvIVX(TOPs);
+
+ if (biv < 0) {
+ /* 2s complement assumptions for IV_MIN */
+ UV result = auv + ((UV)-biv);
+ /* UV + UV can only get bigger... */
+ if (result >= auv) {
+ SP--;
+ SETu( result );
+ RETURN;
+ }
+ /* and if it gets too big for UV then it's NV time. */
+ } else if (auv > (UV)IV_MAX) {
+ /* I think I'm making an implicit 2s complement
+ assumption that IV_MIN == -IV_MAX - 1 */
+ /* biv is >= 0 */
+ UV result = auv - (UV)biv;
+ assert (result <= auv);
+ SP--;
+ SETu( result );
+ RETURN;
+ } else {
+ /* biv is >= 0 */
+ IV result = (IV)auv - biv;
+ assert (result <= (IV)auv);
+ SP--;
+ SETi( result );
+ RETURN;
+ }
+ } else { /* ## Mixed IV - UV ## */
+ IV aiv = SvIVX(TOPm1s);
+ UV buv = SvUVX(TOPs);
+ IV result = aiv - (IV)buv; /* 2s complement assumption. */
+
+ /* result must not get larger. */
+ if (result <= aiv) {
+ SP--;
+ SETi( result );
+ RETURN;
+ } /* end of IV-IV / UV-UV / UV-IV / IV-UV */
+ }
+ }
+ }
+ }
+#endif
{
- dPOPTOPnnrl_ul;
- SETn( left - right );
- RETURN;
+ dPOPnv;
+ if (!useleft) {
+ /* left operand is undef, treat as zero - value */
+ SETn(-value);
+ RETURN;
+ }
+ SETn( TOPn - value );
+ RETURN;
}
}
PP(pp_lt)
{
djSP; tryAMAGICbinSET(lt,0);
+#ifdef PERL_PRESERVE_IVUV
+ SvIV_please(TOPs);
+ if (SvIOK(TOPs)) {
+ SvIV_please(TOPm1s);
+ if (SvIOK(TOPm1s)) {
+ bool auvok = SvUOK(TOPm1s);
+ bool buvok = SvUOK(TOPs);
+
+ if (!auvok && !buvok) { /* ## IV < IV ## */
+ IV aiv = SvIVX(TOPm1s);
+ IV biv = SvIVX(TOPs);
+
+ SP--;
+ SETs(boolSV(aiv < biv));
+ RETURN;
+ }
+ if (auvok && buvok) { /* ## UV < UV ## */
+ UV auv = SvUVX(TOPm1s);
+ UV buv = SvUVX(TOPs);
+
+ SP--;
+ SETs(boolSV(auv < buv));
+ RETURN;
+ }
+ if (auvok) { /* ## UV < IV ## */
+ UV auv;
+ IV biv;
+
+ biv = SvIVX(TOPs);
+ SP--;
+ if (biv < 0) {
+ /* As (a) is a UV, it's >=0, so it cannot be < */
+ SETs(&PL_sv_no);
+ RETURN;
+ }
+ auv = SvUVX(TOPs);
+ if (auv >= (UV) IV_MAX) {
+ /* As (b) is an IV, it cannot be > IV_MAX */
+ SETs(&PL_sv_no);
+ RETURN;
+ }
+ SETs(boolSV(auv < (UV)biv));
+ RETURN;
+ }
+ { /* ## IV < UV ## */
+ IV aiv;
+ UV buv;
+
+ aiv = SvIVX(TOPm1s);
+ if (aiv < 0) {
+ /* As (b) is a UV, it's >=0, so it must be < */
+ SP--;
+ SETs(&PL_sv_yes);
+ RETURN;
+ }
+ buv = SvUVX(TOPs);
+ SP--;
+ if (buv > (UV) IV_MAX) {
+ /* As (a) is an IV, it cannot be > IV_MAX */
+ SETs(&PL_sv_yes);
+ RETURN;
+ }
+ SETs(boolSV((UV)aiv < buv));
+ RETURN;
+ }
+ }
+ }
+#endif
{
dPOPnv;
SETs(boolSV(TOPn < value));
PP(pp_gt)
{
djSP; tryAMAGICbinSET(gt,0);
+#ifdef PERL_PRESERVE_IVUV
+ SvIV_please(TOPs);
+ if (SvIOK(TOPs)) {
+ SvIV_please(TOPm1s);
+ if (SvIOK(TOPm1s)) {
+ bool auvok = SvUOK(TOPm1s);
+ bool buvok = SvUOK(TOPs);
+
+ if (!auvok && !buvok) { /* ## IV > IV ## */
+ IV aiv = SvIVX(TOPm1s);
+ IV biv = SvIVX(TOPs);
+
+ SP--;
+ SETs(boolSV(aiv > biv));
+ RETURN;
+ }
+ if (auvok && buvok) { /* ## UV > UV ## */
+ UV auv = SvUVX(TOPm1s);
+ UV buv = SvUVX(TOPs);
+
+ SP--;
+ SETs(boolSV(auv > buv));
+ RETURN;
+ }
+ if (auvok) { /* ## UV > IV ## */
+ UV auv;
+ IV biv;
+
+ biv = SvIVX(TOPs);
+ SP--;
+ if (biv < 0) {
+ /* As (a) is a UV, it's >=0, so it must be > */
+ SETs(&PL_sv_yes);
+ RETURN;
+ }
+ auv = SvUVX(TOPs);
+ if (auv > (UV) IV_MAX) {
+ /* As (b) is an IV, it cannot be > IV_MAX */
+ SETs(&PL_sv_yes);
+ RETURN;
+ }
+ SETs(boolSV(auv > (UV)biv));
+ RETURN;
+ }
+ { /* ## IV > UV ## */
+ IV aiv;
+ UV buv;
+
+ aiv = SvIVX(TOPm1s);
+ if (aiv < 0) {
+ /* As (b) is a UV, it's >=0, so it cannot be > */
+ SP--;
+ SETs(&PL_sv_no);
+ RETURN;
+ }
+ buv = SvUVX(TOPs);
+ SP--;
+ if (buv >= (UV) IV_MAX) {
+ /* As (a) is an IV, it cannot be > IV_MAX */
+ SETs(&PL_sv_no);
+ RETURN;
+ }
+ SETs(boolSV((UV)aiv > buv));
+ RETURN;
+ }
+ }
+ }
+#endif
{
dPOPnv;
SETs(boolSV(TOPn > value));
PP(pp_le)
{
djSP; tryAMAGICbinSET(le,0);
+#ifdef PERL_PRESERVE_IVUV
+ SvIV_please(TOPs);
+ if (SvIOK(TOPs)) {
+ SvIV_please(TOPm1s);
+ if (SvIOK(TOPm1s)) {
+ bool auvok = SvUOK(TOPm1s);
+ bool buvok = SvUOK(TOPs);
+
+ if (!auvok && !buvok) { /* ## IV <= IV ## */
+ IV aiv = SvIVX(TOPm1s);
+ IV biv = SvIVX(TOPs);
+
+ SP--;
+ SETs(boolSV(aiv <= biv));
+ RETURN;
+ }
+ if (auvok && buvok) { /* ## UV <= UV ## */
+ UV auv = SvUVX(TOPm1s);
+ UV buv = SvUVX(TOPs);
+
+ SP--;
+ SETs(boolSV(auv <= buv));
+ RETURN;
+ }
+ if (auvok) { /* ## UV <= IV ## */
+ UV auv;
+ IV biv;
+
+ biv = SvIVX(TOPs);
+ SP--;
+ if (biv < 0) {
+ /* As (a) is a UV, it's >=0, so a cannot be <= */
+ SETs(&PL_sv_no);
+ RETURN;
+ }
+ auv = SvUVX(TOPs);
+ if (auv > (UV) IV_MAX) {
+ /* As (b) is an IV, it cannot be > IV_MAX */
+ SETs(&PL_sv_no);
+ RETURN;
+ }
+ SETs(boolSV(auv <= (UV)biv));
+ RETURN;
+ }
+ { /* ## IV <= UV ## */
+ IV aiv;
+ UV buv;
+
+ aiv = SvIVX(TOPm1s);
+ if (aiv < 0) {
+ /* As (b) is a UV, it's >=0, so a must be <= */
+ SP--;
+ SETs(&PL_sv_yes);
+ RETURN;
+ }
+ buv = SvUVX(TOPs);
+ SP--;
+ if (buv >= (UV) IV_MAX) {
+ /* As (a) is an IV, it cannot be > IV_MAX */
+ SETs(&PL_sv_yes);
+ RETURN;
+ }
+ SETs(boolSV((UV)aiv <= buv));
+ RETURN;
+ }
+ }
+ }
+#endif
{
dPOPnv;
SETs(boolSV(TOPn <= value));
PP(pp_ge)
{
djSP; tryAMAGICbinSET(ge,0);
+#ifdef PERL_PRESERVE_IVUV
+ SvIV_please(TOPs);
+ if (SvIOK(TOPs)) {
+ SvIV_please(TOPm1s);
+ if (SvIOK(TOPm1s)) {
+ bool auvok = SvUOK(TOPm1s);
+ bool buvok = SvUOK(TOPs);
+
+ if (!auvok && !buvok) { /* ## IV >= IV ## */
+ IV aiv = SvIVX(TOPm1s);
+ IV biv = SvIVX(TOPs);
+
+ SP--;
+ SETs(boolSV(aiv >= biv));
+ RETURN;
+ }
+ if (auvok && buvok) { /* ## UV >= UV ## */
+ UV auv = SvUVX(TOPm1s);
+ UV buv = SvUVX(TOPs);
+
+ SP--;
+ SETs(boolSV(auv >= buv));
+ RETURN;
+ }
+ if (auvok) { /* ## UV >= IV ## */
+ UV auv;
+ IV biv;
+
+ biv = SvIVX(TOPs);
+ SP--;
+ if (biv < 0) {
+ /* As (a) is a UV, it's >=0, so it must be >= */
+ SETs(&PL_sv_yes);
+ RETURN;
+ }
+ auv = SvUVX(TOPs);
+ if (auv >= (UV) IV_MAX) {
+ /* As (b) is an IV, it cannot be > IV_MAX */
+ SETs(&PL_sv_yes);
+ RETURN;
+ }
+ SETs(boolSV(auv >= (UV)biv));
+ RETURN;
+ }
+ { /* ## IV >= UV ## */
+ IV aiv;
+ UV buv;
+
+ aiv = SvIVX(TOPm1s);
+ if (aiv < 0) {
+ /* As (b) is a UV, it's >=0, so a cannot be >= */
+ SP--;
+ SETs(&PL_sv_no);
+ RETURN;
+ }
+ buv = SvUVX(TOPs);
+ SP--;
+ if (buv > (UV) IV_MAX) {
+ /* As (a) is an IV, it cannot be > IV_MAX */
+ SETs(&PL_sv_no);
+ RETURN;
+ }
+ SETs(boolSV((UV)aiv >= buv));
+ RETURN;
+ }
+ }
+ }
+#endif
{
dPOPnv;
SETs(boolSV(TOPn >= value));
PP(pp_ne)
{
djSP; tryAMAGICbinSET(ne,0);
+#ifdef PERL_PRESERVE_IVUV
+ SvIV_please(TOPs);
+ if (SvIOK(TOPs)) {
+ SvIV_please(TOPm1s);
+ if (SvIOK(TOPm1s)) {
+ bool auvok = SvUOK(TOPm1s);
+ bool buvok = SvUOK(TOPs);
+
+ if (!auvok && !buvok) { /* ## IV <=> IV ## */
+ IV aiv = SvIVX(TOPm1s);
+ IV biv = SvIVX(TOPs);
+
+ SP--;
+ SETs(boolSV(aiv != biv));
+ RETURN;
+ }
+ if (auvok && buvok) { /* ## UV != UV ## */
+ UV auv = SvUVX(TOPm1s);
+ UV buv = SvUVX(TOPs);
+
+ SP--;
+ SETs(boolSV(auv != buv));
+ RETURN;
+ }
+ { /* ## Mixed IV,UV ## */
+ IV iv;
+ UV uv;
+
+ /* != is commutative so swap if needed (save code) */
+ if (auvok) {
+ /* swap. top of stack (b) is the iv */
+ iv = SvIVX(TOPs);
+ SP--;
+ if (iv < 0) {
+ /* As (a) is a UV, it's >0, so it cannot be == */
+ SETs(&PL_sv_yes);
+ RETURN;
+ }
+ uv = SvUVX(TOPs);
+ } else {
+ iv = SvIVX(TOPm1s);
+ SP--;
+ if (iv < 0) {
+ /* As (b) is a UV, it's >0, so it cannot be == */
+ SETs(&PL_sv_yes);
+ RETURN;
+ }
+ uv = SvUVX(*(SP+1)); /* Do I want TOPp1s() ? */
+ }
+ /* we know iv is >= 0 */
+ if (uv > (UV) IV_MAX) {
+ SETs(&PL_sv_yes);
+ RETURN;
+ }
+ SETs(boolSV((UV)iv != uv));
+ RETURN;
+ }
+ }
+ }
+#endif
{
dPOPnv;
SETs(boolSV(TOPn != value));
PP(pp_ncmp)
{
djSP; dTARGET; tryAMAGICbin(ncmp,0);
+#ifdef PERL_PRESERVE_IVUV
+ /* Fortunately it seems NaN isn't IOK */
+ SvIV_please(TOPs);
+ if (SvIOK(TOPs)) {
+ SvIV_please(TOPm1s);
+ if (SvIOK(TOPm1s)) {
+ bool leftuvok = SvUOK(TOPm1s);
+ bool rightuvok = SvUOK(TOPs);
+ I32 value;
+ if (!leftuvok && !rightuvok) { /* ## IV <=> IV ## */
+ IV leftiv = SvIVX(TOPm1s);
+ IV rightiv = SvIVX(TOPs);
+
+ if (leftiv > rightiv)
+ value = 1;
+ else if (leftiv < rightiv)
+ value = -1;
+ else
+ value = 0;
+ } else if (leftuvok && rightuvok) { /* ## UV <=> UV ## */
+ UV leftuv = SvUVX(TOPm1s);
+ UV rightuv = SvUVX(TOPs);
+
+ if (leftuv > rightuv)
+ value = 1;
+ else if (leftuv < rightuv)
+ value = -1;
+ else
+ value = 0;
+ } else if (leftuvok) { /* ## UV <=> IV ## */
+ UV leftuv;
+ IV rightiv;
+
+ rightiv = SvIVX(TOPs);
+ if (rightiv < 0) {
+ /* As (a) is a UV, it's >=0, so it cannot be < */
+ value = 1;
+ } else {
+ leftuv = SvUVX(TOPm1s);
+ if (leftuv > (UV) IV_MAX) {
+ /* As (b) is an IV, it cannot be > IV_MAX */
+ value = 1;
+ } else if (leftuv > (UV)rightiv) {
+ value = 1;
+ } else if (leftuv < (UV)rightiv) {
+ value = -1;
+ } else {
+ value = 0;
+ }
+ }
+ } else { /* ## IV <=> UV ## */
+ IV leftiv;
+ UV rightuv;
+
+ leftiv = SvIVX(TOPm1s);
+ if (leftiv < 0) {
+ /* As (b) is a UV, it's >=0, so it must be < */
+ value = -1;
+ } else {
+ rightuv = SvUVX(TOPs);
+ if (rightuv > (UV) IV_MAX) {
+ /* As (a) is an IV, it cannot be > IV_MAX */
+ value = -1;
+ } else if (leftiv > (UV)rightuv) {
+ value = 1;
+ } else if (leftiv < (UV)rightuv) {
+ value = -1;
+ } else {
+ value = 0;
+ }
+ }
+ }
+ SP--;
+ SETi(value);
+ RETURN;
+ }
+ }
+#endif
{
dPOPTOPnnrl;
I32 value;
djSP; dTARGET; tryAMAGICun(neg);
{
dTOPss;
+ int flags = SvFLAGS(sv);
if (SvGMAGICAL(sv))
mg_get(sv);
- if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv)) {
+ if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
+ /* It's publicly an integer, or privately an integer-not-float */
+ oops_its_an_int:
if (SvIsUV(sv)) {
if (SvIVX(sv) == IV_MIN) {
+ /* 2s complement assumption. */
SETi(SvIVX(sv)); /* special case: -((UV)IV_MAX+1) == IV_MIN */
RETURN;
}
SETi(-SvIVX(sv));
RETURN;
}
+#ifdef PERL_PRESERVE_IVUV
+ else {
+ SETu((UV)IV_MIN);
+ RETURN;
+ }
+#endif
}
if (SvNIOKp(sv))
SETn(-SvNV(sv));
sv_setpvn(TARG, "-", 1);
sv_catsv(TARG, sv);
}
- else
- sv_setnv(TARG, -SvNV(sv));
+ else {
+ SvIV_please(sv);
+ if (SvIOK(sv))
+ goto oops_its_an_int;
+ sv_setnv(TARG, -SvNV(sv));
+ }
SETTARG;
}
else
}
}
else {
- register char *tmps;
- register long *tmpl;
+ register U8 *tmps;
register I32 anum;
STRLEN len;
SvSetSV(TARG, sv);
- tmps = SvPV_force(TARG, len);
+ tmps = (U8*)SvPV_force(TARG, len);
anum = len;
+ if (SvUTF8(TARG)) {
+ /* Calculate exact length, let's not estimate. */
+ STRLEN targlen = 0;
+ U8 *result;
+ U8 *send;
+ STRLEN l;
+ UV nchar = 0;
+ UV nwide = 0;
+
+ send = tmps + len;
+ while (tmps < send) {
+ UV c = utf8_to_uv(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
+ tmps += UTF8SKIP(tmps);
+ targlen += UNISKIP(~c);
+ nchar++;
+ if (c > 0xff)
+ nwide++;
+ }
+
+ /* Now rewind strings and write them. */
+ tmps -= len;
+
+ if (nwide) {
+ Newz(0, result, targlen + 1, U8);
+ while (tmps < send) {
+ UV c = utf8_to_uv(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
+ tmps += UTF8SKIP(tmps);
+ result = uv_to_utf8(result, ~c);
+ }
+ *result = '\0';
+ result -= targlen;
+ sv_setpvn(TARG, (char*)result, targlen);
+ SvUTF8_on(TARG);
+ }
+ else {
+ Newz(0, result, nchar + 1, U8);
+ while (tmps < send) {
+ U8 c = (U8)utf8_to_uv(tmps, 0, &l, UTF8_ALLOW_ANY);
+ tmps += UTF8SKIP(tmps);
+ *result++ = ~c;
+ }
+ *result = '\0';
+ result -= nchar;
+ sv_setpvn(TARG, (char*)result, nchar);
+ }
+ Safefree(result);
+ SETs(TARG);
+ RETURN;
+ }
#ifdef LIBERAL
- for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
- *tmps = ~*tmps;
- tmpl = (long*)tmps;
- for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
- *tmpl = ~*tmpl;
- tmps = (char*)tmpl;
+ {
+ register long *tmpl;
+ for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
+ *tmps = ~*tmps;
+ tmpl = (long*)tmps;
+ for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
+ *tmpl = ~*tmpl;
+ tmps = (U8*)tmpl;
+ }
#endif
for ( ; anum > 0; anum--, tmps++)
*tmps = ~*tmps;
PP(pp_i_modulo)
{
- djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
{
djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
{
- dPOPTOPiirl;
+ dPOPTOPiirl_ul;
SETi( left + right );
RETURN;
}
{
djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
{
- dPOPTOPiirl;
+ dPOPTOPiirl_ul;
SETi( left - right );
RETURN;
}
#define SEED_C3 269
#define SEED_C5 26107
- dTHR;
#ifndef PERL_NO_DEV_RANDOM
int fd;
#endif
NV value;
value = POPn;
if (value <= 0.0) {
- RESTORE_NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
DIE(aTHX_ "Can't take log of %g", value);
}
value = Perl_log(value);
NV value;
value = POPn;
if (value < 0.0) {
- RESTORE_NUMERIC_STANDARD();
+ SET_NUMERIC_STANDARD();
DIE(aTHX_ "Can't take sqrt of %g", value);
}
value = Perl_sqrt(value);
{
djSP; dTARGET;
{
- NV value = TOPn;
- IV iv;
-
- if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) {
- iv = SvIVX(TOPs);
- SETi(iv);
- }
- else {
- if (value >= 0.0)
- (void)Perl_modf(value, &value);
- else {
- (void)Perl_modf(-value, &value);
- value = -value;
- }
- iv = I_V(value);
- if (iv == value)
- SETi(iv);
- else
- SETn(value);
+ NV value;
+ IV iv = TOPi; /* attempt to convert to IV if possible. */
+ /* XXX it's arguable that compiler casting to IV might be subtly
+ different from modf (for numbers inside (IV_MIN,UV_MAX)) in which
+ else preferring IV has introduced a subtle behaviour change bug. OTOH
+ relying on floating point to be accurate is a bug. */
+
+ if (SvIOK(TOPs)) {
+ if (SvIsUV(TOPs)) {
+ UV uv = TOPu;
+ SETu(uv);
+ } else
+ SETi(iv);
+ } else {
+ value = TOPn;
+ if (value >= 0.0) {
+ if (value < (NV)UV_MAX + 0.5) {
+ SETu(U_V(value));
+ } else {
+#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
+ (void)Perl_modf(value, &value);
+#else
+ double tmp = (double)value;
+ (void)Perl_modf(tmp, &tmp);
+ value = (NV)tmp;
+#endif
+ }
+ }
+ else {
+ if (value > (NV)IV_MIN - 0.5) {
+ SETi(I_V(value));
+ } else {
+#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
+ (void)Perl_modf(-value, &value);
+ value = -value;
+#else
+ double tmp = (double)value;
+ (void)Perl_modf(-tmp, &tmp);
+ value = -(NV)tmp;
+#endif
+ SETn(value);
+ }
+ }
}
}
RETURN;
{
djSP; dTARGET; tryAMAGICun(abs);
{
- NV value = TOPn;
- IV iv;
-
- if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) &&
- (iv = SvIVX(TOPs)) != IV_MIN) {
- if (iv < 0)
- iv = -iv;
- SETi(iv);
- }
- else {
+ /* This will cache the NV value if string isn't actually integer */
+ IV iv = TOPi;
+
+ if (SvIOK(TOPs)) {
+ /* IVX is precise */
+ if (SvIsUV(TOPs)) {
+ SETu(TOPu); /* force it to be numeric only */
+ } else {
+ if (iv >= 0) {
+ SETi(iv);
+ } else {
+ if (iv != IV_MIN) {
+ SETi(-iv);
+ } else {
+ /* 2s complement assumption. Also, not really needed as
+ IV_MIN and -IV_MIN should both be %100...00 and NV-able */
+ SETu(IV_MIN);
+ }
+ }
+ }
+ } else{
+ NV value = TOPn;
if (value < 0.0)
- value = -value;
+ value = -value;
SETn(value);
}
}
{
djSP; dTARGET;
char *tmps;
- I32 argtype;
+ STRLEN argtype;
STRLEN n_a;
tmps = POPpx;
{
djSP; dTARGET;
NV value;
- I32 argtype;
+ STRLEN argtype;
char *tmps;
STRLEN n_a;
PP(pp_vec)
{
djSP; dTARGET;
- register I32 size = POPi;
- register I32 offset = POPi;
+ register IV size = POPi;
+ register IV offset = POPi;
register SV *src = POPs;
I32 lvalue = PL_op->op_flags & OPf_MOD;
PP(pp_ord)
{
djSP; dTARGET;
- UV value;
- STRLEN n_a;
- SV *tmpsv = POPs;
- U8 *tmps = (U8*)SvPVx(tmpsv,n_a);
- I32 retlen;
+ SV *argsv = POPs;
+ STRLEN len;
+ U8 *s = (U8*)SvPVx(argsv, len);
- if ((*tmps & 0x80) && DO_UTF8(tmpsv))
- value = utf8_to_uv(tmps, &retlen);
- else
- value = (UV)(*tmps & 255);
- XPUSHu(value);
+ XPUSHu(DO_UTF8(argsv) ? utf8_to_uv_simple(s, 0) : (*s & 0xff));
RETURN;
}
{
djSP; dTARGET;
char *tmps;
- U32 value = POPu;
+ UV value = POPu;
(void)SvUPGRADE(TARG,SVt_PV);
- if (value > 255 && !IN_BYTE) {
+ if ((value > 255 && !IN_BYTE) || (value & 0x80 && PL_hints & HINT_UTF8) ) {
SvGROW(TARG, UTF8_MAXLEN+1);
tmps = SvPVX(TARG);
tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value);
sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
#endif
#else
- DIE(aTHX_
+ DIE(aTHX_
"The crypt() function is unimplemented due to excessive paranoia.");
#endif
SETs(TARG);
STRLEN slen;
if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
- I32 ulen;
- U8 tmpbuf[UTF8_MAXLEN];
+ STRLEN ulen;
+ U8 tmpbuf[UTF8_MAXLEN+1];
U8 *tend;
- UV uv = utf8_to_uv(s, &ulen);
+ UV uv = utf8_to_uv(s, slen, &ulen, 0);
if (PL_op->op_private & OPpLOCALE) {
TAINT;
STRLEN slen;
if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
- I32 ulen;
- U8 tmpbuf[UTF8_MAXLEN];
+ STRLEN ulen;
+ U8 tmpbuf[UTF8_MAXLEN+1];
U8 *tend;
- UV uv = utf8_to_uv(s, &ulen);
+ UV uv = utf8_to_uv(s, slen, &ulen, 0);
if (PL_op->op_private & OPpLOCALE) {
TAINT;
if (DO_UTF8(sv)) {
dTARGET;
- I32 ulen;
+ STRLEN ulen;
register U8 *d;
U8 *send;
TAINT;
SvTAINTED_on(TARG);
while (s < send) {
- d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen)));
+ d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, len, &ulen, 0)));
s += ulen;
}
}
if (DO_UTF8(sv)) {
dTARGET;
- I32 ulen;
+ STRLEN ulen;
register U8 *d;
U8 *send;
TAINT;
SvTAINTED_on(TARG);
while (s < send) {
- d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen)));
+ d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, len, &ulen, 0)));
s += ulen;
}
}
while (++MARK <= SP) {
SV *keysv = *MARK;
SV **svp;
+ I32 preeminent = SvRMAGICAL(hv) ? 1 : hv_exists_ent(hv, keysv, 0);
if (realhv) {
HE *he = hv_fetch_ent(hv, keysv, lval, 0);
svp = he ? &HeVAL(he) : 0;
STRLEN n_a;
DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
}
- if (PL_op->op_private & OPpLVAL_INTRO)
- save_helem(hv, keysv, svp);
+ if (PL_op->op_private & OPpLVAL_INTRO) {
+ if (preeminent)
+ save_helem(hv, keysv, svp);
+ else {
+ STRLEN keylen;
+ char *key = SvPV(keysv, keylen);
+ save_delete(hv, key, keylen);
+ }
+ }
}
*MARK = svp ? *svp : &PL_sv_undef;
}
ix = SvIVx(*lelem);
if (ix < 0)
ix += max;
- else
+ else
ix -= arybase;
if (ix < 0 || ix >= max)
*lelem = &PL_sv_undef;
register char *str;
/* These must not be in registers: */
- I16 ashort;
+ short ashort;
int aint;
- I32 along;
+ long along;
#ifdef HAS_QUAD
Quad_t aquad;
#endif
len = strend - s;
if (checksum) {
while (len-- > 0 && s < strend) {
- auint = utf8_to_uv((U8*)s, &along);
+ STRLEN alen;
+ auint = utf8_to_uv((U8*)s, strend - s, &alen, 0);
+ along = alen;
s += along;
if (checksum > 32)
cdouble += (NV)auint;
EXTEND(SP, len);
EXTEND_MORTAL(len);
while (len-- > 0 && s < strend) {
- auint = utf8_to_uv((U8*)s, &along);
+ STRLEN alen;
+ auint = utf8_to_uv((U8*)s, strend - s, &alen, 0);
+ along = alen;
s += along;
sv = NEWSV(37, 0);
sv_setuv(sv, (UV)auint);
if (checksum) {
#if LONGSIZE != SIZE32
if (natint) {
- long along;
while (len-- > 0) {
COPYNN(s, &along, sizeof(long));
s += sizeof(long);
#endif
{
while (len-- > 0) {
+#if LONGSIZE > SIZE32 && INTSIZE == SIZE32
+ I32 along;
+#endif
COPY32(s, &along);
#if LONGSIZE > SIZE32
if (along > 2147483647)
EXTEND_MORTAL(len);
#if LONGSIZE != SIZE32
if (natint) {
- long along;
while (len-- > 0) {
COPYNN(s, &along, sizeof(long));
s += sizeof(long);
#endif
{
while (len-- > 0) {
+#if LONGSIZE > SIZE32 && INTSIZE == SIZE32
+ I32 along;
+#endif
COPY32(s, &along);
#if LONGSIZE > SIZE32
if (along > 2147483647)
char *t;
STRLEN n_a;
- sv = Perl_newSVpvf(aTHX_ "%.*Vu", (int)TYPE_DIGITS(UV), auv);
+ sv = Perl_newSVpvf(aTHX_ "%.*"UVf, (int)TYPE_DIGITS(UV), auv);
while (s < strend) {
sv = mul128(sv, *s & 0x7f);
if (!(*s++ & 0x80)) {
*/
if (PL_uudmap['M'] == 0) {
int i;
-
+
for (i = 0; i < sizeof(PL_uuemap); i += 1)
PL_uudmap[(U8)PL_uuemap[i]] = i;
/*
register I32 items;
STRLEN fromlen;
register char *pat = SvPVx(*++MARK, fromlen);
+ char *patcopy;
register char *patend = pat + fromlen;
register I32 len;
I32 datumtype;
items = SP - MARK;
MARK++;
sv_setpvn(cat, "", 0);
+ patcopy = pat;
while (pat < patend) {
SV *lengthcode = Nullsv;
#define NEXTFROM ( lengthcode ? lengthcode : items-- > 0 ? *MARK++ : &PL_sv_no)
#ifdef PERL_NATINT_PACK
natint = 0;
#endif
- if (isSPACE(datumtype))
+ if (isSPACE(datumtype)) {
+ patcopy++;
continue;
+ }
+ if (datumtype == 'U' && pat == patcopy+1)
+ SvUTF8_on(cat);
if (datumtype == '#') {
while (pat < patend && *pat != '\n')
pat++;
while (len-- > 0) {
fromstr = NEXTFROM;
auint = SvUV(fromstr);
- SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN);
+ SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN + 1);
SvCUR_set(cat, (char*)uv_to_utf8((U8*)SvEND(cat),auint)
- SvPVX(cat));
}
do {
double next = floor(adouble / 128);
*--in = (unsigned char)(adouble - (next * 128)) | 0x80;
- if (--in < buf) /* this cannot happen ;-) */
+ if (in <= buf) /* this cannot happen ;-) */
DIE(aTHX_ "Cannot compress integer");
+ in--;
adouble = next;
} while (adouble > 0);
buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
{
djSP; dTARG;
AV *ary;
- register I32 limit = POPi; /* note, negative is forever */
+ register IV limit = POPi; /* note, negative is forever */
SV *sv = POPs;
+ bool do_utf8 = DO_UTF8(sv);
STRLEN len;
register char *s = SvPV(sv, len);
char *strend = s + len;
register SV *dstr;
register char *m;
I32 iters = 0;
- I32 maxiters = (strend - s) + 10;
+ STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (strend - s);
+ I32 maxiters = slen + 10;
I32 i;
char *orig;
I32 origlimit = limit;
pm = (PMOP*)POPs;
#endif
if (!pm || !s)
- DIE(aTHX_ "panic: do_split");
+ DIE(aTHX_ "panic: pp_split");
rx = pm->op_pmregexp;
TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
+ if (do_utf8)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
s = m + 1;
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
+ if (do_utf8)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
s = m;
}
&& !(rx->reganch & ROPT_ANCH)) {
int tail = (rx->reganch & RE_INTUIT_TAIL);
SV *csv = CALLREG_INTUIT_STRING(aTHX_ rx);
- char c;
len = rx->minlen;
if (len == 1 && !tail) {
- c = *SvPV(csv,len);
+ STRLEN n_a;
+ char c = *SvPV(csv, n_a);
while (--limit) {
/*SUPPRESS 530*/
for (m = s; m < strend && *m != c; m++) ;
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
+ if (do_utf8)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
- s = m + 1;
+ /* The rx->minlen is in characters but we want to step
+ * s ahead by bytes. */
+ s = m + (do_utf8 ? SvCUR(csv) : len);
}
}
else {
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
+ if (do_utf8)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
- s = m + len; /* Fake \n at the end */
+ /* The rx->minlen is in characters but we want to step
+ * s ahead by bytes. */
+ s = m + (do_utf8 ? SvCUR(csv) : len); /* Fake \n at the end */
}
}
}
else {
- maxiters += (strend - s) * rx->nparens;
+ maxiters += slen * rx->nparens;
while (s < strend && --limit
-/* && (!rx->check_substr
+/* && (!rx->check_substr
|| ((s = CALLREG_INTUIT_START(aTHX_ rx, sv, s, strend,
0, NULL))))
*/ && CALLREGEXEC(aTHX_ rx, s, strend, orig,
sv_setpvn(dstr, s, m-s);
if (make_mortal)
sv_2mortal(dstr);
+ if (do_utf8)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
if (rx->nparens) {
for (i = 1; i <= rx->nparens; i++) {
dstr = NEWSV(33, 0);
if (make_mortal)
sv_2mortal(dstr);
+ if (do_utf8)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
}
}
/* keep field after final delim? */
if (s < strend || (iters && origlimit)) {
- dstr = NEWSV(34, strend-s);
- sv_setpvn(dstr, s, strend-s);
+ STRLEN l = strend - s;
+ dstr = NEWSV(34, l);
+ sv_setpvn(dstr, s, l);
if (make_mortal)
sv_2mortal(dstr);
+ if (do_utf8)
+ (void)SvUTF8_on(dstr);
XPUSHs(dstr);
iters++;
}
void
Perl_unlock_condpair(pTHX_ void *svv)
{
- dTHR;
MAGIC *mg = mg_find((SV*)svv, 'm');
if (!mg)
dTOPss;
SV *retsv = sv;
#ifdef USE_THREADS
- Perl_lock(aTHX_ sv);
+ sv_lock(sv);
#endif /* USE_THREADS */
if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
|| SvTYPE(retsv) == SVt_PVCV) {
projects / p5sagit/p5-mst-13.2.git / blobdiff