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

diff --git a/doop.c b/doop.c
index ad626ca..b064838 100644 (file)
--- 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 f344dc4..a8b80ec 100644 (file)
--- 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 6f22017..ad6a649 100755 (executable)
--- 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 3b034e8..7379173 100644 (file)
--- 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 fea5fcf..aa5dadd 100644 (file)
--- 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 c3faf68..2423f58 100644 (file)
--- 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 63addd6..9871b48 100644 (file)
--- 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 48898da..f409754 100755 (executable)
--- 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 a068427..fe1c2b0 100644 (file)
--- 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 d5456d2..f4e3709 100644 (file)
--- 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 8a0f0f7..187e72a 100644 (file)
--- 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 b7fed35..5584aa4 100644 (file)
--- 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);