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 (deftype integer-with-a-bite-out (s bite)
 381   (cond ((eq s '*) 'integer)
 382         ((and (integerp s) (> s 1))
 383          (let ((bound (ash 1 (1- s))))
 384            `(integer ,(- bound) ,(- bound bite 1))))
 385         (t
 386          (error "Bad size specified for SIGNED-BYTE type specifier: ~S." s))))
 387
 388 (define-vop (fast-conditional/fixnum fast-conditional)
 389   (:args (x :scs (any-reg zero))
 390          (y :scs (any-reg zero)))
 391   (:arg-types tagged-num tagged-num)
 392   (:note "inline fixnum comparison"))
 393
 394 (define-vop (fast-conditional-c/fixnum fast-conditional/fixnum)
 395   (:args (x :scs (any-reg zero)))
 396   (:arg-types tagged-num (:constant (signed-byte 14)))
 397   (:info target not-p y))
 398
 399 (define-vop (fast-conditional/signed fast-conditional)
 400   (:args (x :scs (signed-reg zero))
 401          (y :scs (signed-reg zero)))
 402   (:arg-types signed-num signed-num)
 403   (:note "inline (signed-byte 32) comparison"))
 404
 405 (define-vop (fast-conditional-c/signed fast-conditional/signed)
 406   (:args (x :scs (signed-reg zero)))
 407   (:arg-types signed-num (:constant (signed-byte 16)))
 408   (:info target not-p y))
 409
 410 (define-vop (fast-conditional/unsigned fast-conditional)
 411   (:args (x :scs (unsigned-reg zero))
 412          (y :scs (unsigned-reg zero)))
 413   (:arg-types unsigned-num unsigned-num)
 414   (:note "inline (unsigned-byte 32) comparison"))
 415
 416 (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned)
 417   (:args (x :scs (unsigned-reg zero)))
 418   (:arg-types unsigned-num (:constant (unsigned-byte 16)))
 419   (:info target not-p y))
 420
 421
 422 (define-vop (fast-if-</fixnum fast-conditional/fixnum)
 423   (:translate <)
 424   (:generator 4
 425     (inst cmpw x y)
 426     (inst b? (if not-p :ge :lt) target)))
 427
 428 (define-vop (fast-if-<-c/fixnum fast-conditional-c/fixnum)
 429   (:translate <)
 430   (:generator 3
 431     (inst cmpwi x (fixnumize y))
 432     (inst b? (if not-p :ge :lt) target)))
 433
 434 (define-vop (fast-if-</signed fast-conditional/signed)
 435   (:translate <)
 436   (:generator 6
 437     (inst cmpw x y)
 438     (inst b? (if not-p :ge :lt) target)))
 439
 440 (define-vop (fast-if-<-c/signed fast-conditional-c/signed)
 441   (:translate <)
 442   (:generator 5
 443     (inst cmpwi x y)
 444     (inst b? (if not-p :ge :lt) target)))
 445
 446 (define-vop (fast-if-</unsigned fast-conditional/unsigned)
 447   (:translate <)
 448   (:generator 6
 449     (inst cmplw x y)
 450     (inst b? (if not-p :ge :lt) target)))
 451
 452 (define-vop (fast-if-<-c/unsigned fast-conditional-c/unsigned)
 453   (:translate <)
 454   (:generator 5
 455     (inst cmplwi x y)
 456     (inst b? (if not-p :ge :lt) target)))
 457
 458 (define-vop (fast-if->/fixnum fast-conditional/fixnum)
 459   (:translate >)
 460   (:generator 4
 461     (inst cmpw x y)
 462     (inst b? (if not-p :le :gt) target)))
 463
 464 (define-vop (fast-if->-c/fixnum fast-conditional-c/fixnum)
 465   (:translate >)
 466   (:generator 3
 467     (inst cmpwi x (fixnumize y))
 468     (inst b? (if not-p :le :gt) target)))
 469
 470 (define-vop (fast-if->/signed fast-conditional/signed)
 471   (:translate >)
 472   (:generator 6
 473     (inst cmpw x y)
 474     (inst b? (if not-p :le :gt) target)))
 475
 476 (define-vop (fast-if->-c/signed fast-conditional-c/signed)
 477   (:translate >)
 478   (:generator 5
 479     (inst cmpwi x y)
 480     (inst b? (if not-p :le :gt) target)))
 481
 482 (define-vop (fast-if->/unsigned fast-conditional/unsigned)
 483   (:translate >)
 484   (:generator 6
 485     (inst cmplw x y)
 486     (inst b? (if not-p :le :gt) target)))
 487
 488 (define-vop (fast-if->-c/unsigned fast-conditional-c/unsigned)
 489   (:translate >)
 490   (:generator 5
 491     (inst cmplwi x y)
 492     (inst b? (if not-p :le :gt) target)))
 493
 494 (define-vop (fast-if-eql/signed fast-conditional/signed)
 495   (:translate eql)
 496   (:generator 6
 497     (inst cmpw x y)
 498     (inst b? (if not-p :ne :eq) target)))
 499
 500 (define-vop (fast-if-eql-c/signed fast-conditional-c/signed)
 501   (:translate eql)
 502   (:generator 5
 503     (inst cmpwi x y)
 504     (inst b? (if not-p :ne :eq) target)))
 505
 506 (define-vop (fast-if-eql/unsigned fast-conditional/unsigned)
 507   (:translate eql)
 508   (:generator 6
 509     (inst cmplw x y)
 510     (inst b? (if not-p :ne :eq) target)))
 511
 512 (define-vop (fast-if-eql-c/unsigned fast-conditional-c/unsigned)
 513   (:translate eql)
 514   (:generator 5
 515     (inst cmplwi x y)
 516     (inst b? (if not-p :ne :eq) target)))
 517
 518
 519 ;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a
 520 ;;; known fixnum.
 521
 522 ;;; These versions specify a fixnum restriction on their first arg.  We have
 523 ;;; also generic-eql/fixnum VOPs which are the same, but have no restriction on
 524 ;;; the first arg and a higher cost.  The reason for doing this is to prevent
 525 ;;; fixnum specific operations from being used on word integers, spuriously
 526 ;;; consing the argument.
 527 ;;;
 528
 529 (define-vop (fast-eql/fixnum fast-conditional)
 530   (:args (x :scs (any-reg descriptor-reg zero))
 531          (y :scs (any-reg zero)))
 532   (:arg-types tagged-num tagged-num)
 533   (:note "inline fixnum comparison")
 534   (:translate eql)
 535   (:generator 4
 536     (inst cmpw x y)
 537     (inst b? (if not-p :ne :eq) target)))
 538 ;;;
 539 (define-vop (generic-eql/fixnum fast-eql/fixnum)
 540   (:arg-types * tagged-num)
 541   (:variant-cost 7))
 542
 543 (define-vop (fast-eql-c/fixnum fast-conditional/fixnum)
 544   (:args (x :scs (any-reg descriptor-reg zero)))
 545   (:arg-types tagged-num (:constant (signed-byte 14)))
 546   (:info target not-p y)
 547   (:translate eql)
 548   (:generator 2
 549     (inst cmpwi x (fixnumize y))
 550     (inst b? (if not-p :ne :eq) target)))
 551 ;;;
 552 (define-vop (generic-eql-c/fixnum fast-eql-c/fixnum)
 553   (:arg-types * (:constant (signed-byte 11)))
 554   (:variant-cost 6))
 555
 556 \f
 557 ;;;; 32-bit logical operations
 558
 559 (define-vop (merge-bits)
 560   (:translate merge-bits)
 561   (:args (shift :scs (signed-reg unsigned-reg))
 562          (prev :scs (unsigned-reg))
 563          (next :scs (unsigned-reg)))
 564   (:arg-types tagged-num unsigned-num unsigned-num)
 565   (:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
 566   (:temporary (:scs (unsigned-reg) :to (:result 0) :target result) res)
 567   (:results (result :scs (unsigned-reg)))
 568   (:result-types unsigned-num)
 569   (:policy :fast-safe)
 570   (:generator 4
 571     (let ((done (gen-label)))
 572       (inst cmpwi shift 0)
 573       (inst beq done)
 574       (inst srw res next shift)
 575       (inst sub temp zero-tn shift)
 576       (inst slw temp prev temp)
 577       (inst or res res temp)
 578       (emit-label done)
 579       (move result res))))
 580
 581
 582 (define-vop (32bit-logical)
 583   (:args (x :scs (unsigned-reg zero))
 584          (y :scs (unsigned-reg zero)))
 585   (:arg-types unsigned-num unsigned-num)
 586   (:results (r :scs (unsigned-reg)))
 587   (:result-types unsigned-num)
 588   (:policy :fast-safe))
 589
 590 (define-vop (32bit-logical-not 32bit-logical)
 591   (:translate 32bit-logical-not)
 592   (:args (x :scs (unsigned-reg zero)))
 593   (:arg-types unsigned-num)
 594   (:generator 1
 595     (inst not r x)))
 596
 597 (define-vop (32bit-logical-and 32bit-logical)
 598   (:translate 32bit-logical-and)
 599   (:generator 1
 600     (inst and r x y)))
 601
 602 (deftransform 32bit-logical-nand ((x y) (* *))
 603   '(32bit-logical-not (32bit-logical-and x y)))
 604
 605 (define-vop (32bit-logical-or 32bit-logical)
 606   (:translate 32bit-logical-or)
 607   (:generator 1
 608     (inst or r x y)))
 609
 610 (deftransform 32bit-logical-nor ((x y) (* *))
 611   '(32bit-logical-not (32bit-logical-or x y)))
 612
 613 (define-vop (32bit-logical-xor 32bit-logical)
 614   (:translate 32bit-logical-xor)
 615   (:generator 1
 616     (inst xor r x y)))
 617
 618 (define-vop (32bit-logical-eqv 32bit-logical)
 619   (:translate 32bit-logical-eqv)
 620   (:generator 1
 621     (inst eqv r x y)))
 622
 623 (define-vop (32bit-logical-orc2 32bit-logical)
 624   (:translate 32bit-logical-orc2)
 625   (:generator 1
 626     (inst orc r x y)))
 627
 628 (deftransform 32bit-logical-orc1 ((x y) (* *))
 629   '(32bit-logical-orc2 y x))
 630
 631 (define-vop (32bit-logical-andc2 32bit-logical)
 632   (:translate 32bit-logical-andc2)
 633   (:generator 1
 634     (inst andc r x y)))
 635
 636 (deftransform 32bit-logical-andc1 ((x y) (* *))
 637   '(32bit-logical-andc2 y x))
 638
 639
 640 (define-vop (shift-towards-someplace)
 641   (:policy :fast-safe)
 642   (:args (num :scs (unsigned-reg))
 643          (amount :scs (signed-reg)))
 644   (:arg-types unsigned-num tagged-num)
 645   (:results (r :scs (unsigned-reg)))
 646   (:result-types unsigned-num))
 647
 648 (define-vop (shift-towards-start shift-towards-someplace)
 649   (:translate shift-towards-start)
 650   (:note "shift-towards-start")
 651   (:generator 1
 652     (inst rlwinm amount amount 0 27 31)
 653     (inst slw r num amount)))
 654
 655 (define-vop (shift-towards-end shift-towards-someplace)
 656   (:translate shift-towards-end)
 657   (:note "shift-towards-end")
 658   (:generator 1
 659     (inst rlwinm amount amount 0 27 31)
 660     (inst srw r num amount)))
 661
 662
 663
 664 \f
 665 ;;;; Bignum stuff.
 666
 667 (define-vop (bignum-length get-header-data)
 668   (:translate sb!bignum::%bignum-length)
 669   (:policy :fast-safe))
 670
 671 (define-vop (bignum-set-length set-header-data)
 672   (:translate sb!bignum::%bignum-set-length)
 673   (:policy :fast-safe))
 674
 675 (define-vop (bignum-ref word-index-ref)
 676   (:variant sb!vm:bignum-digits-offset sb!vm:other-pointer-lowtag)
 677   (:translate sb!bignum::%bignum-ref)
 678   (:results (value :scs (unsigned-reg)))
 679   (:result-types unsigned-num))
 680
 681 (define-vop (bignum-set word-index-set)
 682   (:variant sb!vm:bignum-digits-offset sb!vm:other-pointer-lowtag)
 683   (:translate sb!bignum::%bignum-set)
 684   (:args (object :scs (descriptor-reg))
 685          (index :scs (any-reg immediate zero))
 686          (value :scs (unsigned-reg)))
 687   (:arg-types t positive-fixnum unsigned-num)
 688   (:results (result :scs (unsigned-reg)))
 689   (:result-types unsigned-num))
 690
 691 (define-vop (digit-0-or-plus)
 692   (:translate sb!bignum::%digit-0-or-plusp)
 693   (:policy :fast-safe)
 694   (:args (digit :scs (unsigned-reg)))
 695   (:arg-types unsigned-num)
 696   (:results (result :scs (descriptor-reg)))
 697   (:generator 3
 698     (let ((done (gen-label)))
 699       (inst cmpwi digit 0)
 700       (move result null-tn)
 701       (inst blt done)
 702       (load-symbol result t)
 703       (emit-label done))))
 704
 705 (define-vop (add-w/carry)
 706   (:translate sb!bignum::%add-with-carry)
 707   (:policy :fast-safe)
 708   (:args (a :scs (unsigned-reg))
 709          (b :scs (unsigned-reg))
 710          (c :scs (any-reg)))
 711   (:arg-types unsigned-num unsigned-num positive-fixnum)
 712   (:temporary (:scs (unsigned-reg)) temp)
 713   (:results (result :scs (unsigned-reg))
 714             (carry :scs (unsigned-reg)))
 715   (:result-types unsigned-num positive-fixnum)
 716   (:generator 3
 717     (inst addic temp c -1)
 718     (inst adde result a b)
 719     (inst addze carry zero-tn)))
 720
 721 (define-vop (sub-w/borrow)
 722   (:translate sb!bignum::%subtract-with-borrow)
 723   (:policy :fast-safe)
 724   (:args (a :scs (unsigned-reg))
 725          (b :scs (unsigned-reg))
 726          (c :scs (any-reg)))
 727   (:arg-types unsigned-num unsigned-num positive-fixnum)
 728   (:temporary (:scs (unsigned-reg)) temp)
 729   (:results (result :scs (unsigned-reg))
 730             (borrow :scs (unsigned-reg)))
 731   (:result-types unsigned-num positive-fixnum)
 732   (:generator 4
 733     (inst addic temp c -1)
 734     (inst sube result a b)
 735     (inst addze borrow zero-tn)))
 736
 737 (define-vop (bignum-mult-and-add-3-arg)
 738   (:translate sb!bignum::%multiply-and-add)
 739   (:policy :fast-safe)
 740   (:args (x :scs (unsigned-reg))
 741          (y :scs (unsigned-reg))
 742          (carry-in :scs (unsigned-reg) :to (:eval 1)))
 743   (:arg-types unsigned-num unsigned-num unsigned-num)
 744   (:temporary (:scs (unsigned-reg) :to (:result 0) :target hi) hi-temp)
 745   (:temporary (:scs (unsigned-reg) :from (:eval 0) :to (:result 1)
 746                     :target lo) lo-temp)
 747   (:results (hi :scs (unsigned-reg))
 748             (lo :scs (unsigned-reg)))
 749   (:result-types unsigned-num unsigned-num)
 750   (:generator 40
 751     (inst mulhwu hi-temp x y)
 752     (inst mullw lo-temp x y)
 753     (inst addc lo lo-temp carry-in)
 754     (inst addze hi hi-temp)))
 755
 756 (define-vop (bignum-mult-and-add-4-arg)
 757   (:translate sb!bignum::%multiply-and-add)
 758   (:policy :fast-safe)
 759   (:args (x :scs (unsigned-reg))
 760          (y :scs (unsigned-reg))
 761          (prev :scs (unsigned-reg) :to (:eval 1))
 762          (carry-in :scs (unsigned-reg) :to (:eval 1)))
 763   (:arg-types unsigned-num unsigned-num unsigned-num unsigned-num)
 764   (:temporary (:scs (unsigned-reg) :to (:result 0) :target hi) hi-temp)
 765   (:temporary (:scs (unsigned-reg) :from (:eval 0) :to (:result 1)
 766                     :target lo) lo-temp)
 767   (:results (hi :scs (unsigned-reg))
 768             (lo :scs (unsigned-reg)))
 769   (:result-types unsigned-num unsigned-num)
 770   (:generator 40
 771     (inst mulhwu hi-temp x y)
 772     (inst mullw lo-temp x y)
 773     (inst addc lo-temp lo-temp carry-in)
 774     (inst addze hi-temp hi-temp)
 775     (inst addc lo lo-temp prev)
 776     (inst addze hi hi-temp)))
 777
 778 (define-vop (bignum-mult)
 779   (:translate sb!bignum::%multiply)
 780   (:policy :fast-safe)
 781   (:args (x :scs (unsigned-reg) :to (:result 1))
 782          (y :scs (unsigned-reg) :to (:result 1)))
 783   (:arg-types unsigned-num unsigned-num)
 784   (:results (hi :scs (unsigned-reg))
 785             (lo :scs (unsigned-reg)))
 786   (:result-types unsigned-num unsigned-num)
 787   (:generator 40
 788     (inst mullw lo x y)
 789     (inst mulhwu hi x y)))
 790
 791 (define-vop (bignum-lognot)
 792   (:translate sb!bignum::%lognot)
 793   (:policy :fast-safe)
 794   (:args (x :scs (unsigned-reg)))
 795   (:arg-types unsigned-num)
 796   (:results (r :scs (unsigned-reg)))
 797   (:result-types unsigned-num)
 798   (:generator 1
 799     (inst not r x)))
 800
 801 (define-vop (fixnum-to-digit)
 802   (:translate sb!bignum::%fixnum-to-digit)
 803   (:policy :fast-safe)
 804   (:args (fixnum :scs (any-reg)))
 805   (:arg-types tagged-num)
 806   (:results (digit :scs (unsigned-reg)))
 807   (:result-types unsigned-num)
 808   (:generator 1
 809     (inst srawi digit fixnum 2)))
 810
 811
 812 (define-vop (bignum-floor)
 813   (:translate sb!bignum::%floor)
 814   (:policy :fast-safe)
 815   (:args (num-high :scs (unsigned-reg) :target rem)
 816          (num-low :scs (unsigned-reg) :target rem-low)
 817          (denom :scs (unsigned-reg) :to (:eval 1)))
 818   (:arg-types unsigned-num unsigned-num unsigned-num)
 819   (:temporary (:scs (unsigned-reg) :from (:argument 1)) rem-low)
 820   (:temporary (:scs (unsigned-reg) :from (:eval 0)) temp)
 821   (:results (quo :scs (unsigned-reg) :from (:eval 0))
 822             (rem :scs (unsigned-reg) :from (:argument 0)))
 823   (:result-types unsigned-num unsigned-num)
 824   (:generator 325 ; number of inst assuming targeting works.
 825     (move rem num-high)
 826     (move rem-low num-low)
 827     (flet ((maybe-subtract (&optional (guess temp))
 828              (inst subi temp guess 1)
 829              (inst and temp temp denom)
 830              (inst sub rem rem temp))
 831            (sltu (res x y)
 832              (inst subfc res y x)
 833              (inst subfe res res res)
 834              (inst neg res res)))
 835       (sltu quo rem denom)
 836       (maybe-subtract quo)
 837       (dotimes (i 32)
 838         (inst slwi rem rem 1)
 839         (inst srwi temp rem-low 31)
 840         (inst or rem rem temp)
 841         (inst slwi rem-low rem-low 1)
 842         (sltu temp rem denom)
 843         (inst slwi quo quo 1)
 844         (inst or quo quo temp)
 845         (maybe-subtract)))
 846     (inst not quo quo)))
 847
 848 #|
 849
 850 (define-vop (bignum-floor)
 851   (:translate sb!bignum::%floor)
 852   (:policy :fast-safe)
 853   (:args (div-high :scs (unsigned-reg) :target rem)
 854          (div-low :scs (unsigned-reg) :target quo)
 855          (divisor :scs (unsigned-reg)))
 856   (:arg-types unsigned-num unsigned-num unsigned-num)
 857   (:results (quo :scs (unsigned-reg) :from (:argument 1))
 858             (rem :scs (unsigned-reg) :from (:argument 0)))
 859   (:result-types unsigned-num unsigned-num)
 860   (:generator 300
 861     (inst mtmq div-low)
 862     (inst div quo div-high divisor)
 863     (inst mfmq rem)))
 864 |#
 865
 866 (define-vop (signify-digit)
 867   (:translate sb!bignum::%fixnum-digit-with-correct-sign)
 868   (:policy :fast-safe)
 869   (:args (digit :scs (unsigned-reg) :target res))
 870   (:arg-types unsigned-num)
 871   (:results (res :scs (any-reg signed-reg)))
 872   (:result-types signed-num)
 873   (:generator 1
 874     (sc-case res
 875       (any-reg
 876        (inst slwi res digit 2))
 877       (signed-reg
 878        (move res digit)))))
 879
 880
 881 (define-vop (digit-ashr)
 882   (:translate sb!bignum::%ashr)
 883   (:policy :fast-safe)
 884   (:args (digit :scs (unsigned-reg))
 885          (count :scs (unsigned-reg)))
 886   (:arg-types unsigned-num positive-fixnum)
 887   (:results (result :scs (unsigned-reg)))
 888   (:result-types unsigned-num)
 889   (:generator 1
 890     (inst sraw result digit count)))
 891
 892 (define-vop (digit-lshr digit-ashr)
 893   (:translate sb!bignum::%digit-logical-shift-right)
 894   (:generator 1
 895     (inst srw result digit count)))
 896
 897 (define-vop (digit-ashl digit-ashr)
 898   (:translate sb!bignum::%ashl)
 899   (:generator 1
 900     (inst slw result digit count)))
 901
 902 \f
 903 ;;;; Static funs.
 904
 905 (define-static-fun two-arg-gcd (x y) :translate gcd)
 906 (define-static-fun two-arg-lcm (x y) :translate lcm)
 907
 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 (define-static-fun two-arg-/ (x y) :translate /)
 912
 913 (define-static-fun two-arg-< (x y) :translate <)
 914 (define-static-fun two-arg-<= (x y) :translate <=)
 915 (define-static-fun two-arg-> (x y) :translate >)
 916 (define-static-fun two-arg->= (x y) :translate >=)
 917 (define-static-fun two-arg-= (x y) :translate =)
 918 (define-static-fun two-arg-/= (x y) :translate /=)
 919
 920 (define-static-fun %negate (x) :translate %negate)
 921
 922 (define-static-fun two-arg-and (x y) :translate logand)
 923 (define-static-fun two-arg-ior (x y) :translate logior)
 924 (define-static-fun two-arg-xor (x y) :translate logxor)