diff options
| -rw-r--r-- | pod/perldelta.pod | 17 | ||||
| -rw-r--r-- | pod/perlop.pod | 9 | ||||
| -rw-r--r-- | pp.c | 91 | ||||
| -rw-r--r-- | sv.c | 57 | ||||
| -rw-r--r-- | t/op/64bit.t | 29 | ||||
| -rwxr-xr-x | t/op/misc.t | 3 | ||||
| -rwxr-xr-x | t/op/numconvert.t | 2 |
7 files changed, 97 insertions, 111 deletions
diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 3df6f558e9..f1216fe7d0 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -670,24 +670,23 @@ pack() and unpack() "q" and "Q" formats =item * -in basic arithmetics: + - * / % +in basic arithmetics: + - * / % (NOTE: operating close to the limits +of the integer values may produce surprising results) =item * -vec() (but see the below note about bit arithmetics) +in bit arithmetics: & | ^ ~ << >> (NOTE: these used to be forced +to be 32 bits wide.) + +=item * + +vec() =back Note that unless you have the case (a) you will have to configure and compile Perl using the -Duse64bitint Configure flag. -Unfortunately bit arithmetics (&, |, ^, ~, <<, >>) for numbers are not -64-bit clean, they are explictly forced to be 32-bit because of -tangled backward compatibility issues. This limitation is subject to -change. Bit arithmetics for bit vector scalars (created by vec()) are -not limited in their width, you can use the & | ^ ~ operators on such -scalars. - There are actually two modes of 64-bitness: the first one is achieved using Configure -Duse64bitint and the second one using Configure -Duse64bitall. The difference is that the first one is minimal and diff --git a/pod/perlop.pod b/pod/perlop.pod index dfbdd19234..ce25298531 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -148,9 +148,12 @@ starts with a plus or minus, a string starting with the opposite sign is returned. One effect of these rules is that C<-bareword> is equivalent to C<"-bareword">. -Unary "~" performs bitwise negation, i.e., 1's complement. For example, -C<0666 &~ 027> is 0640. (See also L<Integer Arithmetic> and L<Bitwise -String Operators>.) +Unary "~" performs bitwise negation, i.e., 1's complement. For +example, C<0666 & ~027> is 0640. (See also L<Integer Arithmetic> and +L<Bitwise String Operators>.) Note that the width of the result is +platform-dependent: ~0 is 32 bits wide on a 32-bit platform, but 64 +bits wide on a 64-bit platform, so if you are expecting a certain bit +width, remember use the & operator to mask off the excess bits. Unary "+" has no effect whatsoever, even on strings. It is useful syntactically for separating a function name from a parenthesized expression @@ -28,37 +28,6 @@ static double UV_MAX_cxux = ((double)UV_MAX); #endif /* - * Types used in bitwise operations. - * - * Normally we'd just use IV and UV. However, some hardware and - * software combinations (e.g. Alpha and current OSF/1) don't have a - * floating-point type to use for NV that has adequate bits to fully - * hold an IV/UV. (In other words, sizeof(long) == sizeof(double).) - * - * It just so happens that "int" is the right size almost everywhere. - */ -typedef int IBW; -typedef unsigned UBW; - -/* - * Mask used after bitwise operations. - * - * There is at least one realm (Cray word machines) that doesn't - * have an integral type (except char) small enough to be represented - * in a double without loss; that is, it has no 32-bit type. - */ -#if LONGSIZE > 4 && defined(_CRAY) -# define BW_BITS 32 -# define BW_MASK ((1 << BW_BITS) - 1) -# define BW_SIGN (1 << (BW_BITS - 1)) -# define BWi(i) (((i) & BW_SIGN) ? ((i) | ~BW_MASK) : ((i) & BW_MASK)) -# define BWu(u) ((u) & BW_MASK) -#else -# define BWi(i) (i) -# define BWu(u) (u) -#endif - -/* * Offset for integer pack/unpack. * * On architectures where I16 and I32 aren't really 16 and 32 bits, @@ -1144,16 +1113,14 @@ PP(pp_left_shift) { djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); { - IBW shift = POPi; + IV shift = POPi; if (PL_op->op_private & HINT_INTEGER) { - IBW i = TOPi; - i = BWi(i) << shift; - SETi(BWi(i)); + IV i = TOPi; + SETi(i << shift); } else { - UBW u = TOPu; - u <<= shift; - SETu(BWu(u)); + UV u = TOPu; + SETu(u << shift); } RETURN; } @@ -1163,16 +1130,14 @@ PP(pp_right_shift) { djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); { - IBW shift = POPi; + IV shift = POPi; if (PL_op->op_private & HINT_INTEGER) { - IBW i = TOPi; - i = BWi(i) >> shift; - SETi(BWi(i)); + IV i = TOPi; + SETi(i >> shift); } else { - UBW u = TOPu; - u >>= shift; - SETu(BWu(u)); + UV u = TOPu; + SETu(u >> shift); } RETURN; } @@ -1342,12 +1307,12 @@ PP(pp_bit_and) dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { if (PL_op->op_private & HINT_INTEGER) { - IBW value = SvIV(left) & SvIV(right); - SETi(BWi(value)); + IV i = SvIV(left) & SvIV(right); + SETi(i); } else { - UBW value = SvUV(left) & SvUV(right); - SETu(BWu(value)); + UV u = SvUV(left) & SvUV(right); + SETu(u); } } else { @@ -1365,12 +1330,12 @@ PP(pp_bit_xor) dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { if (PL_op->op_private & HINT_INTEGER) { - IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right); - SETi(BWi(value)); + IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right); + SETi(i); } else { - UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right); - SETu(BWu(value)); + UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right); + SETu(u); } } else { @@ -1388,12 +1353,12 @@ PP(pp_bit_or) dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { if (PL_op->op_private & HINT_INTEGER) { - IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right); - SETi(BWi(value)); + IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right); + SETi(i); } else { - UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right); - SETu(BWu(value)); + UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right); + SETu(u); } } else { @@ -1454,12 +1419,12 @@ PP(pp_complement) dTOPss; if (SvNIOKp(sv)) { if (PL_op->op_private & HINT_INTEGER) { - IBW value = ~SvIV(sv); - SETi(BWi(value)); + IV i = ~SvIV(sv); + SETi(i); } else { - UBW value = ~SvUV(sv); - SETu(BWu(value)); + UV u = ~SvUV(sv); + SETu(u); } } else { @@ -4749,15 +4714,11 @@ PP(pp_pack) DIE(aTHX_ "Cannot compress negative numbers"); if ( -#ifdef BW_BITS - adouble <= BW_MASK -#else #ifdef CXUX_BROKEN_CONSTANT_CONVERT adouble <= UV_MAX_cxux #else adouble <= UV_MAX #endif -#endif ) { char buf[1 + sizeof(UV)]; @@ -2097,11 +2097,32 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) return ""; } } - if (SvNOKp(sv)) { /* See note in sv_2uv() */ - /* XXXX 64-bit? IV may have better precision... */ - /* I tried changing this for to be 64-bit-aware and - * the t/op/numconvert.t became very, very, angry. - * --jhi Sep 1999 */ + if (SvIOKp(sv)) { + I32 isIOK = SvIOK(sv); + I32 isUIOK = SvIsUV(sv); + char buf[TYPE_CHARS(UV)]; + char *ebuf, *ptr; + + if (SvTYPE(sv) < SVt_PVIV) + sv_upgrade(sv, SVt_PVIV); + if (isUIOK) + ptr = uiv_2buf(buf, 0, SvUVX(sv), 1, &ebuf); + else + ptr = uiv_2buf(buf, SvIVX(sv), 0, 0, &ebuf); + SvGROW(sv, ebuf - ptr + 1); /* inlined from sv_setpvn */ + Move(ptr,SvPVX(sv),ebuf - ptr,char); + SvCUR_set(sv, ebuf - ptr); + s = SvEND(sv); + *s = '\0'; + if (isIOK) + SvIOK_on(sv); + else + SvIOKp_on(sv); + if (isUIOK) + SvIsUV_on(sv); + SvPOK_on(sv); + } + else if (SvNOKp(sv)) { /* See note in sv_2uv() */ if (SvTYPE(sv) < SVt_PVNV) sv_upgrade(sv, SVt_PVNV); SvGROW(sv, 28); @@ -2126,31 +2147,6 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) *--s = '\0'; #endif } - else if (SvIOKp(sv)) { - U32 isIOK = SvIOK(sv); - U32 isUIOK = SvIsUV(sv); - char buf[TYPE_CHARS(UV)]; - char *ebuf, *ptr; - - if (SvTYPE(sv) < SVt_PVIV) - sv_upgrade(sv, SVt_PVIV); - if (isUIOK) - ptr = uiv_2buf(buf, 0, SvUVX(sv), 1, &ebuf); - else - ptr = uiv_2buf(buf, SvIVX(sv), 0, 0, &ebuf); - SvGROW(sv, ebuf - ptr + 1); /* inlined from sv_setpvn */ - Move(ptr,SvPVX(sv),ebuf - ptr,char); - SvCUR_set(sv, ebuf - ptr); - s = SvEND(sv); - *s = '\0'; - if (isIOK) - SvIOK_on(sv); - else - SvIOKp_on(sv); - if (isUIOK) - SvIsUV_on(sv); - SvPOK_on(sv); - } else { dTHR; if (ckWARN(WARN_UNINITIALIZED) @@ -6078,6 +6074,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV goto uns_integer; case 'X': + /* FALL THROUGH */ case 'x': base = 16; diff --git a/t/op/64bit.t b/t/op/64bit.t index f7103af73e..9648598bc5 100644 --- a/t/op/64bit.t +++ b/t/op/64bit.t @@ -14,10 +14,10 @@ BEGIN { # See the beginning of pp.c and the explanation next to IBW/UBW. # so that using > 0xfffffff constants and -# 32+ bit vector sizes doesn't cause noise +# 32+ bit integers don't cause noise no warnings qw(overflow portable); -print "1..34\n"; +print "1..42\n"; my $q = 12345678901; my $r = 23456789012; @@ -179,4 +179,29 @@ print "ok 33\n"; print "not " unless vec($x, 0, 64) == 0 && vec($x, 2, 64) == 0; print "ok 34\n"; + +print "not " unless ~0 == 0xffffffffffffffff; +print "ok 35\n"; + +print "not " unless (0xffffffff<<32) == 0xffffffff00000000; +print "ok 36\n"; + +print "not " unless ((0xffffffff)<<32)>>32 == 0xffffffff; +print "ok 37\n"; + +print "not " unless 1<<63 == 0x8000000000000000; +print "ok 38\n"; + +print "not " unless (sprintf "%#Vx", 1<<63) eq '0x8000000000000000'; +print "ok 39\n"; + +print "not " unless (0x8000000000000000 | 1) == 0x8000000000000001; +print "ok 40\n"; + +print "not " unless (0xf000000000000000 & 0x8000000000000000) == 0x8000000000000000; +print "ok 41\n"; + +print "not " unless (0xf000000000000000 ^ 0xfffffffffffffff0) == 0x0ffffffffffffff0; +print "ok 42\n"; + # eof diff --git a/t/op/misc.t b/t/op/misc.t index 6ffc04cbcf..b46c0ccb54 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -59,11 +59,12 @@ $a = ":="; split /($a)/o, "a:=b:=c"; print "@_" EXPECT a := b := c ######## +use integer; $cusp = ~0 ^ (~0 >> 1); $, = " "; print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, ($cusp + 1) % 8, "!\n"; EXPECT -7 0 0 1 ! +-1 0 0 1 ! ######## $foo=undef; $foo->go; EXPECT diff --git a/t/op/numconvert.t b/t/op/numconvert.t index 1de8ede9fd..8eb9b6e341 100755 --- a/t/op/numconvert.t +++ b/t/op/numconvert.t @@ -49,8 +49,8 @@ my $max_uv1 = ~0; my $max_uv2 = sprintf "%u", $max_uv1 ** 6; # 6 is an arbitrary number here my $big_iv = do {use integer; $max_uv1 * 16}; # 16 is an arbitrary number here +print "# max_uv1 = $max_uv1, max_uv2 = $max_uv2, big_iv = $big_iv\n"; if ($max_uv1 ne $max_uv2 or $big_iv > $max_uv1) { - # see perldelta.pod section 64-bit support print "1..0\n# Unsigned arithmetic is not sane\n"; exit 0; } |