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