src/compiler/arm/arith.lisp

   1 ;;;; the VM definition arithmetic VOPs for the ARM
   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 (unsigned-unop fast-safe-arith-op)
  36   (:args (x :scs (unsigned-reg)))
  37   (:results (res :scs (unsigned-reg)))
  38   (:note "inline (unsigned-byte 32) arithmetic")
  39   (:arg-types unsigned-num)
  40   (:result-types unsigned-num))
  41
  42 (define-vop (fast-negate/fixnum fixnum-unop)
  43   (:translate %negate)
  44   (:generator 1
  45     (inst rsb res x 0)))
  46
  47 (define-vop (fast-negate/signed signed-unop)
  48   (:translate %negate)
  49   (:generator 2
  50     (inst rsb res x 0)))
  51
  52 (define-vop (fast-negate/unsigned signed-unop)
  53   (:args (x :scs (unsigned-reg) :target res))
  54   (:arg-types unsigned-num)
  55   (:translate %negate)
  56   (:generator 3
  57     (inst rsb res x 0)))
  58
  59 (define-vop (fast-lognot/fixnum signed-unop)
  60   (:args (x :scs (any-reg)))
  61   (:arg-types tagged-num)
  62   (:translate lognot)
  63   (:generator 1
  64     (inst mvn res (asr x n-fixnum-tag-bits))))
  65
  66 (define-vop (fast-lognot/signed signed-unop)
  67   (:translate lognot)
  68   (:generator 2
  69     (inst mvn res x)))
  70
  71 \f
  72 ;;;; Binary fixnum operations.
  73
  74 ;;; Assume that any constant operand is the second arg...
  75
  76 (define-vop (fast-fixnum-binop fast-safe-arith-op)
  77   (:args (x :target r :scs (any-reg))
  78          (y :target r :scs (any-reg)))
  79   (:arg-types tagged-num tagged-num)
  80   (:results (r :scs (any-reg)))
  81   (:result-types tagged-num)
  82   (:note "inline fixnum arithmetic"))
  83
  84 (define-vop (fast-unsigned-binop fast-safe-arith-op)
  85   (:args (x :target r :scs (unsigned-reg))
  86          (y :target r :scs (unsigned-reg)))
  87   (:arg-types unsigned-num unsigned-num)
  88   (:results (r :scs (unsigned-reg)))
  89   (:result-types unsigned-num)
  90   (:note "inline (unsigned-byte 32) arithmetic"))
  91
  92 (define-vop (fast-signed-binop fast-safe-arith-op)
  93   (:args (x :target r :scs (signed-reg))
  94          (y :target r :scs (signed-reg)))
  95   (:arg-types signed-num signed-num)
  96   (:results (r :scs (signed-reg)))
  97   (:result-types signed-num)
  98   (:note "inline (signed-byte 32) arithmetic"))
  99
 100 (define-vop (fast-fixnum-binop-c fast-safe-arith-op)
 101   (:args (x :target r :scs (any-reg)))
 102   (:info y)
 103   (:arg-types tagged-num
 104               (:constant (signed-byte #.n-fixnum-bits)))
 105   (:results (r :scs (any-reg)))
 106   (:result-types tagged-num)
 107   (:note "inline fixnum arithmetic"))
 108
 109 (define-vop (fast-unsigned-binop-c fast-safe-arith-op)
 110   (:args (x :target r :scs (unsigned-reg)))
 111   (:info y)
 112   (:arg-types unsigned-num
 113               (:constant (unsigned-byte 32)))
 114   (:results (r :scs (unsigned-reg)))
 115   (:result-types unsigned-num)
 116   (:note "inline (unsigned-byte 32) arithmetic"))
 117
 118 (define-vop (fast-signed-binop-c fast-safe-arith-op)
 119   (:args (x :target r :scs (signed-reg)))
 120   (:info y)
 121   (:arg-types signed-num
 122               (:constant (signed-byte 32)))
 123   (:results (r :scs (signed-reg)))
 124   (:result-types signed-num)
 125   (:note "inline (signed-byte 32) arithmetic"))
 126
 127 (defmacro define-binop (translate untagged-penalty op
 128                         &key cop arg-swap neg-op invert-y invert-r try-single-op)
 129   (let ((cop (or cop op)))
 130     `(progn
 131        (define-vop (,(symbolicate 'fast- translate '/fixnum=>fixnum)
 132                      fast-fixnum-binop)
 133          (:translate ,translate)
 134          (:generator 2
 135                      ,(if arg-swap
 136                           `(inst ,op r y x)
 137                           `(inst ,op r x y))))
 138        (define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum)
 139                      fast-fixnum-binop-c)
 140          (:translate ,translate)
 141          (:generator 1
 142           (composite-immediate-instruction ,cop r x y :fixnumize t :neg-op ,neg-op :invert-y ,invert-y :invert-r ,invert-r :single-op-op ,(when try-single-op op))))
 143        (define-vop (,(symbolicate 'fast- translate '/signed=>signed)
 144                      fast-signed-binop)
 145          (:translate ,translate)
 146          (:generator ,(1+ untagged-penalty)
 147                      ,(if arg-swap
 148                           `(inst ,op r y x)
 149                           `(inst ,op r x y))))
 150        (define-vop (,(symbolicate 'fast- translate '-c/signed=>signed)
 151                      fast-signed-binop-c)
 152          (:translate ,translate)
 153          (:generator ,untagged-penalty
 154           (composite-immediate-instruction ,cop r x y :neg-op ,neg-op :invert-y ,invert-y :invert-r ,invert-r :single-op-op ,(when try-single-op op))))
 155        (define-vop (,(symbolicate 'fast- translate '/unsigned=>unsigned)
 156                      fast-unsigned-binop)
 157          (:translate ,translate)
 158          (:generator ,(1+ untagged-penalty)
 159                      ,(if arg-swap
 160                           `(inst ,op r y x)
 161                           `(inst ,op r x y))))
 162        (define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned)
 163                      fast-unsigned-binop-c)
 164          (:translate ,translate)
 165          (:generator ,untagged-penalty
 166           (composite-immediate-instruction ,cop r x y :neg-op ,neg-op :invert-y ,invert-y :invert-r ,invert-r :single-op-op ,(when try-single-op op)))))))
 167
 168 (define-binop + 4 add :neg-op sub)
 169 (define-binop - 4 sub :neg-op add)
 170 (define-binop logand 2 and :cop bic :invert-y t :try-single-op t)
 171 (define-binop logandc1 2 bic :cop orr :arg-swap t :invert-y t :invert-r t)
 172 (define-binop logandc2 2 bic)
 173 (define-binop logior 2 orr)
 174 (define-binop logxor 2 eor)
 175
 176 (define-vop (fast-logior-unsigned-signed=>signed fast-safe-arith-op)
 177   (:args (x :scs (unsigned-reg))
 178          (y :target r :scs (signed-reg)))
 179   (:arg-types unsigned-num signed-num)
 180   (:results (r :scs (signed-reg) :from (:argument 1)))
 181   (:result-types signed-num)
 182   (:note "inline (unsigned-byte 32) arithmetic")
 183   (:translate logior)
 184   (:generator 3
 185     (inst orr r x y)))
 186
 187 (define-vop (fast-logior-signed-unsigned=>signed fast-safe-arith-op)
 188   (:args (x :target r :scs (signed-reg))
 189          (y :scs (unsigned-reg)))
 190   (:arg-types signed-num unsigned-num)
 191   (:results (r :scs (signed-reg) :from (:argument 0)))
 192   (:result-types signed-num)
 193   (:note "inline (unsigned-byte 32) arithmetic")
 194   (:translate logior)
 195   (:generator 3
 196     (inst orr r x y)))
 197
 198 ;;; Multiplication
 199
 200 (define-vop (fast-*/fixnum=>fixnum fast-fixnum-binop)
 201   (:args (x :scs (signed-reg)) ;; one operand needs to be untagged
 202          (y :target r :scs (any-reg)))
 203   (:translate *)
 204   (:generator 2
 205     (inst mul r x y)))
 206
 207 (define-vop (fast-*-c/fixnum=>fixnum fast-fixnum-binop-c)
 208   (:args (x :scs (any-reg) :to :result))
 209   (:results (r :scs (any-reg) :from :eval))
 210   (:temporary (:sc non-descriptor-reg :target r) temp)
 211   (:translate *)
 212   (:generator 1
 213     (load-immediate-word temp y)
 214     (inst mul r temp x)))
 215
 216 (define-vop (fast-*/signed=>signed fast-signed-binop)
 217   (:translate *)
 218   (:generator 3
 219     (inst mul r x y)))
 220
 221 (define-vop (fast-*/unsigned=>unsigned fast-unsigned-binop)
 222   (:translate *)
 223   (:generator 3
 224     (inst mul r x y)))
 225
 226 ;;;
 227 (define-vop (fast-lognor/fixnum=>fixnum fast-fixnum-binop)
 228   (:translate lognor)
 229   (:args (x :target r :scs (any-reg))
 230          (y :target r :scs (any-reg)))
 231   (:temporary (:sc non-descriptor-reg) temp)
 232   (:generator 3
 233     (inst orr temp x y)
 234     (inst mvn temp temp)
 235     (inst eor r temp fixnum-tag-mask)))
 236
 237 (define-vop (fast-logand/signed-unsigned=>unsigned fast-logand/unsigned=>unsigned)
 238   (:args (x :scs (signed-reg) :target r)
 239          (y :scs (unsigned-reg) :target r))
 240   (:arg-types signed-num unsigned-num)
 241   (:translate logand))
 242
 243 (define-source-transform logeqv (&rest args)
 244   (if (oddp (length args))
 245       `(logxor ,@args)
 246       `(lognot (logxor ,@args))))
 247 (define-source-transform logorc1 (x y)
 248   `(logior (lognot ,x) ,y))
 249 (define-source-transform logorc2 (x y)
 250   `(logior ,x (lognot ,y)))
 251 \f
 252 ;;; Shifting
 253
 254 (define-vop (fast-ash-left-c/fixnum=>fixnum)
 255   (:translate ash)
 256   (:policy :fast-safe)
 257   (:args (number :scs (any-reg) :target result))
 258   (:info amount)
 259   (:arg-types tagged-num (:constant unsigned-byte))
 260   (:results (result :scs (any-reg)))
 261   (:result-types tagged-num)
 262   (:note "inline ASH")
 263   (:generator 1
 264     (if (< amount 32)
 265         (inst mov result (lsl number amount))
 266         (inst mov result 0))))
 267
 268 (define-vop (fast-ash-right-c/fixnum=>fixnum)
 269   (:translate ash)
 270   (:policy :fast-safe)
 271   (:args (number :scs (any-reg) :target result))
 272   (:info amount)
 273   (:arg-types tagged-num (:constant (integer * -1)))
 274   (:results (result :scs (any-reg)))
 275   (:result-types tagged-num)
 276   (:temporary (:sc unsigned-reg :target result) temp)
 277   (:note "inline ASH")
 278   (:generator 1
 279     (inst mov temp (asr number (min (- amount) 31)))
 280     (inst bic result temp fixnum-tag-mask)))
 281
 282 (define-vop (fast-ash-left-modfx-c/fixnum=>fixnum
 283              fast-ash-left-c/fixnum=>fixnum)
 284   (:translate ash-left-modfx))
 285
 286 (define-vop (fast-ash-left-mod32-c/fixnum=>fixnum
 287              fast-ash-left-c/fixnum=>fixnum)
 288   (:translate ash-left-mod32))
 289
 290 (define-vop (fast-ash-c/unsigned=>unsigned)
 291   (:translate ash)
 292   (:policy :fast-safe)
 293   (:args (number :scs (unsigned-reg) :target result))
 294   (:info amount)
 295   (:arg-types unsigned-num (:constant integer))
 296   (:results (result :scs (unsigned-reg)))
 297   (:result-types unsigned-num)
 298   (:note "inline ASH")
 299   (:generator 3
 300     (cond ((< -32 amount 32)
 301            (if (plusp amount)
 302                (inst mov result (lsl number amount))
 303                (inst mov result (lsr number (- amount)))))
 304           (t
 305            (inst mov result 0)))))
 306
 307 (define-vop (fast-ash-c/signed=>signed)
 308   (:translate ash)
 309   (:policy :fast-safe)
 310   (:args (number :scs (signed-reg) :target result))
 311   (:info amount)
 312   (:arg-types signed-num (:constant integer))
 313   (:results (result :scs (signed-reg)))
 314   (:result-types signed-num)
 315   (:note "inline ASH")
 316   (:generator 3
 317     (cond ((< -32 amount 32)
 318            (if (plusp amount)
 319                (inst mov result (lsl number amount))
 320                (inst mov result (asr number (- amount)))))
 321           (t
 322            (inst mov result 0)))))
 323
 324 (define-vop (fast-ash-left-mod32-c/unsigned=>unsigned
 325              fast-ash-c/unsigned=>unsigned)
 326   (:translate ash-left-mod32))
 327
 328 (define-vop (fast-ash-left-mod32-c/signed=>signed
 329              fast-ash-c/signed=>signed)
 330   (:translate ash-left-mod32))
 331
 332 (define-vop (fast-ash/signed/unsigned)
 333   (:note "inline ASH")
 334   (:args (number)
 335          (amount))
 336   (:results (result))
 337   (:policy :fast-safe)
 338   (:temporary (:sc non-descriptor-reg) temp)
 339   (:variant-vars variant)
 340   (:generator 5
 341     (move temp amount)
 342     (inst cmp temp 0)
 343     (inst b :ge LEFT)
 344     (inst rsb temp temp 0) ;; negate
 345     (inst cmp temp n-word-bits)
 346     (inst mov :gt temp n-word-bits)
 347     (inst mov result (ecase variant
 348                        (:signed (asr number temp))
 349                        (:unsigned (lsr number temp))))
 350     (inst b END)
 351     LEFT
 352     (inst cmp temp n-word-bits)
 353     (inst mov :gt temp n-word-bits)
 354     (inst mov result (lsl number temp))
 355     END))
 356
 357 (define-vop (fast-ash/signed=>signed fast-ash/signed/unsigned)
 358   (:args (number :scs (signed-reg) :to :save)
 359          (amount :scs (signed-reg) :to :save :target temp))
 360   (:arg-types signed-num signed-num)
 361   (:results (result :scs (signed-reg)))
 362   (:result-types signed-num)
 363   (:translate ash)
 364   (:variant :signed))
 365
 366 (define-vop (fast-ash/unsigned=>unsigned fast-ash/signed/unsigned)
 367   (:args (number :scs (unsigned-reg) :to :save)
 368          (amount :scs (signed-reg) :to :save))
 369   (:arg-types unsigned-num signed-num)
 370   (:results (result :scs (unsigned-reg)))
 371   (:result-types unsigned-num)
 372   (:translate ash)
 373   (:variant :unsigned))
 374
 375 (macrolet ((def (name sc-type type result-type cost)
 376              `(define-vop (,name)
 377                 (:note "inline ASH")
 378                 (:translate ash)
 379                 (:args (number :scs (,sc-type))
 380                        (amount :scs (signed-reg unsigned-reg)
 381                                :target temp))
 382                 (:temporary (:sc non-descriptor-reg) temp)
 383                 (:arg-types ,type positive-fixnum)
 384                 (:results (result :scs (,result-type)))
 385                 (:result-types ,type)
 386                 (:policy :fast-safe)
 387                 (:generator ,cost
 388                   (move temp amount)
 389                   (inst cmp temp n-word-bits)
 390                   (inst mov :gt temp n-word-bits)
 391                   (inst mov result (lsl number temp))))))
 392   ;; FIXME: There's the opportunity for a sneaky optimization here, I
 393   ;; think: a FAST-ASH-LEFT-C/FIXNUM=>SIGNED vop.  -- CSR, 2003-09-03
 394   (def fast-ash-left/fixnum=>fixnum any-reg tagged-num any-reg 2)
 395   (def fast-ash-left/signed=>signed signed-reg signed-num signed-reg 3)
 396   (def fast-ash-left/unsigned=>unsigned unsigned-reg unsigned-num unsigned-reg 3))
 397
 398 (define-vop (fast-ash-left-mod32/unsigned=>unsigned
 399              fast-ash-left/unsigned=>unsigned)
 400   (:translate ash-left-mod32))
 401
 402 #!+ash-right-vops
 403 (define-vop (fast-%ash/right/unsigned)
 404   (:translate %ash/right)
 405   (:policy :fast-safe)
 406   (:args (number :scs (unsigned-reg) :target result)
 407          (amount :scs (unsigned-reg)))
 408   (:arg-types unsigned-num unsigned-num)
 409   (:results (result :scs (unsigned-reg) :from (:argument 0)))
 410   (:result-types unsigned-num)
 411   (:generator 4
 412     (inst mov result (lsr number amount))))
 413
 414 #!+ash-right-vops
 415 (define-vop (fast-%ash/right/signed)
 416   (:translate %ash/right)
 417   (:policy :fast-safe)
 418   (:args (number :scs (signed-reg) :target result)
 419          (amount :scs (unsigned-reg)))
 420   (:arg-types signed-num unsigned-num)
 421   (:results (result :scs (signed-reg) :from (:argument 0)))
 422   (:result-types signed-num)
 423   (:generator 4
 424     (inst mov result (asr number amount))))
 425
 426 #!+ash-right-vops
 427 (define-vop (fast-%ash/right/fixnum)
 428   (:translate %ash/right)
 429   (:policy :fast-safe)
 430   (:args (number :scs (any-reg) :target result)
 431          (amount :scs (unsigned-reg) :target temp))
 432   (:arg-types tagged-num unsigned-num)
 433   (:results (result :scs (any-reg) :from (:argument 0)))
 434   (:result-types tagged-num)
 435   (:temporary (:sc unsigned-reg :target result) temp)
 436   (:generator 3
 437     (inst mov temp (asr number amount))
 438     (inst bic result temp fixnum-tag-mask)))
 439
 440 ;;; Only the lower 5 bits of the shift amount are significant.
 441 (define-vop (shift-towards-someplace)
 442   (:policy :fast-safe)
 443   (:args (num :scs (unsigned-reg))
 444          (amount :scs (signed-reg)))
 445   (:arg-types unsigned-num tagged-num)
 446   (:temporary (:sc signed-reg) temp)
 447   (:results (r :scs (unsigned-reg)))
 448   (:result-types unsigned-num))
 449
 450 (define-vop (shift-towards-start shift-towards-someplace)
 451   (:translate shift-towards-start)
 452   (:note "SHIFT-TOWARDS-START")
 453   (:generator 1
 454     (inst and temp amount #b11111)
 455     (inst mov r (lsr num temp))))
 456
 457 (define-vop (shift-towards-end shift-towards-someplace)
 458   (:translate shift-towards-end)
 459   (:note "SHIFT-TOWARDS-END")
 460   (:generator 1
 461     (inst and temp amount #b11111)
 462     (inst mov r (lsl num temp))))
 463
 464 (define-vop (signed-byte-32-len)
 465   (:translate integer-length)
 466   (:note "inline (signed-byte 32) integer-length")
 467   (:policy :fast-safe)
 468   (:args (arg :scs (signed-reg) :target temp))
 469   (:arg-types signed-num)
 470   (:results (res :scs (any-reg)))
 471   (:result-types positive-fixnum)
 472   (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) temp)
 473   (:generator 30
 474     (move temp arg)
 475     (inst cmp temp 0)
 476     (inst mvn :lt temp temp)
 477     (inst clz temp temp)
 478     (inst rsb temp temp 32)
 479     (inst mov res (lsl temp n-fixnum-tag-bits))))
 480
 481 (define-vop (unsigned-byte-32-count)
 482   (:translate logcount)
 483   (:note "inline (unsigned-byte 32) logcount")
 484   (:policy :fast-safe)
 485   (:args (arg :scs (unsigned-reg) :target num))
 486   (:arg-types unsigned-num)
 487   (:results (res :scs (unsigned-reg)))
 488   (:result-types positive-fixnum)
 489   (:temporary (:scs (non-descriptor-reg) :from (:argument 0) :to (:result 0)
 490                     :target res) num)
 491   (:temporary (:scs (non-descriptor-reg)) mask temp)
 492   (:generator 30
 493     (move num arg)
 494     (load-immediate-word mask #x55555555)
 495     (inst and temp mask (lsr num 1))
 496     (inst and num num mask)
 497     (inst add num num temp)
 498     (load-immediate-word mask #x33333333)
 499     (inst and temp mask (lsr num 2))
 500     (inst and num num mask)
 501     (inst add num num temp)
 502     (load-immediate-word mask #x0f0f0f0f)
 503     (inst and temp mask (lsr num 4))
 504     (inst and num num mask)
 505     (inst add num num temp)
 506     (inst add num num (lsr num 8))
 507     (inst add num num (lsr num 16))
 508     (inst and res num #xff)))
 509
 510 ;;; Modular functions
 511 (define-modular-fun lognot-mod32 (x) lognot :untagged nil 32)
 512 (define-vop (lognot-mod32/unsigned=>unsigned)
 513   (:translate lognot-mod32)
 514   (:args (x :scs (unsigned-reg)))
 515   (:arg-types unsigned-num)
 516   (:results (res :scs (unsigned-reg)))
 517   (:result-types unsigned-num)
 518   (:policy :fast-safe)
 519   (:generator 1
 520     (inst mvn res x)))
 521
 522 (macrolet
 523     ((define-modular-backend (fun &optional constantp)
 524        (let ((mfun-name (symbolicate fun '-mod32))
 525              (modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned))
 526              (modcvop (symbolicate 'fast- fun 'mod32-c/unsigned=>unsigned))
 527              (vop (symbolicate 'fast- fun '/unsigned=>unsigned))
 528              (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned)))
 529          `(progn
 530             (define-modular-fun ,mfun-name (x y) ,fun :untagged nil 32)
 531             (define-vop (,modvop ,vop)
 532               (:translate ,mfun-name))
 533             ,@(when constantp
 534                 `((define-vop (,modcvop ,cvop)
 535                     (:translate ,mfun-name))))))))
 536   (define-modular-backend + t)
 537   (define-modular-backend - t)
 538   (define-modular-backend *)
 539   ;; (define-modular-backend logeqv)
 540   ;; (define-modular-backend lognand)
 541   ;; (define-modular-backend lognor)
 542   (define-modular-backend logandc1)
 543   (define-modular-backend logandc2)
 544   ;; (define-modular-backend logorc1)
 545   ;; (define-modular-backend logorc2)
 546   )
 547
 548 ;;;; Binary conditional VOPs:
 549
 550 (define-vop (fast-conditional)
 551   (:conditional :eq)
 552   (:effects)
 553   (:affected)
 554   (:policy :fast-safe))
 555
 556 (define-vop (fast-conditional/fixnum fast-conditional)
 557   (:args (x :scs (any-reg))
 558          (y :scs (any-reg)))
 559   (:arg-types tagged-num tagged-num)
 560   (:note "inline fixnum comparison"))
 561
 562 (define-vop (fast-conditional-c/fixnum fast-conditional/fixnum)
 563   (:args (x :scs (any-reg)))
 564   (:arg-types tagged-num (:constant (unsigned-byte 8)))
 565   (:info y))
 566
 567 (define-vop (fast-conditional/signed fast-conditional)
 568   (:args (x :scs (signed-reg))
 569          (y :scs (signed-reg)))
 570   (:arg-types signed-num signed-num)
 571   (:note "inline (signed-byte 32) comparison"))
 572
 573 (define-vop (fast-conditional-c/signed fast-conditional/signed)
 574   (:args (x :scs (signed-reg)))
 575   (:arg-types signed-num (:constant (unsigned-byte 8)))
 576   (:info y))
 577
 578 (define-vop (fast-conditional/unsigned fast-conditional)
 579   (:args (x :scs (unsigned-reg))
 580          (y :scs (unsigned-reg)))
 581   (:arg-types unsigned-num unsigned-num)
 582   (:note "inline (unsigned-byte 32) comparison"))
 583
 584 (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned)
 585   (:args (x :scs (unsigned-reg)))
 586   (:arg-types unsigned-num (:constant (unsigned-byte 8)))
 587   (:info y))
 588
 589 (defmacro define-conditional-vop (tran cond unsigned)
 590   `(progn
 591      ,@(mapcar (lambda (suffix cost signed)
 592                  (unless (and (member suffix '(/fixnum -c/fixnum))
 593                               (eq tran 'eql))
 594                    `(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)"
 595                                                   tran suffix))
 596                                  ,(intern
 597                                    (format nil "~:@(FAST-CONDITIONAL~A~)"
 598                                            suffix)))
 599                      (:translate ,tran)
 600                      (:conditional ,(if signed cond unsigned))
 601                      (:generator ,cost
 602                       (inst cmp x
 603                        ,(if (eq suffix '-c/fixnum) '(fixnumize y) 'y))))))
 604                '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned)
 605                '(4 3 6 5 6 5)
 606                '(t t t t nil nil))))
 607
 608 (define-conditional-vop < :lt :lo)
 609 (define-conditional-vop > :gt :hi)
 610 (define-conditional-vop eql :eq :eq)
 611
 612 ;;; EQL/FIXNUM is funny because the first arg can be of any type, not
 613 ;;; just a known fixnum.
 614
 615 ;;; These versions specify a fixnum restriction on their first arg.
 616 ;;; We have also generic-eql/fixnum VOPs which are the same, but have
 617 ;;; no restriction on the first arg and a higher cost.  The reason for
 618 ;;; doing this is to prevent fixnum specific operations from being
 619 ;;; used on word integers, spuriously consing the argument.
 620
 621 (define-vop (fast-eql/fixnum)
 622   (:args (x :scs (any-reg))
 623          (y :scs (any-reg)))
 624   (:arg-types tagged-num tagged-num)
 625   (:note "inline fixnum comparison")
 626   (:translate eql)
 627   (:conditional :eq)
 628   (:policy :fast-safe)
 629   (:generator 4
 630     (inst cmp x y)))
 631
 632 (define-vop (generic-eql/fixnum fast-eql/fixnum)
 633   (:args (x :scs (any-reg descriptor-reg))
 634          (y :scs (any-reg)))
 635   (:arg-types * tagged-num)
 636   (:variant-cost 7))
 637
 638 (define-vop (fast-eql-c/fixnum)
 639   (:args (x :scs (any-reg)))
 640   (:arg-types tagged-num (:constant (signed-byte 9)))
 641   (:info y)
 642   (:translate eql)
 643   (:policy :fast-safe)
 644   (:conditional :eq)
 645   (:generator 3
 646     (if (minusp y)
 647         (inst cmn x (fixnumize (abs y)))
 648         (inst cmp x (fixnumize y)))))
 649
 650 (define-vop (generic-eql-c/fixnum fast-eql-c/fixnum)
 651   (:args (x :scs (any-reg descriptor-reg)))
 652   (:arg-types * (:constant (signed-byte 9)))
 653   (:variant-cost 6))
 654
 655 (macrolet ((define-logtest-vops ()
 656              `(progn
 657                 ,@(loop for suffix in '(/fixnum -c/fixnum
 658                                         /signed -c/signed
 659                                         /unsigned -c/unsigned)
 660                         for cost in '(4 3 6 5 6 5)
 661                         collect
 662                         `(define-vop (,(symbolicate "FAST-LOGTEST" suffix)
 663                                       ,(symbolicate "FAST-CONDITIONAL" suffix))
 664                            (:translate logtest)
 665                            (:conditional :ne)
 666                            (:generator ,cost
 667                                        (inst tst x
 668                                              ,(case suffix
 669                                                 (-c/fixnum
 670                                                  `(fixnumize y))
 671                                                 ((-c/signed -c/unsigned)
 672                                                  `y)
 673                                                 (t
 674                                                  'y)))))))))
 675   (define-logtest-vops))
 676
 677 (define-source-transform lognand (x y)
 678   `(lognot (logand ,x ,y)))
 679
 680 (defknown %logbitp (integer unsigned-byte) boolean
 681   (movable foldable flushable always-translatable))
 682
 683 ;;; For constant folding
 684 (defun %logbitp (integer index)
 685   (logbitp index integer))
 686
 687 (define-vop (fast-logbitp-c/fixnum fast-conditional-c/fixnum)
 688   (:translate %logbitp)
 689   (:conditional :ne)
 690   (:arg-types tagged-num (:constant (integer 0 29)))
 691   (:generator 4
 692     (inst tst x (ash 1 (+ y n-fixnum-tag-bits)))))
 693
 694 (define-vop (fast-logbitp-c/signed fast-conditional-c/signed)
 695   (:translate %logbitp)
 696   (:conditional :ne)
 697   (:arg-types signed-num (:constant (integer 0 31)))
 698   (:generator 5
 699     (inst tst x (ash 1 y))))
 700
 701 (define-vop (fast-logbitp-c/unsigned fast-conditional-c/unsigned)
 702   (:translate %logbitp)
 703   (:conditional :ne)
 704   (:arg-types unsigned-num (:constant (integer 0 31)))
 705   (:generator 5
 706     (inst tst x (ash 1 y))))
 707
 708 (define-vop (fast-signum-fixnum fixnum-unop)
 709   (:args (x :scs (any-reg) :target res))
 710   (:translate signum)
 711   (:generator 4
 712     (move res x)
 713     (inst cmp x 0)
 714     (inst mov :ne res (fixnumize 1))
 715     (inst mvn :mi res (lognot (fixnumize -1)))))
 716
 717 (define-vop (fast-signum-signed signed-unop)
 718   (:args (x :scs (signed-reg) :target res))
 719   (:translate signum)
 720   (:generator 5
 721     (move res x)
 722     (inst cmp x 0)
 723     (inst mov :ne res 1)
 724     (inst mvn :mi res 0)))
 725
 726 (define-vop (fast-signum-unsigned unsigned-unop)
 727   (:args (x :scs (unsigned-reg) :target res))
 728   (:translate signum)
 729   (:generator 5
 730     (move res x)
 731     (inst cmp x 0)
 732     (inst mov :ne res 1)))
 733
 734 ;; Specialised mask-signed-field VOPs.
 735 (define-vop (mask-signed-field-word/c)
 736   (:translate sb!c::mask-signed-field)
 737   (:policy :fast-safe)
 738   (:args (x :scs (signed-reg unsigned-reg) :target r))
 739   (:arg-types (:constant (integer 0 32)) untagged-num)
 740   (:results (r :scs (signed-reg)))
 741   (:result-types signed-num)
 742   (:info width)
 743   (:generator 3
 744     (cond ((zerop width)
 745            (inst mov r 0))
 746           ((= width 32)
 747            (move r x))
 748           (t
 749            (let ((delta (- n-word-bits width)))
 750              (inst mov r (lsl x delta))
 751              (inst mov r (asr r delta)))))))
 752
 753 (define-vop (mask-signed-field-bignum/c)
 754   (:translate sb!c::mask-signed-field)
 755   (:policy :fast-safe)
 756   (:args (x :scs (descriptor-reg) :target r))
 757   (:arg-types (:constant (integer 0 32)) bignum)
 758   (:results (r :scs (signed-reg)))
 759   (:result-types signed-num)
 760   (:info width)
 761   (:generator 4
 762     (cond ((zerop width)
 763            (inst mov r 0))
 764           (t
 765            (loadw r x bignum-digits-offset other-pointer-lowtag)
 766            (let ((delta (- n-word-bits width)))
 767              (inst mov r (lsl r delta))
 768              (inst mov r (asr r delta)))))))
 769 ;;;; Bignum stuff.
 770
 771 (define-vop (bignum-length get-header-data)
 772   (:translate sb!bignum:%bignum-length)
 773   (:policy :fast-safe))
 774
 775 (define-vop (bignum-set-length set-header-data)
 776   (:translate sb!bignum:%bignum-set-length)
 777   (:policy :fast-safe))
 778
 779 (define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag
 780   (unsigned-reg) unsigned-num sb!bignum:%bignum-ref)
 781
 782 (define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag
 783   (unsigned-reg) unsigned-num sb!bignum:%bignum-set)
 784
 785 (define-vop (digit-0-or-plus)
 786   (:translate sb!bignum:%digit-0-or-plusp)
 787   (:policy :fast-safe)
 788   (:args (digit :scs (unsigned-reg)))
 789   (:arg-types unsigned-num)
 790   (:conditional)
 791   (:info target not-p)
 792   (:generator 2
 793      (inst cmp digit 0)
 794      (inst b (if not-p :lt :ge) target)))
 795
 796 (define-vop (add-w/carry)
 797   (:translate sb!bignum:%add-with-carry)
 798   (:policy :fast-safe)
 799   (:args (a :scs (unsigned-reg))
 800          (b :scs (unsigned-reg))
 801          (c :scs (any-reg)))
 802   (:arg-types unsigned-num unsigned-num positive-fixnum)
 803   (:results (result :scs (unsigned-reg))
 804             (carry :scs (unsigned-reg) :from :eval))
 805   (:result-types unsigned-num positive-fixnum)
 806   (:generator 3
 807     (inst cmp c 1) ;; Set carry if (fixnum 0 or 1) c=0, else clear.
 808     (inst adcs result a b)
 809     (inst mov :cs carry 1)
 810     (inst mov :cc carry 0)))
 811
 812 (define-vop (sub-w/borrow)
 813   (:translate sb!bignum:%subtract-with-borrow)
 814   (:policy :fast-safe)
 815   (:args (a :scs (unsigned-reg))
 816          (b :scs (unsigned-reg))
 817          (c :scs (any-reg)))
 818   (:arg-types unsigned-num unsigned-num positive-fixnum)
 819   (:results (result :scs (unsigned-reg))
 820             (borrow :scs (unsigned-reg) :from :eval))
 821   (:result-types unsigned-num positive-fixnum)
 822   (:generator 4
 823     (inst cmp c 1) ;; Set carry if (fixnum 0 or 1) c=0, else clear.
 824     (inst sbcs result a b)
 825     (inst mov :cs borrow 1)
 826     (inst mov :cc borrow 0)))
 827
 828 (define-vop (bignum-mult-and-add-3-arg)
 829   (:translate sb!bignum:%multiply-and-add)
 830   (:policy :fast-safe)
 831   (:args (x :scs (unsigned-reg) :to :result)
 832          (y :scs (unsigned-reg) :to :result)
 833          (carry-in :scs (unsigned-reg) :target lo))
 834   (:arg-types unsigned-num unsigned-num unsigned-num)
 835   (:results (hi :scs (unsigned-reg) :from :eval)
 836             (lo :scs (unsigned-reg) :from (:argument 2)))
 837   (:result-types unsigned-num unsigned-num)
 838   (:generator 2
 839     (move lo carry-in)
 840     (inst mov hi 0)
 841     (inst umlal lo hi x y)))
 842
 843 (define-vop (bignum-mult-and-add-4-arg)
 844   (:translate sb!bignum:%multiply-and-add)
 845   (:policy :fast-safe)
 846   (:args (x :scs (unsigned-reg) :to :result)
 847          (y :scs (unsigned-reg) :to :result)
 848          (prev :scs (unsigned-reg) :to :eval)
 849          (carry-in :scs (unsigned-reg) :to :eval))
 850   (:arg-types unsigned-num unsigned-num unsigned-num unsigned-num)
 851   (:results (hi :scs (unsigned-reg) :from :eval)
 852             (lo :scs (unsigned-reg) :from :eval))
 853   (:result-types unsigned-num unsigned-num)
 854   (:generator 9
 855     (inst adds lo prev carry-in)
 856     (inst mov :cs hi 1)
 857     (inst mov :cc hi 0)
 858     (inst umlal lo hi x y)))
 859
 860 (define-vop (bignum-mult)
 861   (:translate sb!bignum:%multiply)
 862   (:policy :fast-safe)
 863   (:args (x :scs (unsigned-reg))
 864          (y :scs (unsigned-reg)))
 865   (:arg-types unsigned-num unsigned-num)
 866   (:results (hi :scs (unsigned-reg))
 867             (lo :scs (unsigned-reg)))
 868   (:result-types unsigned-num unsigned-num)
 869   (:generator 1
 870     (inst umull lo hi x y)))
 871
 872 #!+multiply-high-vops
 873 (define-vop (mulhi)
 874   (:translate %multiply-high)
 875   (:policy :fast-safe)
 876   (:args (x :scs (unsigned-reg) :target hi)
 877          (y :scs (unsigned-reg)))
 878   (:arg-types unsigned-num unsigned-num)
 879   (:temporary (:sc unsigned-reg) lo)
 880   (:results (hi :scs (unsigned-reg)))
 881   (:result-types unsigned-num)
 882   (:generator 20
 883     (inst umull lo hi x y)))
 884
 885 #!+multiply-high-vops
 886 (define-vop (mulhi/fx)
 887   (:translate %multiply-high)
 888   (:policy :fast-safe)
 889   (:args (x :scs (any-reg) :target hi)
 890          (y :scs (unsigned-reg)))
 891   (:arg-types positive-fixnum unsigned-num)
 892   (:temporary (:sc any-reg) lo)
 893   (:temporary (:sc any-reg) temp)
 894   (:results (hi :scs (any-reg)))
 895   (:result-types positive-fixnum)
 896   (:generator 15
 897     (inst umull lo temp x y)
 898     (inst bic hi temp fixnum-tag-mask)))
 899
 900 (define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned)
 901   (:translate sb!bignum:%lognot))
 902
 903 (define-vop (bignum-floor)
 904   (:translate sb!bignum:%bigfloor)
 905   (:policy :fast-safe)
 906   (:args (div-high :scs (unsigned-reg) :target rem)
 907          (div-low :scs (unsigned-reg) :target quo)
 908          (divisor :scs (unsigned-reg)))
 909   (:arg-types unsigned-num unsigned-num unsigned-num)
 910   (:results (quo :scs (unsigned-reg) :from (:argument 1))
 911             (rem :scs (unsigned-reg) :from (:argument 0)))
 912   (:result-types unsigned-num unsigned-num)
 913   (:generator 300
 914     (move rem div-high)
 915     (move quo div-low)
 916     (dotimes (i 33)
 917       (inst cmp rem divisor)
 918       (inst sub :hs rem rem divisor)
 919       (inst adcs quo quo quo)
 920       (unless (= i 32)
 921         (inst adc rem rem rem)))))
 922
 923 (define-vop (signify-digit)
 924   (:translate sb!bignum:%fixnum-digit-with-correct-sign)
 925   (:policy :fast-safe)
 926   (:args (digit :scs (unsigned-reg) :target res))
 927   (:arg-types unsigned-num)
 928   (:results (res :scs (any-reg signed-reg)))
 929   (:result-types signed-num)
 930   (:generator 1
 931     (if (sc-is res any-reg)
 932         (inst mov res (lsl digit n-fixnum-tag-bits))
 933         (inst mov res digit))))
 934
 935 (define-vop (digit-ashr)
 936   (:translate sb!bignum:%ashr)
 937   (:policy :fast-safe)
 938   (:args (digit :scs (unsigned-reg))
 939          (count :scs (unsigned-reg)))
 940   (:arg-types unsigned-num positive-fixnum)
 941   (:results (result :scs (unsigned-reg)))
 942   (:result-types unsigned-num)
 943   (:generator 1
 944     (inst mov result (asr digit count))))
 945
 946 (define-vop (digit-lshr digit-ashr)
 947   (:translate sb!bignum:%digit-logical-shift-right)
 948   (:generator 1
 949     (inst mov result (lsr digit count))))
 950
 951 (define-vop (digit-ashl digit-ashr)
 952   (:translate sb!bignum:%ashl)
 953   (:generator 1
 954     (inst mov result (lsl digit count))))
 955 \f
 956 ;;;; Static functions.
 957
 958 (define-static-fun two-arg-gcd (x y) :translate gcd)
 959 (define-static-fun two-arg-lcm (x y) :translate lcm)
 960
 961 (define-static-fun two-arg-+ (x y) :translate +)
 962 (define-static-fun two-arg-- (x y) :translate -)
 963 (define-static-fun two-arg-* (x y) :translate *)
 964 (define-static-fun two-arg-/ (x y) :translate /)
 965
 966 (define-static-fun two-arg-< (x y) :translate <)
 967 (define-static-fun two-arg-> (x y) :translate >)
 968 (define-static-fun two-arg-= (x y) :translate =)
 969
 970 (define-static-fun two-arg-and (x y) :translate logand)
 971 (define-static-fun two-arg-ior (x y) :translate logior)
 972 (define-static-fun two-arg-xor (x y) :translate logxor)
 973 (define-static-fun two-arg-eqv (x y) :translate logeqv)
 974
 975 (define-static-fun eql (x y) :translate eql)
 976
 977 (define-static-fun %negate (x) :translate %negate)