src/compiler/ppc/arith.lisp

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