1;;;; the VM definition arithmetic VOPs for the SPARC 2 3;;;; This software is part of the SBCL system. See the README file for 4;;;; more information. 5;;;; 6;;;; This software is derived from the CMU CL system, which was 7;;;; written at Carnegie Mellon University and released into the 8;;;; public domain. The software is in the public domain and is 9;;;; provided with absolutely no warranty. See the COPYING and CREDITS 10;;;; files for more information. 11 12(in-package "SB!VM") 13 14;;;; unary operations. 15 16(define-vop (fast-safe-arith-op) 17 (:policy :fast-safe) 18 (:effects) 19 (:affected)) 20 21(define-vop (fixnum-unop fast-safe-arith-op) 22 (:args (x :scs (any-reg))) 23 (:results (res :scs (any-reg))) 24 (:note "inline fixnum arithmetic") 25 (:arg-types tagged-num) 26 (:result-types tagged-num)) 27 28(define-vop (signed-unop fast-safe-arith-op) 29 (:args (x :scs (signed-reg))) 30 (:results (res :scs (signed-reg))) 31 (:note "inline (signed-byte 32) arithmetic") 32 (:arg-types signed-num) 33 (:result-types signed-num)) 34 35(define-vop (fast-negate/fixnum fixnum-unop) 36 (:translate %negate) 37 (:generator 1 38 (inst neg res x))) 39 40(define-vop (fast-negate/signed signed-unop) 41 (:translate %negate) 42 (:generator 2 43 (inst neg res x))) 44 45(define-vop (fast-lognot/fixnum fixnum-unop) 46 (:translate lognot) 47 (:generator 1 48 (inst xor res x (fixnumize -1)))) 49 50(define-vop (fast-lognot/signed signed-unop) 51 (:translate lognot) 52 (:generator 2 53 (inst not res x))) 54 55;;;; Binary fixnum operations. 56 57;;; Assume that any constant operand is the second arg... 58 59(define-vop (fast-fixnum-binop fast-safe-arith-op) 60 (:args (x :target r :scs (any-reg zero)) 61 (y :target r :scs (any-reg zero))) 62 (:arg-types tagged-num tagged-num) 63 (:results (r :scs (any-reg))) 64 (:result-types tagged-num) 65 (:note "inline fixnum arithmetic")) 66 67(define-vop (fast-unsigned-binop fast-safe-arith-op) 68 (:args (x :target r :scs (unsigned-reg zero)) 69 (y :target r :scs (unsigned-reg zero))) 70 (:arg-types unsigned-num unsigned-num) 71 (:results (r :scs (unsigned-reg))) 72 (:result-types unsigned-num) 73 (:note "inline (unsigned-byte 32) arithmetic")) 74 75(define-vop (fast-signed-binop fast-safe-arith-op) 76 (:args (x :target r :scs (signed-reg zero)) 77 (y :target r :scs (signed-reg zero))) 78 (:arg-types signed-num signed-num) 79 (:results (r :scs (signed-reg))) 80 (:result-types signed-num) 81 (:note "inline (signed-byte 32) arithmetic")) 82 83 84(define-vop (fast-fixnum-binop-c fast-safe-arith-op) 85 (:args (x :target r :scs (any-reg zero))) 86 (:info y) 87 (:arg-types tagged-num 88 (:constant (and (signed-byte 11) (not (integer 0 0))))) 89 (:results (r :scs (any-reg))) 90 (:result-types tagged-num) 91 (:note "inline fixnum arithmetic")) 92 93(define-vop (fast-unsigned-binop-c fast-safe-arith-op) 94 (:args (x :target r :scs (unsigned-reg zero))) 95 (:info y) 96 (:arg-types unsigned-num 97 (:constant (and (signed-byte 13) (not (integer 0 0))))) 98 (:results (r :scs (unsigned-reg))) 99 (:result-types unsigned-num) 100 (:note "inline (unsigned-byte 32) arithmetic")) 101 102(define-vop (fast-signed-binop-c fast-safe-arith-op) 103 (:args (x :target r :scs (signed-reg zero))) 104 (:info y) 105 (:arg-types signed-num 106 (:constant (and (signed-byte 13) (not (integer 0 0))))) 107 (:results (r :scs (signed-reg))) 108 (:result-types signed-num) 109 (:note "inline (signed-byte 32) arithmetic")) 110 111 112(eval-when (:compile-toplevel :load-toplevel :execute) 113 114(defmacro define-binop (translate untagged-penalty op 115 &optional arg-swap restore-fixnum-mask) 116 `(progn 117 (define-vop (,(symbolicate 'fast translate '/fixnum=>fixnum) 118 fast-fixnum-binop) 119 ,@(when restore-fixnum-mask 120 `((:temporary (:sc non-descriptor-reg) temp))) 121 (:translate ,translate) 122 (:generator 2 123 ,(if arg-swap 124 `(inst ,op ,(if restore-fixnum-mask 'temp 'r) y x) 125 `(inst ,op ,(if restore-fixnum-mask 'temp 'r) x y)) 126 ,@(when restore-fixnum-mask 127 `((inst andn r temp fixnum-tag-mask))))) 128 ,@(unless arg-swap 129 `((define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum) 130 fast-fixnum-binop-c) 131 ,@(when restore-fixnum-mask 132 `((:temporary (:sc non-descriptor-reg) temp))) 133 (:translate ,translate) 134 (:generator 1 135 (inst ,op ,(if restore-fixnum-mask 'temp 'r) x (fixnumize y)) 136 ,@(when restore-fixnum-mask 137 `((inst andn r temp fixnum-tag-mask))))))) 138 (define-vop (,(symbolicate 'fast- translate '/signed=>signed) 139 fast-signed-binop) 140 (:translate ,translate) 141 (:generator ,(1+ untagged-penalty) 142 ,(if arg-swap 143 `(inst ,op r y x) 144 `(inst ,op r x y)))) 145 ,@(unless arg-swap 146 `((define-vop (,(symbolicate 'fast- translate '-c/signed=>signed) 147 fast-signed-binop-c) 148 (:translate ,translate) 149 (:generator ,untagged-penalty 150 (inst ,op r x y))))) 151 (define-vop (,(symbolicate 'fast- translate '/unsigned=>unsigned) 152 fast-unsigned-binop) 153 (:translate ,translate) 154 (:generator ,(1+ untagged-penalty) 155 ,(if arg-swap 156 `(inst ,op r y x) 157 `(inst ,op r x y)))) 158 ,@(unless arg-swap 159 `((define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned) 160 fast-unsigned-binop-c) 161 (:translate ,translate) 162 (:generator ,untagged-penalty 163 (inst ,op r x y))))))) 164 165); eval-when 166 167(define-binop + 4 add) 168(define-binop - 4 sub) 169(define-binop logand 2 and) 170(define-binop logandc1 2 andn t) 171(define-binop logandc2 2 andn) 172(define-binop logior 2 or) 173(define-binop logorc1 2 orn t t) 174(define-binop logorc2 2 orn nil t) 175(define-binop logxor 2 xor) 176(define-binop logeqv 2 xnor nil t) 177 178(define-vop (fast-logand/signed-unsigned=>unsigned fast-logand/unsigned=>unsigned) 179 (:args (x :scs (signed-reg) :target r) 180 (y :scs (unsigned-reg) :target r)) 181 (:arg-types signed-num unsigned-num) 182 (:translate logand)) 183 184;;; Truncate 185 186;; This doesn't work for some reason. 187#+nil 188(define-vop (fast-v8-truncate/fixnum=>fixnum fast-safe-arith-op) 189 (:translate truncate) 190 (:args (x :scs (any-reg)) 191 (y :scs (any-reg))) 192 (:arg-types tagged-num tagged-num) 193 (:results (quo :scs (any-reg)) 194 (rem :scs (any-reg))) 195 (:result-types tagged-num tagged-num) 196 (:note "inline fixnum arithmetic") 197 (:temporary (:scs (any-reg) :target quo) q) 198 (:temporary (:scs (any-reg)) r) 199 (:temporary (:scs (signed-reg)) y-int) 200 (:vop-var vop) 201 (:save-p :compute-only) 202 (:guard (or (member :sparc-v8 *backend-subfeatures*) 203 (and (member :sparc-v9 *backend-subfeatures*) 204 (not (member :sparc-64 *backend-subfeatures*))))) 205 (:generator 12 206 (let ((zero (generate-error-code vop 'division-by-zero-error x y))) 207 (inst cmp y zero-tn) 208 (inst b :eq zero) 209 ;; Extend the sign of X into the Y register 210 (inst sra r x 31) 211 (inst wry r) 212 ;; Remove tag bits so Q and R will be tagged correctly. 213 (inst sra y-int y n-fixnum-tag-bits) 214 (inst nop) 215 (inst nop) 216 217 (inst sdiv q x y-int) ; Q is tagged. 218 ;; We have the quotient so we need to compute the remainder 219 (inst smul r q y-int) ; R is tagged 220 (inst sub rem x r) 221 (unless (location= quo q) 222 (move quo q))))) 223 224(define-vop (fast-v8-truncate/signed=>signed fast-safe-arith-op) 225 (:translate truncate) 226 (:args (x :scs (signed-reg)) 227 (y :scs (signed-reg))) 228 (:arg-types signed-num signed-num) 229 (:results (quo :scs (signed-reg)) 230 (rem :scs (signed-reg))) 231 (:result-types signed-num signed-num) 232 (:note "inline (signed-byte 32) arithmetic") 233 (:temporary (:scs (signed-reg) :target quo) q) 234 (:temporary (:scs (signed-reg)) r) 235 (:vop-var vop) 236 (:save-p :compute-only) 237 (:guard (or (member :sparc-v8 *backend-subfeatures*) 238 (and (member :sparc-v9 *backend-subfeatures*) 239 (not (member :sparc-64 *backend-subfeatures*))))) 240 (:generator 12 241 (let ((zero (generate-error-code vop 'division-by-zero-error x y))) 242 (inst cmp y zero-tn) 243 (if (member :sparc-v9 *backend-subfeatures*) 244 (inst b :eq zero :pn) 245 (inst b :eq zero)) 246 ;; Extend the sign of X into the Y register 247 (inst sra r x 31) 248 (inst wry r) 249 (inst nop) 250 (inst nop) 251 (inst nop) 252 253 (inst sdiv q x y) 254 ;; We have the quotient so we need to compue the remainder 255 (inst smul r q y) ; rem 256 (inst sub rem x r) 257 (unless (location= quo q) 258 (move quo q))))) 259 260(define-vop (fast-v8-truncate/unsigned=>unsigned fast-safe-arith-op) 261 (:translate truncate) 262 (:args (x :scs (unsigned-reg)) 263 (y :scs (unsigned-reg))) 264 (:arg-types unsigned-num unsigned-num) 265 (:results (quo :scs (unsigned-reg)) 266 (rem :scs (unsigned-reg))) 267 (:result-types unsigned-num unsigned-num) 268 (:note "inline (unsigned-byte 32) arithmetic") 269 (:temporary (:scs (unsigned-reg) :target quo) q) 270 (:temporary (:scs (unsigned-reg)) r) 271 (:vop-var vop) 272 (:save-p :compute-only) 273 (:guard (or (member :sparc-v8 *backend-subfeatures*) 274 (and (member :sparc-v9 *backend-subfeatures*) 275 (not (member :sparc-64 *backend-subfeatures*))))) 276 (:generator 8 277 (let ((zero (generate-error-code vop 'division-by-zero-error x y))) 278 (inst cmp y zero-tn) 279 (if (member :sparc-v9 *backend-subfeatures*) 280 (inst b :eq zero :pn) 281 (inst b :eq zero)) 282 (inst wry zero-tn) ; Clear out high part 283 (inst nop) 284 (inst nop) 285 (inst nop) 286 287 (inst udiv q x y) 288 ;; Compute remainder 289 (inst umul r q y) 290 (inst sub rem x r) 291 (unless (location= quo q) 292 (inst move quo q))))) 293 294(define-vop (fast-v9-truncate/signed=>signed fast-safe-arith-op) 295 (:translate truncate) 296 (:args (x :scs (signed-reg)) 297 (y :scs (signed-reg))) 298 (:arg-types signed-num signed-num) 299 (:results (quo :scs (signed-reg)) 300 (rem :scs (signed-reg))) 301 (:result-types signed-num signed-num) 302 (:note "inline (signed-byte 32) arithmetic") 303 (:temporary (:scs (signed-reg) :target quo) q) 304 (:temporary (:scs (signed-reg)) r) 305 (:vop-var vop) 306 (:save-p :compute-only) 307 (:guard (member :sparc-64 *backend-subfeatures*)) 308 (:generator 8 309 (let ((zero (generate-error-code vop 'division-by-zero-error x y))) 310 (inst cmp y zero-tn) 311 (inst b :eq zero :pn) 312 ;; Sign extend the numbers, just in case. 313 (inst sra x 0) 314 (inst sra y 0) 315 (inst sdivx q x y) 316 ;; Compute remainder 317 (inst mulx r q y) 318 (inst sub rem x r) 319 (unless (location= quo q) 320 (inst move quo q))))) 321 322(define-vop (fast-v9-truncate/unsigned=>unsigned fast-safe-arith-op) 323 (:translate truncate) 324 (:args (x :scs (unsigned-reg)) 325 (y :scs (unsigned-reg))) 326 (:arg-types unsigned-num unsigned-num) 327 (:results (quo :scs (unsigned-reg)) 328 (rem :scs (unsigned-reg))) 329 (:result-types unsigned-num unsigned-num) 330 (:note "inline (unsigned-byte 32) arithmetic") 331 (:temporary (:scs (unsigned-reg) :target quo) q) 332 (:temporary (:scs (unsigned-reg)) r) 333 (:vop-var vop) 334 (:save-p :compute-only) 335 (:guard (member :sparc-64 *backend-subfeatures*)) 336 (:generator 8 337 (let ((zero (generate-error-code vop 'division-by-zero-error x y))) 338 (inst cmp y zero-tn) 339 (inst b :eq zero :pn) 340 ;; Zap the higher 32 bits, just in case 341 (inst srl x 0) 342 (inst srl y 0) 343 (inst udivx q x y) 344 ;; Compute remainder 345 (inst mulx r q y) 346 (inst sub rem x r) 347 (unless (location= quo q) 348 (inst move quo q))))) 349 350;;; Shifting 351 352(define-vop (fast-ash/signed=>signed) 353 (:note "inline ASH") 354 (:args (number :scs (signed-reg) :to :save) 355 (amount :scs (signed-reg) :to :save)) 356 (:arg-types signed-num signed-num) 357 (:results (result :scs (signed-reg))) 358 (:result-types signed-num) 359 (:translate ash) 360 (:policy :fast-safe) 361 (:temporary (:sc non-descriptor-reg) ndesc) 362 (:generator 5 363 (let ((done (gen-label))) 364 (inst cmp amount) 365 (inst b :ge done) 366 ;; The result-type assures us that this shift will not 367 ;; overflow. 368 (inst sll result number amount) 369 (inst neg ndesc amount) 370 (inst cmp ndesc 31) 371 (if (member :sparc-v9 *backend-subfeatures*) 372 (progn 373 (inst cmove :ge ndesc 31) 374 (inst sra result number ndesc)) 375 (progn 376 (inst b :le done) 377 (inst sra result number ndesc) 378 (inst sra result number 31))) 379 (emit-label done)))) 380 381(define-vop (fast-ash-c/signed=>signed) 382 (:note "inline constant ASH") 383 (:args (number :scs (signed-reg))) 384 (:info count) 385 (:arg-types signed-num (:constant integer)) 386 (:results (result :scs (signed-reg))) 387 (:result-types signed-num) 388 (:translate ash) 389 (:policy :fast-safe) 390 (:generator 4 391 (cond 392 ((< count 0) (inst sra result number (min (- count) 31))) 393 ((> count 0) (inst sll result number (min count 31))) 394 (t (bug "identity ASH not transformed away"))))) 395 396(define-vop (fast-ash/unsigned=>unsigned) 397 (:note "inline ASH") 398 (:args (number :scs (unsigned-reg) :to :save) 399 (amount :scs (signed-reg) :to :save)) 400 (:arg-types unsigned-num signed-num) 401 (:results (result :scs (unsigned-reg))) 402 (:result-types unsigned-num) 403 (:translate ash) 404 (:policy :fast-safe) 405 (:temporary (:sc non-descriptor-reg) ndesc) 406 (:generator 5 407 (let ((done (gen-label))) 408 (inst cmp amount) 409 (inst b :ge done) 410 ;; The result-type assures us that this shift will not 411 ;; overflow. 412 (inst sll result number amount) 413 (inst neg ndesc amount) 414 (inst cmp ndesc 32) 415 (if (member :sparc-v9 *backend-subfeatures*) 416 (progn 417 (inst srl result number ndesc) 418 (inst cmove :ge result zero-tn)) 419 (progn 420 (inst b :lt done) 421 (inst srl result number ndesc) 422 (move result zero-tn))) 423 (emit-label done)))) 424 425(define-vop (fast-ash-c/unsigned=>unsigned) 426 (:note "inline constant ASH") 427 (:args (number :scs (unsigned-reg))) 428 (:info count) 429 (:arg-types unsigned-num (:constant integer)) 430 (:results (result :scs (unsigned-reg))) 431 (:result-types unsigned-num) 432 (:translate ash) 433 (:policy :fast-safe) 434 (:generator 4 435 (cond 436 ((< count -31) (move result zero-tn)) 437 ((< count 0) (inst srl result number (min (- count) 31))) 438 ((> count 0) (inst sll result number (min count 31))) 439 (t (bug "identity ASH not transformed away"))))) 440 441;; Some special cases where we know we want a left shift. Just do the 442;; shift, instead of checking for the sign of the shift. 443(macrolet 444 ((def (name sc-type type result-type cost) 445 `(define-vop (,name) 446 (:note "inline ASH") 447 (:translate ash) 448 (:args (number :scs (,sc-type)) 449 (amount :scs (signed-reg unsigned-reg immediate))) 450 (:arg-types ,type positive-fixnum) 451 (:results (result :scs (,result-type))) 452 (:result-types ,type) 453 (:policy :fast-safe) 454 (:generator ,cost 455 ;; The result-type assures us that this shift will not 456 ;; overflow. And for fixnums, the zero bits that get 457 ;; shifted in are just fine for the fixnum tag. 458 (sc-case amount 459 ((signed-reg unsigned-reg) 460 (inst sll result number amount)) 461 (immediate 462 (let ((amount (tn-value amount))) 463 (aver (>= amount 0)) 464 (inst sll result number amount)))))))) 465 (def fast-ash-left/signed=>signed signed-reg signed-num signed-reg 3) 466 (def fast-ash-left/fixnum=>fixnum any-reg tagged-num any-reg 2) 467 (def fast-ash-left/unsigned=>unsigned unsigned-reg unsigned-num unsigned-reg 3)) 468 469 470(define-vop (signed-byte-32-len) 471 (:translate integer-length) 472 (:note "inline (signed-byte 32) integer-length") 473 (:policy :fast-safe) 474 (:args (arg :scs (signed-reg) :target shift)) 475 (:arg-types signed-num) 476 (:results (res :scs (any-reg))) 477 (:result-types positive-fixnum) 478 (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) shift) 479 (:generator 30 480 (let ((loop (gen-label)) 481 (test (gen-label))) 482 (inst addcc shift zero-tn arg) 483 (inst b :ge test) 484 (move res zero-tn) 485 (inst b test) 486 (inst not shift) 487 488 (emit-label loop) 489 (inst add res (fixnumize 1)) 490 491 (emit-label test) 492 (inst cmp shift) 493 (inst b :ne loop) 494 (inst srl shift 1)))) 495 496(define-vop (unsigned-byte-32-count) 497 (:translate logcount) 498 (:note "inline (unsigned-byte 32) logcount") 499 (:policy :fast-safe) 500 (:args (arg :scs (unsigned-reg))) 501 (:arg-types unsigned-num) 502 (:results (res :scs (unsigned-reg))) 503 (:result-types positive-fixnum) 504 (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) mask temp) 505 (:generator 35 506 (move res arg) 507 508 (dolist (stuff '((1 #x55555555) (2 #x33333333) (4 #x0f0f0f0f) 509 (8 #x00ff00ff) (16 #x0000ffff))) 510 (destructuring-bind (shift bit-mask) 511 stuff 512 ;; Set mask 513 (inst sethi mask (ldb (byte 22 10) bit-mask)) 514 (inst add mask (ldb (byte 10 0) bit-mask)) 515 516 (inst and temp res mask) 517 (inst srl res shift) 518 (inst and res mask) 519 (inst add res temp))))) 520 521 522;;; Multiply and Divide. 523 524(define-vop (fast-v8-*/fixnum=>fixnum fast-fixnum-binop) 525 (:temporary (:scs (non-descriptor-reg)) temp) 526 (:translate *) 527 (:guard (or (member :sparc-v8 *backend-subfeatures*) 528 (and (member :sparc-v9 *backend-subfeatures*) 529 (not (member :sparc-64 *backend-subfeatures*))))) 530 (:generator 2 531 ;; The cost here should be less than the cost for 532 ;; */signed=>signed. Why? A fixnum product using signed=>signed 533 ;; has to convert both args to signed-nums. But using this, we 534 ;; don't have to and that saves an instruction. 535 (inst sra temp y n-fixnum-tag-bits) 536 (inst smul r x temp))) 537 538(define-vop (fast-v8-*-c/fixnum=>fixnum fast-safe-arith-op) 539 (:args (x :target r :scs (any-reg zero))) 540 (:info y) 541 (:arg-types tagged-num 542 (:constant (and (signed-byte 13) (not (integer 0 0))))) 543 (:results (r :scs (any-reg))) 544 (:result-types tagged-num) 545 (:note "inline fixnum arithmetic") 546 (:translate *) 547 (:guard (or (member :sparc-v8 *backend-subfeatures*) 548 (and (member :sparc-v9 *backend-subfeatures*) 549 (not (member :sparc-64 *backend-subfeatures*))))) 550 (:generator 1 551 (inst smul r x y))) 552 553(define-vop (fast-v8-*/signed=>signed fast-signed-binop) 554 (:translate *) 555 (:guard (or (member :sparc-v8 *backend-subfeatures*) 556 (and (member :sparc-v9 *backend-subfeatures*) 557 (not (member :sparc-64 *backend-subfeatures*))))) 558 (:generator 3 559 (inst smul r x y))) 560 561(define-vop (fast-v8-*-c/signed=>signed fast-signed-binop-c) 562 (:translate *) 563 (:guard (or (member :sparc-v8 *backend-subfeatures*) 564 (and (member :sparc-v9 *backend-subfeatures*) 565 (not (member :sparc-64 *backend-subfeatures*))))) 566 (:generator 2 567 (inst smul r x y))) 568 569(define-vop (fast-v8-*/unsigned=>unsigned fast-unsigned-binop) 570 (:translate *) 571 (:guard (or (member :sparc-v8 *backend-subfeatures*) 572 (and (member :sparc-v9 *backend-subfeatures*) 573 (not (member :sparc-64 *backend-subfeatures*))))) 574 (:generator 3 575 (inst umul r x y))) 576 577(define-vop (fast-v8-*-c/unsigned=>unsigned fast-unsigned-binop-c) 578 (:translate *) 579 (:guard (or (member :sparc-v8 *backend-subfeatures*) 580 (and (member :sparc-v9 *backend-subfeatures*) 581 (not (member :sparc-64 *backend-subfeatures*))))) 582 (:generator 2 583 (inst umul r x y))) 584 585;; The smul and umul instructions are deprecated on the Sparc V9. Use 586;; mulx instead. 587(define-vop (fast-v9-*/fixnum=>fixnum fast-fixnum-binop) 588 (:temporary (:scs (non-descriptor-reg)) temp) 589 (:translate *) 590 (:guard (member :sparc-64 *backend-subfeatures*)) 591 (:generator 4 592 (inst sra temp y n-fixnum-tag-bits) 593 (inst mulx r x temp))) 594 595(define-vop (fast-v9-*/signed=>signed fast-signed-binop) 596 (:translate *) 597 (:guard (member :sparc-64 *backend-subfeatures*)) 598 (:generator 3 599 (inst mulx r x y))) 600 601(define-vop (fast-v9-*/unsigned=>unsigned fast-unsigned-binop) 602 (:translate *) 603 (:guard (member :sparc-64 *backend-subfeatures*)) 604 (:generator 3 605 (inst mulx r x y))) 606 607 608;;;; Modular functions: 609(define-modular-fun lognot-mod32 (x) lognot :untagged nil 32) 610(define-vop (lognot-mod32/unsigned=>unsigned) 611 (:translate lognot-mod32) 612 (:args (x :scs (unsigned-reg))) 613 (:arg-types unsigned-num) 614 (:results (res :scs (unsigned-reg))) 615 (:result-types unsigned-num) 616 (:policy :fast-safe) 617 (:generator 1 618 (inst not res x))) 619 620(macrolet 621 ((define-modular-backend (fun &optional constantp) 622 (let ((mfun-name (symbolicate fun '-mod32)) 623 (modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned)) 624 (modcvop (symbolicate 'fast- fun '-mod32-c/unsigned=>unsigned)) 625 (vop (symbolicate 'fast- fun '/unsigned=>unsigned)) 626 (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned))) 627 `(progn 628 (define-modular-fun ,mfun-name (x y) ,fun :untagged nil 32) 629 (define-vop (,modvop ,vop) 630 (:translate ,mfun-name)) 631 ,@(when constantp 632 `((define-vop (,modcvop ,cvop) 633 (:translate ,mfun-name)))))))) 634 (define-modular-backend + t) 635 (define-modular-backend - t) 636 (define-modular-backend logeqv t) 637 (define-modular-backend logandc1) 638 (define-modular-backend logandc2 t) 639 (define-modular-backend logorc1) 640 (define-modular-backend logorc2 t)) 641 642(define-source-transform lognand (x y) 643 `(lognot (logand ,x ,y))) 644(define-source-transform lognor (x y) 645 `(lognot (logior ,x ,y))) 646 647(define-vop (fast-ash-left-mod32-c/unsigned=>unsigned 648 fast-ash-c/unsigned=>unsigned) 649 (:translate ash-left-mod32)) 650 651(define-vop (fast-ash-left-mod32/unsigned=>unsigned 652 fast-ash-left/unsigned=>unsigned)) 653(deftransform ash-left-mod32 ((integer count) 654 ((unsigned-byte 32) (unsigned-byte 5))) 655 (when (sb!c::constant-lvar-p count) 656 (sb!c::give-up-ir1-transform)) 657 '(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count)) 658 659;;;; Binary conditional VOPs: 660 661(define-vop (fast-conditional) 662 (:conditional) 663 (:info target not-p) 664 (:effects) 665 (:affected) 666 (:policy :fast-safe)) 667 668(define-vop (fast-conditional/fixnum fast-conditional) 669 (:args (x :scs (any-reg zero)) 670 (y :scs (any-reg zero))) 671 (:arg-types tagged-num tagged-num) 672 (:note "inline fixnum comparison")) 673 674(define-vop (fast-conditional-c/fixnum fast-conditional/fixnum) 675 (:args (x :scs (any-reg zero))) 676 (:arg-types tagged-num (:constant (signed-byte 11))) 677 (:info target not-p y)) 678 679(define-vop (fast-conditional/signed fast-conditional) 680 (:args (x :scs (signed-reg zero)) 681 (y :scs (signed-reg zero))) 682 (:arg-types signed-num signed-num) 683 (:note "inline (signed-byte 32) comparison")) 684 685(define-vop (fast-conditional-c/signed fast-conditional/signed) 686 (:args (x :scs (signed-reg zero))) 687 (:arg-types signed-num (:constant (signed-byte 13))) 688 (:info target not-p y)) 689 690(define-vop (fast-conditional/unsigned fast-conditional) 691 (:args (x :scs (unsigned-reg zero)) 692 (y :scs (unsigned-reg zero))) 693 (:arg-types unsigned-num unsigned-num) 694 (:note "inline (unsigned-byte 32) comparison")) 695 696(define-vop (fast-conditional-c/unsigned fast-conditional/unsigned) 697 (:args (x :scs (unsigned-reg zero))) 698 (:arg-types unsigned-num (:constant (unsigned-byte 12))) 699 (:info target not-p y)) 700 701 702(defmacro define-conditional-vop (tran cond unsigned not-cond not-unsigned) 703 `(progn 704 ,@(mapcar (lambda (suffix cost signed) 705 (unless (and (member suffix '(/fixnum -c/fixnum)) 706 (eq tran 'eql)) 707 `(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)" 708 tran suffix)) 709 ,(intern 710 (format nil "~:@(FAST-CONDITIONAL~A~)" 711 suffix))) 712 (:translate ,tran) 713 (:generator ,cost 714 (inst cmp x 715 ,(if (eq suffix '-c/fixnum) '(fixnumize y) 'y)) 716 (inst b (if not-p 717 ,(if signed not-cond not-unsigned) 718 ,(if signed cond unsigned)) 719 target) 720 (inst nop))))) 721 '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned) 722 '(4 3 6 5 6 5) 723 '(t t t t nil nil)))) 724 725(define-conditional-vop < :lt :ltu :ge :geu) 726 727(define-conditional-vop > :gt :gtu :le :leu) 728 729(define-conditional-vop eql :eq :eq :ne :ne) 730 731;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a 732;;; known fixnum. 733 734;;; These versions specify a fixnum restriction on their first arg. We have 735;;; also generic-eql/fixnum VOPs which are the same, but have no restriction on 736;;; the first arg and a higher cost. The reason for doing this is to prevent 737;;; fixnum specific operations from being used on word integers, spuriously 738;;; consing the argument. 739;;; 740 741(define-vop (fast-eql/fixnum fast-conditional) 742 (:args (x :scs (any-reg zero)) 743 (y :scs (any-reg zero))) 744 (:arg-types tagged-num tagged-num) 745 (:note "inline fixnum comparison") 746 (:translate eql) 747 (:generator 4 748 (inst cmp x y) 749 (inst b (if not-p :ne :eq) target) 750 (inst nop))) 751;;; 752(define-vop (generic-eql/fixnum fast-eql/fixnum) 753 (:args (x :scs (any-reg descriptor-reg)) 754 (y :scs (any-reg))) 755 (:arg-types * tagged-num) 756 (:variant-cost 7)) 757 758(define-vop (fast-eql-c/fixnum fast-conditional/fixnum) 759 (:args (x :scs (any-reg zero))) 760 (:arg-types tagged-num (:constant (signed-byte 11))) 761 (:info target not-p y) 762 (:translate eql) 763 (:generator 2 764 (inst cmp x (fixnumize y)) 765 (inst b (if not-p :ne :eq) target) 766 (inst nop))) 767;;; 768(define-vop (generic-eql-c/fixnum fast-eql-c/fixnum) 769 (:args (x :scs (any-reg descriptor-reg))) 770 (:arg-types * (:constant (signed-byte 11))) 771 (:variant-cost 6)) 772 773 774;;;; 32-bit logical operations 775 776(define-vop (shift-towards-someplace) 777 (:policy :fast-safe) 778 (:args (num :scs (unsigned-reg)) 779 (amount :scs (signed-reg))) 780 (:arg-types unsigned-num tagged-num) 781 (:results (r :scs (unsigned-reg))) 782 (:result-types unsigned-num)) 783 784(define-vop (shift-towards-start shift-towards-someplace) 785 (:translate shift-towards-start) 786 (:note "shift-towards-start") 787 (:generator 1 788 (inst sll r num amount))) 789 790(define-vop (shift-towards-end shift-towards-someplace) 791 (:translate shift-towards-end) 792 (:note "shift-towards-end") 793 (:generator 1 794 (inst srl r num amount))) 795 796;;;; Bignum stuff. 797(define-vop (bignum-length get-header-data) 798 (:translate sb!bignum:%bignum-length) 799 (:policy :fast-safe)) 800 801(define-vop (bignum-set-length set-header-data) 802 (:translate sb!bignum:%bignum-set-length) 803 (:policy :fast-safe)) 804 805(define-vop (bignum-ref word-index-ref) 806 (:variant bignum-digits-offset other-pointer-lowtag) 807 (:translate sb!bignum:%bignum-ref) 808 (:results (value :scs (unsigned-reg))) 809 (:result-types unsigned-num)) 810 811(define-vop (bignum-set word-index-set) 812 (:variant bignum-digits-offset other-pointer-lowtag) 813 (:translate sb!bignum:%bignum-set) 814 (:args (object :scs (descriptor-reg)) 815 (index :scs (any-reg immediate zero)) 816 (value :scs (unsigned-reg))) 817 (:arg-types t positive-fixnum unsigned-num) 818 (:results (result :scs (unsigned-reg))) 819 (:result-types unsigned-num)) 820 821(define-vop (digit-0-or-plus) 822 (:translate sb!bignum:%digit-0-or-plusp) 823 (:policy :fast-safe) 824 (:args (digit :scs (unsigned-reg))) 825 (:arg-types unsigned-num) 826 (:results (result :scs (descriptor-reg))) 827 (:guard (not (member :sparc-v9 *backend-subfeatures*))) 828 (:generator 3 829 (let ((done (gen-label))) 830 (inst cmp digit) 831 (inst b :lt done) 832 (move result null-tn) 833 (load-symbol result t) 834 (emit-label done)))) 835 836(define-vop (v9-digit-0-or-plus-cmove) 837 (:translate sb!bignum:%digit-0-or-plusp) 838 (:policy :fast-safe) 839 (:args (digit :scs (unsigned-reg))) 840 (:arg-types unsigned-num) 841 (:results (result :scs (descriptor-reg))) 842 (:guard (member :sparc-v9 *backend-subfeatures*)) 843 (:generator 3 844 (inst cmp digit) 845 (load-symbol result t) 846 (inst cmove :lt result null-tn))) 847 848;; This doesn't work? 849#+nil 850(define-vop (v9-digit-0-or-plus-movr) 851 (:translate sb!bignum:%digit-0-or-plusp) 852 (:policy :fast-safe) 853 (:args (digit :scs (unsigned-reg))) 854 (:arg-types unsigned-num) 855 (:results (result :scs (descriptor-reg))) 856 (:temporary (:scs (descriptor-reg)) temp) 857 (:guard #!+:sparc-v9 t #!-:sparc-v9 nil) 858 (:generator 2 859 (load-symbol temp t) 860 (inst movr result null-tn digit :lz) 861 (inst movr result temp digit :gez))) 862 863(define-vop (add-w/carry) 864 (:translate sb!bignum:%add-with-carry) 865 (:policy :fast-safe) 866 (:args (a :scs (unsigned-reg)) 867 (b :scs (unsigned-reg)) 868 (c :scs (any-reg))) 869 (:arg-types unsigned-num unsigned-num positive-fixnum) 870 (:results (result :scs (unsigned-reg)) 871 (carry :scs (unsigned-reg))) 872 (:result-types unsigned-num positive-fixnum) 873 (:generator 3 874 (inst addcc zero-tn c -1) 875 (inst addxcc result a b) 876 (inst addx carry zero-tn zero-tn))) 877 878(define-vop (sub-w/borrow) 879 (:translate sb!bignum:%subtract-with-borrow) 880 (:policy :fast-safe) 881 (:args (a :scs (unsigned-reg)) 882 (b :scs (unsigned-reg)) 883 (c :scs (any-reg))) 884 (:arg-types unsigned-num unsigned-num positive-fixnum) 885 (:results (result :scs (unsigned-reg)) 886 (borrow :scs (unsigned-reg))) 887 (:result-types unsigned-num positive-fixnum) 888 (:generator 4 889 (inst subcc zero-tn c 1) 890 (inst subxcc result a b) 891 (inst addx borrow zero-tn zero-tn) 892 (inst xor borrow 1))) 893 894;;; EMIT-MULTIPLY -- This is used both for bignum stuff and in assembly 895;;; routines. 896;;; 897(defun emit-multiply (multiplier multiplicand result-high result-low) 898 "Emit code to multiply MULTIPLIER with MULTIPLICAND, putting the result 899 in RESULT-HIGH and RESULT-LOW. KIND is either :signed or :unsigned. 900 Note: the lifetimes of MULTIPLICAND and RESULT-HIGH overlap." 901 (declare (type tn multiplier result-high result-low) 902 (type (or tn (signed-byte 13)) multiplicand)) 903 ;; It seems that emit-multiply is only used to do an unsigned 904 ;; multiply, so the code only does an unsigned multiply. 905 (cond 906 ((member :sparc-64 *backend-subfeatures*) 907 ;; Take advantage of V9's 64-bit multiplier. 908 ;; 909 ;; Make sure the multiplier and multiplicand are really 910 ;; unsigned 64-bit numbers. 911 (inst srl multiplier 0) 912 (inst srl multiplicand 0) 913 914 ;; Multiply the two numbers and put the result in 915 ;; result-high. Copy the low 32-bits to result-low. Then 916 ;; shift result-high so the high 32-bits end up in the low 917 ;; 32-bits. 918 (inst mulx result-high multiplier multiplicand) 919 (inst move result-low result-high) 920 (inst srax result-high 32)) 921 ((or (member :sparc-v8 *backend-subfeatures*) 922 (member :sparc-v9 *backend-subfeatures*)) 923 ;; V8 has a multiply instruction. This should also work for 924 ;; the V9, but umul and the Y register is deprecated on the 925 ;; V9. 926 (inst umul result-low multiplier multiplicand) 927 (inst rdy result-high)) 928 (t 929 (let ((label (gen-label))) 930 (inst wry multiplier) 931 (inst andcc result-high zero-tn) 932 ;; Note: we can't use the Y register until three insts 933 ;; after it's written. 934 (inst nop) 935 (inst nop) 936 (dotimes (i 32) 937 (inst mulscc result-high multiplicand)) 938 (inst mulscc result-high zero-tn) 939 (inst cmp multiplicand) 940 (inst b :ge label) 941 (inst nop) 942 (inst add result-high multiplier) 943 (emit-label label) 944 (inst rdy result-low))))) 945 946(define-vop (bignum-mult-and-add-3-arg) 947 (:translate sb!bignum:%multiply-and-add) 948 (:policy :fast-safe) 949 (:args (x :scs (unsigned-reg) :to (:eval 1)) 950 (y :scs (unsigned-reg) :to (:eval 1)) 951 (carry-in :scs (unsigned-reg) :to (:eval 2))) 952 (:arg-types unsigned-num unsigned-num unsigned-num) 953 (:results (hi :scs (unsigned-reg) :from (:eval 0)) 954 (lo :scs (unsigned-reg) :from (:eval 1))) 955 (:result-types unsigned-num unsigned-num) 956 (:generator 40 957 (emit-multiply x y hi lo) 958 (inst addcc lo carry-in) 959 (inst addx hi zero-tn))) 960 961(define-vop (bignum-mult-and-add-4-arg) 962 (:translate sb!bignum:%multiply-and-add) 963 (:policy :fast-safe) 964 (:args (x :scs (unsigned-reg) :to (:eval 1)) 965 (y :scs (unsigned-reg) :to (:eval 1)) 966 (prev :scs (unsigned-reg) :to (:eval 2)) 967 (carry-in :scs (unsigned-reg) :to (:eval 2))) 968 (:arg-types unsigned-num unsigned-num unsigned-num unsigned-num) 969 (:results (hi :scs (unsigned-reg) :from (:eval 0)) 970 (lo :scs (unsigned-reg) :from (:eval 1))) 971 (:result-types unsigned-num unsigned-num) 972 (:generator 40 973 (emit-multiply x y hi lo) 974 (inst addcc lo carry-in) 975 (inst addx hi zero-tn) 976 (inst addcc lo prev) 977 (inst addx hi zero-tn))) 978 979(define-vop (bignum-mult) 980 (:translate sb!bignum:%multiply) 981 (:policy :fast-safe) 982 (:args (x :scs (unsigned-reg) :to (:result 1)) 983 (y :scs (unsigned-reg) :to (:result 1))) 984 (:arg-types unsigned-num unsigned-num) 985 (:results (hi :scs (unsigned-reg)) 986 (lo :scs (unsigned-reg))) 987 (:result-types unsigned-num unsigned-num) 988 (:generator 40 989 (emit-multiply x y hi lo))) 990 991(define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned) 992 (:translate sb!bignum:%lognot)) 993 994(define-vop (fixnum-to-digit) 995 (:translate sb!bignum:%fixnum-to-digit) 996 (:policy :fast-safe) 997 (:args (fixnum :scs (any-reg))) 998 (:arg-types tagged-num) 999 (:results (digit :scs (unsigned-reg))) 1000 (:result-types unsigned-num) 1001 (:generator 1 1002 (inst sra digit fixnum n-fixnum-tag-bits))) 1003 1004(define-vop (bignum-floor) 1005 (:translate sb!bignum:%bigfloor) 1006 (:policy :fast-safe) 1007 (:args (div-high :scs (unsigned-reg) :target rem) 1008 (div-low :scs (unsigned-reg) :target quo) 1009 (divisor :scs (unsigned-reg))) 1010 (:arg-types unsigned-num unsigned-num unsigned-num) 1011 (:results (quo :scs (unsigned-reg) :from (:argument 1)) 1012 (rem :scs (unsigned-reg) :from (:argument 0))) 1013 (:result-types unsigned-num unsigned-num) 1014 (:generator 300 1015 (move rem div-high) 1016 (move quo div-low) 1017 (dotimes (i 33) 1018 (let ((label (gen-label))) 1019 (inst cmp rem divisor) 1020 (inst b :ltu label) 1021 (inst addxcc quo quo) 1022 (inst sub rem divisor) 1023 (emit-label label) 1024 (unless (= i 32) 1025 (inst addx rem rem)))) 1026 (inst not quo))) 1027 1028(define-vop (bignum-floor-v8) 1029 (:translate sb!bignum:%bigfloor) 1030 (:policy :fast-safe) 1031 (:args (div-high :scs (unsigned-reg) :target rem) 1032 (div-low :scs (unsigned-reg) :target quo) 1033 (divisor :scs (unsigned-reg))) 1034 (:arg-types unsigned-num unsigned-num unsigned-num) 1035 (:results (quo :scs (unsigned-reg) :from (:argument 1)) 1036 (rem :scs (unsigned-reg) :from (:argument 0))) 1037 (:result-types unsigned-num unsigned-num) 1038 (:temporary (:scs (unsigned-reg) :target quo) q) 1039 ;; This vop is for a v8 or v9, provided we're also not using 1040 ;; sparc-64, for which there a special sparc-64 vop. 1041 (:guard (or (member :sparc-v8 *backend-subfeatures*) 1042 (member :sparc-v9 *backend-subfeatures*))) 1043 (:generator 15 1044 (inst wry div-high) 1045 (inst nop) 1046 (inst nop) 1047 (inst nop) 1048 ;; Compute the quotient [Y, div-low] / divisor 1049 (inst udiv q div-low divisor) 1050 ;; Compute the remainder. The high part of the result is in the Y 1051 ;; register. 1052 (inst umul rem q divisor) 1053 (inst sub rem div-low rem) 1054 (unless (location= quo q) 1055 (move quo q)))) 1056 1057(define-vop (bignum-floor-v9) 1058 (:translate sb!bignum:%bigfloor) 1059 (:policy :fast-safe) 1060 (:args (div-high :scs (unsigned-reg)) 1061 (div-low :scs (unsigned-reg)) 1062 (divisor :scs (unsigned-reg) :to (:result 1))) 1063 (:arg-types unsigned-num unsigned-num unsigned-num) 1064 (:temporary (:sc unsigned-reg :from (:argument 0)) dividend) 1065 (:results (quo :scs (unsigned-reg)) 1066 (rem :scs (unsigned-reg))) 1067 (:result-types unsigned-num unsigned-num) 1068 (:guard (member :sparc-64 *backend-subfeatures*)) 1069 (:generator 5 1070 ;; Set dividend to be div-high and div-low 1071 (inst sllx dividend div-high 32) 1072 (inst add dividend div-low) 1073 ;; Compute quotient 1074 (inst udivx quo dividend divisor) 1075 ;; Compute the remainder 1076 (inst mulx rem quo divisor) 1077 (inst sub rem dividend rem))) 1078 1079(define-vop (signify-digit) 1080 (:translate sb!bignum:%fixnum-digit-with-correct-sign) 1081 (:policy :fast-safe) 1082 (:args (digit :scs (unsigned-reg) :target res)) 1083 (:arg-types unsigned-num) 1084 (:results (res :scs (any-reg signed-reg))) 1085 (:result-types signed-num) 1086 (:generator 1 1087 (sc-case res 1088 (any-reg 1089 (inst sll res digit n-fixnum-tag-bits)) 1090 (signed-reg 1091 (move res digit))))) 1092 1093(define-vop (digit-ashr) 1094 (:translate sb!bignum:%ashr) 1095 (:policy :fast-safe) 1096 (:args (digit :scs (unsigned-reg)) 1097 (count :scs (unsigned-reg))) 1098 (:arg-types unsigned-num positive-fixnum) 1099 (:results (result :scs (unsigned-reg))) 1100 (:result-types unsigned-num) 1101 (:generator 1 1102 (inst sra result digit count))) 1103 1104(define-vop (digit-lshr digit-ashr) 1105 (:translate sb!bignum:%digit-logical-shift-right) 1106 (:generator 1 1107 (inst srl result digit count))) 1108 1109(define-vop (digit-ashl digit-ashr) 1110 (:translate sb!bignum:%ashl) 1111 (:generator 1 1112 (inst sll result digit count))) 1113 1114 1115;;;; Static functions. 1116 1117(define-static-fun two-arg-gcd (x y) :translate gcd) 1118(define-static-fun two-arg-lcm (x y) :translate lcm) 1119 1120(define-static-fun two-arg-+ (x y) :translate +) 1121(define-static-fun two-arg-- (x y) :translate -) 1122(define-static-fun two-arg-* (x y) :translate *) 1123(define-static-fun two-arg-/ (x y) :translate /) 1124 1125(define-static-fun two-arg-< (x y) :translate <) 1126(define-static-fun two-arg-<= (x y) :translate <=) 1127(define-static-fun two-arg-> (x y) :translate >) 1128(define-static-fun two-arg->= (x y) :translate >=) 1129(define-static-fun two-arg-= (x y) :translate =) 1130(define-static-fun two-arg-/= (x y) :translate /=) 1131 1132(define-static-fun %negate (x) :translate %negate) 1133 1134(define-static-fun two-arg-and (x y) :translate logand) 1135(define-static-fun two-arg-ior (x y) :translate logior) 1136(define-static-fun two-arg-xor (x y) :translate logxor) 1137(define-static-fun two-arg-eqv (x y) :translate logeqv) 1138 1139 1140(in-package "SB!C") 1141 1142(deftransform * ((x y) 1143 ((unsigned-byte 32) (constant-arg (unsigned-byte 32))) 1144 (unsigned-byte 32)) 1145 "recode as shifts and adds" 1146 (let ((y (lvar-value y))) 1147 (multiple-value-bind (result adds shifts) 1148 (ub32-strength-reduce-constant-multiply 'x y) 1149 (cond 1150 ;; we assume, perhaps foolishly, that good SPARCs don't have an 1151 ;; issue with multiplications. (Remember that there's a 1152 ;; different transform for converting x*2^k to a shift). 1153 ((member :sparc-64 *backend-subfeatures*) (give-up-ir1-transform)) 1154 ((or (member :sparc-v9 *backend-subfeatures*) 1155 (member :sparc-v8 *backend-subfeatures*)) 1156 ;; breakeven point as measured by Raymond Toy 1157 (when (> (+ adds shifts) 9) 1158 (give-up-ir1-transform)))) 1159 (or result 0)))) 1160