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