Removed duplicated code (in pp.c and mg.c) by introducing

do_vecget().  NOTE: the calling convention of do_vecset()
changes, too: the `offset' that is assigned to LvTARGOFF(TARG)
in pp_vec() is no more multiplied by `size' in pp_vec(),
the multiplication is now done in do_vecset().

Also fix a cpp thinko in change #4002.

p4raw-link: @4002 on //depot/cfgperl: 24db6c0d56fddf85ee587fc1cb1dbce678fa6a8c

p4raw-id: //depot/cfgperl@4004

12 files changed, 114 insertions, 127 deletions

diff --git a/doop.c b/doop.c
index ad626ca6d3..b06483852c 100644
--- a/doop.c
+++ b/doop.c
@@ -697,6 +697,71 @@ Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg)
 	SvTAINTED_on(sv);
 }
 
+UV
+Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
+{
+    STRLEN srclen, len;
+    unsigned char *s = (unsigned char *) SvPV(sv, srclen);
+    UV retnum = 0;
+
+    if (offset < 0 || size < 1)
+	return retnum;
+    offset *= size;	/* turn into bit offset */
+    len = (offset + size + 7) / 8;	/* required number of bytes */
+    if (len > srclen) {
+	if (size <= 8)
+	    retnum = 0;
+	else {
+	    offset >>= 3;	/* turn into byte offset */
+	    if (size == 16) {
+		if (offset >= srclen)
+		    retnum = 0;
+		else
+		    retnum = (UV) s[offset] << 8;
+	    }
+	    else if (size == 32) {
+		if (offset >= srclen)
+		    retnum = 0;
+		else if (offset + 1 >= srclen)
+		    retnum =
+			((UV) s[offset    ] << 24);
+		else if (offset + 2 >= srclen)
+		    retnum =
+			((UV) s[offset    ] << 24) +
+			((UV) s[offset + 1] << 16);
+		else
+		    retnum =
+			((UV) s[offset    ] << 24) +
+			((UV) s[offset + 1] << 16) +
+			(     s[offset + 2] <<  8);
+	    }
+	    else
+		Perl_croak(aTHX_ "Illegal number of bits in vec");
+	}
+    }
+    else if (size < 8)
+	retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
+    else {
+	offset >>= 3;	/* turn into byte offset */
+	if (size == 8)
+	    retnum = s[offset];
+	else if (size == 16)
+	    retnum =
+		((UV) s[offset] <<  8) +
+		      s[offset + 1];
+	else if (size == 32)
+	    retnum =
+		((UV) s[offset    ] << 24) +
+		((UV) s[offset + 1] << 16) +
+		(     s[offset + 2] <<  8) +
+		      s[offset + 3];
+	else
+	    Perl_croak(aTHX_ "Illegal number of bits in vec");
+    }
+
+    return retnum;
+}
+
 void
 Perl_do_vecset(pTHX_ SV *sv)
 {
@@ -704,7 +769,7 @@ Perl_do_vecset(pTHX_ SV *sv)
     register I32 offset;
     register I32 size;
     register unsigned char *s;
-    register unsigned long lval;
+    register UV lval;
     I32 mask;
     STRLEN targlen;
     STRLEN len;
@@ -712,11 +777,12 @@ Perl_do_vecset(pTHX_ SV *sv)
     if (!targ)
 	return;
     s = (unsigned char*)SvPV_force(targ, targlen);
-    lval = U_L(SvNV(sv));
+    lval = SvUV(sv);
     offset = LvTARGOFF(sv);
     size = LvTARGLEN(sv);
     
-    len = (offset + size + 7) / 8;
+    offset *= size;			/* turn into bit offset */
+    len = (offset + size + 7) / 8;	/* required number of bytes */
     if (len > targlen) {
 	s = (unsigned char*)SvGROW(targ, len + 1);
 	(void)memzero(s + targlen, len - targlen + 1);
@@ -727,12 +793,12 @@ Perl_do_vecset(pTHX_ SV *sv)
 	mask = (1 << size) - 1;
 	size = offset & 7;
 	lval &= mask;
-	offset >>= 3;
+	offset >>= 3;			/* turn into byte offset */
 	s[offset] &= ~(mask << size);
 	s[offset] |= lval << size;
     }
     else {
-	offset >>= 3;
+	offset >>= 3;			/* turn into byte offset */
 	if (size == 8)
 	    s[offset] = lval & 255;
 	else if (size == 16) {
diff --git a/embed.h b/embed.h
index f344dc4b2f..a8b80ecb69 100644
--- a/embed.h
+++ b/embed.h
@@ -160,6 +160,7 @@
 #define do_sysseek		Perl_do_sysseek
 #define do_tell			Perl_do_tell
 #define do_trans		Perl_do_trans
+#define do_vecget		Perl_do_vecget
 #define do_vecset		Perl_do_vecset
 #define do_vop			Perl_do_vop
 #define dofile			Perl_dofile
@@ -1485,6 +1486,7 @@
 #define do_sysseek(a,b,c)	Perl_do_sysseek(aTHX_ a,b,c)
 #define do_tell(a)		Perl_do_tell(aTHX_ a)
 #define do_trans(a)		Perl_do_trans(aTHX_ a)
+#define do_vecget(a,b,c)	Perl_do_vecget(aTHX_ a,b,c)
 #define do_vecset(a)		Perl_do_vecset(aTHX_ a)
 #define do_vop(a,b,c,d)		Perl_do_vop(aTHX_ a,b,c,d)
 #define dofile(a)		Perl_dofile(aTHX_ a)
@@ -2923,6 +2925,8 @@
 #define do_tell			Perl_do_tell
 #define Perl_do_trans		CPerlObj::Perl_do_trans
 #define do_trans		Perl_do_trans
+#define Perl_do_vecget		CPerlObj::Perl_do_vecget
+#define do_vecget		Perl_do_vecget
 #define Perl_do_vecset		CPerlObj::Perl_do_vecset
 #define do_vecset		Perl_do_vecset
 #define Perl_do_vop		CPerlObj::Perl_do_vop
diff --git a/embed.pl b/embed.pl
index 6f22017eca..ad6a649515 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1143,6 +1143,7 @@ p	|void	|do_sprintf	|SV* sv|I32 len|SV** sarg
 p	|Off_t	|do_sysseek	|GV* gv|Off_t pos|int whence
 p	|Off_t	|do_tell	|GV* gv
 p	|I32	|do_trans	|SV* sv
+p	|UV	|do_vecget	|SV* sv|I32 offset|I32 size
 p	|void	|do_vecset	|SV* sv
 p	|void	|do_vop		|I32 optype|SV* sv|SV* left|SV* right
 p	|OP*	|dofile		|OP* term
diff --git a/global.sym b/global.sym
index 3b034e8290..7379173182 100644
--- a/global.sym
+++ b/global.sym
@@ -112,6 +112,7 @@ Perl_do_sprintf
 Perl_do_sysseek
 Perl_do_tell
 Perl_do_trans
+Perl_do_vecget
 Perl_do_vecset
 Perl_do_vop
 Perl_dofile
diff --git a/mg.c b/mg.c
index fea5fcf2bd..aa5dadd143 100644
--- a/mg.c
+++ b/mg.c
@@ -1361,65 +1361,13 @@ int
 Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg)
 {
     SV *lsv = LvTARG(sv);
-    unsigned char *s;
-    unsigned long retnum;
-    STRLEN lsvlen;
-    I32 len;
-    I32 offset;
-    I32 size;
 
     if (!lsv) {
 	SvOK_off(sv);
 	return 0;
     }
-    s = (unsigned char *) SvPV(lsv, lsvlen);
-    offset = LvTARGOFF(sv);
-    size = LvTARGLEN(sv);
-    len = (offset + size + 7) / 8;
-
-    /* Copied from pp_vec() */
-
-    if (len > lsvlen) {
-	if (size <= 8)
-	    retnum = 0;
-	else {
-	    offset >>= 3;
-	    if (size == 16) {
-		if (offset >= lsvlen)
-		    retnum = 0;
-		else
-		    retnum = (unsigned long) s[offset] << 8;
-	    }
-	    else if (size == 32) {
-		if (offset >= lsvlen)
-		    retnum = 0;
-		else if (offset + 1 >= lsvlen)
-		    retnum = (unsigned long) s[offset] << 24;
-		else if (offset + 2 >= lsvlen)
-		    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);
-	    }
-	}
-    }
-    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];
-    }
 
