2 ;;; Converted by William Lott.
11 (define-vop (fast-safe-arith-op)
17 (define-vop (fixnum-unop fast-safe-arith-op)
18 (:args (x :scs (any-reg)))
19 (:results (res :scs (any-reg)))
20 (:note "inline fixnum arithmetic")
21 (:arg-types tagged-num)
22 (:result-types tagged-num))
24 (define-vop (signed-unop fast-safe-arith-op)
25 (:args (x :scs (signed-reg)))
26 (:results (res :scs (signed-reg)))
27 (:note "inline (signed-byte 32) arithmetic")
28 (:arg-types signed-num)
29 (:result-types signed-num))
31 (define-vop (fast-negate/fixnum fixnum-unop)
36 (define-vop (fast-negate/signed signed-unop)
41 (define-vop (fast-lognot/fixnum fixnum-unop)
44 (inst xori res x (fixnumize -1))))
46 (define-vop (fast-lognot/signed signed-unop)
53 ;;;; Binary fixnum operations.
55 ;;; Assume that any constant operand is the second arg...
57 (define-vop (fast-fixnum-binop fast-safe-arith-op)
58 (:args (x :target r :scs (any-reg zero))
59 (y :target r :scs (any-reg zero)))
60 (:arg-types tagged-num tagged-num)
61 (:results (r :scs (any-reg)))
62 (:result-types tagged-num)
63 (:note "inline fixnum arithmetic"))
65 (define-vop (fast-unsigned-binop fast-safe-arith-op)
66 (:args (x :target r :scs (unsigned-reg zero))
67 (y :target r :scs (unsigned-reg zero)))
68 (:arg-types unsigned-num unsigned-num)
69 (:results (r :scs (unsigned-reg)))
70 (:result-types unsigned-num)
71 (:note "inline (unsigned-byte 32) arithmetic"))
73 (define-vop (fast-signed-binop fast-safe-arith-op)
74 (:args (x :target r :scs (signed-reg zero))
75 (y :target r :scs (signed-reg zero)))
76 (:arg-types signed-num signed-num)
77 (:results (r :scs (signed-reg)))
78 (:result-types signed-num)
79 (:note "inline (signed-byte 32) arithmetic"))
82 (define-vop (fast-fixnum-binop-c fast-safe-arith-op)
83 (:args (x :target r :scs (any-reg zero)))
85 (:arg-types tagged-num
86 (:constant (and (signed-byte 14) (not (integer 0 0)))))
87 (:results (r :scs (any-reg)))
88 (:result-types tagged-num)
89 (:note "inline fixnum arithmetic"))
91 (define-vop (fast-fixnum-logop-c fast-safe-arith-op)
92 (:args (x :target r :scs (any-reg zero)))
94 (:arg-types tagged-num
95 (:constant (and (unsigned-byte 14) (not (integer 0 0)))))
96 (:results (r :scs (any-reg)))
97 (:result-types tagged-num)
98 (:note "inline fixnum logical op"))
100 (define-vop (fast-unsigned-binop-c fast-safe-arith-op)
101 (:args (x :target r :scs (unsigned-reg zero)))
103 (:arg-types unsigned-num
104 (:constant (and (signed-byte 16) (not (integer 0 0)))))
105 (:results (r :scs (unsigned-reg)))
106 (:result-types unsigned-num)
107 (:note "inline (unsigned-byte 32) arithmetic"))
109 (define-vop (fast-unsigned-logop-c fast-safe-arith-op)
110 (:args (x :target r :scs (unsigned-reg zero)))
112 (:arg-types unsigned-num
113 (:constant (and (unsigned-byte 16) (not (integer 0 0)))))
114 (:results (r :scs (unsigned-reg)))
115 (:result-types unsigned-num)
116 (:note "inline (unsigned-byte 32) logical op"))
118 (define-vop (fast-signed-binop-c fast-safe-arith-op)
119 (:args (x :target r :scs (signed-reg zero)))
121 (:arg-types signed-num
122 (:constant (and (signed-byte 16) (not (integer 0 0)))))
123 (:results (r :scs (signed-reg)))
124 (:result-types signed-num)
125 (:note "inline (signed-byte 32) arithmetic"))
127 (define-vop (fast-signed-logop-c fast-safe-arith-op)
128 (:args (x :target r :scs (signed-reg zero)))
130 (:arg-types signed-num
131 (:constant (and (unsigned-byte 16) (not (integer 0 0)))))
132 (:results (r :scs (signed-reg)))
133 (:result-types signed-num)
134 (:note "inline (signed-byte 32) arithmetic"))
137 (eval-when (:compile-toplevel :load-toplevel :execute)
139 (defmacro define-var-binop (translate untagged-penalty op)
141 (define-vop (,(symbolicate "FAST-" translate "/FIXNUM=>FIXNUM")
143 (:translate ,translate)
146 (define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED")
148 (:translate ,translate)
149 (:generator ,(1+ untagged-penalty)
151 (define-vop (,(symbolicate "FAST-" translate "/UNSIGNED=>UNSIGNED")
153 (:translate ,translate)
154 (:generator ,(1+ untagged-penalty)
158 (defmacro define-const-binop (translate untagged-penalty op)
161 (define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum)
163 (:translate ,translate)
165 (inst ,op r x (fixnumize y))))
166 (define-vop (,(symbolicate 'fast- translate '-c/signed=>signed)
168 (:translate ,translate)
169 (:generator ,untagged-penalty
171 (define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned)
172 fast-unsigned-binop-c)
173 (:translate ,translate)
174 (:generator ,untagged-penalty
177 (defmacro define-const-logop (translate untagged-penalty op)
180 (define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum)
182 (:translate ,translate)
184 (inst ,op r x (fixnumize y))))
185 (define-vop (,(symbolicate 'fast- translate '-c/signed=>signed)
187 (:translate ,translate)
188 (:generator ,untagged-penalty
190 (define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned)
191 fast-unsigned-logop-c)
192 (:translate ,translate)
193 (:generator ,untagged-penalty
198 (define-var-binop + 4 add)
199 (define-var-binop - 4 sub)
200 (define-var-binop logand 2 and)
201 (define-var-binop logandc2 2 andc)
202 (define-var-binop logior 2 or)
203 (define-var-binop logorc2 2 orc)
204 (define-var-binop logxor 2 xor)
205 (define-var-binop logeqv 2 eqv)
207 (define-const-binop + 4 addi)
208 (define-const-binop - 4 subi)
209 (define-const-logop logand 2 andi.)
210 (define-const-logop logior 2 ori)
211 (define-const-logop logxor 2 xori)
214 ;;; Special case fixnum + and - that trap on overflow. Useful when we
215 ;;; don't know that the output type is a fixnum.
217 (define-vop (+/fixnum fast-+/fixnum=>fixnum)
219 (:results (r :scs (any-reg descriptor-reg)))
220 (:result-types tagged-num)
221 (:note "safe inline fixnum arithmetic")
223 (let* ((no-overflow (gen-label)))
226 (inst bns no-overflow)
227 (inst unimp (logior (ash (reg-tn-encoding r) 5)
228 fixnum-additive-overflow-trap))
229 (emit-label no-overflow))))
232 (define-vop (-/fixnum fast--/fixnum=>fixnum)
234 (:results (r :scs (any-reg descriptor-reg)))
235 (:result-types tagged-num)
236 (:note "safe inline fixnum arithmetic")
238 (let* ((no-overflow (gen-label)))
241 (inst bns no-overflow)
242 (inst unimp (logior (ash (reg-tn-encoding r) 5)
243 fixnum-additive-overflow-trap))
244 (emit-label no-overflow))))
249 (define-vop (fast-ash/unsigned=>unsigned)
251 (:args (number :scs (unsigned-reg) :to :save)
252 (amount :scs (signed-reg immediate)))
253 (:arg-types (:or unsigned-num) signed-num)
254 (:results (result :scs (unsigned-reg)))
255 (:result-types unsigned-num)
258 (:temporary (:sc non-descriptor-reg) ndesc)
262 (let ((positive (gen-label))
264 (inst cmpwi amount 0)
265 (inst neg ndesc amount)
267 (inst cmpwi ndesc 31)
268 (inst srw result number ndesc)
270 (inst srwi result number 31)
273 (emit-label positive)
274 ;; The result-type assures us that this shift will not overflow.
275 (inst slw result number amount)
280 (let ((amount (tn-value amount)))
282 (let ((amount (min 31 (- amount))))
283 (inst srwi result number amount))
284 (inst slwi result number amount)))))))
287 (define-vop (fast-ash/signed=>signed)
289 (:args (number :scs (signed-reg) :to :save)
290 (amount :scs (signed-reg immediate)))
291 (:arg-types (:or signed-num) signed-num)
292 (:results (result :scs (signed-reg)))
293 (:result-types (:or signed-num))
296 (:temporary (:sc non-descriptor-reg) ndesc)
300 (let ((positive (gen-label))
302 (inst cmpwi amount 0)
303 (inst neg ndesc amount)
305 (inst cmpwi ndesc 31)
306 (inst sraw result number ndesc)
308 (inst srawi result number 31)
311 (emit-label positive)
312 ;; The result-type assures us that this shift will not overflow.
313 (inst slw result number amount)
318 (let ((amount (tn-value amount)))
320 (let ((amount (min 31 (- amount))))
321 (inst srawi result number amount))
322 (inst slwi result number amount)))))))
326 (define-vop (signed-byte-32-len)
327 (:translate integer-length)
328 (:note "inline (signed-byte 32) integer-length")
330 (:args (arg :scs (signed-reg)))
331 (:arg-types signed-num)
332 (:results (res :scs (any-reg)))
333 (:result-types positive-fixnum)
334 (:temporary (:scs (non-descriptor-reg) :to (:argument 0)) shift)
336 ; (integer-length arg) = (- 32 (cntlz (if (>= arg 0) arg (lognot arg))))
337 (let ((nonneg (gen-label)))
338 (inst cntlzw. shift arg)
341 (inst cntlzw shift shift)
343 (inst slwi shift shift 2)
344 (inst subfic res shift (fixnumize 32)))))
346 (define-vop (unsigned-byte-32-count)
347 (:translate logcount)
348 (:note "inline (unsigned-byte 32) logcount")
350 (:args (arg :scs (unsigned-reg) :target shift))
351 (:arg-types unsigned-num)
352 (:results (res :scs (any-reg)))
353 (:result-types positive-fixnum)
354 (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) shift temp)
356 (let ((loop (gen-label))
358 (inst add. shift zero-tn arg)
363 (inst subi temp shift 1)
364 (inst and. shift shift temp)
365 (inst addi res res (fixnumize 1))
371 ;;;; Binary conditional VOPs:
373 (define-vop (fast-conditional)
378 (:policy :fast-safe))
380 (deftype integer-with-a-bite-out (s bite)
381 (cond ((eq s '*) 'integer)
382 ((and (integerp s) (> s 1))
383 (let ((bound (ash 1 (1- s))))
384 `(integer ,(- bound) ,(- bound bite 1))))
386 (error "Bad size specified for SIGNED-BYTE type specifier: ~S." s))))
388 (define-vop (fast-conditional/fixnum fast-conditional)
389 (:args (x :scs (any-reg zero))
390 (y :scs (any-reg zero)))
391 (:arg-types tagged-num tagged-num)
392 (:note "inline fixnum comparison"))
394 (define-vop (fast-conditional-c/fixnum fast-conditional/fixnum)
395 (:args (x :scs (any-reg zero)))
396 (:arg-types tagged-num (:constant (signed-byte 14)))
397 (:info target not-p y))
399 (define-vop (fast-conditional/signed fast-conditional)
400 (:args (x :scs (signed-reg zero))
401 (y :scs (signed-reg zero)))
402 (:arg-types signed-num signed-num)
403 (:note "inline (signed-byte 32) comparison"))
405 (define-vop (fast-conditional-c/signed fast-conditional/signed)
406 (:args (x :scs (signed-reg zero)))
407 (:arg-types signed-num (:constant (signed-byte 16)))
408 (:info target not-p y))
410 (define-vop (fast-conditional/unsigned fast-conditional)
411 (:args (x :scs (unsigned-reg zero))
412 (y :scs (unsigned-reg zero)))
413 (:arg-types unsigned-num unsigned-num)
414 (:note "inline (unsigned-byte 32) comparison"))
416 (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned)
417 (:args (x :scs (unsigned-reg zero)))
418 (:arg-types unsigned-num (:constant (unsigned-byte 16)))
419 (:info target not-p y))
422 (define-vop (fast-if-</fixnum fast-conditional/fixnum)
426 (inst b? (if not-p :ge :lt) target)))
428 (define-vop (fast-if-<-c/fixnum fast-conditional-c/fixnum)
431 (inst cmpwi x (fixnumize y))
432 (inst b? (if not-p :ge :lt) target)))
434 (define-vop (fast-if-</signed fast-conditional/signed)
438 (inst b? (if not-p :ge :lt) target)))
440 (define-vop (fast-if-<-c/signed fast-conditional-c/signed)
444 (inst b? (if not-p :ge :lt) target)))
446 (define-vop (fast-if-</unsigned fast-conditional/unsigned)
450 (inst b? (if not-p :ge :lt) target)))
452 (define-vop (fast-if-<-c/unsigned fast-conditional-c/unsigned)
456 (inst b? (if not-p :ge :lt) target)))
458 (define-vop (fast-if->/fixnum fast-conditional/fixnum)
462 (inst b? (if not-p :le :gt) target)))
464 (define-vop (fast-if->-c/fixnum fast-conditional-c/fixnum)
467 (inst cmpwi x (fixnumize y))
468 (inst b? (if not-p :le :gt) target)))
470 (define-vop (fast-if->/signed fast-conditional/signed)
474 (inst b? (if not-p :le :gt) target)))
476 (define-vop (fast-if->-c/signed fast-conditional-c/signed)
480 (inst b? (if not-p :le :gt) target)))
482 (define-vop (fast-if->/unsigned fast-conditional/unsigned)
486 (inst b? (if not-p :le :gt) target)))
488 (define-vop (fast-if->-c/unsigned fast-conditional-c/unsigned)
492 (inst b? (if not-p :le :gt) target)))
494 (define-vop (fast-if-eql/signed fast-conditional/signed)
498 (inst b? (if not-p :ne :eq) target)))
500 (define-vop (fast-if-eql-c/signed fast-conditional-c/signed)
504 (inst b? (if not-p :ne :eq) target)))
506 (define-vop (fast-if-eql/unsigned fast-conditional/unsigned)
510 (inst b? (if not-p :ne :eq) target)))
512 (define-vop (fast-if-eql-c/unsigned fast-conditional-c/unsigned)
516 (inst b? (if not-p :ne :eq) target)))
519 ;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a
522 ;;; These versions specify a fixnum restriction on their first arg. We have
523 ;;; also generic-eql/fixnum VOPs which are the same, but have no restriction on
524 ;;; the first arg and a higher cost. The reason for doing this is to prevent
525 ;;; fixnum specific operations from being used on word integers, spuriously
526 ;;; consing the argument.
529 (define-vop (fast-eql/fixnum fast-conditional)
530 (:args (x :scs (any-reg descriptor-reg zero))
531 (y :scs (any-reg zero)))
532 (:arg-types tagged-num tagged-num)
533 (:note "inline fixnum comparison")
537 (inst b? (if not-p :ne :eq) target)))
539 (define-vop (generic-eql/fixnum fast-eql/fixnum)
540 (:arg-types * tagged-num)
543 (define-vop (fast-eql-c/fixnum fast-conditional/fixnum)
544 (:args (x :scs (any-reg descriptor-reg zero)))
545 (:arg-types tagged-num (:constant (signed-byte 14)))
546 (:info target not-p y)
549 (inst cmpwi x (fixnumize y))
550 (inst b? (if not-p :ne :eq) target)))
552 (define-vop (generic-eql-c/fixnum fast-eql-c/fixnum)
553 (:arg-types * (:constant (signed-byte 11)))
557 ;;;; 32-bit logical operations
559 (define-vop (merge-bits)
560 (:translate merge-bits)
561 (:args (shift :scs (signed-reg unsigned-reg))
562 (prev :scs (unsigned-reg))
563 (next :scs (unsigned-reg)))
564 (:arg-types tagged-num unsigned-num unsigned-num)
565 (:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
566 (:temporary (:scs (unsigned-reg) :to (:result 0) :target result) res)
567 (:results (result :scs (unsigned-reg)))
568 (:result-types unsigned-num)
571 (let ((done (gen-label)))
574 (inst srw res next shift)
575 (inst sub temp zero-tn shift)
576 (inst slw temp prev temp)
577 (inst or res res temp)
582 (define-vop (32bit-logical)
583 (:args (x :scs (unsigned-reg zero))
584 (y :scs (unsigned-reg zero)))
585 (:arg-types unsigned-num unsigned-num)
586 (:results (r :scs (unsigned-reg)))
587 (:result-types unsigned-num)
588 (:policy :fast-safe))
590 (define-vop (32bit-logical-not 32bit-logical)
591 (:translate 32bit-logical-not)
592 (:args (x :scs (unsigned-reg zero)))
593 (:arg-types unsigned-num)
597 (define-vop (32bit-logical-and 32bit-logical)
598 (:translate 32bit-logical-and)
602 (deftransform 32bit-logical-nand ((x y) (* *))
603 '(32bit-logical-not (32bit-logical-and x y)))
605 (define-vop (32bit-logical-or 32bit-logical)
606 (:translate 32bit-logical-or)
610 (deftransform 32bit-logical-nor ((x y) (* *))
611 '(32bit-logical-not (32bit-logical-or x y)))
613 (define-vop (32bit-logical-xor 32bit-logical)
614 (:translate 32bit-logical-xor)
618 (define-vop (32bit-logical-eqv 32bit-logical)
619 (:translate 32bit-logical-eqv)
623 (define-vop (32bit-logical-orc2 32bit-logical)
624 (:translate 32bit-logical-orc2)
628 (deftransform 32bit-logical-orc1 ((x y) (* *))
629 '(32bit-logical-orc2 y x))
631 (define-vop (32bit-logical-andc2 32bit-logical)
632 (:translate 32bit-logical-andc2)
636 (deftransform 32bit-logical-andc1 ((x y) (* *))
637 '(32bit-logical-andc2 y x))
640 (define-vop (shift-towards-someplace)
642 (:args (num :scs (unsigned-reg))
643 (amount :scs (signed-reg)))
644 (:arg-types unsigned-num tagged-num)
645 (:results (r :scs (unsigned-reg)))
646 (:result-types unsigned-num))
648 (define-vop (shift-towards-start shift-towards-someplace)
649 (:translate shift-towards-start)
650 (:note "shift-towards-start")
652 (inst rlwinm amount amount 0 27 31)
653 (inst slw r num amount)))
655 (define-vop (shift-towards-end shift-towards-someplace)
656 (:translate shift-towards-end)
657 (:note "shift-towards-end")
659 (inst rlwinm amount amount 0 27 31)
660 (inst srw r num amount)))
667 (define-vop (bignum-length get-header-data)
668 (:translate sb!bignum::%bignum-length)
669 (:policy :fast-safe))
671 (define-vop (bignum-set-length set-header-data)
672 (:translate sb!bignum::%bignum-set-length)
673 (:policy :fast-safe))
675 (define-vop (bignum-ref word-index-ref)
676 (:variant sb!vm:bignum-digits-offset sb!vm:other-pointer-lowtag)
677 (:translate sb!bignum::%bignum-ref)
678 (:results (value :scs (unsigned-reg)))
679 (:result-types unsigned-num))
681 (define-vop (bignum-set word-index-set)
682 (:variant sb!vm:bignum-digits-offset sb!vm:other-pointer-lowtag)
683 (:translate sb!bignum::%bignum-set)
684 (:args (object :scs (descriptor-reg))
685 (index :scs (any-reg immediate zero))
686 (value :scs (unsigned-reg)))
687 (:arg-types t positive-fixnum unsigned-num)
688 (:results (result :scs (unsigned-reg)))
689 (:result-types unsigned-num))
691 (define-vop (digit-0-or-plus)
692 (:translate sb!bignum::%digit-0-or-plusp)
694 (:args (digit :scs (unsigned-reg)))
695 (:arg-types unsigned-num)
696 (:results (result :scs (descriptor-reg)))
698 (let ((done (gen-label)))
700 (move result null-tn)
702 (load-symbol result t)
705 (define-vop (add-w/carry)
706 (:translate sb!bignum::%add-with-carry)
708 (:args (a :scs (unsigned-reg))
709 (b :scs (unsigned-reg))
711 (:arg-types unsigned-num unsigned-num positive-fixnum)
712 (:temporary (:scs (unsigned-reg)) temp)
713 (:results (result :scs (unsigned-reg))
714 (carry :scs (unsigned-reg)))
715 (:result-types unsigned-num positive-fixnum)
717 (inst addic temp c -1)
718 (inst adde result a b)
719 (inst addze carry zero-tn)))
721 (define-vop (sub-w/borrow)
722 (:translate sb!bignum::%subtract-with-borrow)
724 (:args (a :scs (unsigned-reg))
725 (b :scs (unsigned-reg))
727 (:arg-types unsigned-num unsigned-num positive-fixnum)
728 (:temporary (:scs (unsigned-reg)) temp)
729 (:results (result :scs (unsigned-reg))
730 (borrow :scs (unsigned-reg)))
731 (:result-types unsigned-num positive-fixnum)
733 (inst addic temp c -1)
734 (inst sube result a b)
735 (inst addze borrow zero-tn)))
737 (define-vop (bignum-mult-and-add-3-arg)
738 (:translate sb!bignum::%multiply-and-add)
740 (:args (x :scs (unsigned-reg))
741 (y :scs (unsigned-reg))
742 (carry-in :scs (unsigned-reg) :to (:eval 1)))
743 (:arg-types unsigned-num unsigned-num unsigned-num)
744 (:temporary (:scs (unsigned-reg) :to (:result 0) :target hi) hi-temp)
745 (:temporary (:scs (unsigned-reg) :from (:eval 0) :to (:result 1)
747 (:results (hi :scs (unsigned-reg))
748 (lo :scs (unsigned-reg)))
749 (:result-types unsigned-num unsigned-num)
751 (inst mulhwu hi-temp x y)
752 (inst mullw lo-temp x y)
753 (inst addc lo lo-temp carry-in)
754 (inst addze hi hi-temp)))
756 (define-vop (bignum-mult-and-add-4-arg)
757 (:translate sb!bignum::%multiply-and-add)
759 (:args (x :scs (unsigned-reg))
760 (y :scs (unsigned-reg))
761 (prev :scs (unsigned-reg) :to (:eval 1))
762 (carry-in :scs (unsigned-reg) :to (:eval 1)))
763 (:arg-types unsigned-num unsigned-num unsigned-num unsigned-num)
764 (:temporary (:scs (unsigned-reg) :to (:result 0) :target hi) hi-temp)
765 (:temporary (:scs (unsigned-reg) :from (:eval 0) :to (:result 1)
767 (:results (hi :scs (unsigned-reg))
768 (lo :scs (unsigned-reg)))
769 (:result-types unsigned-num unsigned-num)
771 (inst mulhwu hi-temp x y)
772 (inst mullw lo-temp x y)
773 (inst addc lo-temp lo-temp carry-in)
774 (inst addze hi-temp hi-temp)
775 (inst addc lo lo-temp prev)
776 (inst addze hi hi-temp)))
778 (define-vop (bignum-mult)
779 (:translate sb!bignum::%multiply)
781 (:args (x :scs (unsigned-reg) :to (:result 1))
782 (y :scs (unsigned-reg) :to (:result 1)))
783 (:arg-types unsigned-num unsigned-num)
784 (:results (hi :scs (unsigned-reg))
785 (lo :scs (unsigned-reg)))
786 (:result-types unsigned-num unsigned-num)
789 (inst mulhwu hi x y)))
791 (define-vop (bignum-lognot)
792 (:translate sb!bignum::%lognot)
794 (:args (x :scs (unsigned-reg)))
795 (:arg-types unsigned-num)
796 (:results (r :scs (unsigned-reg)))
797 (:result-types unsigned-num)
801 (define-vop (fixnum-to-digit)
802 (:translate sb!bignum::%fixnum-to-digit)
804 (:args (fixnum :scs (any-reg)))
805 (:arg-types tagged-num)
806 (:results (digit :scs (unsigned-reg)))
807 (:result-types unsigned-num)
809 (inst srawi digit fixnum 2)))
812 (define-vop (bignum-floor)
813 (:translate sb!bignum::%floor)
815 (:args (num-high :scs (unsigned-reg) :target rem)
816 (num-low :scs (unsigned-reg) :target rem-low)
817 (denom :scs (unsigned-reg) :to (:eval 1)))
818 (:arg-types unsigned-num unsigned-num unsigned-num)
819 (:temporary (:scs (unsigned-reg) :from (:argument 1)) rem-low)
820 (:temporary (:scs (unsigned-reg) :from (:eval 0)) temp)
821 (:results (quo :scs (unsigned-reg) :from (:eval 0))
822 (rem :scs (unsigned-reg) :from (:argument 0)))
823 (:result-types unsigned-num unsigned-num)
824 (:generator 325 ; number of inst assuming targeting works.
826 (move rem-low num-low)
827 (flet ((maybe-subtract (&optional (guess temp))
828 (inst subi temp guess 1)
829 (inst and temp temp denom)
830 (inst sub rem rem temp))
833 (inst subfe res res res)
838 (inst slwi rem rem 1)
839 (inst srwi temp rem-low 31)
840 (inst or rem rem temp)
841 (inst slwi rem-low rem-low 1)
842 (sltu temp rem denom)
843 (inst slwi quo quo 1)
844 (inst or quo quo temp)
850 (define-vop (bignum-floor)
851 (:translate sb!bignum::%floor)
853 (:args (div-high :scs (unsigned-reg) :target rem)
854 (div-low :scs (unsigned-reg) :target quo)
855 (divisor :scs (unsigned-reg)))
856 (:arg-types unsigned-num unsigned-num unsigned-num)
857 (:results (quo :scs (unsigned-reg) :from (:argument 1))
858 (rem :scs (unsigned-reg) :from (:argument 0)))
859 (:result-types unsigned-num unsigned-num)
862 (inst div quo div-high divisor)
866 (define-vop (signify-digit)
867 (:translate sb!bignum::%fixnum-digit-with-correct-sign)
869 (:args (digit :scs (unsigned-reg) :target res))
870 (:arg-types unsigned-num)
871 (:results (res :scs (any-reg signed-reg)))
872 (:result-types signed-num)
876 (inst slwi res digit 2))
881 (define-vop (digit-ashr)
882 (:translate sb!bignum::%ashr)
884 (:args (digit :scs (unsigned-reg))
885 (count :scs (unsigned-reg)))
886 (:arg-types unsigned-num positive-fixnum)
887 (:results (result :scs (unsigned-reg)))
888 (:result-types unsigned-num)
890 (inst sraw result digit count)))
892 (define-vop (digit-lshr digit-ashr)
893 (:translate sb!bignum::%digit-logical-shift-right)
895 (inst srw result digit count)))
897 (define-vop (digit-ashl digit-ashr)
898 (:translate sb!bignum::%ashl)
900 (inst slw result digit count)))
905 (define-static-fun two-arg-gcd (x y) :translate gcd)
906 (define-static-fun two-arg-lcm (x y) :translate lcm)
908 (define-static-fun two-arg-+ (x y) :translate +)
909 (define-static-fun two-arg-- (x y) :translate -)
910 (define-static-fun two-arg-* (x y) :translate *)
911 (define-static-fun two-arg-/ (x y) :translate /)
913 (define-static-fun two-arg-< (x y) :translate <)
914 (define-static-fun two-arg-<= (x y) :translate <=)
915 (define-static-fun two-arg-> (x y) :translate >)
916 (define-static-fun two-arg->= (x y) :translate >=)
917 (define-static-fun two-arg-= (x y) :translate =)
918 (define-static-fun two-arg-/= (x y) :translate /=)
920 (define-static-fun %negate (x) :translate %negate)
922 (define-static-fun two-arg-and (x y) :translate logand)
923 (define-static-fun two-arg-ior (x y) :translate logior)
924 (define-static-fun two-arg-xor (x y) :translate logxor)