X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=07bb33d367add9720dfe56396c8ad45a7bec8f46;hb=564319723c2c18fa4801cd77e0d203a582b4d5a3;hp=3cc975921d2ad364ae6a954c475c27ffb1977447;hpb=d28f7c377ae191ca53d9157f124642cf323614a0;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index 3cc9759..07bb33d 100644 --- a/pp.c +++ b/pp.c @@ -28,6 +28,37 @@ static double UV_MAX_cxux = ((double)UV_MAX); #endif /* + * Types used in bitwise operations. + * + * Normally we'd just use IV and UV. However, some hardware and + * software combinations (e.g. Alpha and current OSF/1) don't have a + * floating-point type to use for NV that has adequate bits to fully + * hold an IV/UV. (In other words, sizeof(long) == sizeof(double).) + * + * It just so happens that "int" is the right size almost everywhere. + */ +typedef int IBW; +typedef unsigned UBW; + +/* + * Mask used after bitwise operations. + * + * There is at least one realm (Cray word machines) that doesn't + * have an integral type (except char) small enough to be represented + * in a double without loss; that is, it has no 32-bit type. + */ +#if LONGSIZE > 4 && defined(_CRAY) && !defined(_CRAYMPP) +# define BW_BITS 32 +# define BW_MASK ((1 << BW_BITS) - 1) +# define BW_SIGN (1 << (BW_BITS - 1)) +# define BWi(i) (((i) & BW_SIGN) ? ((i) | ~BW_MASK) : ((i) & BW_MASK)) +# define BWu(u) ((u) & BW_MASK) +#else +# define BWi(i) (i) +# define BWu(u) (u) +#endif + +/* * Offset for integer pack/unpack. * * On architectures where I16 and I32 aren't really 16 and 32 bits, @@ -375,6 +406,8 @@ PP(pp_rv2cv) if (cv) { if (CvCLONE(cv)) cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); + if ((PL_op->op_private & OPpLVAL_INTRO) && !CvLVALUE(cv)) + Perl_croak(aTHX_ "Can't modify non-lvalue subroutine call"); } else cv = (CV*)&PL_sv_undef; @@ -900,7 +933,6 @@ PP(pp_pow) PP(pp_multiply) { djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); - tryIVIVbin(*); { dPOPTOPnnrl; SETn( left * right ); @@ -911,16 +943,6 @@ PP(pp_multiply) PP(pp_divide) { djSP; dATARGET; tryAMAGICbin(div,opASSIGN); - if (TOPIOKbin) { - dPOPTOPiirl_ul; - if (right == 0) - DIE(aTHX_ "Illegal division by zero"); - if ((left % right) && !(PL_op->op_private & HINT_INTEGER)) - SETn( (NV)left / (NV)right ); - else - SETi( left / right ); - RETURN; - } { dPOPPOPnnrl; NV value; @@ -1100,7 +1122,6 @@ PP(pp_repeat) PP(pp_subtract) { djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); - tryIVIVbin(-); { dPOPTOPnnrl_ul; SETn( left - right ); @@ -1112,14 +1133,16 @@ PP(pp_left_shift) { djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); { - IV shift = POPi; + IBW shift = POPi; if (PL_op->op_private & HINT_INTEGER) { - IV i = TOPi; - SETi(i << shift); + IBW i = TOPi; + i = BWi(i) << shift; + SETi(BWi(i)); } else { - UV u = TOPu; - SETu(u << shift); + UBW u = TOPu; + u <<= shift; + SETu(BWu(u)); } RETURN; } @@ -1129,14 +1152,16 @@ PP(pp_right_shift) { djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); { - IV shift = POPi; + IBW shift = POPi; if (PL_op->op_private & HINT_INTEGER) { - IV i = TOPi; - SETi(i >> shift); + IBW i = TOPi; + i = BWi(i) >> shift; + SETi(BWi(i)); } else { - UV u = TOPu; - SETu(u >> shift); + UBW u = TOPu; + u >>= shift; + SETu(BWu(u)); } RETURN; } @@ -1306,12 +1331,12 @@ PP(pp_bit_and) dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { if (PL_op->op_private & HINT_INTEGER) { - IV value = SvIV(left) & SvIV(right); - SETi(value); + IBW value = SvIV(left) & SvIV(right); + SETi(BWi(value)); } else { - UV value = SvUV(left) & SvUV(right); - SETu(value); + UBW value = SvUV(left) & SvUV(right); + SETu(BWu(value)); } } else { @@ -1329,12 +1354,12 @@ PP(pp_bit_xor) dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { if (PL_op->op_private & HINT_INTEGER) { - IV value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right); - SETi(value); + IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right); + SETi(BWi(value)); } else { - UV value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right); - SETu(value); + UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right); + SETu(BWu(value)); } } else { @@ -1352,12 +1377,12 @@ PP(pp_bit_or) dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { if (PL_op->op_private & HINT_INTEGER) { - IV value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right); - SETi(value); + IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right); + SETi(BWi(value)); } else { - UV value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right); - SETu(value); + UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right); + SETu(BWu(value)); } } else { @@ -1418,12 +1443,12 @@ PP(pp_complement) dTOPss; if (SvNIOKp(sv)) { if (PL_op->op_private & HINT_INTEGER) { - IV value = ~SvIV(sv); - SETi(value); + IBW value = ~SvIV(sv); + SETi(BWi(value)); } else { - UV value = ~SvUV(sv); - SETu(value); + UBW value = ~SvUV(sv); + SETu(BWu(value)); } } else { @@ -1753,9 +1778,9 @@ S_seed(pTHX) # endif #endif u += SEED_C3 * (U32)getpid(); - u += SEED_C4 * (U32)(UV)PL_stack_sp; + u += SEED_C4 * (U32)PTR2UV(PL_stack_sp); #ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */ - u += SEED_C5 * (U32)(UV)&when; + u += SEED_C5 * (U32)PTR2UV(&when); #endif return u; } @@ -2029,74 +2054,24 @@ PP(pp_vec) register I32 offset = POPi; register SV *src = POPs; I32 lvalue = PL_op->op_flags & OPf_MOD; - STRLEN srclen; - unsigned char *s = (unsigned char*)SvPV(src, srclen); - unsigned long retnum; - I32 len; - SvTAINTED_off(TARG); /* decontaminate */ - offset *= size; /* turn into bit offset */ - len = (offset + size + 7) / 8; - if (offset < 0 || size < 1) - retnum = 0; - else { - if (lvalue) { /* it's an lvalue! */ - if (SvTYPE(TARG) < SVt_PVLV) { - sv_upgrade(TARG, SVt_PVLV); - sv_magic(TARG, Nullsv, 'v', Nullch, 0); - } - - LvTYPE(TARG) = 'v'; - if (LvTARG(TARG) != src) { - if (LvTARG(TARG)) - SvREFCNT_dec(LvTARG(TARG)); - LvTARG(TARG) = SvREFCNT_inc(src); - } - LvTARGOFF(TARG) = offset; - LvTARGLEN(TARG) = size; - } - if (len > srclen) { - if (size <= 8) - retnum = 0; - else { - offset >>= 3; - if (size == 16) { - if (offset >= srclen) - retnum = 0; - else - retnum = (unsigned long) s[offset] << 8; - } - else if (size == 32) { - if (offset >= srclen) - retnum = 0; - else if (offset + 1 >= srclen) - retnum = (unsigned long) s[offset] << 24; - else if (offset + 2 >= srclen) - retnum = ((unsigned long) s[offset] << 24) + - ((unsigned long) s[offset + 1] << 16); - else - retnum = ((unsigned long) s[offset] << 24) + - ((unsigned long) s[offset + 1] << 16) + - (s[offset + 2] << 8); - } - } + SvTAINTED_off(TARG); /* decontaminate */ + if (lvalue) { /* it's an lvalue! */ + if (SvTYPE(TARG) < SVt_PVLV) { + sv_upgrade(TARG, SVt_PVLV); + sv_magic(TARG, Nullsv, 'v', Nullch, 0); } - else if (size < 8) - retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1); - else { - offset >>= 3; - if (size == 8) - retnum = s[offset]; - else if (size == 16) - retnum = ((unsigned long) s[offset] << 8) + s[offset+1]; - else if (size == 32) - retnum = ((unsigned long) s[offset] << 24) + - ((unsigned long) s[offset + 1] << 16) + - (s[offset + 2] << 8) + s[offset+3]; + LvTYPE(TARG) = 'v'; + if (LvTARG(TARG) != src) { + if (LvTARG(TARG)) + SvREFCNT_dec(LvTARG(TARG)); + LvTARG(TARG) = SvREFCNT_inc(src); } + LvTARGOFF(TARG) = offset; + LvTARGLEN(TARG) = size; } - sv_setuv(TARG, (UV)retnum); + sv_setuv(TARG, do_vecget(src, offset, size)); PUSHs(TARG); RETURN; } @@ -4954,6 +4929,7 @@ PP(pp_split) else { if (!AvREAL(ary)) { AvREAL_on(ary); + AvREIFY_off(ary); for (i = AvFILLp(ary); i >= 0; i--) AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */ } @@ -5004,14 +4980,7 @@ PP(pp_split) ++s; } } - else if (rx->prelen == 1 && *rx->precomp == '^') { - if (!(pm->op_pmflags & PMf_MULTILINE) - && !(pm->op_pmregexp->reganch & ROPT_WARNED)) { - if (ckWARN(WARN_DEPRECATED)) - Perl_warner(aTHX_ WARN_DEPRECATED, - "split /^/ better written as split /^/m"); - pm->op_pmregexp->reganch |= ROPT_WARNED; - } + else if (strEQ("^", rx->precomp)) { while (--limit) { /*SUPPRESS 530*/ for (m = s; m < strend && *m != '\n'; m++) ;