-    sv_setuv(sv, (UV)retnum);
+    sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv)));
     return 0;
 }
 
diff --git a/objXSUB.h b/objXSUB.h
index c3faf68190..2423f58bcb 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -1265,6 +1265,10 @@
 #define Perl_do_trans		pPerl->Perl_do_trans
 #undef  do_trans
 #define do_trans		Perl_do_trans
+#undef  Perl_do_vecget
+#define Perl_do_vecget		pPerl->Perl_do_vecget
+#undef  do_vecget
+#define do_vecget		Perl_do_vecget
 #undef  Perl_do_vecset
 #define Perl_do_vecset		pPerl->Perl_do_vecset
 #undef  do_vecset
diff --git a/perl.h b/perl.h
index 63addd6830..9871b48e82 100644
--- a/perl.h
+++ b/perl.h
@@ -1886,7 +1886,7 @@ typedef I32 CHECKPOINT;
 #           endif
 #       endif
 #   endif
-#else
+#endif
 
 /* Used with UV/IV arguments: */
 					/* XXXX: need to speed it up */
diff --git a/perlapi.c b/perlapi.c
index 48898da0dd..f409754310 100755
--- a/perlapi.c
+++ b/perlapi.c
@@ -868,6 +868,13 @@ Perl_do_trans(pTHXo_ SV* sv)
     return ((CPerlObj*)pPerl)->Perl_do_trans(sv);
 }
 
