src/compiler/mips/arith.lisp

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