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