src/compiler/ppc/arith.lisp

   1 ;;;; the VM definition arithmetic VOPs for the PPC
   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 xori 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 (define-vop (fast-fixnum-binop-c fast-safe-arith-op)
  84   (:args (x :target r :scs (any-reg zero)))
  85   (:info y)
  86   (:arg-types tagged-num
  87               (:constant (and (signed-byte 14) (not (integer 0 0)))))
  88   (:results (r :scs (any-reg)))
  89   (:result-types tagged-num)
  90   (:note "inline fixnum arithmetic"))
  91
  92 (define-vop (fast-fixnum-binop30-c fast-safe-arith-op)
  93   (:args (x :target r :scs (any-reg zero)))
  94   (:info y)
  95   (:arg-types tagged-num
  96               (:constant (and (signed-byte 30) (not (integer 0 0)))))
  97   (:results (r :scs (any-reg)))
  98   (:result-types tagged-num)
  99   (:note "inline fixnum arithmetic"))
 100
 101 (define-vop (fast-fixnum-logop-c fast-safe-arith-op)
 102   (:args (x :target r :scs (any-reg zero)))
 103   (:info y)
 104   (:arg-types tagged-num
 105               (:constant (and (unsigned-byte 14) (not (integer 0 0)))))
 106   (:results (r :scs (any-reg)))
 107   (:result-types tagged-num)
 108   (:note "inline fixnum logical op"))
 109
 110 (define-vop (fast-fixnum-logop30-c fast-safe-arith-op)
 111   (:args (x :target r :scs (any-reg zero)))
 112   (:info y)
 113   (:arg-types tagged-num
 114               (:constant (and (unsigned-byte 16) (not (integer 0 0)))))
 115   (:results (r :scs (any-reg)))
 116   (:result-types tagged-num)
 117   (:note "inline fixnum logical op"))
 118
 119 (define-vop (fast-unsigned-binop-c fast-safe-arith-op)
 120   (:args (x :target r :scs (unsigned-reg zero)))
 121   (:info y)
 122   (:arg-types unsigned-num
 123               (:constant (and (signed-byte 16) (not (integer 0 0)))))
 124   (:results (r :scs (unsigned-reg)))
 125   (:result-types unsigned-num)
 126   (:note "inline (unsigned-byte 32) arithmetic"))
 127
 128 (define-vop (fast-unsigned-binop32-c fast-safe-arith-op)
 129   (:args (x :target r :scs (unsigned-reg zero)))
 130   (:info y)
 131   (:arg-types unsigned-num
 132               (:constant (and (unsigned-byte 32) (not (integer 0 0)))))
 133   (:results (r :scs (unsigned-reg)))
 134   (:result-types unsigned-num)
 135   (:note "inline (unsigned-byte 32) arithmetic"))
 136
 137 (define-vop (fast-unsigned-logop-c fast-safe-arith-op)
 138   (:args (x :target r :scs (unsigned-reg zero)))
 139   (:info y)
 140   (:arg-types unsigned-num
 141               (:constant (and (unsigned-byte 16) (not (integer 0 0)))))
 142   (:results (r :scs (unsigned-reg)))
 143   (:result-types unsigned-num)
 144   (:note "inline (unsigned-byte 32) logical op"))
 145
 146 (define-vop (fast-unsigned-logop32-c fast-safe-arith-op)
 147   (:args (x :target r :scs (unsigned-reg zero)))
 148   (:info y)
 149   (:arg-types unsigned-num
 150               (:constant (and (unsigned-byte 32) (not (integer 0 0)))))
 151   (:results (r :scs (unsigned-reg)))
 152   (:result-types unsigned-num)
 153   (:note "inline (unsigned-byte 32) logical op"))
 154
 155
 156
 157 (define-vop (fast-unsigned-binop-c fast-safe-arith-op)
 158   (:args (x :target r :scs (unsigned-reg zero)))
 159   (:info y)
 160   (:arg-types unsigned-num
 161               (:constant (and (signed-byte 16) (not (integer 0 0)))))
 162   (:results (r :scs (unsigned-reg)))
 163   (:result-types unsigned-num)
 164   (:note "inline (unsigned-byte 32) arithmetic"))
 165
 166 (define-vop (fast-unsigned-logop-c fast-safe-arith-op)
 167   (:args (x :target r :scs (unsigned-reg zero)))
 168   (:info y)
 169   (:arg-types unsigned-num
 170               (:constant (and (unsigned-byte 16) (not (integer 0 0)))))
 171   (:results (r :scs (unsigned-reg)))
 172   (:result-types unsigned-num)
 173   (:note "inline (unsigned-byte 32) logical op"))
 174
 175
 176 (eval-when (:compile-toplevel :load-toplevel :execute)
 177
 178 (defmacro !define-var-binop (translate untagged-penalty op
 179                              &optional arg-swap restore-fixnum-mask)
 180   `(progn
 181      (define-vop (,(symbolicate "FAST-" translate "/FIXNUM=>FIXNUM")
 182                   fast-fixnum-binop)
 183        ,@(when restore-fixnum-mask
 184            `((:temporary (:sc non-descriptor-reg) temp)))
 185        (:translate ,translate)
 186        (:generator 2
 187          ,(if arg-swap
 188              `(inst ,op ,(if restore-fixnum-mask 'temp 'r) y x)
 189              `(inst ,op ,(if restore-fixnum-mask 'temp 'r) x y))
 190          ;; FIXME: remind me what convention we used for 64bitizing
 191          ;; stuff?  -- CSR, 2003-08-27
 192          ,@(when restore-fixnum-mask
 193              `((inst clrrwi r temp (1- n-lowtag-bits))))))
 194      (define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED")
 195                   fast-signed-binop)
 196        (:translate ,translate)
 197        (:generator ,(1+ untagged-penalty)
 198          ,(if arg-swap
 199              `(inst ,op r y x)
 200              `(inst ,op r x y))))
 201      (define-vop (,(symbolicate "FAST-" translate "/UNSIGNED=>UNSIGNED")
 202                   fast-unsigned-binop)
 203        (:translate ,translate)
 204        (:generator ,(1+ untagged-penalty)
 205          ,(if arg-swap
 206              `(inst ,op r y x)
 207              `(inst ,op r x y))))))
 208
 209 ;;; FIXME: the code has really only been checked for adds; we could do
 210 ;;; subtracts, too, but my brain is not up to the task of figuring out
 211 ;;; signs and borrows.
 212 (defmacro !define-const-binop (translate untagged-penalty op &optional (shifted-op nil))
 213   `(progn
 214      (define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum)
 215                   ,(if shifted-op
 216                        'fast-fixnum-binop30-c
 217                        'fast-fixnum-binop-c))
 218        (:translate ,translate)
 219        ,@(when shifted-op
 220           `((:temporary (:sc any-reg :target r) temp)))
 221        (:generator 1
 222         ,(if shifted-op
 223              `(let* ((y (fixnumize y))
 224                      (high-half (ldb (byte 16 16) y))
 225                      (low-half (ldb (byte 16 0) y)))
 226                ;; Compare %LR in insts.lisp.
 227                (cond
 228                  ((and (logbitp 15 low-half) (= high-half #xffff))
 229                   ;; Let sign-extension do the work for us, but make sure
 230                   ;; to turn LOW-HALF into a signed integer.
 231                   (inst ,op r x (dpb low-half (byte 16 0) -1)))
 232                  ((and (not (logbitp 15 low-half)) (zerop high-half))
 233                   (inst ,op r x low-half))
 234                  ((zerop low-half)
 235                   (inst ,shifted-op r x (if (logbitp 15 high-half)
 236                                             (dpb high-half (byte 16 0) -1)
 237                                             high-half)))
 238                  (t
 239                   ;; Check to see whether compensating for the sign bit
 240                   ;; of LOW-HALF is necessary.
 241                   (let ((high-half (let ((top (if (logbitp 15 low-half)
 242                                                   (ldb (byte 16 0)
 243                                                        (1+ high-half))
 244                                                   high-half)))
 245                                      (if (logbitp 15 top)
 246                                          (dpb top (byte 16 0) -1)
 247                                          top))))
 248                     (inst ,shifted-op temp x high-half)
 249                     (inst ,op r temp low-half)))))
 250              `(inst ,op r x (fixnumize y)))))
 251      (define-vop (,(symbolicate 'fast- translate '-c/signed=>signed)
 252                   ,(if shifted-op
 253                        'fast-signed-binop32-c
 254                        'fast-signed-binop-c))
 255        (:translate ,translate)
 256        ,@(when shifted-op
 257           `((:temporary (:sc non-descriptor-reg :target r) temp)))
 258        (:generator ,untagged-penalty
 259         ,(if shifted-op
 260              `(let ((high-half (ldb (byte 16 16) y))
 261                     (low-half (ldb (byte 16 0) y)))
 262                ;; Compare %LR in insts.lisp.
 263                (cond
 264                  ((and (logbitp 15 low-half) (= high-half #xffff))
 265                   ;; Let sign-extension do the work for us, but make sure
 266                   ;; to turn LOW-HALF into a signed integer.
 267                   (inst ,op r x (dpb low-half (byte 16 0) -1)))
 268                  ((and (not (logbitp 15 low-half)) (zerop high-half))
 269                   (inst ,op r x low-half))
 270                  ((zerop low-half)
 271                   (inst ,shifted-op r x (if (logbitp 15 high-half)
 272                                             (dpb high-half (byte 16 0) -1)
 273                                             high-half)))
 274                  (t
 275                   ;; Check to see whether compensating for the sign bit
 276                   ;; of LOW-HALF is necessary.
 277                   (let ((high-half (let ((top (if (logbitp 15 low-half)
 278                                                   (ldb (byte 16 0)
 279                                                        (1+ high-half))
 280                                                   high-half)))
 281                                      (if (logbitp 15 top)
 282                                          (dpb top (byte 16 0) -1)
 283                                          top))))
 284                     (inst ,shifted-op temp x high-half)
 285                     (inst ,op r temp low-half)))))
 286              `(inst ,op r x y))))
 287      (define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned)
 288                   ,(if shifted-op
 289                        'fast-unsigned-binop32-c
 290                        'fast-unsigned-binop-c))
 291        (:translate ,translate)
 292        ,@(when shifted-op
 293           `((:temporary (:sc non-descriptor-reg :target r) temp)))
 294        (:generator ,untagged-penalty
 295         ,(if shifted-op
 296              `(let ((high-half (ldb (byte 16 16) y))
 297                     (low-half (ldb (byte 16 0) y)))
 298                ;; Compare %LR in insts.lisp.
 299                (cond
 300                  ((and (logbitp 15 low-half) (= high-half #xffff))
 301                   ;; Let sign-extension do the work for us, but make sure
 302                   ;; to turn LOW-HALF into a signed integer.
 303                   (inst ,op r x (dpb low-half (byte 16 0) -1)))
 304                  ((and (not (logbitp 15 low-half)) (zerop high-half))
 305                   (inst ,op r x low-half))
 306                  ((zerop low-half)
 307                   (inst ,shifted-op r x (if (logbitp 15 high-half)
 308                                             (dpb high-half (byte 16 0) -1)
 309                                             high-half)))
 310                  (t
 311                   ;; Check to see whether compensating for the sign bit
 312                   ;; of LOW-HALF is necessary.
 313                   (let ((high-half (let ((top (if (logbitp 15 low-half)
 314                                                   (ldb (byte 16 0)
 315                                                        (1+ high-half))
 316                                                   high-half)))
 317                                      (if (logbitp 15 top)
 318                                          (dpb top (byte 16 0) -1)
 319                                          top))))
 320                     (inst ,shifted-op temp x high-half)
 321                     (inst ,op r temp low-half)))))
 322              `(inst ,op r x y))))))
 323
 324 ;;; For logical operations, we don't have to worry about signed bit
 325 ;;; propagation from the lower half of a 32-bit operand.
 326 (defmacro !define-const-logop (translate untagged-penalty op &optional (shifted-op nil))
 327   `(progn
 328      (define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum)
 329                   ,(if shifted-op
 330                        'fast-fixnum-logop30-c
 331                        'fast-fixnum-logop-c))
 332        (:translate ,translate)
 333        ,@(when shifted-op
 334           `((:temporary (:sc any-reg :target r) temp)))
 335        (:generator 1
 336         ,(if shifted-op
 337              `(let* ((y (fixnumize y))
 338                      (high-half (ldb (byte 16 16) y))
 339                      (low-half (ldb (byte 16 0) y)))
 340                (cond
 341                  ((zerop high-half) (inst ,op r x low-half))
 342                  ((zerop low-half) (inst ,shifted-op r x high-half))
 343                  (t
 344                   (inst ,shifted-op temp x high-half)
 345                   (inst ,op r temp low-half))))
 346              `(inst ,op r x (fixnumize y)))))
 347      (define-vop (,(symbolicate 'fast- translate '-c/signed=>signed)
 348                   ,(if shifted-op
 349                        'fast-signed-logop32-c
 350                        'fast-signed-logop-c))
 351        (:translate ,translate)
 352        ,@(when shifted-op
 353           `((:temporary (:sc non-descriptor-reg :target r) temp)))
 354        (:generator ,untagged-penalty
 355         ,(if shifted-op
 356              `(let ((high-half (ldb (byte 16 16) y))
 357                     (low-half (ldb (byte 16 0) y)))
 358                (cond
 359                  ((zerop high-half) (inst ,op r x low-half))
 360                  ((zerop low-half) (inst ,shifted-op r x high-half))
 361                  (t
 362                   (inst ,shifted-op temp x high-half)
 363                   (inst ,op r temp low-half))))
 364              `(inst ,op r x y))))
 365      (define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned)
 366                   ,(if shifted-op
 367                        'fast-unsigned-logop32-c
 368                        'fast-unsigned-logop-c))
 369        (:translate ,translate)
 370        ,@(when shifted-op
 371           `((:temporary (:sc non-descriptor-reg :target r) temp)))
 372        (:generator ,untagged-penalty
 373         ,(if shifted-op
 374              `(let ((high-half (ldb (byte 16 16) y))
 375                     (low-half (ldb (byte 16 0) y)))
 376                (cond
 377                  ((zerop high-half) (inst ,op r x low-half))
 378                  ((zerop low-half) (inst ,shifted-op r x high-half))
 379                  (t
 380                   (inst ,shifted-op temp x high-half)
 381                   (inst ,op r temp low-half))))
 382              `(inst ,op r x y))))))
 383
 384 ); eval-when
 385
 386 (!define-var-binop + 4 add)
 387 (!define-var-binop - 4 sub)
 388 (!define-var-binop logand 2 and)
 389 (!define-var-binop logandc1 2 andc t)
 390 (!define-var-binop logandc2 2 andc)
 391 (!define-var-binop logior 2 or)
 392 (!define-var-binop logorc1 2 orc t t)
 393 (!define-var-binop logorc2 2 orc nil t)
 394 (!define-var-binop logxor 2 xor)
 395 (!define-var-binop logeqv 2 eqv nil t)
 396 (!define-var-binop lognand 2 nand nil t)
 397 (!define-var-binop lognor 2 nor nil t)
 398
 399 (!define-const-binop + 4 addi addis)
 400 (!define-const-binop - 4 subi)
 401 ;;; Implementing a 32-bit immediate version of LOGAND wouldn't be any
 402 ;;; better than loading the 32-bit constant via LR and then performing
 403 ;;; an /AND/.  So don't bother.  (It would be better in some cases, such
 404 ;;; as when one half of the word is zeros--we save a register--but we
 405 ;;; would have specified one temporary register in the VOP, so we lose
 406 ;;; any possible advantage.)
 407 (!define-const-logop logand 2 andi.)
 408 (!define-const-logop logior 2 ori oris)
 409 (!define-const-logop logxor 2 xori xoris)
 410
 411
 412 ;;; Special case fixnum + and - that trap on overflow.  Useful when we
 413 ;;; don't know that the output type is a fixnum.
 414 ;;;
 415 (define-vop (+/fixnum fast-+/fixnum=>fixnum)
 416   (:policy :safe)
 417   (:results (r :scs (any-reg descriptor-reg)))
 418   (:result-types tagged-num)
 419   (:note "safe inline fixnum arithmetic")
 420   (:generator 4
 421     (let* ((no-overflow (gen-label)))
 422       (inst mtxer zero-tn)
 423       (inst addo. r x y)
 424       (inst bns no-overflow)
 425       (inst unimp (logior (ash (reg-tn-encoding r) 5)
 426                           fixnum-additive-overflow-trap))
 427       (emit-label no-overflow))))
 428
 429
 430 (define-vop (-/fixnum fast--/fixnum=>fixnum)
 431   (:policy :safe)
 432   (:results (r :scs (any-reg descriptor-reg)))
 433   (:result-types tagged-num)
 434   (:note "safe inline fixnum arithmetic")
 435   (:generator 4
 436     (let* ((no-overflow (gen-label)))
 437       (inst mtxer zero-tn)
 438       (inst subo. r x y)
 439       (inst bns no-overflow)
 440       (inst unimp (logior (ash (reg-tn-encoding r) 5)
 441                           fixnum-additive-overflow-trap))
 442       (emit-label no-overflow))))
 443
 444 (define-vop (fast-*/fixnum=>fixnum fast-fixnum-binop)
 445   (:temporary (:scs (non-descriptor-reg)) temp)
 446   (:translate *)
 447   (:generator 2
 448     (inst srawi temp y 2)
 449     (inst mullw r x temp)))
 450
 451 (define-vop (fast-*-c/fixnum=>fixnum fast-fixnum-binop-c)
 452   (:translate *)
 453   (:arg-types tagged-num
 454               (:constant (and (signed-byte 16) (not (integer 0 0)))))
 455   (:generator 1
 456     (inst mulli r x y)))
 457
 458 (define-vop (fast-*-bigc/fixnum=>fixnum fast-fixnum-binop-c)
 459   (:translate *)
 460   (:arg-types tagged-num
 461               (:constant (and fixnum (not (signed-byte 16)))))
 462   (:temporary (:scs (non-descriptor-reg)) temp)
 463   (:generator 1
 464     (inst lr temp y)
 465     (inst mullw r x temp)))
 466
 467 (define-vop (fast-*/signed=>signed fast-signed-binop)
 468   (:translate *)
 469   (:generator 4
 470     (inst mullw r x y)))
 471
 472 (define-vop (fast-*-c/signed=>signed fast-signed-binop-c)
 473   (:translate *)
 474   (:generator 3
 475     (inst mulli r x y)))
 476
 477 (define-vop (fast-*/unsigned=>unsigned fast-unsigned-binop)
 478   (:translate *)
 479   (:generator 4
 480     (inst mullw r x y)))
 481
 482 (define-vop (fast-*-c/unsigned=>unsigned fast-unsigned-binop-c)
 483   (:translate *)
 484   (:generator 3
 485     (inst mulli r x y)))
 486 \f
 487 ;;; Shifting
 488
 489 (macrolet ((def (name sc-type type result-type cost)
 490              `(define-vop (,name)
 491                 (:note "inline ASH")
 492                 (:translate ash)
 493                 (:args (number :scs (,sc-type))
 494                        (amount :scs (signed-reg unsigned-reg immediate)))
 495                 (:arg-types ,type positive-fixnum)
 496                 (:results (result :scs (,result-type)))
 497                 (:result-types ,type)
 498                 (:policy :fast-safe)
 499                 (:generator ,cost
 500                    (sc-case amount
 501                      ((signed-reg unsigned-reg)
 502                       (inst slw result number amount))
 503                      (immediate
 504                       (let ((amount (tn-value amount)))
 505                         (aver (> amount 0))
 506                         (inst slwi result number amount))))))))
 507   ;; FIXME: There's the opportunity for a sneaky optimization here, I
 508   ;; think: a FAST-ASH-LEFT-C/FIXNUM=>SIGNED vop.  -- CSR, 2003-09-03
 509   (def fast-ash-left/fixnum=>fixnum any-reg tagged-num any-reg 2)
 510   (def fast-ash-left/signed=>signed signed-reg signed-num signed-reg 3)
 511   (def fast-ash-left/unsigned=>unsigned unsigned-reg unsigned-num unsigned-reg 3))
 512
 513 (define-vop (fast-ash/unsigned=>unsigned)
 514   (:note "inline ASH")
 515   (:args (number :scs (unsigned-reg) :to :save)
 516          (amount :scs (signed-reg)))
 517   (:arg-types (:or unsigned-num) signed-num)
 518   (:results (result :scs (unsigned-reg)))
 519   (:result-types unsigned-num)
 520   (:translate ash)
 521   (:policy :fast-safe)
 522   (:temporary (:sc non-descriptor-reg) ndesc)
 523   (:generator 5
 524     (let ((positive (gen-label))
 525           (done (gen-label)))
 526       (inst cmpwi amount 0)
 527       (inst neg ndesc amount)
 528       (inst bge positive)
 529       (inst cmpwi ndesc 31)
 530       (inst srw result number ndesc)
 531       (inst ble done)
 532       (move result zero-tn)
 533       (inst b done)
 534
 535       (emit-label positive)
 536       ;; The result-type assures us that this shift will not overflow.
 537       (inst slw result number amount)
 538
 539       (emit-label done))))
 540
 541 (define-vop (fast-ash-c/unsigned=>unsigned)
 542   (:note "inline constant ASH")
 543   (:args (number :scs (unsigned-reg)))
 544   (:info amount)
 545   (:arg-types unsigned-num (:constant integer))
 546   (:results (result :scs (unsigned-reg)))
 547   (:result-types unsigned-num)
 548   (:translate ash)
 549   (:policy :fast-safe)
 550   (:generator 4
 551     (cond
 552       ((and (minusp amount) (< amount -31)) (move result zero-tn))
 553       ((minusp amount) (inst srwi result number (- amount)))
 554       ;; possible because this is used in the modular version too
 555       ((> amount 31) (move result zero-tn))
 556       (t (inst slwi result number amount)))))
 557
 558 (define-vop (fast-ash/signed=>signed)
 559   (:note "inline ASH")
 560   (:args (number :scs (signed-reg) :to :save)
 561          (amount :scs (signed-reg immediate)))
 562   (:arg-types (:or signed-num) signed-num)
 563   (:results (result :scs (signed-reg)))
 564   (:result-types (:or signed-num))
 565   (:translate ash)
 566   (:policy :fast-safe)
 567   (:temporary (:sc non-descriptor-reg) ndesc)
 568   (:generator 3
 569     (sc-case amount
 570       (signed-reg
 571        (let ((positive (gen-label))
 572              (done (gen-label)))
 573          (inst cmpwi amount 0)
 574          (inst neg ndesc amount)
 575          (inst bge positive)
 576          (inst cmpwi ndesc 31)
 577          (inst sraw result number ndesc)
 578          (inst ble done)
 579          (inst srawi result number 31)
 580          (inst b done)
 581
 582          (emit-label positive)
 583          ;; The result-type assures us that this shift will not overflow.
 584          (inst slw result number amount)
 585
 586          (emit-label done)))
 587
 588       (immediate
 589        (let ((amount (tn-value amount)))
 590          (if (minusp amount)
 591              (let ((amount (min 31 (- amount))))
 592                (inst srawi result number amount))
 593              (inst slwi result number amount)))))))
 594
 595
 596
 597 (define-vop (signed-byte-32-len)
 598   (:translate integer-length)
 599   (:note "inline (signed-byte 32) integer-length")
 600   (:policy :fast-safe)
 601   (:args (arg :scs (signed-reg)))
 602   (:arg-types signed-num)
 603   (:results (res :scs (any-reg)))
 604   (:result-types positive-fixnum)
 605   (:temporary (:scs (non-descriptor-reg) :to (:argument 0)) shift)
 606   (:generator 6
 607     ; (integer-length arg) = (- 32 (cntlz (if (>= arg 0) arg (lognot arg))))
 608     (let ((nonneg (gen-label)))
 609       (inst cntlzw. shift arg)
 610       (inst bne nonneg)
 611       (inst not shift arg)
 612       (inst cntlzw shift shift)
 613       (emit-label nonneg)
 614       (inst slwi shift shift 2)
 615       (inst subfic res  shift (fixnumize 32)))))
 616
 617 (define-vop (unsigned-byte-32-count)
 618   (:translate logcount)
 619   (:note "inline (unsigned-byte 32) logcount")
 620   (:policy :fast-safe)
 621   (:args (arg :scs (unsigned-reg) :target shift))
 622   (:arg-types unsigned-num)
 623   (:results (res :scs (any-reg)))
 624   (:result-types positive-fixnum)
 625   (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) shift temp)
 626   (:generator 30
 627     (let ((loop (gen-label))
 628           (done (gen-label)))
 629       (inst add. shift zero-tn arg)
 630       (move res zero-tn)
 631       (inst beq done)
 632
 633       (emit-label loop)
 634       (inst subi temp shift 1)
 635       (inst and. shift shift temp)
 636       (inst addi res res (fixnumize 1))
 637       (inst bne loop)
 638
 639       (emit-label done))))
 640
 641 \f
 642 ;;;; Modular functions:
 643 (define-modular-fun lognot-mod32 (x) lognot :unsigned 32)
 644 (define-vop (lognot-mod32/unsigned=>unsigned)
 645   (:translate lognot-mod32)
 646   (:args (x :scs (unsigned-reg)))
 647   (:arg-types unsigned-num)
 648   (:results (res :scs (unsigned-reg)))
 649   (:result-types unsigned-num)
 650   (:policy :fast-safe)
 651   (:generator 1
 652     (inst not res x)))
 653
 654 (define-vop (fast-ash-left-mod32-c/unsigned=>unsigned
 655              fast-ash-c/unsigned=>unsigned)
 656   (:translate ash-left-mod32))
 657
 658 (define-vop (fast-ash-left-mod32/unsigned=>unsigned
 659              fast-ash-left/unsigned=>unsigned))
 660 (deftransform ash-left-mod32 ((integer count)
 661                               ((unsigned-byte 32) (unsigned-byte 5)))
 662   (when (sb!c::constant-lvar-p count)
 663     (sb!c::give-up-ir1-transform))
 664   '(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count))
 665
 666 (macrolet
 667     ((define-modular-backend (fun &optional constantp)
 668        (let ((mfun-name (symbolicate fun '-mod32))
 669              (modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned))
 670              (modcvop (symbolicate 'fast- fun 'mod32-c/unsigned=>unsigned))
 671              (vop (symbolicate 'fast- fun '/unsigned=>unsigned))
 672              (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned)))
 673          `(progn
 674             (define-modular-fun ,mfun-name (x y) ,fun :unsigned 32)
 675             (define-vop (,modvop ,vop)
 676               (:translate ,mfun-name))
 677             ,@(when constantp
 678                 `((define-vop (,modcvop ,cvop)
 679                     (:translate ,mfun-name))))))))
 680   (define-modular-backend + t)
 681   (define-modular-backend - t)
 682   (define-modular-backend * t)
 683   (define-modular-backend logxor t)
 684   (define-modular-backend logeqv)
 685   (define-modular-backend lognand)
 686   (define-modular-backend lognor)
 687   (define-modular-backend logandc1)
 688   (define-modular-backend logandc2)
 689   (define-modular-backend logorc1)
 690   (define-modular-backend logorc2))
 691 \f
 692 ;;;; Binary conditional VOPs:
 693
 694 (define-vop (fast-conditional)
 695   (:conditional)
 696   (:info target not-p)
 697   (:effects)
 698   (:affected)
 699   (:policy :fast-safe))
 700
 701 (define-vop (fast-conditional/fixnum fast-conditional)
 702   (:args (x :scs (any-reg zero))
 703          (y :scs (any-reg zero)))
 704   (:arg-types tagged-num tagged-num)
 705   (:note "inline fixnum comparison"))
 706
 707 (define-vop (fast-conditional-c/fixnum fast-conditional/fixnum)
 708   (:args (x :scs (any-reg zero)))
 709   (:arg-types tagged-num (:constant (signed-byte 14)))
 710   (:info target not-p y))
 711
 712 (define-vop (fast-conditional/signed fast-conditional)
 713   (:args (x :scs (signed-reg zero))
 714          (y :scs (signed-reg zero)))
 715   (:arg-types signed-num signed-num)
 716   (:note "inline (signed-byte 32) comparison"))
 717
 718 (define-vop (fast-conditional-c/signed fast-conditional/signed)
 719   (:args (x :scs (signed-reg zero)))
 720   (:arg-types signed-num (:constant (signed-byte 16)))
 721   (:info target not-p y))
 722
 723 (define-vop (fast-conditional/unsigned fast-conditional)
 724   (:args (x :scs (unsigned-reg zero))
 725          (y :scs (unsigned-reg zero)))
 726   (:arg-types unsigned-num unsigned-num)
 727   (:note "inline (unsigned-byte 32) comparison"))
 728
 729 (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned)
 730   (:args (x :scs (unsigned-reg zero)))
 731   (:arg-types unsigned-num (:constant (unsigned-byte 16)))
 732   (:info target not-p y))
 733
 734
 735 (define-vop (fast-if-</fixnum fast-conditional/fixnum)
 736   (:translate <)
 737   (:generator 4
 738     (inst cmpw x y)
 739     (inst b? (if not-p :ge :lt) target)))
 740
 741 (define-vop (fast-if-<-c/fixnum fast-conditional-c/fixnum)
 742   (:translate <)
 743   (:generator 3
 744     (inst cmpwi x (fixnumize y))
 745     (inst b? (if not-p :ge :lt) target)))
 746
 747 (define-vop (fast-if-</signed fast-conditional/signed)
 748   (:translate <)
 749   (:generator 6
 750     (inst cmpw x y)
 751     (inst b? (if not-p :ge :lt) target)))
 752
 753 (define-vop (fast-if-<-c/signed fast-conditional-c/signed)
 754   (:translate <)
 755   (:generator 5
 756     (inst cmpwi x y)
 757     (inst b? (if not-p :ge :lt) target)))
 758
 759 (define-vop (fast-if-</unsigned fast-conditional/unsigned)
 760   (:translate <)
 761   (:generator 6
 762     (inst cmplw x y)
 763     (inst b? (if not-p :ge :lt) target)))
 764
 765 (define-vop (fast-if-<-c/unsigned fast-conditional-c/unsigned)
 766   (:translate <)
 767   (:generator 5
 768     (inst cmplwi x y)
 769     (inst b? (if not-p :ge :lt) target)))
 770
 771 (define-vop (fast-if->/fixnum fast-conditional/fixnum)
 772   (:translate >)
 773   (:generator 4
 774     (inst cmpw x y)
 775     (inst b? (if not-p :le :gt) target)))
 776
 777 (define-vop (fast-if->-c/fixnum fast-conditional-c/fixnum)
 778   (:translate >)
 779   (:generator 3
 780     (inst cmpwi x (fixnumize y))
 781     (inst b? (if not-p :le :gt) target)))
 782
 783 (define-vop (fast-if->/signed fast-conditional/signed)
 784   (:translate >)
 785   (:generator 6
 786     (inst cmpw x y)
 787     (inst b? (if not-p :le :gt) target)))
 788
 789 (define-vop (fast-if->-c/signed fast-conditional-c/signed)
 790   (:translate >)
 791   (:generator 5
 792     (inst cmpwi x y)
 793     (inst b? (if not-p :le :gt) target)))
 794
 795 (define-vop (fast-if->/unsigned fast-conditional/unsigned)
 796   (:translate >)
 797   (:generator 6
 798     (inst cmplw x y)
 799     (inst b? (if not-p :le :gt) target)))
 800
 801 (define-vop (fast-if->-c/unsigned fast-conditional-c/unsigned)
 802   (:translate >)
 803   (:generator 5
 804     (inst cmplwi x y)
 805     (inst b? (if not-p :le :gt) target)))
 806
 807 (define-vop (fast-if-eql/signed fast-conditional/signed)
 808   (:translate eql)
 809   (:generator 6
 810     (inst cmpw x y)
 811     (inst b? (if not-p :ne :eq) target)))
 812
 813 (define-vop (fast-if-eql-c/signed fast-conditional-c/signed)
 814   (:translate eql)
 815   (:generator 5
 816     (inst cmpwi x y)
 817     (inst b? (if not-p :ne :eq) target)))
 818
 819 (define-vop (fast-if-eql/unsigned fast-conditional/unsigned)
 820   (:translate eql)
 821   (:generator 6
 822     (inst cmplw x y)
 823     (inst b? (if not-p :ne :eq) target)))
 824
 825 (define-vop (fast-if-eql-c/unsigned fast-conditional-c/unsigned)
 826   (:translate eql)
 827   (:generator 5
 828     (inst cmplwi x y)
 829     (inst b? (if not-p :ne :eq) target)))
 830
 831
 832 ;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a
 833 ;;; known fixnum.
 834
 835 ;;; These versions specify a fixnum restriction on their first arg.  We have
 836 ;;; also generic-eql/fixnum VOPs which are the same, but have no restriction on
 837 ;;; the first arg and a higher cost.  The reason for doing this is to prevent
 838 ;;; fixnum specific operations from being used on word integers, spuriously
 839 ;;; consing the argument.
 840 ;;;
 841
 842 (define-vop (fast-eql/fixnum fast-conditional)
 843   (:args (x :scs (any-reg descriptor-reg zero))
 844          (y :scs (any-reg zero)))
 845   (:arg-types tagged-num tagged-num)
 846   (:note "inline fixnum comparison")
 847   (:translate eql)
 848   (:generator 4
 849     (inst cmpw x y)
 850     (inst b? (if not-p :ne :eq) target)))
 851 ;;;
 852 (define-vop (generic-eql/fixnum fast-eql/fixnum)
 853   (:arg-types * tagged-num)
 854   (:variant-cost 7))
 855
 856 (define-vop (fast-eql-c/fixnum fast-conditional/fixnum)
 857   (:args (x :scs (any-reg descriptor-reg zero)))
 858   (:arg-types tagged-num (:constant (signed-byte 14)))
 859   (:info target not-p y)
 860   (:translate eql)
 861   (:generator 2
 862     (inst cmpwi x (fixnumize y))
 863     (inst b? (if not-p :ne :eq) target)))
 864 ;;;
 865 (define-vop (generic-eql-c/fixnum fast-eql-c/fixnum)
 866   (:arg-types * (:constant (signed-byte 11)))
 867   (:variant-cost 6))
 868
 869 \f
 870 ;;;; 32-bit logical operations
 871
 872 (define-vop (merge-bits)
 873   (:translate merge-bits)
 874   (:args (shift :scs (signed-reg unsigned-reg))
 875          (prev :scs (unsigned-reg))
 876          (next :scs (unsigned-reg)))
 877   (:arg-types tagged-num unsigned-num unsigned-num)
 878   (:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
 879   (:temporary (:scs (unsigned-reg) :to (:result 0) :target result) res)
 880   (:results (result :scs (unsigned-reg)))
 881   (:result-types unsigned-num)
 882   (:policy :fast-safe)
 883   (:generator 4
 884     (let ((done (gen-label)))
 885       (inst cmpwi shift 0)
 886       (inst beq done)
 887       (inst srw res next shift)
 888       (inst sub temp zero-tn shift)
 889       (inst slw temp prev temp)
 890       (inst or res res temp)
 891       (emit-label done)
 892       (move result res))))
 893
 894 (define-vop (shift-towards-someplace)
 895   (:policy :fast-safe)
 896   (:args (num :scs (unsigned-reg))
 897          (amount :scs (signed-reg)))
 898   (:arg-types unsigned-num tagged-num)
 899   (:results (r :scs (unsigned-reg)))
 900   (:result-types unsigned-num))
 901
 902 (define-vop (shift-towards-start shift-towards-someplace)
 903   (:translate shift-towards-start)
 904   (:note "shift-towards-start")
 905   (:generator 1
 906     (inst rlwinm amount amount 0 27 31)
 907     (inst slw r num amount)))
 908
 909 (define-vop (shift-towards-end shift-towards-someplace)
 910   (:translate shift-towards-end)
 911   (:note "shift-towards-end")
 912   (:generator 1
 913     (inst rlwinm amount amount 0 27 31)
 914     (inst srw r num amount)))
 915 \f
 916 ;;;; Bignum stuff.
 917
 918 (define-vop (bignum-length get-header-data)
 919   (:translate sb!bignum:%bignum-length)
 920   (:policy :fast-safe))
 921
 922 (define-vop (bignum-set-length set-header-data)
 923   (:translate sb!bignum:%bignum-set-length)
 924   (:policy :fast-safe))
 925
 926 (define-vop (bignum-ref word-index-ref)
 927   (:variant bignum-digits-offset other-pointer-lowtag)
 928   (:translate sb!bignum:%bignum-ref)
 929   (:results (value :scs (unsigned-reg)))
 930   (:result-types unsigned-num))
 931
 932 (define-vop (bignum-set word-index-set)
 933   (:variant bignum-digits-offset other-pointer-lowtag)
 934   (:translate sb!bignum:%bignum-set)
 935   (:args (object :scs (descriptor-reg))
 936          (index :scs (any-reg immediate zero))
 937          (value :scs (unsigned-reg)))
 938   (:arg-types t positive-fixnum unsigned-num)
 939   (:results (result :scs (unsigned-reg)))
 940   (:result-types unsigned-num))
 941
 942 (define-vop (digit-0-or-plus)
 943   (:translate sb!bignum:%digit-0-or-plusp)
 944   (:policy :fast-safe)
 945   (:args (digit :scs (unsigned-reg)))
 946   (:arg-types unsigned-num)
 947   (:results (result :scs (descriptor-reg)))
 948   (:generator 3
 949     (let ((done (gen-label)))
 950       (inst cmpwi digit 0)
 951       (move result null-tn)
 952       (inst blt done)
 953       (load-symbol result t)
 954       (emit-label done))))
 955
 956 (define-vop (add-w/carry)
 957   (:translate sb!bignum:%add-with-carry)
 958   (:policy :fast-safe)
 959   (:args (a :scs (unsigned-reg))
 960          (b :scs (unsigned-reg))
 961          (c :scs (any-reg)))
 962   (:arg-types unsigned-num unsigned-num positive-fixnum)
 963   (:temporary (:scs (unsigned-reg)) temp)
 964   (:results (result :scs (unsigned-reg))
 965             (carry :scs (unsigned-reg)))
 966   (:result-types unsigned-num positive-fixnum)
 967   (:generator 3
 968     (inst addic temp c -1)
 969     (inst adde result a b)
 970     (inst addze carry zero-tn)))
 971
 972 (define-vop (sub-w/borrow)
 973   (:translate sb!bignum:%subtract-with-borrow)
 974   (:policy :fast-safe)
 975   (:args (a :scs (unsigned-reg))
 976          (b :scs (unsigned-reg))
 977          (c :scs (any-reg)))
 978   (:arg-types unsigned-num unsigned-num positive-fixnum)
 979   (:temporary (:scs (unsigned-reg)) temp)
 980   (:results (result :scs (unsigned-reg))
 981             (borrow :scs (unsigned-reg)))
 982   (:result-types unsigned-num positive-fixnum)
 983   (:generator 4
 984     (inst addic temp c -1)
 985     (inst sube result a b)
 986     (inst addze borrow zero-tn)))
 987
 988 (define-vop (bignum-mult-and-add-3-arg)
 989   (:translate sb!bignum:%multiply-and-add)
 990   (:policy :fast-safe)
 991   (:args (x :scs (unsigned-reg))
 992          (y :scs (unsigned-reg))
 993          (carry-in :scs (unsigned-reg) :to (:eval 1)))
 994   (:arg-types unsigned-num unsigned-num unsigned-num)
 995   (:temporary (:scs (unsigned-reg) :to (:result 0) :target hi) hi-temp)
 996   (:temporary (:scs (unsigned-reg) :from (:eval 0) :to (:result 1)
 997                     :target lo) lo-temp)
 998   (:results (hi :scs (unsigned-reg))
 999             (lo :scs (unsigned-reg)))
1000   (:result-types unsigned-num unsigned-num)
1001   (:generator 40
1002     (inst mulhwu hi-temp x y)
1003     (inst mullw lo-temp x y)
1004     (inst addc lo lo-temp carry-in)
1005     (inst addze hi hi-temp)))
1006
1007 (define-vop (bignum-mult-and-add-4-arg)
1008   (:translate sb!bignum:%multiply-and-add)
1009   (:policy :fast-safe)
1010   (:args (x :scs (unsigned-reg))
1011          (y :scs (unsigned-reg))
1012          (prev :scs (unsigned-reg) :to (:eval 1))
1013          (carry-in :scs (unsigned-reg) :to (:eval 1)))
1014   (:arg-types unsigned-num unsigned-num unsigned-num unsigned-num)
1015   (:temporary (:scs (unsigned-reg) :to (:result 0) :target hi) hi-temp)
1016   (:temporary (:scs (unsigned-reg) :from (:eval 0) :to (:result 1)
1017                     :target lo) lo-temp)
1018   (:results (hi :scs (unsigned-reg))
1019             (lo :scs (unsigned-reg)))
1020   (:result-types unsigned-num unsigned-num)
1021   (:generator 40
1022     (inst mulhwu hi-temp x y)
1023     (inst mullw lo-temp x y)
1024     (inst addc lo-temp lo-temp carry-in)
1025     (inst addze hi-temp hi-temp)
1026     (inst addc lo lo-temp prev)
1027     (inst addze hi hi-temp)))
1028
1029 (define-vop (bignum-mult)
1030   (:translate sb!bignum:%multiply)
1031   (:policy :fast-safe)
1032   (:args (x :scs (unsigned-reg) :to (:eval 1))
1033          (y :scs (unsigned-reg) :to (:eval 1)))
1034   (:arg-types unsigned-num unsigned-num)
1035   (:results (hi :scs (unsigned-reg) :from (:eval 1))
1036             (lo :scs (unsigned-reg) :from (:eval 0)))
1037   (:result-types unsigned-num unsigned-num)
1038   (:generator 40
1039     (inst mullw lo x y)
1040     (inst mulhwu hi x y)))
1041
1042 (define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned)
1043   (:translate sb!bignum:%lognot))
1044
1045 (define-vop (fixnum-to-digit)
1046   (:translate sb!bignum:%fixnum-to-digit)
1047   (:policy :fast-safe)
1048   (:args (fixnum :scs (any-reg)))
1049   (:arg-types tagged-num)
1050   (:results (digit :scs (unsigned-reg)))
1051   (:result-types unsigned-num)
1052   (:generator 1
1053     (inst srawi digit fixnum 2)))
1054
1055
1056 (define-vop (bignum-floor)
1057   (:translate sb!bignum:%floor)
1058   (:policy :fast-safe)
1059   (:args (num-high :scs (unsigned-reg) :target rem)
1060          (num-low :scs (unsigned-reg) :target rem-low)
1061          (denom :scs (unsigned-reg) :to (:eval 1)))
1062   (:arg-types unsigned-num unsigned-num unsigned-num)
1063   (:temporary (:scs (unsigned-reg) :from (:argument 1)) rem-low)
1064   (:temporary (:scs (unsigned-reg) :from (:eval 0)) temp)
1065   (:results (quo :scs (unsigned-reg) :from (:eval 0))
1066             (rem :scs (unsigned-reg) :from (:argument 0)))
1067   (:result-types unsigned-num unsigned-num)
1068   (:generator 325 ; number of inst assuming targeting works.
1069     (move rem num-high)
1070     (move rem-low num-low)
1071     (flet ((maybe-subtract (&optional (guess temp))
1072              (inst subi temp guess 1)
1073              (inst and temp temp denom)
1074              (inst sub rem rem temp))
1075            (sltu (res x y)
1076              (inst subfc res y x)
1077              (inst subfe res res res)
1078              (inst neg res res)))
1079       (sltu quo rem denom)
1080       (maybe-subtract quo)
1081       (dotimes (i 32)
1082         (inst slwi rem rem 1)
1083         (inst srwi temp rem-low 31)
1084         (inst or rem rem temp)
1085         (inst slwi rem-low rem-low 1)
1086         (sltu temp rem denom)
1087         (inst slwi quo quo 1)
1088         (inst or quo quo temp)
1089         (maybe-subtract)))
1090     (inst not quo quo)))
1091
1092 #|
1093
1094 (define-vop (bignum-floor)
1095   (:translate sb!bignum:%floor)
1096   (:policy :fast-safe)
1097   (:args (div-high :scs (unsigned-reg) :target rem)
1098          (div-low :scs (unsigned-reg) :target quo)
1099          (divisor :scs (unsigned-reg)))
1100   (:arg-types unsigned-num unsigned-num unsigned-num)
1101   (:results (quo :scs (unsigned-reg) :from (:argument 1))
1102             (rem :scs (unsigned-reg) :from (:argument 0)))
1103   (:result-types unsigned-num unsigned-num)
1104   (:generator 300
1105     (inst mtmq div-low)
1106     (inst div quo div-high divisor)
1107     (inst mfmq rem)))
1108 |#
1109
1110 (define-vop (signify-digit)
1111   (:translate sb!bignum:%fixnum-digit-with-correct-sign)
1112   (:policy :fast-safe)
1113   (:args (digit :scs (unsigned-reg) :target res))
1114   (:arg-types unsigned-num)
1115   (:results (res :scs (any-reg signed-reg)))
1116   (:result-types signed-num)
1117   (:generator 1
1118     (sc-case res
1119       (any-reg
1120        (inst slwi res digit 2))
1121       (signed-reg
1122        (move res digit)))))
1123
1124
1125 (define-vop (digit-ashr)
1126   (:translate sb!bignum:%ashr)
1127   (:policy :fast-safe)
1128   (:args (digit :scs (unsigned-reg))
1129          (count :scs (unsigned-reg)))
1130   (:arg-types unsigned-num positive-fixnum)
1131   (:results (result :scs (unsigned-reg)))
1132   (:result-types unsigned-num)
1133   (:generator 1
1134     (inst sraw result digit count)))
1135
1136 (define-vop (digit-lshr digit-ashr)
1137   (:translate sb!bignum:%digit-logical-shift-right)
1138   (:generator 1
1139     (inst srw result digit count)))
1140
1141 (define-vop (digit-ashl digit-ashr)
1142   (:translate sb!bignum:%ashl)
1143   (:generator 1
1144     (inst slw result digit count)))
1145
1146 \f
1147 ;;;; Static funs.
1148
1149 (define-static-fun two-arg-gcd (x y) :translate gcd)
1150 (define-static-fun two-arg-lcm (x y) :translate lcm)
1151
1152 (define-static-fun two-arg-+ (x y) :translate +)
1153 (define-static-fun two-arg-- (x y) :translate -)
1154 (define-static-fun two-arg-* (x y) :translate *)
1155 (define-static-fun two-arg-/ (x y) :translate /)
1156
1157 (define-static-fun two-arg-< (x y) :translate <)
1158 (define-static-fun two-arg-<= (x y) :translate <=)
1159 (define-static-fun two-arg-> (x y) :translate >)
1160 (define-static-fun two-arg->= (x y) :translate >=)
1161 (define-static-fun two-arg-= (x y) :translate =)
1162 (define-static-fun two-arg-/= (x y) :translate /=)
1163
1164 (define-static-fun %negate (x) :translate %negate)
1165
1166 (define-static-fun two-arg-and (x y) :translate logand)
1167 (define-static-fun two-arg-ior (x y) :translate logior)
1168 (define-static-fun two-arg-xor (x y) :translate logxor)
1169 (define-static-fun two-arg-eqv (x y) :translate logeqv)
1170 \f
1171 (in-package "SB!C")
1172
1173 (deftransform * ((x y)
1174                  ((unsigned-byte 32) (constant-arg (unsigned-byte 32)))
1175                  (unsigned-byte 32))
1176   "recode as shifts and adds"
1177   (let ((y (lvar-value y)))
1178     (multiple-value-bind (result adds shifts)
1179         (ub32-strength-reduce-constant-multiply 'x y)
1180       (cond
1181        ((typep y '(signed-byte 16))
1182         ;; a mulli instruction has a latency of 5.
1183         (when (> (+ adds shifts) 4)
1184           (give-up-ir1-transform)))
1185        (t
1186         ;; a mullw instruction also has a latency of 5, plus two
1187         ;; instructions (in general) to load the immediate into a
1188         ;; register.
1189         (when (> (+ adds shifts) 6)
1190           (give-up-ir1-transform))))
1191       (or result 0))))