t/op/bitwise.t

   1 #!parrot
   2 # Copyright (C) 2001-2009, Parrot Foundation.
   3 # $Id$
   4
   5 =head1 NAME
   6
   7 t/op/bitwise.t - Bitwise Ops
   8
   9 =head1 SYNOPSIS
  10
  11         % prove t/op/bitwise.t
  12
  13 =head1 DESCRIPTION
  14
  15 Tests various bitwise logical operations.
  16
  17 =cut
  18
  19 .sub main :main
  20     .include 'test_more.pir'
  21
  22     plan(68)
  23
  24     test_shr_i_i_i_shift_rt_()
  25     test_shr_i_i_shift_rt_()
  26     test_shr_i_i_ic_shift_rt_()
  27     test_shr_i_ic_i_shift_rt_()
  28     test_shr_i_ic_ic_shift_rt_()
  29     test_lsr_i_ic_ic_shift_rt_()
  30     test_lsr_i_ic_shift_rt()
  31     test_lsr_i_i_i_shift_rt()
  32     test_lsr_i_i_ic_shift_rt()
  33     test_shr_i_i_ic_shift_rt_negative()
  34     test_shl_i_i_i_shift_lt()
  35     test_shl_i_i_ic_shift_lt()
  36     test_shl_i_ic_i_shift_lt()
  37     test_shl_i_ic_ic_shift_lt()
  38     test_shl_i_i_shift_lt()
  39     test_bxor_i_i_i_xor()
  40     test_bxor_i_i_ic_xor()
  41     test_bxor_i_ic_xor()
  42     test_band_i_i_i_and()
  43     test_band_i_i_ic_and()
  44     test_band_i_i_ic_and_2()
  45     test_bor_i_i_i()
  46     test_bor_i_i_ic()
  47     test_bor_i_i_ic_2()
  48     test_bnot_i_i_2()
  49     test_rot_i_i_ic_ic()
  50     test_i_reg_shl_and_pmc_shl_are_consistent()
  51     # END_OF_TESTS
  52 .end
  53
  54 .macro exception_is ( M )
  55     .local pmc exception
  56     .local string message
  57     .get_results (exception)
  58
  59     message = exception['message']
  60     is( message, .M, .M )
  61 .endm
  62
  63 .sub test_shr_i_i_i_shift_rt_
  64     set $I0, 0b001100
  65     set $I1, 0b010100
  66     set $I2, 1
  67     set $I3, 2
  68     shr $I4, $I0, $I2
  69     shr $I2, $I0, $I2
  70     shr $I1, $I1, $I3
  71     is( $I4, "6", 'shr_i_i_i (>>)' )
  72     is( $I2, "6", 'shr_i_i_i (>>)' )
  73     is( $I1, "5", 'shr_i_i_i (>>)' )
  74     is( $I0, "12", 'shr_i_i_i (>>)' )
  75 .end
  76
  77 .sub test_shr_i_i_shift_rt_
  78     set $I0, 0b001100
  79     set $I1, 0b010100
  80     set $I2, 1
  81     set $I3, 2
  82     shr $I0, $I2
  83     shr $I1, $I3
  84     is( $I0, "6", 'shr_i_i (>>)' )
  85     is( $I1, "5", 'shr_i_i (>>)' )
  86 .end
  87
  88 .sub test_shr_i_i_ic_shift_rt_
  89     set     $I0, 0b001100
  90     set     $I1, 0b010100
  91     shr     $I2, $I0, 1
  92     shr     $I1, $I1, 2
  93     is( $I2, "6", 'shr_i_i_ic (>>)' )
  94     is( $I1, "5", 'shr_i_i_ic (>>)' )
  95     is( $I0, "12", 'shr_i_i_ic (>>)' )
  96 .end
  97
  98 .sub test_shr_i_ic_i_shift_rt_
  99     set $I0, 1
 100     set $I1, 2
 101     shr $I2, 0b001100, $I0
 102     shr $I1, 0b010100, $I1
 103     is( $I2, "6", 'shr_i_ic_i (>>)' )
 104     is( $I1, "5", 'shr_i_ic_i (>>)' )
 105 .end
 106
 107 .sub test_shr_i_ic_ic_shift_rt_
 108     shr $I2, 0b001100, 1
 109     shr $I1, 0b010100, 2
 110     is( $I2, "6", 'shr_i_ic_ic (>>)' )
 111     is( $I1, "5", 'shr_i_ic_ic (>>)' )
 112 .end
 113
 114 # The crux of this test is that a proper logical right shift
 115 # will clear the most significant bit, so the shifted value
 116 # will be a positive value on any 2's or 1's complement CPU
 117 .sub test_lsr_i_ic_ic_shift_rt_
 118     lsr $I2, -40, 1
 119     lt $I2, 0, BAD
 120     ok( 1, 'lsr_i_ic_ic (>>)' )
 121     goto END
 122   BAD:
 123     ok( 0, 'lsr_i_ic_ic (>>)' )
 124   END:
 125 .end
 126
 127 .sub test_lsr_i_ic_shift_rt
 128     set $I2, -100
 129     lsr $I2, 1
 130     lt $I2, 0, BAD
 131     ok( 1, 'lsr_i_ic (>>) OK')
 132     goto END
 133   BAD:
 134     ok( 0, 'lsr_i_ic (>>)')
 135   END:
 136 .end
 137
 138 .sub test_lsr_i_i_i_shift_rt
 139     set $I0, -40
 140     set $I1, 1
 141     lsr $I2, $I0, $I1
 142     lt $I2, 0, BAD
 143     ok( 1, 'lsr_i_i_i (>>) OK')
 144     goto END
 145   BAD:
 146     ok( 0, 'lsr_i_i_i (>>)')
 147   END:
 148 .end
 149
 150 # ... and the missing op signature was untested and wrong in JIT/i386
 151 .sub test_lsr_i_i_ic_shift_rt
 152     set $I0, -40
 153     lsr $I2, $I0, 1
 154     lt $I2, 0, BAD
 155     ok( 1, 'lsr_i_i_ic (>>) OK')
 156     goto END
 157   BAD:
 158     ok( 0, 'lsr_i_i_ic (>>)')
 159   END:
 160 .end
 161
 162 .sub test_shr_i_i_ic_shift_rt_negative
 163     set $I0, -40
 164     shr $I2, $I0, 1
 165     ge $I2, 0, BAD
 166     ok( 1, 'shr_i_i_ic (>>) negative OK')
 167     goto END
 168   BAD:
 169     ok( 0, 'shr_i_i_ic (>>) negative')
 170   END:
 171 .end
 172
 173 .sub test_shl_i_i_i_shift_lt
 174     set $I0, 0b001100
 175     set $I1, 0b010100
 176     set $I2, 2
 177     set $I3, 1
 178     shl $I4, $I0, $I2
 179     shl $I2, $I0, $I2
 180     shl $I1, $I1, $I3
 181     is( $I4, "48", 'shl_i_i_i (<<)' )
 182     is( $I2, "48", 'shl_i_i_i (<<)' )
 183     is( $I1, "40", 'shl_i_i_i (<<)' )
 184     is( $I0, "12", 'shl_i_i_i (<<)' )
 185 .end
 186
 187 .sub test_shl_i_i_ic_shift_lt
 188     set $I0, 0b001100
 189     set $I1, 0b010100
 190     shl $I2, $I0, 2
 191     shl $I1, $I1, 1
 192     is( $I2, "48", 'shl_i_i_ic (<<)' )
 193     is( $I1, "40", 'shl_i_i_ic (<<)' )
 194     is( $I0, "12", 'shl_i_i_ic (<<)' )
 195 .end
 196
 197 .sub test_shl_i_ic_i_shift_lt
 198     set $I0, 2
 199     set $I1, 1
 200     shl $I2, 0b001100, $I0
 201     shl $I1, 0b010100, $I1
 202     is( $I2, "48", 'shl_i_ic_i (<<)' )
 203     is( $I1, "40", 'shl_i_ic_i (<<)' )
 204 .end
 205
 206 .sub test_shl_i_ic_ic_shift_lt
 207     shl $I2, 0b001100, 2
 208     shl $I1, 0b010100, 1
 209     is( $I2, "48", 'shl_i_ic_ic (<<)' )
 210     is( $I1, "40", 'shl_i_ic_ic (<<)' )
 211 .end
 212
 213 .sub test_shl_i_i_shift_lt
 214     set $I0, 0b001100
 215     set $I1, 0b010100
 216     set $I2, 1
 217     set $I3, 2
 218     shl $I0, $I2
 219     shl $I1, $I3
 220     is( $I0, "24", 'shl_i_i (<<)' )
 221     is( $I1, "80", 'shl_i_i (<<)' )
 222 .end
 223
 224 .sub test_bxor_i_i_i_xor
 225     set     $I0, 0b001100
 226     set     $I1, 0b100110
 227     bxor    $I2, $I0, $I1
 228     is( $I2, "42", 'bxor_i_i_i (^)' )
 229     bxor    $I1, $I0, $I1
 230     is( $I1, "42", 'bxor_i_i_i (^)' )
 231     is( $I0, "12", 'bxor_i_i_i (^)' )
 232 .end
 233
 234 .sub test_bxor_i_i_ic_xor
 235     set $I0, 0b001100
 236     bxor $I2, $I0, 0b100110
 237     is( $I2, "42", 'bxor_i_i_ic (^)' )
 238     is( $I0, "12", 'bxor_i_i_ic (^)' )
 239     bxor $I0, $I0, 0b100110
 240     is( $I0, "42", 'bxor_i_i_ic (^)' )
 241 .end
 242
 243 .sub test_bxor_i_ic_xor
 244     set $I0, 0b001100
 245     set $I2, 0b000011
 246     bxor $I2, $I0
 247     is( $I2, "15", 'bxor_i|ic (^)' )
 248     set $I2, 0b001100
 249     bxor  $I2, $I0
 250     is( $I2, "0", 'bxor_i|ic (^)' )
 251     set $I2, 0b101010
 252     bxor $I2, $I2
 253     is( $I2, "0", 'bxor_i|ic (^)' )
 254     set $I2, 0b010101
 255     bxor $I2, 0b000011
 256     is( $I2, "22", 'bxor_i|ic (^)' )
 257 .end
 258
 259 .sub test_band_i_i_i_and
 260     set     $I0, 0b001100
 261     set     $I1, 0b010110
 262     band    $I2, $I0,$I1
 263     is( $I2, "4", 'band_i_i_i (&)' )
 264     band    $I1,$I0,$I1
 265     is( $I1, "4", 'band_i_i_i (&)' )
 266     is( $I0, "12", 'band_i_i_i (&)' )
 267 .end
 268
 269 .sub test_band_i_i_ic_and
 270     set $I0, 0b001100
 271     band $I2, $I0,0b010110
 272     is( $I2, "4", 'band_i_i_ic (&)' )
 273     is( $I0, "12", 'band_i_i_ic (&)' )
 274     band $I0,$I0,0b010110
 275     is( $I0, "4", 'band_i_i_ic (&)' )
 276 .end
 277
 278 .sub test_band_i_i_ic_and_2
 279     set $I0, 0b001100
 280     set $I2, 0b000011
 281     band $I2, $I0
 282     is( $I2, "0", 'band_i_i|ic (&)' )
 283
 284     set $I2, 0b001100
 285     band  $I2, $I0
 286     is( $I2, "12", 'band_i_i|ic (&)' )
 287
 288     set $I2, 0b101010
 289     band $I2, $I2
 290     is( $I2, "42", 'band_i_i|ic (&)' )
 291
 292     set $I2, 0b010101
 293     band $I2, 0b000011
 294     is( $I2, "1", 'band_i_i|ic (&)' )
 295 .end
 296
 297 .sub test_bor_i_i_i
 298     set $I0, 0b001100
 299     set $I1, 0b010110
 300     bor $I2, $I0,$I1
 301     is( $I2, "30", 'bor_i_i_i (|)' )
 302     bor $I1,$I0,$I1
 303     is( $I1, "30", 'bor_i_i_i (|)' )
 304     is( $I0, "12", 'bor_i_i_i (|)' )
 305 .end
 306
 307 .sub test_bor_i_i_ic
 308     set $I0, 0b001100
 309     bor $I2, $I0,0b010110
 310     is( $I2, "30", 'bor_i_i_ic (|)' )
 311     is( $I0, "12", 'bor_i_i_ic (|)' )
 312     bor $I0,$I0,0b010110
 313     is( $I0, "30", 'bor_i_i_ic (|)' )
 314 .end
 315
 316 .sub test_bor_i_i_ic_2
 317     set $I0, 0b001100
 318     set $I2, 0b000011
 319     bor $I2, $I0
 320     is( $I2, "15", 'bor_i_i|ic (|) 2' )
 321     set $I2, 0b001100
 322     bor  $I2, $I0
 323     is( $I2, "12", 'bor_i_i|ic (|) 2' )
 324     set $I2, 0b101010
 325     bor $I2, $I2
 326     is( $I2, "42", 'bor_i_i|ic (|) 2' )
 327     set $I2, 0b010101
 328     bor $I2, 0b000011
 329     is( $I2, "23", 'bor_i_i|ic (|) 2' )
 330 .end
 331
 332 .sub test_bnot_i_i_2
 333     set     $I0, 0b001100
 334     set     $I1, 0b001100
 335     set     $I31, 0b111111
 336     bnot    $I2, $I0
 337     band    $I2, $I2, $I31
 338     is( $I2, "51", 'bnot_i_i (~) 2' )
 339     bnot    $I1, $I1
 340     band    $I1, $I1, $I31
 341     is( $I1, "51", 'bnot_i_i (~) 2' )
 342     is( $I0, "12", 'bnot_i_i (~) 2' )
 343 .end
 344
 345 .sub test_rot_i_i_ic_ic
 346     .include "iglobals.pasm"
 347     .local pmc interp     # a handle to our interpreter object.
 348     interp = getinterp
 349     .local pmc config
 350     config = interp[.IGLOBALS_CONFIG_HASH]
 351     .local int intvalsize
 352     intvalsize = config['intvalsize']
 353
 354     .local int int_bits
 355     int_bits = intvalsize * 8
 356
 357     set $I0, 0b001100
 358
 359     gt intvalsize, 4, do64bit
 360
 361     rot $I1, $I0, 1, 32         # 1 left
 362     is( $I1, "24", 'rot_i_i_ic_ic' )
 363     rot $I1, $I0, -1, 32        # 1 right
 364     is( $I1, "6", 'rot_i_i_ic_ic' )
 365     goto END
 366
 367   do64bit:
 368     rot $I1, $I0, 1, 64         # 1 left
 369     is( $I1, "24", 'rot_i_i_ic_ic' )
 370     rot $I1, $I0, -1, 64        # 1 right
 371     is( $I1, "6", 'rot_i_i_ic_ic' )
 372
 373   END:
 374 .end
 375
 376 ## The PMC shl op will promote Integer to Bigint when needed.  We can't stuff a
 377 ## BigInt in an I register, but we can produce the same result modulo wordsize.
 378 ## [Only we cheat by using the word size minus one, so that we don't have to
 379 ## deal with negative numbers.  -- rgr, 2-Jun-07.]
 380 .sub test_i_reg_shl_and_pmc_shl_are_consistent
 381
 382     .include "iglobals.pasm"
 383     .local pmc interp     # a handle to our interpreter object.
 384     interp = getinterp
 385     .local pmc config
 386     config = interp[.IGLOBALS_CONFIG_HASH]
 387     .local int gmp
 388     gmp = config['gmp']
 389
 390     if gmp, runtest
 391     skip( 2, 'no BigInt lib found' )
 392     goto END
 393
 394   runtest:
 395
 396     ## Figure out the wordsize.  We need integer_modulus because assigning a
 397     ## too-big BigInt throws an error otherwise.
 398     .include 'sysinfo.pasm'
 399     .local int i_bytes_per_word, i_bits_per_word_minus_one
 400     .local pmc bits_per_word_minus_one, integer_modulus
 401     i_bytes_per_word = sysinfo .SYSINFO_PARROT_INTSIZE
 402     i_bits_per_word_minus_one = 8 * i_bytes_per_word
 403     dec i_bits_per_word_minus_one
 404     bits_per_word_minus_one = new 'Integer'
 405     bits_per_word_minus_one = i_bits_per_word_minus_one
 406     integer_modulus = new 'BigInt'
 407     integer_modulus = 1
 408     integer_modulus <<= bits_per_word_minus_one
 409
 410     ## Test shifting a positive number.
 411     new $P0, 'Integer'
 412     set $P0, 1000001
 413     test_shift($P0, integer_modulus)
 414
 415     ## Test shifting a negative number.
 416     set $P0, -1000001
 417     test_shift($P0, integer_modulus)
 418   END:
 419 .end
 420
 421 .sub test_shift
 422     .param pmc number
 423     .param pmc integer_modulus
 424     new $P1, 'Integer'
 425     set $P1, 1
 426     .local int i_number
 427     i_number = number
 428
 429     ## Start the loop.
 430   loop:
 431     if $P1 > 100 goto done
 432     ## shift number and i_number into $P2 and $I2.
 433     shl $P2, number, $P1
 434     $I1 = $P1
 435     shl $I2, i_number, $I1
 436     ## compare in I registers.
 437     $P3 = mod $P2, integer_modulus
 438     $I3 = $P3
 439     if $I2 >= 0 goto pos_check
 440     ## The register op gave a negative result, but the modulus will always be
 441     ## positive.  If the truncated result is correct, then the difference will
 442     ## be the most negative INTVAL, which is the only number for which -x==x.
 443     $I4 = $I3 - $I2
 444     $I5 = - $I4
 445     if $I4 == $I5 goto ok
 446     goto bad
 447   pos_check:
 448     if $I2 == $I3 goto ok
 449   bad:
 450     ok( 0, "oops; not ok: " )
 451     diag( i_number )
 452     diag( ' << ' )
 453     diag( $I1 )
 454     diag( ' gives I ' )
 455     diag( $I2 )
 456     diag( ' vs. P ' )
 457     diag( $P3 )
 458     diag( ".\n" )
 459     diag( $I5 )
 460     diag( "\n" )
 461   ok:
 462     ## set up for the next one
 463     inc $P1
 464     goto loop
 465   done:
 466     ok( 1, 'finished ok' )
 467 .end
 468
 469 # Local Variables:
 470 #   mode: pir
 471 #   cperl-indent-level: 4
 472 #   fill-column: 100
 473 # End:
 474 # vim: expandtab shiftwidth=4 ft=pir: