X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/ea12c2aa2714a53b7f16f1990366373be0ed8933..cc4db9ba0518cf86693a3267c1f62c8e35fe6e1d:/pp.c?ds=sidebyside

diff --git a/pp.c b/pp.c
index cde539c..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;
@@ -1100,11 +1133,17 @@ PP(pp_left_shift)
 {
     djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
     {
-      IV shift = POPi;
-      if (PL_op->op_private & HINT_INTEGER)
-	SETi(TOPi << shift);
-      else
-	SETu(TOPu << shift);
+      IBW shift = POPi;
+      if (PL_op->op_private & HINT_INTEGER) {
+	IBW i = TOPi;
+	i = BWi(i) << shift;
+	SETi(BWi(i));
+      }
+      else {
+	UBW u = TOPu;
+	u <<= shift;
+	SETu(BWu(u));
+      }
       RETURN;
     }
 }
@@ -1113,11 +1152,17 @@ PP(pp_right_shift)
 {
     djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
     {
-      IV shift = POPi;
-      if (PL_op->op_private & HINT_INTEGER)
-	SETi(TOPi >> shift);
-      else
-	SETu(TOPu >> shift);
+      IBW shift = POPi;
+      if (PL_op->op_private & HINT_INTEGER) {
+	IBW i = TOPi;
+	i = BWi(i) >> shift;
+	SETi(BWi(i));
+      }
+      else {
+	UBW u = TOPu;
+	u >>= shift;
+	SETu(BWu(u));
+      }
       RETURN;
     }
 }
@@ -1285,10 +1330,14 @@ PP(pp_bit_and)
     {
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
-	if (PL_op->op_private & HINT_INTEGER)
-	  SETi( SvIV(left) & SvIV(right) );
-	else
-	  SETu( SvUV(left) & SvUV(right) );
+	if (PL_op->op_private & HINT_INTEGER) {
+	  IBW value = SvIV(left) & SvIV(right);
+	  SETi(BWi(value));
+	}
+	else {
+	  UBW value = SvUV(left) & SvUV(right);
+	  SETu(BWu(value));
+	}
       }
       else {
 	do_vop(PL_op->op_type, TARG, left, right);
@@ -1304,10 +1353,14 @@ PP(pp_bit_xor)
     {
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
-	if (PL_op->op_private & HINT_INTEGER)
-	  SETi( (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right) );
-	else
-	  SETu( (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right) );
+	if (PL_op->op_private & HINT_INTEGER) {
+	  IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
+	  SETi(BWi(value));
+	}
+	else {
+	  UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
+	  SETu(BWu(value));
+	}
       }
       else {
 	do_vop(PL_op->op_type, TARG, left, right);
@@ -1323,10 +1376,14 @@ PP(pp_bit_or)
     {
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
-	if (PL_op->op_private & HINT_INTEGER)
-	  SETi( (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right) );
-	else
-	  SETu( (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right) );
+	if (PL_op->op_private & HINT_INTEGER) {
+	  IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
+	  SETi(BWi(value));
+	}
+	else {
+	  UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
+	  SETu(BWu(value));
+	}
       }
       else {
 	do_vop(PL_op->op_type, TARG, left, right);
@@ -1385,10 +1442,14 @@ PP(pp_complement)
     {
       dTOPss;
       if (SvNIOKp(sv)) {
-	if (PL_op->op_private & HINT_INTEGER)
-	  SETi( ~SvIV(sv) );
-	else
-	  SETu( ~SvUV(sv) );
+	if (PL_op->op_private & HINT_INTEGER) {
+	  IBW value = ~SvIV(sv);
+	  SETi(BWi(value));
+	}
+	else {
+	  UBW value = ~SvUV(sv);
+	  SETu(BWu(value));
+	}
       }
       else {
 	register char *tmps;
@@ -1717,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;
 }
@@ -4868,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 */
 	    }