src/compiler/ppc/arith.lisp

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