1;;;; the VM definition arithmetic VOPs for MIPS 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 subu res zero-tn x))) 39 40(define-vop (fast-negate/signed signed-unop) 41 (:translate %negate) 42 (:generator 2 43 (inst subu res zero-tn x))) 44 45(define-vop (fast-lognot/fixnum fixnum-unop) 46 (:temporary (:scs (any-reg) :type fixnum :to (:result 0)) 47 temp) 48 (:translate lognot) 49 (:generator 1 50 (inst li temp (fixnumize -1)) 51 (inst xor res x temp))) 52 53(define-vop (fast-lognot/signed signed-unop) 54 (:translate lognot) 55 (:generator 2 56 (inst nor res x zero-tn))) 57 58;;;; Binary fixnum operations. 59 60;;; Assume that any constant operand is the second arg... 61 62(define-vop (fast-fixnum-binop fast-safe-arith-op) 63 (:args (x :target r :scs (any-reg zero)) 64 (y :target r :scs (any-reg zero))) 65 (:arg-types tagged-num tagged-num) 66 (:results (r :scs (any-reg))) 67 (:result-types tagged-num) 68 (:note "inline fixnum arithmetic")) 69 70(define-vop (fast-unsigned-binop fast-safe-arith-op) 71 (:args (x :target r :scs (unsigned-reg zero)) 72 (y :target r :scs (unsigned-reg zero))) 73 (:arg-types unsigned-num unsigned-num) 74 (:results (r :scs (unsigned-reg))) 75 (:result-types unsigned-num) 76 (:note "inline (unsigned-byte 32) arithmetic")) 77 78(define-vop (fast-signed-binop fast-safe-arith-op) 79 (:args (x :target r :scs (signed-reg zero)) 80 (y :target r :scs (signed-reg zero))) 81 (:arg-types signed-num signed-num) 82 (:results (r :scs (signed-reg))) 83 (:result-types signed-num) 84 (:note "inline (signed-byte 32) arithmetic")) 85 86(define-vop (fast-fixnum-c-binop fast-fixnum-binop) 87 (:args (x :target r :scs (any-reg))) 88 (:info y) 89 (:arg-types tagged-num (:constant integer))) 90 91(define-vop (fast-signed-c-binop fast-signed-binop) 92 (:args (x :target r :scs (signed-reg))) 93 (:info y) 94 (:arg-types tagged-num (:constant integer))) 95 96(define-vop (fast-unsigned-c-binop fast-unsigned-binop) 97 (:args (x :target r :scs (unsigned-reg))) 98 (:info y) 99 (:arg-types tagged-num (:constant integer))) 100 101(defmacro define-binop (translate cost untagged-cost op 102 tagged-type untagged-type) 103 `(progn 104 (define-vop (,(symbolicate "FAST-" translate "/FIXNUM=>FIXNUM") 105 fast-fixnum-binop) 106 (:args (x :target r :scs (any-reg)) 107 (y :target r :scs (any-reg))) 108 (:translate ,translate) 109 (:generator ,(1+ cost) 110 (inst ,op r x y))) 111 (define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED") 112 fast-signed-binop) 113 (:args (x :target r :scs (signed-reg)) 114 (y :target r :scs (signed-reg))) 115 (:translate ,translate) 116 (:generator ,(1+ untagged-cost) 117 (inst ,op r x y))) 118 (define-vop (,(symbolicate "FAST-" translate "/UNSIGNED=>UNSIGNED") 119 fast-unsigned-binop) 120 (:args (x :target r :scs (unsigned-reg)) 121 (y :target r :scs (unsigned-reg))) 122 (:translate ,translate) 123 (:generator ,(1+ untagged-cost) 124 (inst ,op r x y))) 125 ,@(when tagged-type 126 `((define-vop (,(symbolicate "FAST-" translate "-C/FIXNUM=>FIXNUM") 127 fast-fixnum-c-binop) 128 (:arg-types tagged-num (:constant ,tagged-type)) 129 (:translate ,translate) 130 (:generator ,cost 131 (inst ,op r x (fixnumize y)))))) 132 ,@(when untagged-type 133 `((define-vop (,(symbolicate "FAST-" translate "-C/SIGNED=>SIGNED") 134 fast-signed-c-binop) 135 (:arg-types signed-num (:constant ,untagged-type)) 136 (:translate ,translate) 137 (:generator ,untagged-cost 138 (inst ,op r x y))) 139 (define-vop (,(symbolicate "FAST-" translate 140 "-C/UNSIGNED=>UNSIGNED") 141 fast-unsigned-c-binop) 142 (:arg-types unsigned-num (:constant ,untagged-type)) 143 (:translate ,translate) 144 (:generator ,untagged-cost 145 (inst ,op r x y))))))) 146 147(define-binop + 1 5 addu (signed-byte 14) (signed-byte 16)) 148(define-binop - 1 5 subu 149 (integer #.(- 1 (ash 1 13)) #.(ash 1 13)) 150 (integer #.(- 1 (ash 1 15)) #.(ash 1 15))) 151(define-binop logior 1 3 or (unsigned-byte 14) (unsigned-byte 16)) 152(define-binop logand 1 3 and (unsigned-byte 14) (unsigned-byte 16)) 153(define-binop logxor 1 3 xor (unsigned-byte 14) (unsigned-byte 16)) 154 155;;; No -C/ VOPs for LOGNOR because the NOR instruction doesn't take 156;;; immediate args. -- CSR, 2003-09-11 157(define-vop (fast-lognor/fixnum=>fixnum fast-fixnum-binop) 158 (:translate lognor) 159 (:args (x :target r :scs (any-reg)) 160 (y :target r :scs (any-reg))) 161 (:temporary (:sc non-descriptor-reg) temp) 162 (:generator 4 163 (inst nor temp x y) 164 (inst addu r temp (- fixnum-tag-mask)))) 165 166(define-vop (fast-lognor/signed=>signed fast-signed-binop) 167 (:translate lognor) 168 (:args (x :target r :scs (signed-reg)) 169 (y :target r :scs (signed-reg))) 170 (:generator 4 171 (inst nor r x y))) 172 173(define-vop (fast-lognor/unsigned=>unsigned fast-unsigned-binop) 174 (:translate lognor) 175 (:args (x :target r :scs (unsigned-reg)) 176 (y :target r :scs (unsigned-reg))) 177 (:generator 4 178 (inst nor r x y))) 179 180;;; Shifting 181 182(define-vop (fast-ash/unsigned=>unsigned) 183 (:note "inline ASH") 184 (:args (number :scs (unsigned-reg) :to :save) 185 (amount :scs (signed-reg) :to :save)) 186 (:arg-types unsigned-num signed-num) 187 (:results (result :scs (unsigned-reg))) 188 (:result-types unsigned-num) 189 (:translate ash) 190 (:policy :fast-safe) 191 (:temporary (:sc non-descriptor-reg) ndesc) 192 (:temporary (:sc non-descriptor-reg :to :eval) temp) 193 (:generator 3 194 (inst bgez amount positive) 195 (inst subu ndesc zero-tn amount) 196 (inst slt temp ndesc 32) 197 (inst bne temp done) 198 (inst srl result number ndesc) 199 (inst b done) 200 (move result zero-tn t) 201 202 POSITIVE 203 ;; The result-type assures us that this shift will not overflow. 204 (inst sll result number amount) 205 206 DONE)) 207 208(define-vop (fast-ash/signed=>signed) 209 (:note "inline ASH") 210 (:args (number :scs (signed-reg) :to :save) 211 (amount :scs (signed-reg))) 212 (:arg-types signed-num signed-num) 213 (:results (result :scs (signed-reg))) 214 (:result-types signed-num) 215 (:translate ash) 216 (:policy :fast-safe) 217 (:temporary (:sc non-descriptor-reg) ndesc) 218 (:temporary (:sc non-descriptor-reg :to :eval) temp) 219 (:generator 3 220 (inst bgez amount positive) 221 (inst subu ndesc zero-tn amount) 222 (inst slt temp ndesc 31) 223 (inst bne temp done) 224 (inst sra result number ndesc) 225 (inst b done) 226 (inst sra result number 31) 227 228 POSITIVE 229 ;; The result-type assures us that this shift will not overflow. 230 (inst sll result number amount) 231 232 DONE)) 233 234 235(define-vop (fast-ash-c/unsigned=>unsigned) 236 (:policy :fast-safe) 237 (:translate ash) 238 (:note "inline ASH") 239 (:args (number :scs (unsigned-reg))) 240 (:info count) 241 (:arg-types unsigned-num (:constant integer)) 242 (:results (result :scs (unsigned-reg))) 243 (:result-types unsigned-num) 244 (:generator 1 245 (cond 246 ((< count -31) (move result zero-tn)) 247 ((< count 0) (inst srl result number (min (- count) 31))) 248 ((> count 0) (inst sll result number (min count 31))) 249 (t (bug "identity ASH not transformed away"))))) 250 251(define-vop (fast-ash-c/signed=>signed) 252 (:policy :fast-safe) 253 (:translate ash) 254 (:note "inline ASH") 255 (:args (number :scs (signed-reg))) 256 (:info count) 257 (:arg-types signed-num (:constant integer)) 258 (:results (result :scs (signed-reg))) 259 (:result-types signed-num) 260 (:generator 1 261 (cond 262 ((< count 0) (inst sra result number (min (- count) 31))) 263 ((> count 0) (inst sll result number (min count 31))) 264 (t (bug "identity ASH not transformed away"))))) 265 266(macrolet ((def (name sc-type type result-type cost) 267 `(define-vop (,name) 268 (:note "inline ASH") 269 (:translate ash) 270 (:args (number :scs (,sc-type)) 271 (amount :scs (signed-reg unsigned-reg immediate))) 272 (:arg-types ,type positive-fixnum) 273 (:results (result :scs (,result-type))) 274 (:result-types ,type) 275 (:policy :fast-safe) 276 (:generator ,cost 277 (sc-case amount 278 ((signed-reg unsigned-reg) 279 (inst sll result number amount)) 280 (immediate 281 (let ((amount (tn-value amount))) 282 (aver (> amount 0)) 283 (inst sll result number amount)))))))) 284 (def fast-ash-left/fixnum=>fixnum any-reg tagged-num any-reg 2) 285 (def fast-ash-left/signed=>signed signed-reg signed-num signed-reg 3) 286 (def fast-ash-left/unsigned=>unsigned unsigned-reg unsigned-num unsigned-reg 3)) 287 288(define-vop (signed-byte-32-len) 289 (:translate integer-length) 290 (:note "inline (signed-byte 32) integer-length") 291 (:policy :fast-safe) 292 (:args (arg :scs (signed-reg) :target shift)) 293 (:arg-types signed-num) 294 (:results (res :scs (any-reg))) 295 (:result-types positive-fixnum) 296 (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) shift) 297 (:generator 30 298 (let ((loop (gen-label)) 299 (test (gen-label))) 300 (move shift arg) 301 (inst bgez shift test) 302 (move res zero-tn t) 303 (inst b test) 304 (inst nor shift shift) 305 306 (emit-label loop) 307 (inst addu res (fixnumize 1)) 308 309 (emit-label test) 310 (inst bne shift loop) 311 (inst srl shift 1)))) 312 313(define-vop (unsigned-byte-32-count) 314 (:translate logcount) 315 (:note "inline (unsigned-byte 32) logcount") 316 (:policy :fast-safe) 317 (:args (arg :scs (unsigned-reg) :target num)) 318 (:arg-types unsigned-num) 319 (:results (res :scs (unsigned-reg))) 320 (:result-types positive-fixnum) 321 (:temporary (:scs (non-descriptor-reg) :from (:argument 0) :to (:result 0) 322 :target res) num) 323 (:temporary (:scs (non-descriptor-reg)) mask temp) 324 (:generator 30 325 (inst li mask #x55555555) 326 (inst srl temp arg 1) 327 (inst and num arg mask) 328 (inst and temp mask) 329 (inst addu num temp) 330 (inst li mask #x33333333) 331 (inst srl temp num 2) 332 (inst and num mask) 333 (inst and temp mask) 334 (inst addu num temp) 335 (inst li mask #x0f0f0f0f) 336 (inst srl temp num 4) 337 (inst and num mask) 338 (inst and temp mask) 339 (inst addu num temp) 340 (inst li mask #x00ff00ff) 341 (inst srl temp num 8) 342 (inst and num mask) 343 (inst and temp mask) 344 (inst addu num temp) 345 (inst li mask #x0000ffff) 346 (inst srl temp num 16) 347 (inst and num mask) 348 (inst and temp mask) 349 (inst addu res num temp))) 350 351 352;;; Multiply and Divide. 353 354(define-vop (fast-*/fixnum=>fixnum fast-fixnum-binop) 355 (:temporary (:scs (non-descriptor-reg)) temp) 356 (:translate *) 357 (:generator 4 358 (inst sra temp y n-fixnum-tag-bits) 359 (inst mult x temp) 360 (inst mflo r))) 361 362(define-vop (fast-*/signed=>signed fast-signed-binop) 363 (:translate *) 364 (:generator 3 365 (inst mult x y) 366 (inst mflo r))) 367 368(define-vop (fast-*/unsigned=>unsigned fast-unsigned-binop) 369 (:translate *) 370 (:generator 3 371 (inst multu x y) 372 (inst mflo r))) 373 374 375 376(define-vop (fast-truncate/fixnum fast-fixnum-binop) 377 (:translate truncate) 378 (:results (q :scs (any-reg)) 379 (r :scs (any-reg))) 380 (:result-types tagged-num tagged-num) 381 (:temporary (:scs (non-descriptor-reg) :to :eval) temp) 382 (:vop-var vop) 383 (:save-p :compute-only) 384 (:generator 11 385 (let ((zero (generate-error-code vop 'division-by-zero-error x y))) 386 (inst beq y zero)) 387 (inst nop) 388 (inst div x y) 389 (inst mflo temp) 390 (inst sll q temp n-fixnum-tag-bits) 391 (inst mfhi r))) 392 393(define-vop (fast-truncate/unsigned fast-unsigned-binop) 394 (:translate truncate) 395 (:results (q :scs (unsigned-reg)) 396 (r :scs (unsigned-reg))) 397 (:result-types unsigned-num unsigned-num) 398 (:vop-var vop) 399 (:save-p :compute-only) 400 (:generator 12 401 (let ((zero (generate-error-code vop 'division-by-zero-error x y))) 402 (inst beq y zero)) 403 (inst nop) 404 (inst divu x y) 405 (inst mflo q) 406 (inst mfhi r))) 407 408(define-vop (fast-truncate/signed fast-signed-binop) 409 (:translate truncate) 410 (:results (q :scs (signed-reg)) 411 (r :scs (signed-reg))) 412 (:result-types signed-num signed-num) 413 (:vop-var vop) 414 (:save-p :compute-only) 415 (:generator 12 416 (let ((zero (generate-error-code vop 'division-by-zero-error x y))) 417 (inst beq y zero)) 418 (inst nop) 419 (inst div x y) 420 (inst mflo q) 421 (inst mfhi r))) 422 423 424 425;;;; Binary conditional VOPs: 426 427(define-vop (fast-conditional) 428 (:conditional) 429 (:info target not-p) 430 (:effects) 431 (:affected) 432 (:temporary (:scs (non-descriptor-reg)) temp) 433 (:policy :fast-safe)) 434 435(define-vop (fast-conditional/fixnum fast-conditional) 436 (:args (x :scs (any-reg)) 437 (y :scs (any-reg))) 438 (:arg-types tagged-num tagged-num) 439 (:note "inline fixnum comparison")) 440 441(define-vop (fast-conditional-c/fixnum fast-conditional/fixnum) 442 (:args (x :scs (any-reg))) 443 (:arg-types tagged-num (:constant (signed-byte-with-a-bite-out 14 4))) 444 (:info target not-p y)) 445 446(define-vop (fast-conditional/signed fast-conditional) 447 (:args (x :scs (signed-reg)) 448 (y :scs (signed-reg))) 449 (:arg-types signed-num signed-num) 450 (:note "inline (signed-byte 32) comparison")) 451 452(define-vop (fast-conditional-c/signed fast-conditional/signed) 453 (:args (x :scs (signed-reg))) 454 (:arg-types signed-num (:constant (signed-byte-with-a-bite-out 16 1))) 455 (:info target not-p y)) 456 457(define-vop (fast-conditional/unsigned fast-conditional) 458 (:args (x :scs (unsigned-reg)) 459 (y :scs (unsigned-reg))) 460 (:arg-types unsigned-num unsigned-num) 461 (:note "inline (unsigned-byte 32) comparison")) 462 463(define-vop (fast-conditional-c/unsigned fast-conditional/unsigned) 464 (:args (x :scs (unsigned-reg))) 465 (:arg-types unsigned-num (:constant (and (signed-byte-with-a-bite-out 16 1) 466 unsigned-byte))) 467 (:info target not-p y)) 468 469 470(defmacro define-conditional-vop (translate &rest generator) 471 `(progn 472 ,@(mapcar #'(lambda (suffix cost signed) 473 (unless (and (member suffix '(/fixnum -c/fixnum)) 474 (eq translate 'eql)) 475 `(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)" 476 translate suffix)) 477 ,(intern 478 (format nil "~:@(FAST-CONDITIONAL~A~)" 479 suffix))) 480 (:translate ,translate) 481 (:generator ,cost 482 (let* ((signed ,signed) 483 (-c/fixnum ,(eq suffix '-c/fixnum)) 484 (y (if -c/fixnum (fixnumize y) y))) 485 (declare (ignorable signed -c/fixnum y)) 486 ,@generator))))) 487 '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned) 488 '(3 2 5 4 5 4) 489 '(t t t t nil nil)))) 490 491(define-conditional-vop < 492 (cond ((and signed (eql y 0)) 493 (if not-p 494 (inst bgez x target) 495 (inst bltz x target))) 496 (t 497 (if signed 498 (inst slt temp x y) 499 (inst sltu temp x y)) 500 (if not-p 501 (inst beq temp target) 502 (inst bne temp target)))) 503 (inst nop)) 504 505(define-conditional-vop > 506 (cond ((and signed (eql y 0)) 507 (if not-p 508 (inst blez x target) 509 (inst bgtz x target))) 510 ((integerp y) 511 (let ((y (+ y (if -c/fixnum (fixnumize 1) 1)))) 512 (if signed 513 (inst slt temp x y) 514 (inst sltu temp x y)) 515 (if not-p 516 (inst bne temp target) 517 (inst beq temp target)))) 518 (t 519 (if signed 520 (inst slt temp y x) 521 (inst sltu temp y x)) 522 (if not-p 523 (inst beq temp target) 524 (inst bne temp target)))) 525 (inst nop)) 526 527;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a 528;;; known fixnum. 529 530(define-conditional-vop eql 531 (declare (ignore signed)) 532 (when (integerp y) 533 (inst li temp y) 534 (setf y temp)) 535 (if not-p 536 (inst bne x y target) 537 (inst beq x y target)) 538 (inst nop)) 539 540;;; These versions specify a fixnum restriction on their first arg. We have 541;;; also generic-eql/fixnum VOPs which are the same, but have no restriction on 542;;; the first arg and a higher cost. The reason for doing this is to prevent 543;;; fixnum specific operations from being used on word integers, spuriously 544;;; consing the argument. 545;;; 546(define-vop (fast-eql/fixnum fast-conditional) 547 (:args (x :scs (any-reg)) 548 (y :scs (any-reg))) 549 (:arg-types tagged-num tagged-num) 550 (:note "inline fixnum comparison") 551 (:translate eql) 552 (:ignore temp) 553 (:generator 3 554 (if not-p 555 (inst bne x y target) 556 (inst beq x y target)) 557 (inst nop))) 558;;; 559(define-vop (generic-eql/fixnum fast-eql/fixnum) 560 (:args (x :scs (any-reg descriptor-reg)) 561 (y :scs (any-reg))) 562 (:arg-types * tagged-num) 563 (:variant-cost 7)) 564 565(define-vop (fast-eql-c/fixnum fast-conditional/fixnum) 566 (:args (x :scs (any-reg))) 567 (:arg-types tagged-num (:constant (signed-byte 14))) 568 (:info target not-p y) 569 (:translate eql) 570 (:generator 2 571 (let ((y (cond ((eql y 0) zero-tn) 572 (t 573 (inst li temp (fixnumize y)) 574 temp)))) 575 (if not-p 576 (inst bne x y target) 577 (inst beq x y target)) 578 (inst nop)))) 579;;; 580(define-vop (generic-eql-c/fixnum fast-eql-c/fixnum) 581 (:args (x :scs (any-reg descriptor-reg))) 582 (:arg-types * (:constant (signed-byte 14))) 583 (:variant-cost 6)) 584 585 586;;;; 32-bit logical operations 587 588(define-vop (shift-towards-someplace) 589 (:policy :fast-safe) 590 (:args (num :scs (unsigned-reg)) 591 (amount :scs (signed-reg))) 592 (:arg-types unsigned-num tagged-num) 593 (:results (r :scs (unsigned-reg))) 594 (:result-types unsigned-num)) 595 596(define-vop (shift-towards-start shift-towards-someplace) 597 (:translate shift-towards-start) 598 (:note "SHIFT-TOWARDS-START") 599 (:generator 1 600 (ecase *backend-byte-order* 601 (:big-endian 602 (inst sll r num amount)) 603 (:little-endian 604 (inst srl r num amount))))) 605 606(define-vop (shift-towards-end shift-towards-someplace) 607 (:translate shift-towards-end) 608 (:note "SHIFT-TOWARDS-END") 609 (:generator 1 610 (ecase *backend-byte-order* 611 (:big-endian 612 (inst srl r num amount)) 613 (:little-endian 614 (inst sll r num amount))))) 615 616;;;; Modular arithmetic 617(define-modular-fun +-mod32 (x y) + :untagged nil 32) 618(define-vop (fast-+-mod32/unsigned=>unsigned fast-+/unsigned=>unsigned) 619 (:translate +-mod32)) 620(define-vop (fast-+-mod32-c/unsigned=>unsigned fast-+-c/unsigned=>unsigned) 621 (:translate +-mod32)) 622(define-modular-fun --mod32 (x y) - :untagged nil 32) 623(define-vop (fast---mod32/unsigned=>unsigned fast--/unsigned=>unsigned) 624 (:translate --mod32)) 625(define-vop (fast---mod32-c/unsigned=>unsigned fast---c/unsigned=>unsigned) 626 (:translate --mod32)) 627 628(define-vop (fast-ash-left-mod32-c/unsigned=>unsigned 629 fast-ash-c/unsigned=>unsigned) 630 (:translate ash-left-mod32)) 631 632(define-vop (fast-ash-left-mod32/unsigned=>unsigned 633 fast-ash-left/unsigned=>unsigned)) 634(deftransform ash-left-mod32 ((integer count) 635 ((unsigned-byte 32) (unsigned-byte 5))) 636 (when (sb!c::constant-lvar-p count) 637 (sb!c::give-up-ir1-transform)) 638 '(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count)) 639 640;;; logical operations 641(define-modular-fun lognot-mod32 (x) lognot :untagged nil 32) 642(define-vop (lognot-mod32/unsigned=>unsigned) 643 (:translate lognot-mod32) 644 (:args (x :scs (unsigned-reg))) 645 (:arg-types unsigned-num) 646 (:results (r :scs (unsigned-reg))) 647 (:result-types unsigned-num) 648 (:policy :fast-safe) 649 (:generator 1 650 (inst nor r x zero-tn))) 651 652(define-modular-fun lognor-mod32 (x y) lognor :untagged nil 32) 653(define-vop (fast-lognor-mod32/unsigned=>unsigned 654 fast-lognor/unsigned=>unsigned) 655 (:translate lognor-mod32)) 656 657(define-source-transform logeqv (&rest args) 658 (if (oddp (length args)) 659 `(logxor ,@args) 660 `(lognot (logxor ,@args)))) 661(define-source-transform logandc1 (x y) 662 `(logand (lognot ,x) ,y)) 663(define-source-transform logandc2 (x y) 664 `(logand ,x (lognot ,y))) 665(define-source-transform logorc1 (x y) 666 `(logior (lognot ,x) ,y)) 667(define-source-transform logorc2 (x y) 668 `(logior ,x (lognot ,y))) 669(define-source-transform lognand (x y) 670 `(lognot (logand ,x ,y))) 671;;;; Bignum stuff. 672 673(define-vop (bignum-length get-header-data) 674 (:translate sb!bignum:%bignum-length) 675 (:policy :fast-safe)) 676 677(define-vop (bignum-set-length set-header-data) 678 (:translate sb!bignum:%bignum-set-length) 679 (:policy :fast-safe)) 680 681(define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag 682 (unsigned-reg) unsigned-num sb!bignum:%bignum-ref) 683 684(define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag 685 (unsigned-reg) unsigned-num sb!bignum:%bignum-set) 686 687(define-vop (digit-0-or-plus) 688 (:translate sb!bignum:%digit-0-or-plusp) 689 (:policy :fast-safe) 690 (:args (digit :scs (unsigned-reg))) 691 (:arg-types unsigned-num) 692 (:conditional) 693 (:info target not-p) 694 (:generator 2 695 (if not-p 696 (inst bltz digit target) 697 (inst bgez digit target)) 698 (inst nop))) 699 700(define-vop (add-w/carry) 701 (:translate sb!bignum:%add-with-carry) 702 (:policy :fast-safe) 703 (:args (a :scs (unsigned-reg)) 704 (b :scs (unsigned-reg)) 705 (c :scs (any-reg))) 706 (:arg-types unsigned-num unsigned-num positive-fixnum) 707 (:temporary (:scs (unsigned-reg) :to (:result 0) :target result) res) 708 (:results (result :scs (unsigned-reg)) 709 (carry :scs (unsigned-reg) :from :eval)) 710 (:result-types unsigned-num positive-fixnum) 711 (:temporary (:scs (non-descriptor-reg)) temp) 712 (:generator 5 713 (let ((carry-in (gen-label)) 714 (done (gen-label))) 715 (inst bne c carry-in) 716 (inst addu res a b) 717 718 (inst b done) 719 (inst sltu carry res b) 720 721 (emit-label carry-in) 722 (inst addu res 1) 723 (inst nor temp a zero-tn) 724 (inst sltu carry b temp) 725 (inst xor carry 1) 726 727 (emit-label done) 728 (move result res)))) 729 730(define-vop (sub-w/borrow) 731 (:translate sb!bignum:%subtract-with-borrow) 732 (:policy :fast-safe) 733 (:args (a :scs (unsigned-reg)) 734 (b :scs (unsigned-reg)) 735 (c :scs (any-reg))) 736 (:arg-types unsigned-num unsigned-num positive-fixnum) 737 (:temporary (:scs (unsigned-reg) :to (:result 0) :target result) res) 738 (:results (result :scs (unsigned-reg)) 739 (borrow :scs (unsigned-reg) :from :eval)) 740 (:result-types unsigned-num positive-fixnum) 741 (:generator 4 742 (let ((no-borrow-in (gen-label)) 743 (done (gen-label))) 744 745 (inst bne c no-borrow-in) 746 (inst subu res a b) 747 748 (inst subu res 1) 749 (inst b done) 750 (inst sltu borrow b a) 751 752 (emit-label no-borrow-in) 753 (inst sltu borrow a b) 754 (inst xor borrow 1) 755 756 (emit-label done) 757 (move result res)))) 758 759(define-vop (bignum-mult-and-add-3-arg) 760 (:translate sb!bignum:%multiply-and-add) 761 (:policy :fast-safe) 762 (:args (x :scs (unsigned-reg)) 763 (y :scs (unsigned-reg)) 764 (carry-in :scs (unsigned-reg) :to :save)) 765 (:arg-types unsigned-num unsigned-num unsigned-num) 766 (:temporary (:scs (unsigned-reg) :from (:argument 1)) temp) 767 (:results (hi :scs (unsigned-reg)) 768 (lo :scs (unsigned-reg))) 769 (:result-types unsigned-num unsigned-num) 770 (:generator 6 771 (inst multu x y) 772 (inst mflo temp) 773 (inst addu lo temp carry-in) 774 (inst sltu temp lo carry-in) 775 (inst mfhi hi) 776 (inst addu hi temp))) 777 778(define-vop (bignum-mult-and-add-4-arg) 779 (:translate sb!bignum:%multiply-and-add) 780 (:policy :fast-safe) 781 (:args (x :scs (unsigned-reg)) 782 (y :scs (unsigned-reg)) 783 (prev :scs (unsigned-reg)) 784 (carry-in :scs (unsigned-reg) :to :save)) 785 (:arg-types unsigned-num unsigned-num unsigned-num unsigned-num) 786 (:temporary (:scs (unsigned-reg) :from (:argument 2)) temp) 787 (:results (hi :scs (unsigned-reg)) 788 (lo :scs (unsigned-reg))) 789 (:result-types unsigned-num unsigned-num) 790 (:generator 9 791 (inst multu x y) 792 (inst addu lo prev carry-in) 793 (inst sltu temp lo carry-in) 794 (inst mfhi hi) 795 (inst addu hi temp) 796 (inst mflo temp) 797 (inst addu lo temp) 798 (inst sltu temp lo temp) 799 (inst addu hi temp))) 800 801(define-vop (bignum-mult) 802 (:translate sb!bignum:%multiply) 803 (:policy :fast-safe) 804 (:args (x :scs (unsigned-reg)) 805 (y :scs (unsigned-reg))) 806 (:arg-types unsigned-num unsigned-num) 807 (:results (hi :scs (unsigned-reg)) 808 (lo :scs (unsigned-reg))) 809 (:result-types unsigned-num unsigned-num) 810 (:generator 3 811 (inst multu x y) 812 (inst mflo lo) 813 (inst mfhi hi))) 814 815(define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned) 816 (:translate sb!bignum:%lognot)) 817 818(define-vop (fixnum-to-digit) 819 (:translate sb!bignum:%fixnum-to-digit) 820 (:policy :fast-safe) 821 (:args (fixnum :scs (any-reg))) 822 (:arg-types tagged-num) 823 (:results (digit :scs (unsigned-reg))) 824 (:result-types unsigned-num) 825 (:generator 1 826 (inst sra digit fixnum n-fixnum-tag-bits))) 827 828(define-vop (bignum-floor) 829 (:translate sb!bignum:%bigfloor) 830 (:policy :fast-safe) 831 (:args (num-high :scs (unsigned-reg) :target rem) 832 (num-low :scs (unsigned-reg) :target rem-low) 833 (denom :scs (unsigned-reg) :to (:eval 1))) 834 (:arg-types unsigned-num unsigned-num unsigned-num) 835 (:temporary (:scs (unsigned-reg) :from (:argument 1)) rem-low) 836 (:temporary (:scs (unsigned-reg) :from (:eval 0)) temp) 837 (:results (quo :scs (unsigned-reg) :from (:eval 0)) 838 (rem :scs (unsigned-reg) :from (:argument 0))) 839 (:result-types unsigned-num unsigned-num) 840 (:generator 325 ; number of inst assuming targeting works. 841 (move rem num-high) 842 (move rem-low num-low) 843 (flet ((maybe-subtract (&optional (guess temp)) 844 (inst subu temp guess 1) 845 (inst and temp denom) 846 (inst subu rem temp))) 847 (inst sltu quo rem denom) 848 (maybe-subtract quo) 849 (dotimes (i 32) 850 (inst sll rem 1) 851 (inst srl temp rem-low 31) 852 (inst or rem temp) 853 (inst sll rem-low 1) 854 (inst sltu temp rem denom) 855 (inst sll quo 1) 856 (inst or quo temp) 857 (maybe-subtract))) 858 (inst nor quo zero-tn))) 859 860(define-vop (signify-digit) 861 (:translate sb!bignum:%fixnum-digit-with-correct-sign) 862 (:policy :fast-safe) 863 (:args (digit :scs (unsigned-reg) :target res)) 864 (:arg-types unsigned-num) 865 (:results (res :scs (any-reg signed-reg))) 866 (:result-types signed-num) 867 (:generator 1 868 (sc-case res 869 (any-reg 870 (inst sll res digit n-fixnum-tag-bits)) 871 (signed-reg 872 (move res digit))))) 873 874 875(define-vop (digit-ashr) 876 (:translate sb!bignum:%ashr) 877 (:policy :fast-safe) 878 (:args (digit :scs (unsigned-reg)) 879 (count :scs (unsigned-reg))) 880 (:arg-types unsigned-num positive-fixnum) 881 (:results (result :scs (unsigned-reg))) 882 (:result-types unsigned-num) 883 (:generator 1 884 (inst sra result digit count))) 885 886(define-vop (digit-lshr digit-ashr) 887 (:translate sb!bignum:%digit-logical-shift-right) 888 (:generator 1 889 (inst srl result digit count))) 890 891(define-vop (digit-ashl digit-ashr) 892 (:translate sb!bignum:%ashl) 893 (:generator 1 894 (inst sll result digit count))) 895 896 897;;;; Static functions. 898 899(define-static-fun two-arg-gcd (x y) :translate gcd) 900(define-static-fun two-arg-lcm (x y) :translate lcm) 901 902(define-static-fun two-arg-+ (x y) :translate +) 903(define-static-fun two-arg-- (x y) :translate -) 904(define-static-fun two-arg-* (x y) :translate *) 905(define-static-fun two-arg-/ (x y) :translate /) 906 907(define-static-fun two-arg-< (x y) :translate <) 908(define-static-fun two-arg-<= (x y) :translate <=) 909(define-static-fun two-arg-> (x y) :translate >) 910(define-static-fun two-arg->= (x y) :translate >=) 911(define-static-fun two-arg-= (x y) :translate =) 912(define-static-fun two-arg-/= (x y) :translate /=) 913 914(define-static-fun %negate (x) :translate %negate) 915 916(define-static-fun two-arg-and (x y) :translate logand) 917(define-static-fun two-arg-ior (x y) :translate logior) 918(define-static-fun two-arg-xor (x y) :translate logxor) 919