src/compiler/sparc/arith.lisp

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