Ticket #1119: bitwise.t.patch
File bitwise.t.patch, 19.8 KB (added by mgrimes, 12 years ago) |
---|
-
t/op/bitwise.t
1 #!p erl2 # Copyright (C) 2001-200 5, Parrot Foundation.1 #!parrot 2 # Copyright (C) 2001-2009, Parrot Foundation. 3 3 # $Id$ 4 4 5 use strict;6 use warnings;7 use lib qw( . lib ../lib ../../lib );8 use Test::More;9 use Parrot::Test tests => 27;10 use Parrot::Config;11 12 5 =head1 NAME 13 6 14 7 t/op/bitwise.t - Bitwise Ops … … 23 16 24 17 =cut 25 18 26 pasm_output_is( <<'CODE', <<'OUTPUT', "shr_i_i_i (>>)" ); 27 set I0, 0b001100 28 set I1, 0b010100 29 set I2, 1 30 set I3, 2 31 shr I4, I0, I2 32 shr I2, I0, I2 33 shr I1, I1, I3 34 print I4 35 print "\n" 36 print I2 37 print "\n" 38 print I1 39 print "\n" 40 print I0 41 print "\n" 42 end 43 CODE 44 6 45 6 46 5 47 12 48 OUTPUT 19 .sub main :main 20 .include 'test_more.pir' 49 21 50 pasm_output_is( <<'CODE', <<'OUTPUT', "shr_i_i (>>)" ); 51 set I0, 0b001100 52 set I1, 0b010100 53 set I2, 1 54 set I3, 2 55 shr I0, I2 56 shr I1, I3 57 print I0 58 print "\n" 59 print I1 60 print "\n" 61 end 62 CODE 63 6 64 5 65 OUTPUT 22 plan(68) 66 23 67 pasm_output_is( <<'CODE', <<'OUTPUT', "shr_i_i_ic (>>)" ); 68 set I0, 0b001100 69 set I1, 0b010100 70 shr I2, I0, 1 71 shr I1, I1, 2 72 print I2 73 print "\n" 74 print I1 75 print "\n" 76 print I0 77 print "\n" 78 end 79 CODE 80 6 81 5 82 12 83 OUTPUT 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 84 53 85 pasm_output_is( <<'CODE', <<'OUTPUT', "shr_i_ic_i (>>)" ); 86 set I0, 1 87 set I1, 2 88 shr I2, 0b001100, I0 89 shr I1, 0b010100, I1 90 print I2 91 print "\n" 92 print I1 93 print "\n" 94 end 95 CODE 96 6 97 5 98 OUTPUT 54 .macro exception_is ( M ) 55 .local pmc exception 56 .local string message 57 .get_results (exception) 99 58 100 pasm_output_is( <<'CODE', <<'OUTPUT', "shr_i_ic_ic (>>)" ); 101 shr I2, 0b001100, 1 102 shr I1, 0b010100, 2 103 print I2 104 print "\n" 105 print I1 106 print "\n" 107 end 108 CODE 109 6 110 5 111 OUTPUT 59 message = exception['message'] 60 is( message, .M, .M ) 61 .endm 112 62 113 # The crux of this test is that a proper logical right shift 114 # will clear the most significant bit, so the shifted value 115 # will be a positive value on any 2's or 1's complement CPU 116 pasm_output_is( <<'CODE', <<'OUTPUT', "lsr_i_ic_ic (>>)" ); 117 lsr I2, -40, 1 118 lt I2, 0, BAD 119 print "OK\n" 120 end 121 BAD: 122 print "Not OK" 123 print "\n" 124 end 125 CODE 126 OK 127 OUTPUT 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 128 76 129 pasm_output_is( <<'CODE', <<'OUTPUT', "lsr_i_ic (>>)" ); 130 set I2, -100 131 lsr I2, 1 132 lt I2, 0, BAD 133 print "OK\n" 134 end 135 BAD: 136 print "Not OK" 137 print "\n" 138 end 139 CODE 140 OK 141 OUTPUT 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 142 87 143 pasm_output_is( <<'CODE', <<'OUTPUT', "lsr_i_i_i (>>)" ); 144 set I0, -40 145 set I1, 1 146 lsr I2, I0, I1 147 lt I2, 0, BAD 148 print "OK\n" 149 end 150 BAD: 151 print "Not OK" 152 print "\n" 153 end 154 CODE 155 OK 156 OUTPUT 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 157 97 158 # ... and the missing op signature was untested and wrong in JIT/i386 159 pasm_output_is( <<'CODE', <<'OUTPUT', "lsr_i_i_ic (>>)" ); 160 set I0, -40 161 lsr I2, I0, 1 162 lt I2, 0, BAD 163 print "OK\n" 164 end 165 BAD: 166 print "Not OK" 167 print "\n" 168 end 169 CODE 170 OK 171 OUTPUT 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 172 106 173 pasm_output_is( <<'CODE', <<'OUTPUT', "shr_i_i_ic (>>) negative" ); 174 set I0, -40 175 shr I2, I0, 1 176 ge I2, 0, BAD 177 print "OK\n" 178 end 179 BAD: 180 print "Not OK" 181 print "\n" 182 end 183 CODE 184 OK 185 OUTPUT 186 pasm_output_is( <<'CODE', <<'OUTPUT', "shl_i_i_i (<<)" ); 187 set I0, 0b001100 188 set I1, 0b010100 189 set I2, 2 190 set I3, 1 191 shl I4, I0, I2 192 shl I2, I0, I2 193 shl I1, I1, I3 194 print I4 195 print "\n" 196 print I2 197 print "\n" 198 print I1 199 print "\n" 200 print I0 201 print "\n" 202 end 203 CODE 204 48 205 48 206 40 207 12 208 OUTPUT 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 209 113 210 pasm_output_is( <<'CODE', <<'OUTPUT', "shl_i_i_ic (<<)" ); 211 set I0, 0b001100 212 set I1, 0b010100 213 shl I2, I0, 2 214 shl I1, I1, 1 215 print I2 216 print "\n" 217 print I1 218 print "\n" 219 print I0 220 print "\n" 221 end 222 CODE 223 48 224 40 225 12 226 OUTPUT 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 227 126 228 pasm_output_is( <<'CODE', <<'OUTPUT', "shl_i_ic_i (<<)" ); 229 set I0, 2 230 set I1, 1 231 shl I2, 0b001100, I0 232 shl I1, 0b010100, I1 233 print I2 234 print "\n" 235 print I1 236 print "\n" 237 end 238 CODE 239 48 240 40 241 OUTPUT 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 242 137 243 pasm_output_is( <<'CODE', <<'OUTPUT', "shl_i_ic_ic (<<)" ); 244 shl I2, 0b001100, 2 245 shl I1, 0b010100, 1 246 print I2 247 print "\n" 248 print I1 249 print "\n" 250 end 251 CODE 252 48 253 40 254 OUTPUT 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 255 149 256 pasm_output_is( <<'CODE', <<'OUTPUT', "shl_i_i (<<)" ); 257 set I0, 0b001100 258 set I1, 0b010100 259 set I2, 1 260 set I3, 2 261 shl I0, I2 262 shl I1, I3 263 print I0 264 print "\n" 265 print I1 266 print "\n" 267 end 268 CODE 269 24 270 80 271 OUTPUT 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 272 161 273 pasm_output_is( <<'CODE', <<'OUTPUT', "bxor_i_i_i (^)" ); 274 set I0, 0b001100 275 set I1, 0b100110 276 bxor I2, I0, I1 277 print I2 278 print "\n" 279 bxor I1, I0, I1 280 print I1 281 print "\n" 282 print I0 283 print "\n" 284 end 285 CODE 286 42 287 42 288 12 289 OUTPUT 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 290 172 291 pasm_output_is( <<'CODE', <<'OUTPUT', "bxor_i_i_ic (^)" ); 292 set I0, 0b001100 293 bxor I2, I0, 0b100110 294 print I2 295 print "\n" 296 print I0 297 print "\n" 298 bxor I0, I0, 0b100110 299 print I0 300 print "\n" 301 end 302 CODE 303 42 304 12 305 42 306 OUTPUT 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 307 186 308 pasm_output_is( <<'CODE', <<'OUTPUT', "bxor_i|ic (^)" ); 309 set I0, 0b001100 310 set I2, 0b000011 311 bxor I2, I0 312 print I2 313 print "\n" 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 314 196 315 set I2, 0b001100 316 bxor I2, I0 317 print I2 318 print "\n" 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 319 205 320 set I2, 0b101010 321 bxor I2, I2 322 print I2 323 print "\n" 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 324 212 325 set I2, 0b010101 326 bxor I2, 0b000011 327 print I2 328 print "\n" 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 329 223 330 end 331 CODE 332 15 333 0 334 0 335 22 336 OUTPUT 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 337 233 338 pasm_output_is( <<'CODE', <<'OUTPUT', "band_i_i_i (&)" ); 339 set I0, 0b001100 340 set I1, 0b010110 341 band I2, I0,I1 342 print I2 343 print "\n" 344 band I1,I0,I1 345 print I1 346 print "\n" 347 print I0 348 print "\n" 349 end 350 CODE 351 4 352 4 353 12 354 OUTPUT 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 355 242 356 pasm_output_is( <<'CODE', <<'OUTPUT', "band_i_i_ic (&)" ); 357 set I0, 0b001100 358 band I2, I0,0b010110 359 print I2 360 print "\n" 361 print I0 362 print "\n" 363 band I0,I0,0b010110 364 print I0 365 print "\n" 366 end 367 CODE 368 4 369 12 370 4 371 OUTPUT 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 372 258 373 pasm_output_is( <<'CODE', <<'OUTPUT', "band_i_i|ic (&)" ); 374 set I0, 0b001100 375 set I2, 0b000011 376 band I2, I0 377 print I2 378 print "\n" 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 379 268 380 set I2, 0b001100 381 band I2, I0 382 print I2 383 print "\n" 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 384 277 385 set I2, 0b101010 386 band I2, I2 387 print I2 388 print "\n" 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 (&)' ) 389 283 390 set I2, 0b010101 391 band I2, 0b000011 392 print I2 393 print "\n" 284 set $I2, 0b001100 285 band $I2, $I0 286 is( $I2, "12", 'band_i_i|ic (&)' ) 394 287 395 end 396 CODE 397 0 398 12 399 42 400 1 401 OUTPUT 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 402 296 403 pasm_output_is( <<'CODE', <<'OUTPUT', "bor_i_i_i (|)" ); 404 set I0, 0b001100 405 set I1, 0b010110 406 bor I2, I0,I1 407 print I2 408 print "\n" 409 bor I1,I0,I1 410 print I1 411 print "\n" 412 print I0 413 print "\n" 414 end 415 CODE 416 30 417 30 418 12 419 OUTPUT 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 420 306 421 pasm_output_is( <<'CODE', <<'OUTPUT', "bor_i_i_ic (|)" ); 422 set I0, 0b001100 423 bor I2, I0,0b010110 424 print I2 425 print "\n" 426 print I0 427 print "\n" 428 bor I0,I0,0b010110 429 print I0 430 print "\n" 431 end 432 CODE 433 30 434 12 435 30 436 OUTPUT 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 437 315 438 pasm_output_is( <<'CODE', <<'OUTPUT', "bor_i_i|ic (|)" ); 439 set I0, 0b001100 440 set I2, 0b000011 441 bor I2, I0 442 print I2 443 print "\n" 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 444 331 445 set I2, 0b001100 446 bor I2, I0 447 print I2 448 print "\n" 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 449 344 450 set I2, 0b101010 451 bor I2, I2 452 print I2 453 print "\n" 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'] 454 353 455 set I2, 0b010101 456 bor I2, 0b000011 457 print I2 458 print "\n" 354 .local int int_bits 355 int_bits = intvalsize * 8 459 356 460 end 461 CODE 462 15 463 12 464 42 465 23 466 OUTPUT 357 set $I0, 0b001100 467 358 468 # use C<and> to only check low order bits, this should be platform nice 469 pasm_output_is( <<'CODE', <<'OUTPUT', "bnot_i_i (~)" ); 470 set I0, 0b001100 471 set I1, 0b001100 472 set I31, 0b111111 473 bnot I2, I0 474 band I2, I2, I31 475 print I2 476 print "\n" 477 bnot I1, I1 478 band I1, I1, I31 479 print I1 480 print "\n" 481 print I0 482 print "\n" 483 end 484 CODE 485 51 486 51 487 12 488 OUTPUT 359 gt intvalsize, 4, do64bit 489 360 490 my $int_bits = $PConfig{intvalsize} * 8; 491 pasm_output_is( <<"CODE", <<'OUTPUT', 'rot_i_i_ic_ic' ); 492 set I0, 0b001100 493 rot I1, I0, 1, $int_bits # 1 left 494 print I1 495 print "\\n" 496 rot I1, I0, -1, $int_bits # 1 right 497 print I1 498 print "\\n" 499 end 500 CODE 501 24 502 6 503 OUTPUT 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 504 366 505 SKIP: { 506 skip 'no BigInt lib found' => 1 507 unless $PConfig{gmp}; 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 508 375 509 my @todo;510 @todo = ( todo => 'broken with JIT (RT #43245)' )511 if ( defined $ENV{TEST_PROG_ARGS} and512 $ENV{TEST_PROG_ARGS} =~ /--runcore=jit/ );513 514 pir_output_is( <<'CODE', <<'OUT', "I-reg shl and PMC shl are consistent", @todo );515 376 ## The PMC shl op will promote Integer to Bigint when needed. We can't stuff a 516 377 ## BigInt in an I register, but we can produce the same result modulo wordsize. 517 378 ## [Only we cheat by using the word size minus one, so that we don't have to 518 379 ## deal with negative numbers. -- rgr, 2-Jun-07.] 519 .sub main :main 380 .sub test_i_reg_shl_and_pmc_shl_are_consistent 381 382 # This seems to be passing fine with --runcore=jit 383 # my @todo; 384 # @todo = ( todo => 'broken with JIT (RT #43245)' ) 385 # if ( defined $ENV{TEST_PROG_ARGS} and 386 # $ENV{TEST_PROG_ARGS} =~ /--runcore=jit/ ); 387 388 .include "iglobals.pasm" 389 .local pmc interp # a handle to our interpreter object. 390 interp = getinterp 391 .local pmc config 392 config = interp[.IGLOBALS_CONFIG_HASH] 393 .local string gmp 394 gmp = config['gmp'] 395 396 if gmp, runtest 397 skip( 1, 'no BigInt lib found' ) 398 goto END 399 400 runtest: 401 520 402 ## Figure out the wordsize. We need integer_modulus because assigning a 521 403 ## too-big BigInt throws an error otherwise. 522 404 .include 'sysinfo.pasm' … … 539 421 ## Test shifting a negative number. 540 422 set $P0, -1000001 541 423 test_shift($P0, integer_modulus) 424 END: 542 425 .end 543 426 544 427 .sub test_shift … … 550 433 i_number = number 551 434 552 435 ## Start the loop. 553 loop:436 loop: 554 437 if $P1 > 100 goto done 555 438 ## shift number and i_number into $P2 and $I2. 556 439 shl $P2, number, $P1 … … 567 450 $I5 = - $I4 568 451 if $I4 == $I5 goto ok 569 452 goto bad 570 pos_check:453 pos_check: 571 454 if $I2 == $I3 goto ok 572 bad:573 print "oops; not ok: "574 print i_number575 print ' << '576 print $I1577 print ' gives I '578 print $I2579 print ' vs. P '580 print $P3581 print ".\n"582 print $I5583 print "\n"584 ok:455 bad: 456 ok( 0, "oops; not ok: " ) 457 diag( i_number ) 458 diag( ' << ' ) 459 diag( $I1 ) 460 diag( ' gives I ' ) 461 diag( $I2 ) 462 diag( ' vs. P ' ) 463 diag( $P3 ) 464 diag( ".\n" ) 465 diag( $I5 ) 466 diag( "\n" ) 467 ok: 585 468 ## set up for the next one 586 469 inc $P1 587 470 goto loop 588 done:589 print "done.\n"471 done: 472 ok( 1, 'finished ok' ) 590 473 .end 591 CODE592 done.593 done.594 OUT595 }596 474 597 475 # Local Variables: 598 # mode: cperl476 # mode: pir 599 477 # cperl-indent-level: 4 600 478 # fill-column: 100 601 479 # End: 602 # vim: expandtab shiftwidth=4 :480 # vim: expandtab shiftwidth=4 ft=pir: