diff options
| -rw-r--r-- | doop.c | 98 | ||||
| -rw-r--r-- | pod/perldelta.pod | 13 | ||||
| -rw-r--r-- | pod/perldiag.pod | 6 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 9 | ||||
| -rw-r--r-- | pp.h | 6 | ||||
| -rw-r--r-- | t/op/64bit.t | 21 |
6 files changed, 128 insertions, 25 deletions
@@ -737,6 +737,58 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) ((UV) s[offset + 1] << 16) + ( s[offset + 2] << 8); } +#ifdef HAS_QUAD + else if (size == 64) { + dTHR; + if (ckWARN(WARN_PORTABLE)) + Perl_warner(aTHX_ WARN_PORTABLE, + "Bit vector size > 32 non-portable"); + if (offset >= srclen) + retnum = 0; + else if (offset + 1 >= srclen) + retnum = + (UV) s[offset ] << 56; + else if (offset + 2 >= srclen) + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48); + else if (offset + 3 >= srclen) + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48) + + ((UV) s[offset + 2] << 40); + else if (offset + 4 >= srclen) + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48) + + ((UV) s[offset + 2] << 40) + + ((UV) s[offset + 3] << 32); + else if (offset + 5 >= srclen) + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48) + + ((UV) s[offset + 2] << 40) + + ((UV) s[offset + 3] << 32) + + ( s[offset + 4] << 24); + else if (offset + 6 >= srclen) + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48) + + ((UV) s[offset + 2] << 40) + + ((UV) s[offset + 3] << 32) + + ((UV) s[offset + 4] << 24) + + ((UV) s[offset + 5] << 16); + else + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48) + + ((UV) s[offset + 2] << 40) + + ((UV) s[offset + 3] << 32) + + ((UV) s[offset + 4] << 24) + + ((UV) s[offset + 5] << 16) + + ( s[offset + 6] << 8); + } +#endif } } else if (size < 8) @@ -755,6 +807,23 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) ((UV) s[offset + 1] << 16) + ( s[offset + 2] << 8) + s[offset + 3]; +#ifdef HAS_QUAD + else if (size == 64) { + dTHR; + if (ckWARN(WARN_PORTABLE)) + Perl_warner(aTHX_ WARN_PORTABLE, + "Bit vector size > 32 non-portable"); + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48) + + ((UV) s[offset + 2] << 40) + + ((UV) s[offset + 3] << 32) + + ((UV) s[offset + 4] << 24) + + ((UV) s[offset + 5] << 16) + + ( s[offset + 6] << 8) + + s[offset + 7]; + } +#endif } return retnum; @@ -800,16 +869,31 @@ Perl_do_vecset(pTHX_ SV *sv) else { offset >>= 3; /* turn into byte offset */ if (size == 8) - s[offset] = lval & 255; + s[offset ] = lval & 0xff; else if (size == 16) { - s[offset] = (lval >> 8) & 255; - s[offset+1] = lval & 255; + s[offset ] = (lval >> 8) & 0xff; + s[offset+1] = lval & 0xff; } else if (size == 32) { - s[offset] = (lval >> 24) & 255; - s[offset+1] = (lval >> 16) & 255; - s[offset+2] = (lval >> 8) & 255; - s[offset+3] = lval & 255; + s[offset ] = (lval >> 24) & 0xff; + s[offset+1] = (lval >> 16) & 0xff; + s[offset+2] = (lval >> 8) & 0xff; + s[offset+3] = lval & 0xff; + } +#ifdef HAS_QUAD + else if (size == 64) { + dTHR; + if (ckWARN(WARN_PORTABLE)) + Perl_warner(aTHX_ WARN_PORTABLE, + "Bit vector size > 32 non-portable"); + s[offset ] = (lval >> 56) & 0xff; + s[offset+1] = (lval >> 48) & 0xff; + s[offset+2] = (lval >> 40) & 0xff; + s[offset+3] = (lval >> 32) & 0xff; + s[offset+4] = (lval >> 24) & 0xff; + s[offset+5] = (lval >> 16) & 0xff; + s[offset+6] = (lval >> 8) & 0xff; + s[offset+7] = lval & 0xff; } } SvSETMAGIC(targ); diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 90f1729020..26a6450c6b 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -161,19 +161,20 @@ use "quads" (64-integers) as follows: =item in basic arithmetics +=item vec() (but see the below note about bit arithmetics) + =back Note that unless you have the case (a) you will have to configure and compile Perl using the -Duse64bits Configure flag. -Unfortunately, bit operations (&, <<, ...) and vec() do not work, -they are limited to 32 bits. +Unfortunately bit arithmetics (&, |, ^, ~, <<, >>) are not 64-bit clean. Last but not least: note that due to Perl's habit of always using -floating point numbers the quads are still not true integers. When -quads overflow their limits (18446744073709551615 unsigned, --9223372036854775808...9223372036854775807 signed), they are silently -promoted to floating point numbers, after which they will +floating point numbers the quads are still not true integers. +When quads overflow their limits (0...18_446_744_073_709_551_615 unsigned, +-9_223_372_036_854_775_808...9_223_372_036_854_775_807 signed), they +are silently promoted to floating point numbers, after which they will start losing precision (their lower digits). =head2 Large file support diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 49e654afb5..90439402a8 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -488,6 +488,10 @@ L<perlport> for more on portability concerns. (W) You tried to do a bind on a closed socket. Did you forget to check the return value of your socket() call? See L<perlfunc/bind>. +=item Bit vector size > 32 non-portable + +(W) Using bit vector sizes larger than 32 is non-portable. + =item Bizarre copy of %s in %s (P) Perl detected an attempt to copy an internal value that is not copiable. @@ -1522,7 +1526,7 @@ before the illegal character. =item Illegal number of bits in vec (F) The number of bits in vec() (the third argument) must be a power of -two from 1 to 32. +two from 1 to 32 (or 64, if your platform supports that). =item Illegal switch in PERL5OPT: %s diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 0e4b7c7cc3..25c8efe27c 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -4990,15 +4990,18 @@ See also C<keys>, C<each>, and C<sort>. 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. +bit vector. This must be a power of two from 1 to 32 (or 64, if your +platform supports that). + 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; Vectors created with C<vec> can also be manipulated with the logical -operators C<|>, C<&>, and C<^>, which will assume a bit vector operation is -desired when both operands are strings. See L<perlop/"Bitwise String Operators">. +operators C<|>, C<&>, and C<^>, which will assume a bit vector +operation is desired when both operands are strings. +See L<perlop/"Bitwise String Operators">. The following code will build up an ASCII string saying C<'PerlPerlPerl'>. The comments show the string after each step. Note that this code works @@ -67,7 +67,7 @@ #define POPul ((unsigned long)SvIVx(POPs)) #ifdef HAS_QUAD #define POPq ((Quad_t)SvIVx(POPs)) -#define POPuq ((Uquad_t)SvIVx(POPs)) +#define POPuq ((Uquad_t)SvUVx(POPs)) #endif #define TOPs (*sp) @@ -77,10 +77,10 @@ #define TOPi ((IV)SvIV(TOPs)) #define TOPu ((UV)SvUV(TOPs)) #define TOPl ((long)SvIV(TOPs)) -#define TOPul ((unsigned long)SvIV(TOPs)) +#define TOPul ((unsigned long)SvUV(TOPs)) #ifdef HAS_QUAD #define TOPq ((Quad_t)SvIV(TOPs)) -#define TOPuq ((Uquad_t)SvIV(TOPs)) +#define TOPuq ((Uquad_t)SvUV(TOPs)) #endif /* Go to some pains in the rare event that we must extend the stack. */ diff --git a/t/op/64bit.t b/t/op/64bit.t index 4da3a9e2e8..d35254be24 100644 --- a/t/op/64bit.t +++ b/t/op/64bit.t @@ -10,14 +10,14 @@ BEGIN { # This could use a lot of more tests. # -# Nota bene: bit operations (&, |, ^, ~, <<, >>, vec) are not 64-bit clean. +# Nota bene: bit operations (&, |, ^, ~, <<, >>) are not 64-bit clean. # See the beginning of pp.c and the explanation next to IBW/UBW. -# so that using > 0xfffffff constants and 32+ bit -# shifts and vector sizes doesn't cause noise -no warning 'overflow'; +# so that using > 0xfffffff constants and +# 32+ bit vector sizes doesn't cause noise +no warning qw(overflow portable); -print "1..36\n"; +print "1..39\n"; my $q = 12345678901; my $r = 23456789012; @@ -190,3 +190,14 @@ print "not " unless $a == -9223372036854775809; print "ok 36\n"; +$x = ''; +print "not " unless (vec($x, 1, 64) = $q) == $q; +print "ok 37\n"; + +print "not " unless vec($x, 1, 64) == $q && vec($x, 1, 64) > $f; +print "ok 38\n"; + +print "not " unless vec($x, 0, 64) == 0 && vec($x, 2, 64) == 0; +print "ok 39\n"; + +# eof |