((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)
((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;
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);
=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
(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.
=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
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
#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)
#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. */
# 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;
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
projects / p5sagit/p5-mst-13.2.git / commitdiff