#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,
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;
PP(pp_multiply)
{
djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
- tryIVIVbin(*);
{
dPOPTOPnnrl;
SETn( left * right );
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;
PP(pp_subtract)
{
djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
- tryIVIVbin(-);
{
dPOPTOPnnrl_ul;
SETn( left - right );
{
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;
}
{
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;
}
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 {
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 {
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 {
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 {
# 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;
}
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;
}
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 */
}
++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++) ;
projects / p5sagit/p5-mst-13.2.git / blobdiff