From: Jarkko Hietaniemi Date: Thu, 19 Aug 1999 12:49:41 +0000 (+0000) Subject: Removed duplicated code (in pp.c and mg.c) by introducing X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=81e118e078828ea41cd654ee18f4193484a89cf3;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -4988,11 +4988,11 @@ See also C, C, and C. =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 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 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 --- 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 --- 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);