1 ;;;; the VM definition arithmetic VOPs for the PPC
3 ;;;; This software is part of the SBCL system. See the README file for
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.
14 ;;;; Unary operations.
16 (define-vop (fast-safe-arith-op)
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))
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))
35 (define-vop (fast-negate/fixnum fixnum-unop)
40 (define-vop (fast-negate/signed signed-unop)
45 (define-vop (fast-lognot/fixnum fixnum-unop)
48 (inst xori res x (fixnumize -1))))
50 (define-vop (fast-lognot/signed signed-unop)
55 ;;;; Binary fixnum operations.
57 ;;; Assume that any constant operand is the second arg...
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"))
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"))
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"))
83 (define-vop (fast-fixnum-binop-c fast-safe-arith-op)
84 (:args (x :target r :scs (any-reg zero)))
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"))
92 (define-vop (fast-fixnum-logop-c fast-safe-arith-op)
93 (:args (x :target r :scs (any-reg zero)))
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"))
101 (define-vop (fast-unsigned-binop-c fast-safe-arith-op)
102 (:args (x :target r :scs (unsigned-reg zero)))
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"))
110 (define-vop (fast-unsigned-logop-c fast-safe-arith-op)
111 (:args (x :target r :scs (unsigned-reg zero)))
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"))
119 (define-vop (fast-signed-binop-c fast-safe-arith-op)
120 (:args (x :target r :scs (signed-reg zero)))
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"))
128 (define-vop (fast-signed-logop-c fast-safe-arith-op)
129 (:args (x :target r :scs (signed-reg zero)))
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"))
138 (eval-when (:compile-toplevel :load-toplevel :execute)
140 (defmacro define-var-binop (translate untagged-penalty op
141 &optional arg-swap restore-fixnum-mask)
143 (define-vop (,(symbolicate "FAST-" translate "/FIXNUM=>FIXNUM")
145 ,@(when restore-fixnum-mask
146 `((:temporary (:sc non-descriptor-reg) temp)))
147 (:translate ,translate)
150 `(inst ,op ,(if restore-fixnum-mask 'temp 'r) y x)
151 `(inst ,op ,(if restore-fixnum-mask 'temp 'r) x y))
152 ;; FIXME: remind me what convention we used for 64bitizing
153 ;; stuff? -- CSR, 2003-08-27
154 ,@(when restore-fixnum-mask
155 `((inst clrrwi r temp (1- n-lowtag-bits))))))
156 (define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED")
158 (:translate ,translate)
159 (:generator ,(1+ untagged-penalty)
163 (define-vop (,(symbolicate "FAST-" translate "/UNSIGNED=>UNSIGNED")
165 (:translate ,translate)
166 (:generator ,(1+ untagged-penalty)
169 `(inst ,op r x y))))))
172 (defmacro define-const-binop (translate untagged-penalty op)
175 (define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum)
177 (:translate ,translate)
179 (inst ,op r x (fixnumize y))))
180 (define-vop (,(symbolicate 'fast- translate '-c/signed=>signed)
182 (:translate ,translate)
183 (:generator ,untagged-penalty
185 (define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned)
186 fast-unsigned-binop-c)
187 (:translate ,translate)
188 (:generator ,untagged-penalty
191 (defmacro define-const-logop (translate untagged-penalty op)
194 (define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum)
196 (:translate ,translate)
198 (inst ,op r x (fixnumize y))))
199 (define-vop (,(symbolicate 'fast- translate '-c/signed=>signed)
201 (:translate ,translate)
202 (:generator ,untagged-penalty
204 (define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned)
205 fast-unsigned-logop-c)
206 (:translate ,translate)
207 (:generator ,untagged-penalty
212 (define-var-binop + 4 add)
213 (define-var-binop - 4 sub)
214 (define-var-binop logand 2 and)
215 (define-var-binop logandc1 2 andc t)
216 (define-var-binop logandc2 2 andc)
217 (define-var-binop logior 2 or)
218 (define-var-binop logorc1 2 orc t t)
219 (define-var-binop logorc2 2 orc nil t)
220 (define-var-binop logxor 2 xor)
221 (define-var-binop logeqv 2 eqv nil t)
222 (define-var-binop lognand 2 nand nil t)
223 (define-var-binop lognor 2 nor nil t)
225 (define-const-binop + 4 addi)
226 (define-const-binop - 4 subi)
227 (define-const-logop logand 2 andi.)
228 (define-const-logop logior 2 ori)
229 (define-const-logop logxor 2 xori)
232 ;;; Special case fixnum + and - that trap on overflow. Useful when we
233 ;;; don't know that the output type is a fixnum.
235 (define-vop (+/fixnum fast-+/fixnum=>fixnum)
237 (:results (r :scs (any-reg descriptor-reg)))
238 (:result-types tagged-num)
239 (:note "safe inline fixnum arithmetic")
241 (let* ((no-overflow (gen-label)))
244 (inst bns no-overflow)
245 (inst unimp (logior (ash (reg-tn-encoding r) 5)
246 fixnum-additive-overflow-trap))
247 (emit-label no-overflow))))
250 (define-vop (-/fixnum fast--/fixnum=>fixnum)
252 (:results (r :scs (any-reg descriptor-reg)))
253 (:result-types tagged-num)
254 (:note "safe inline fixnum arithmetic")
256 (let* ((no-overflow (gen-label)))
259 (inst bns no-overflow)
260 (inst unimp (logior (ash (reg-tn-encoding r) 5)
261 fixnum-additive-overflow-trap))
262 (emit-label no-overflow))))
264 (define-vop (fast-*/fixnum=>fixnum fast-fixnum-binop)
265 (:temporary (:scs (non-descriptor-reg)) temp)
268 (inst srawi temp y 2)
269 (inst mullw r x temp)))
271 (define-vop (fast-*-c/fixnum=>fixnum fast-fixnum-binop-c)
273 (:arg-types tagged-num
274 (:constant (and (signed-byte 16) (not (integer 0 0)))))
278 (define-vop (fast-*-bigc/fixnum=>fixnum fast-fixnum-binop-c)
280 (:arg-types tagged-num
281 (:constant (and fixnum (not (signed-byte 16)))))
282 (:temporary (:scs (non-descriptor-reg)) temp)
285 (inst mullw r x temp)))
287 (define-vop (fast-*/signed=>signed fast-signed-binop)
292 (define-vop (fast-*-c/signed=>signed fast-signed-binop-c)
297 (define-vop (fast-*/unsigned=>unsigned fast-unsigned-binop)
302 (define-vop (fast-*-c/unsigned=>unsigned fast-unsigned-binop-c)
309 (macrolet ((def (name sc-type type result-type cost)
313 (:args (number :scs (,sc-type))
314 (amount :scs (signed-reg unsigned-reg immediate)))
315 (:arg-types ,type positive-fixnum)
316 (:results (result :scs (,result-type)))
317 (:result-types ,type)
321 ((signed-reg unsigned-reg)
322 (inst slw result number amount))
324 (let ((amount (tn-value amount)))
326 (inst slwi result number amount))))))))
327 ;; FIXME: There's the opportunity for a sneaky optimization here, I
328 ;; think: a FAST-ASH-LEFT-C/FIXNUM=>SIGNED vop. -- CSR, 2003-09-03
329 (def fast-ash-left/fixnum=>fixnum any-reg tagged-num any-reg 2)
330 (def fast-ash-left/signed=>signed signed-reg signed-num signed-reg 3)
331 (def fast-ash-left/unsigned=>unsigned unsigned-reg unsigned-num unsigned-reg 3))
333 (define-vop (fast-ash/unsigned=>unsigned)
335 (:args (number :scs (unsigned-reg) :to :save)
336 (amount :scs (signed-reg)))
337 (:arg-types (:or unsigned-num) signed-num)
338 (:results (result :scs (unsigned-reg)))
339 (:result-types unsigned-num)
342 (:temporary (:sc non-descriptor-reg) ndesc)
344 (let ((positive (gen-label))
346 (inst cmpwi amount 0)
347 (inst neg ndesc amount)
349 (inst cmpwi ndesc 31)
350 (inst srw result number ndesc)
352 (move result zero-tn)
355 (emit-label positive)
356 ;; The result-type assures us that this shift will not overflow.
357 (inst slw result number amount)
361 (define-vop (fast-ash-c/unsigned=>unsigned)
362 (:note "inline constant ASH")
363 (:args (number :scs (unsigned-reg)))
365 (:arg-types unsigned-num (:constant integer))
366 (:results (result :scs (unsigned-reg)))
367 (:result-types unsigned-num)
372 ((and (minusp amount) (< amount -31)) (move result zero-tn))
373 ((minusp amount) (inst srwi result number (- amount)))
374 ;; possible because this is used in the modular version too
375 ((> amount 31) (move result zero-tn))
376 (t (inst slwi result number amount)))))
378 (define-vop (fast-ash/signed=>signed)
380 (:args (number :scs (signed-reg) :to :save)
381 (amount :scs (signed-reg immediate)))
382 (:arg-types (:or signed-num) signed-num)
383 (:results (result :scs (signed-reg)))
384 (:result-types (:or signed-num))
387 (:temporary (:sc non-descriptor-reg) ndesc)
391 (let ((positive (gen-label))
393 (inst cmpwi amount 0)
394 (inst neg ndesc amount)
396 (inst cmpwi ndesc 31)
397 (inst sraw result number ndesc)
399 (inst srawi result number 31)
402 (emit-label positive)
403 ;; The result-type assures us that this shift will not overflow.
404 (inst slw result number amount)
409 (let ((amount (tn-value amount)))
411 (let ((amount (min 31 (- amount))))
412 (inst srawi result number amount))
413 (inst slwi result number amount)))))))
417 (define-vop (signed-byte-32-len)
418 (:translate integer-length)
419 (:note "inline (signed-byte 32) integer-length")
421 (:args (arg :scs (signed-reg)))
422 (:arg-types signed-num)
423 (:results (res :scs (any-reg)))
424 (:result-types positive-fixnum)
425 (:temporary (:scs (non-descriptor-reg) :to (:argument 0)) shift)
427 ; (integer-length arg) = (- 32 (cntlz (if (>= arg 0) arg (lognot arg))))
428 (let ((nonneg (gen-label)))
429 (inst cntlzw. shift arg)
432 (inst cntlzw shift shift)
434 (inst slwi shift shift 2)
435 (inst subfic res shift (fixnumize 32)))))
437 (define-vop (unsigned-byte-32-count)
438 (:translate logcount)
439 (:note "inline (unsigned-byte 32) logcount")
441 (:args (arg :scs (unsigned-reg) :target shift))
442 (:arg-types unsigned-num)
443 (:results (res :scs (any-reg)))
444 (:result-types positive-fixnum)
445 (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) shift temp)
447 (let ((loop (gen-label))
449 (inst add. shift zero-tn arg)
454 (inst subi temp shift 1)
455 (inst and. shift shift temp)
456 (inst addi res res (fixnumize 1))
462 ;;;; Modular functions:
463 (define-modular-fun lognot-mod32 (x) lognot 32)
464 (define-vop (lognot-mod32/unsigned=>unsigned)
465 (:translate lognot-mod32)
466 (:args (x :scs (unsigned-reg)))
467 (:arg-types unsigned-num)
468 (:results (res :scs (unsigned-reg)))
469 (:result-types unsigned-num)
474 (define-vop (fast-ash-left-mod32-c/unsigned=>unsigned
475 fast-ash-c/unsigned=>unsigned)
476 (:translate ash-left-mod32))
479 ((define-modular-backend (fun &optional constantp)
480 (let ((mfun-name (symbolicate fun '-mod32))
481 (modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned))
482 (modcvop (symbolicate 'fast- fun 'mod32-c/unsigned=>unsigned))
483 (vop (symbolicate 'fast- fun '/unsigned=>unsigned))
484 (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned)))
486 (define-modular-fun ,mfun-name (x y) ,fun 32)
487 (define-vop (,modvop ,vop)
488 (:translate ,mfun-name))
490 `((define-vop (,modcvop ,cvop)
491 (:translate ,mfun-name))))))))
492 (define-modular-backend + t)
493 (define-modular-backend - t)
494 (define-modular-backend * t)
495 (define-modular-backend logxor t)
496 (define-modular-backend logeqv)
497 (define-modular-backend lognand)
498 (define-modular-backend lognor)
499 (define-modular-backend logandc1)
500 (define-modular-backend logandc2)
501 (define-modular-backend logorc1)
502 (define-modular-backend logorc2))
504 ;;;; Binary conditional VOPs:
506 (define-vop (fast-conditional)
511 (:policy :fast-safe))
513 (define-vop (fast-conditional/fixnum fast-conditional)
514 (:args (x :scs (any-reg zero))
515 (y :scs (any-reg zero)))
516 (:arg-types tagged-num tagged-num)
517 (:note "inline fixnum comparison"))
519 (define-vop (fast-conditional-c/fixnum fast-conditional/fixnum)
520 (:args (x :scs (any-reg zero)))
521 (:arg-types tagged-num (:constant (signed-byte 14)))
522 (:info target not-p y))
524 (define-vop (fast-conditional/signed fast-conditional)
525 (:args (x :scs (signed-reg zero))
526 (y :scs (signed-reg zero)))
527 (:arg-types signed-num signed-num)
528 (:note "inline (signed-byte 32) comparison"))
530 (define-vop (fast-conditional-c/signed fast-conditional/signed)
531 (:args (x :scs (signed-reg zero)))
532 (:arg-types signed-num (:constant (signed-byte 16)))
533 (:info target not-p y))
535 (define-vop (fast-conditional/unsigned fast-conditional)
536 (:args (x :scs (unsigned-reg zero))
537 (y :scs (unsigned-reg zero)))
538 (:arg-types unsigned-num unsigned-num)
539 (:note "inline (unsigned-byte 32) comparison"))
541 (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned)
542 (:args (x :scs (unsigned-reg zero)))
543 (:arg-types unsigned-num (:constant (unsigned-byte 16)))
544 (:info target not-p y))
547 (define-vop (fast-if-</fixnum fast-conditional/fixnum)
551 (inst b? (if not-p :ge :lt) target)))
553 (define-vop (fast-if-<-c/fixnum fast-conditional-c/fixnum)
556 (inst cmpwi x (fixnumize y))
557 (inst b? (if not-p :ge :lt) target)))
559 (define-vop (fast-if-</signed fast-conditional/signed)
563 (inst b? (if not-p :ge :lt) target)))
565 (define-vop (fast-if-<-c/signed fast-conditional-c/signed)
569 (inst b? (if not-p :ge :lt) target)))
571 (define-vop (fast-if-</unsigned fast-conditional/unsigned)
575 (inst b? (if not-p :ge :lt) target)))
577 (define-vop (fast-if-<-c/unsigned fast-conditional-c/unsigned)
581 (inst b? (if not-p :ge :lt) target)))
583 (define-vop (fast-if->/fixnum fast-conditional/fixnum)
587 (inst b? (if not-p :le :gt) target)))
589 (define-vop (fast-if->-c/fixnum fast-conditional-c/fixnum)
592 (inst cmpwi x (fixnumize y))
593 (inst b? (if not-p :le :gt) target)))
595 (define-vop (fast-if->/signed fast-conditional/signed)
599 (inst b? (if not-p :le :gt) target)))
601 (define-vop (fast-if->-c/signed fast-conditional-c/signed)
605 (inst b? (if not-p :le :gt) target)))
607 (define-vop (fast-if->/unsigned fast-conditional/unsigned)
611 (inst b? (if not-p :le :gt) target)))
613 (define-vop (fast-if->-c/unsigned fast-conditional-c/unsigned)
617 (inst b? (if not-p :le :gt) target)))
619 (define-vop (fast-if-eql/signed fast-conditional/signed)
623 (inst b? (if not-p :ne :eq) target)))
625 (define-vop (fast-if-eql-c/signed fast-conditional-c/signed)
629 (inst b? (if not-p :ne :eq) target)))
631 (define-vop (fast-if-eql/unsigned fast-conditional/unsigned)
635 (inst b? (if not-p :ne :eq) target)))
637 (define-vop (fast-if-eql-c/unsigned fast-conditional-c/unsigned)
641 (inst b? (if not-p :ne :eq) target)))
644 ;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a
647 ;;; These versions specify a fixnum restriction on their first arg. We have
648 ;;; also generic-eql/fixnum VOPs which are the same, but have no restriction on
649 ;;; the first arg and a higher cost. The reason for doing this is to prevent
650 ;;; fixnum specific operations from being used on word integers, spuriously
651 ;;; consing the argument.
654 (define-vop (fast-eql/fixnum fast-conditional)
655 (:args (x :scs (any-reg descriptor-reg zero))
656 (y :scs (any-reg zero)))
657 (:arg-types tagged-num tagged-num)
658 (:note "inline fixnum comparison")
662 (inst b? (if not-p :ne :eq) target)))
664 (define-vop (generic-eql/fixnum fast-eql/fixnum)
665 (:arg-types * tagged-num)
668 (define-vop (fast-eql-c/fixnum fast-conditional/fixnum)
669 (:args (x :scs (any-reg descriptor-reg zero)))
670 (:arg-types tagged-num (:constant (signed-byte 14)))
671 (:info target not-p y)
674 (inst cmpwi x (fixnumize y))
675 (inst b? (if not-p :ne :eq) target)))
677 (define-vop (generic-eql-c/fixnum fast-eql-c/fixnum)
678 (:arg-types * (:constant (signed-byte 11)))
682 ;;;; 32-bit logical operations
684 (define-vop (merge-bits)
685 (:translate merge-bits)
686 (:args (shift :scs (signed-reg unsigned-reg))
687 (prev :scs (unsigned-reg))
688 (next :scs (unsigned-reg)))
689 (:arg-types tagged-num unsigned-num unsigned-num)
690 (:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
691 (:temporary (:scs (unsigned-reg) :to (:result 0) :target result) res)
692 (:results (result :scs (unsigned-reg)))
693 (:result-types unsigned-num)
696 (let ((done (gen-label)))
699 (inst srw res next shift)
700 (inst sub temp zero-tn shift)
701 (inst slw temp prev temp)
702 (inst or res res temp)
706 (define-source-transform 32bit-logical-not (x)
707 `(logand (lognot (the (unsigned-byte 32) ,x)) #.(1- (ash 1 32))))
709 (deftransform 32bit-logical-and ((x y))
712 (deftransform 32bit-logical-nand ((x y))
713 '(logand (lognand x y) #.(1- (ash 1 32))))
715 (deftransform 32bit-logical-or ((x y))
718 (deftransform 32bit-logical-nor ((x y))
719 '(logand (lognor x y) #.(1- (ash 1 32))))
721 (deftransform 32bit-logical-xor ((x y))
724 (deftransform 32bit-logical-eqv ((x y))
725 '(logand (logeqv x y) #.(1- (ash 1 32))))
727 (deftransform 32bit-logical-orc1 ((x y))
728 '(logand (logorc1 x y) #.(1- (ash 1 32))))
730 (deftransform 32bit-logical-orc2 ((x y))
731 '(logand (logorc2 x y) #.(1- (ash 1 32))))
733 (deftransform 32bit-logical-andc1 ((x y))
734 '(logand (logandc1 x y) #.(1- (ash 1 32))))
736 (deftransform 32bit-logical-andc2 ((x y))
737 '(logand (logandc2 x y) #.(1- (ash 1 32))))
739 (define-vop (shift-towards-someplace)
741 (:args (num :scs (unsigned-reg))
742 (amount :scs (signed-reg)))
743 (:arg-types unsigned-num tagged-num)
744 (:results (r :scs (unsigned-reg)))
745 (:result-types unsigned-num))
747 (define-vop (shift-towards-start shift-towards-someplace)
748 (:translate shift-towards-start)
749 (:note "shift-towards-start")
751 (inst rlwinm amount amount 0 27 31)
752 (inst slw r num amount)))
754 (define-vop (shift-towards-end shift-towards-someplace)
755 (:translate shift-towards-end)
756 (:note "shift-towards-end")
758 (inst rlwinm amount amount 0 27 31)
759 (inst srw r num amount)))
763 (define-vop (bignum-length get-header-data)
764 (:translate sb!bignum:%bignum-length)
765 (:policy :fast-safe))
767 (define-vop (bignum-set-length set-header-data)
768 (:translate sb!bignum:%bignum-set-length)
769 (:policy :fast-safe))
771 (define-vop (bignum-ref word-index-ref)
772 (:variant bignum-digits-offset other-pointer-lowtag)
773 (:translate sb!bignum:%bignum-ref)
774 (:results (value :scs (unsigned-reg)))
775 (:result-types unsigned-num))
777 (define-vop (bignum-set word-index-set)
778 (:variant bignum-digits-offset other-pointer-lowtag)
779 (:translate sb!bignum:%bignum-set)
780 (:args (object :scs (descriptor-reg))
781 (index :scs (any-reg immediate zero))
782 (value :scs (unsigned-reg)))
783 (:arg-types t positive-fixnum unsigned-num)
784 (:results (result :scs (unsigned-reg)))
785 (:result-types unsigned-num))
787 (define-vop (digit-0-or-plus)
788 (:translate sb!bignum:%digit-0-or-plusp)
790 (:args (digit :scs (unsigned-reg)))
791 (:arg-types unsigned-num)
792 (:results (result :scs (descriptor-reg)))
794 (let ((done (gen-label)))
796 (move result null-tn)
798 (load-symbol result t)
801 (define-vop (add-w/carry)
802 (:translate sb!bignum:%add-with-carry)
804 (:args (a :scs (unsigned-reg))
805 (b :scs (unsigned-reg))
807 (:arg-types unsigned-num unsigned-num positive-fixnum)
808 (:temporary (:scs (unsigned-reg)) temp)
809 (:results (result :scs (unsigned-reg))
810 (carry :scs (unsigned-reg)))
811 (:result-types unsigned-num positive-fixnum)
813 (inst addic temp c -1)
814 (inst adde result a b)
815 (inst addze carry zero-tn)))
817 (define-vop (sub-w/borrow)
818 (:translate sb!bignum:%subtract-with-borrow)
820 (:args (a :scs (unsigned-reg))
821 (b :scs (unsigned-reg))
823 (:arg-types unsigned-num unsigned-num positive-fixnum)
824 (:temporary (:scs (unsigned-reg)) temp)
825 (:results (result :scs (unsigned-reg))
826 (borrow :scs (unsigned-reg)))
827 (:result-types unsigned-num positive-fixnum)
829 (inst addic temp c -1)
830 (inst sube result a b)
831 (inst addze borrow zero-tn)))
833 (define-vop (bignum-mult-and-add-3-arg)
834 (:translate sb!bignum:%multiply-and-add)
836 (:args (x :scs (unsigned-reg))
837 (y :scs (unsigned-reg))
838 (carry-in :scs (unsigned-reg) :to (:eval 1)))
839 (:arg-types unsigned-num unsigned-num unsigned-num)
840 (:temporary (:scs (unsigned-reg) :to (:result 0) :target hi) hi-temp)
841 (:temporary (:scs (unsigned-reg) :from (:eval 0) :to (:result 1)
843 (:results (hi :scs (unsigned-reg))
844 (lo :scs (unsigned-reg)))
845 (:result-types unsigned-num unsigned-num)
847 (inst mulhwu hi-temp x y)
848 (inst mullw lo-temp x y)
849 (inst addc lo lo-temp carry-in)
850 (inst addze hi hi-temp)))
852 (define-vop (bignum-mult-and-add-4-arg)
853 (:translate sb!bignum:%multiply-and-add)
855 (:args (x :scs (unsigned-reg))
856 (y :scs (unsigned-reg))
857 (prev :scs (unsigned-reg) :to (:eval 1))
858 (carry-in :scs (unsigned-reg) :to (:eval 1)))
859 (:arg-types unsigned-num unsigned-num unsigned-num unsigned-num)
860 (:temporary (:scs (unsigned-reg) :to (:result 0) :target hi) hi-temp)
861 (:temporary (:scs (unsigned-reg) :from (:eval 0) :to (:result 1)
863 (:results (hi :scs (unsigned-reg))
864 (lo :scs (unsigned-reg)))
865 (:result-types unsigned-num unsigned-num)
867 (inst mulhwu hi-temp x y)
868 (inst mullw lo-temp x y)
869 (inst addc lo-temp lo-temp carry-in)
870 (inst addze hi-temp hi-temp)
871 (inst addc lo lo-temp prev)
872 (inst addze hi hi-temp)))
874 (define-vop (bignum-mult)
875 (:translate sb!bignum:%multiply)
877 (:args (x :scs (unsigned-reg) :to (:eval 1))
878 (y :scs (unsigned-reg) :to (:eval 1)))
879 (:arg-types unsigned-num unsigned-num)
880 (:results (hi :scs (unsigned-reg) :from (:eval 1))
881 (lo :scs (unsigned-reg) :from (:eval 0)))
882 (:result-types unsigned-num unsigned-num)
885 (inst mulhwu hi x y)))
887 (define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned)
888 (:translate sb!bignum:%lognot))
890 (define-vop (fixnum-to-digit)
891 (:translate sb!bignum:%fixnum-to-digit)
893 (:args (fixnum :scs (any-reg)))
894 (:arg-types tagged-num)
895 (:results (digit :scs (unsigned-reg)))
896 (:result-types unsigned-num)
898 (inst srawi digit fixnum 2)))
901 (define-vop (bignum-floor)
902 (:translate sb!bignum:%floor)
904 (:args (num-high :scs (unsigned-reg) :target rem)
905 (num-low :scs (unsigned-reg) :target rem-low)
906 (denom :scs (unsigned-reg) :to (:eval 1)))
907 (:arg-types unsigned-num unsigned-num unsigned-num)
908 (:temporary (:scs (unsigned-reg) :from (:argument 1)) rem-low)
909 (:temporary (:scs (unsigned-reg) :from (:eval 0)) temp)
910 (:results (quo :scs (unsigned-reg) :from (:eval 0))
911 (rem :scs (unsigned-reg) :from (:argument 0)))
912 (:result-types unsigned-num unsigned-num)
913 (:generator 325 ; number of inst assuming targeting works.
915 (move rem-low num-low)
916 (flet ((maybe-subtract (&optional (guess temp))
917 (inst subi temp guess 1)
918 (inst and temp temp denom)
919 (inst sub rem rem temp))
922 (inst subfe res res res)
927 (inst slwi rem rem 1)
928 (inst srwi temp rem-low 31)
929 (inst or rem rem temp)
930 (inst slwi rem-low rem-low 1)
931 (sltu temp rem denom)
932 (inst slwi quo quo 1)
933 (inst or quo quo temp)
939 (define-vop (bignum-floor)
940 (:translate sb!bignum:%floor)
942 (:args (div-high :scs (unsigned-reg) :target rem)
943 (div-low :scs (unsigned-reg) :target quo)
944 (divisor :scs (unsigned-reg)))
945 (:arg-types unsigned-num unsigned-num unsigned-num)
946 (:results (quo :scs (unsigned-reg) :from (:argument 1))
947 (rem :scs (unsigned-reg) :from (:argument 0)))
948 (:result-types unsigned-num unsigned-num)
951 (inst div quo div-high divisor)
955 (define-vop (signify-digit)
956 (:translate sb!bignum:%fixnum-digit-with-correct-sign)
958 (:args (digit :scs (unsigned-reg) :target res))
959 (:arg-types unsigned-num)
960 (:results (res :scs (any-reg signed-reg)))
961 (:result-types signed-num)
965 (inst slwi res digit 2))
970 (define-vop (digit-ashr)
971 (:translate sb!bignum:%ashr)
973 (:args (digit :scs (unsigned-reg))
974 (count :scs (unsigned-reg)))
975 (:arg-types unsigned-num positive-fixnum)
976 (:results (result :scs (unsigned-reg)))
977 (:result-types unsigned-num)
979 (inst sraw result digit count)))
981 (define-vop (digit-lshr digit-ashr)
982 (:translate sb!bignum:%digit-logical-shift-right)
984 (inst srw result digit count)))
986 (define-vop (digit-ashl digit-ashr)
987 (:translate sb!bignum:%ashl)
989 (inst slw result digit count)))
994 (define-static-fun two-arg-gcd (x y) :translate gcd)
995 (define-static-fun two-arg-lcm (x y) :translate lcm)
997 (define-static-fun two-arg-+ (x y) :translate +)
998 (define-static-fun two-arg-- (x y) :translate -)
999 (define-static-fun two-arg-* (x y) :translate *)
1000 (define-static-fun two-arg-/ (x y) :translate /)
1002 (define-static-fun two-arg-< (x y) :translate <)
1003 (define-static-fun two-arg-<= (x y) :translate <=)
1004 (define-static-fun two-arg-> (x y) :translate >)
1005 (define-static-fun two-arg->= (x y) :translate >=)
1006 (define-static-fun two-arg-= (x y) :translate =)
1007 (define-static-fun two-arg-/= (x y) :translate /=)
1009 (define-static-fun %negate (x) :translate %negate)
1011 (define-static-fun two-arg-and (x y) :translate logand)
1012 (define-static-fun two-arg-ior (x y) :translate logior)
1013 (define-static-fun two-arg-xor (x y) :translate logxor)
1014 (define-static-fun two-arg-eqv (x y) :translate logeqv)
1018 (deftransform * ((x y)
1019 ((unsigned-byte 32) (constant-arg (unsigned-byte 32)))
1021 "recode as shifts and adds"
1022 (let ((y (lvar-value y)))
1023 (multiple-value-bind (result adds shifts)
1024 (ub32-strength-reduce-constant-multiply 'x y)
1026 ((typep y '(signed-byte 16))
1027 ;; a mulli instruction has a latency of 5.
1028 (when (> (+ adds shifts) 4)
1029 (give-up-ir1-transform)))
1031 ;; a mullw instruction also has a latency of 5, plus two
1032 ;; instructions (in general) to load the immediate into a
1034 (when (> (+ adds shifts) 6)
1035 (give-up-ir1-transform))))