+#undef  Perl_do_vecget
+UV
+Perl_do_vecget(pTHXo_ SV* sv, I32 offset, I32 size)
+{
+    return ((CPerlObj*)pPerl)->Perl_do_vecget(sv, offset, size);
+}
+
 #undef  Perl_do_vecset
 void
 Perl_do_vecset(pTHXo_ SV* sv)
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index a068427c21..fe1c2b0dc2 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1519,6 +1519,11 @@ of the octal number stopped before the 8 or 9.
 in a hexadecimal number.  Interpretation of the hexadecimal number stopped
 before the illegal character.
 
+=item Illegal number of bits in vec
+
+(F) The number of bits in vec() (the third argument) must be from 1 to 8
+(inclusive), or 16, or 32.
+ 
 =item Illegal switch in PERL5OPT: %s
 
 (X) The PERL5OPT environment variable may only be used to set the
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index d5456d2e34..f4e37096a1 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -4988,11 +4988,11 @@ See also C<keys>, C<each>, and C<sort>.
 =item vec EXPR,OFFSET,BITS
 
 Treats the string in EXPR as a vector of unsigned integers, and
-returns the value of the bit field specified by OFFSET.  BITS specifies
-the number of bits that are reserved for each entry in the bit
-vector.  This must be a power of two from 1 to 32.  C<vec> may also be
-assigned to, in which case parentheses are needed to give the expression
-the correct precedence as in
+returns the value of the bit field specified by OFFSET.  BITS
+specifies the number of bits that are reserved for each entry in the
+bit vector.  This must be between 1 and 8 (inclusive), or 16, or 32.
+C<vec> may also be assigned to, in which case parentheses are needed
+to give the expression the correct precedence as in
 
     vec($image, $max_x * $x + $y, 8) = 3;
 
diff --git a/pp.c b/pp.c
index 8a0f0f7131..187e72abf0 100644
--- a/pp.c
+++ b/pp.c
@@ -2052,74 +2052,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;
 }
diff --git a/proto.h b/proto.h
index b7fed35870..5584aa4304 100644
--- a/proto.h
+++ b/proto.h
@@ -125,6 +125,7 @@ VIRTUAL void	Perl_do_sprintf(pTHX_ SV* sv, I32 len, SV** sarg);
 VIRTUAL Off_t	Perl_do_sysseek(pTHX_ GV* gv, Off_t pos, int whence);
 VIRTUAL Off_t	Perl_do_tell(pTHX_ GV* gv);
 VIRTUAL I32	Perl_do_trans(pTHX_ SV* sv);
+VIRTUAL UV	Perl_do_vecget(pTHX_ SV* sv, I32 offset, I32 size);
 VIRTUAL void	Perl_do_vecset(pTHX_ SV* sv);
 VIRTUAL void	Perl_do_vop(pTHX_ I32 optype, SV* sv, SV* left, SV* right);
 VIRTUAL OP*	Perl_dofile(pTHX_ OP* term);