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)
22 (define-vop (fixnum-unop fast-safe-arith-op
)
23 (:args
(x :scs
(any-reg)))
24 (:results
(res :scs
(any-reg)))
25 (:note
"inline fixnum arithmetic")
26 (:arg-types tagged-num
)
27 (:result-types tagged-num
))
29 (define-vop (signed-unop fast-safe-arith-op
)
30 (:args
(x :scs
(signed-reg)))
31 (:results
(res :scs
(signed-reg)))
32 (:note
"inline (signed-byte 32) arithmetic")
33 (:arg-types signed-num
)
34 (:result-types signed-num
))
36 (define-vop (fast-negate/fixnum fixnum-unop
)
41 (define-vop (fast-negate/signed signed-unop
)
46 (define-vop (fast-lognot/fixnum fixnum-unop
)
49 (inst xori res x
(fixnumize -
1))))
51 (define-vop (fast-lognot/signed signed-unop
)
58 ;;;; Binary fixnum operations.
60 ;;; Assume that any constant operand is the second arg...
62 (define-vop (fast-fixnum-binop fast-safe-arith-op
)
63 (:args
(x :target r
:scs
(any-reg zero
))
64 (y :target r
:scs
(any-reg zero
)))
65 (:arg-types tagged-num tagged-num
)
66 (:results
(r :scs
(any-reg)))
67 (:result-types tagged-num
)
68 (:note
"inline fixnum arithmetic"))
70 (define-vop (fast-unsigned-binop fast-safe-arith-op
)
71 (:args
(x :target r
:scs
(unsigned-reg zero
))
72 (y :target r
:scs
(unsigned-reg zero
)))
73 (:arg-types unsigned-num unsigned-num
)
74 (:results
(r :scs
(unsigned-reg)))
75 (:result-types unsigned-num
)
76 (:note
"inline (unsigned-byte 32) arithmetic"))
78 (define-vop (fast-signed-binop fast-safe-arith-op
)
79 (:args
(x :target r
:scs
(signed-reg zero
))
80 (y :target r
:scs
(signed-reg zero
)))
81 (:arg-types signed-num signed-num
)
82 (:results
(r :scs
(signed-reg)))
83 (:result-types signed-num
)
84 (:note
"inline (signed-byte 32) arithmetic"))
87 (define-vop (fast-fixnum-binop-c fast-safe-arith-op
)
88 (:args
(x :target r
:scs
(any-reg zero
)))
90 (:arg-types tagged-num
91 (:constant
(and (signed-byte 14) (not (integer 0 0)))))
92 (:results
(r :scs
(any-reg)))
93 (:result-types tagged-num
)
94 (:note
"inline fixnum arithmetic"))
96 (define-vop (fast-fixnum-logop-c fast-safe-arith-op
)
97 (:args
(x :target r
:scs
(any-reg zero
)))
99 (:arg-types tagged-num
100 (:constant
(and (unsigned-byte 14) (not (integer 0 0)))))
101 (:results
(r :scs
(any-reg)))
102 (:result-types tagged-num
)
103 (:note
"inline fixnum logical op"))
105 (define-vop (fast-unsigned-binop-c fast-safe-arith-op
)
106 (:args
(x :target r
:scs
(unsigned-reg zero
)))
108 (:arg-types unsigned-num
109 (:constant
(and (signed-byte 16) (not (integer 0 0)))))
110 (:results
(r :scs
(unsigned-reg)))
111 (:result-types unsigned-num
)
112 (:note
"inline (unsigned-byte 32) arithmetic"))
114 (define-vop (fast-unsigned-logop-c fast-safe-arith-op
)
115 (:args
(x :target r
:scs
(unsigned-reg zero
)))
117 (:arg-types unsigned-num
118 (:constant
(and (unsigned-byte 16) (not (integer 0 0)))))
119 (:results
(r :scs
(unsigned-reg)))
120 (:result-types unsigned-num
)
121 (:note
"inline (unsigned-byte 32) logical op"))
123 (define-vop (fast-signed-binop-c fast-safe-arith-op
)
124 (:args
(x :target r
:scs
(signed-reg zero
)))
126 (:arg-types signed-num
127 (:constant
(and (signed-byte 16) (not (integer 0 0)))))
128 (:results
(r :scs
(signed-reg)))
129 (:result-types signed-num
)
130 (:note
"inline (signed-byte 32) arithmetic"))
132 (define-vop (fast-signed-logop-c fast-safe-arith-op
)
133 (:args
(x :target r
:scs
(signed-reg zero
)))
135 (:arg-types signed-num
136 (:constant
(and (unsigned-byte 16) (not (integer 0 0)))))
137 (:results
(r :scs
(signed-reg)))
138 (:result-types signed-num
)
139 (:note
"inline (signed-byte 32) arithmetic"))
142 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
144 (defmacro define-var-binop
(translate untagged-penalty op
)
146 (define-vop (,(symbolicate "FAST-" translate
"/FIXNUM=>FIXNUM")
148 (:translate
,translate
)
151 (define-vop (,(symbolicate "FAST-" translate
"/SIGNED=>SIGNED")
153 (:translate
,translate
)
154 (:generator
,(1+ untagged-penalty
)
156 (define-vop (,(symbolicate "FAST-" translate
"/UNSIGNED=>UNSIGNED")
158 (:translate
,translate
)
159 (:generator
,(1+ untagged-penalty
)
163 (defmacro define-const-binop
(translate untagged-penalty op
)
166 (define-vop (,(symbolicate 'fast- translate
'-c
/fixnum
=>fixnum
)
168 (:translate
,translate
)
170 (inst ,op r x
(fixnumize y
))))
171 (define-vop (,(symbolicate 'fast- translate
'-c
/signed
=>signed
)
173 (:translate
,translate
)
174 (:generator
,untagged-penalty
176 (define-vop (,(symbolicate 'fast- translate
'-c
/unsigned
=>unsigned
)
177 fast-unsigned-binop-c
)
178 (:translate
,translate
)
179 (:generator
,untagged-penalty
182 (defmacro define-const-logop
(translate untagged-penalty op
)
185 (define-vop (,(symbolicate 'fast- translate
'-c
/fixnum
=>fixnum
)
187 (:translate
,translate
)
189 (inst ,op r x
(fixnumize y
))))
190 (define-vop (,(symbolicate 'fast- translate
'-c
/signed
=>signed
)
192 (:translate
,translate
)
193 (:generator
,untagged-penalty
195 (define-vop (,(symbolicate 'fast- translate
'-c
/unsigned
=>unsigned
)
196 fast-unsigned-logop-c
)
197 (:translate
,translate
)
198 (:generator
,untagged-penalty
203 (define-var-binop + 4 add
)
204 (define-var-binop -
4 sub
)
205 (define-var-binop logand
2 and
)
206 (define-var-binop logandc2
2 andc
)
207 (define-var-binop logior
2 or
)
208 (define-var-binop logorc2
2 orc
)
209 (define-var-binop logxor
2 xor
)
210 (define-var-binop logeqv
2 eqv
)
212 (define-const-binop + 4 addi
)
213 (define-const-binop -
4 subi
)
214 (define-const-logop logand
2 andi.
)
215 (define-const-logop logior
2 ori
)
216 (define-const-logop logxor
2 xori
)
219 ;;; Special case fixnum + and - that trap on overflow. Useful when we
220 ;;; don't know that the output type is a fixnum.
222 (define-vop (+/fixnum fast-
+/fixnum
=>fixnum
)
224 (:results
(r :scs
(any-reg descriptor-reg
)))
225 (:result-types tagged-num
)
226 (:note
"safe inline fixnum arithmetic")
228 (let* ((no-overflow (gen-label)))
231 (inst bns no-overflow
)
232 (inst unimp
(logior (ash (reg-tn-encoding r
) 5)
233 fixnum-additive-overflow-trap
))
234 (emit-label no-overflow
))))
237 (define-vop (-/fixnum fast--
/fixnum
=>fixnum
)
239 (:results
(r :scs
(any-reg descriptor-reg
)))
240 (:result-types tagged-num
)
241 (:note
"safe inline fixnum arithmetic")
243 (let* ((no-overflow (gen-label)))
246 (inst bns no-overflow
)
247 (inst unimp
(logior (ash (reg-tn-encoding r
) 5)
248 fixnum-additive-overflow-trap
))
249 (emit-label no-overflow
))))
254 (define-vop (fast-ash/unsigned
=>unsigned
)
256 (:args
(number :scs
(unsigned-reg) :to
:save
)
257 (amount :scs
(signed-reg immediate
)))
258 (:arg-types
(:or unsigned-num
) signed-num
)
259 (:results
(result :scs
(unsigned-reg)))
260 (:result-types unsigned-num
)
263 (:temporary
(:sc non-descriptor-reg
) ndesc
)
267 (let ((positive (gen-label))
269 (inst cmpwi amount
0)
270 (inst neg ndesc amount
)
272 (inst cmpwi ndesc
31)
273 (inst srw result number ndesc
)
275 (inst srwi result number
31)
278 (emit-label positive
)
279 ;; The result-type assures us that this shift will not overflow.
280 (inst slw result number amount
)
285 (let ((amount (tn-value amount
)))
287 (let ((amount (min 31 (- amount
))))
288 (inst srwi result number amount
))
289 (inst slwi result number amount
)))))))
292 (define-vop (fast-ash/signed
=>signed
)
294 (:args
(number :scs
(signed-reg) :to
:save
)
295 (amount :scs
(signed-reg immediate
)))
296 (:arg-types
(:or signed-num
) signed-num
)
297 (:results
(result :scs
(signed-reg)))
298 (:result-types
(:or signed-num
))
301 (:temporary
(:sc non-descriptor-reg
) ndesc
)
305 (let ((positive (gen-label))
307 (inst cmpwi amount
0)
308 (inst neg ndesc amount
)
310 (inst cmpwi ndesc
31)
311 (inst sraw result number ndesc
)
313 (inst srawi result number
31)
316 (emit-label positive
)
317 ;; The result-type assures us that this shift will not overflow.
318 (inst slw result number amount
)
323 (let ((amount (tn-value amount
)))
325 (let ((amount (min 31 (- amount
))))
326 (inst srawi result number amount
))
327 (inst slwi result number amount
)))))))
331 (define-vop (signed-byte-32-len)
332 (:translate integer-length
)
333 (:note
"inline (signed-byte 32) integer-length")
335 (:args
(arg :scs
(signed-reg)))
336 (:arg-types signed-num
)
337 (:results
(res :scs
(any-reg)))
338 (:result-types positive-fixnum
)
339 (:temporary
(:scs
(non-descriptor-reg) :to
(:argument
0)) shift
)
341 ; (integer-length arg) = (- 32 (cntlz (if (>= arg 0) arg (lognot arg))))
342 (let ((nonneg (gen-label)))
343 (inst cntlzw. shift arg
)
346 (inst cntlzw shift shift
)
348 (inst slwi shift shift
2)
349 (inst subfic res shift
(fixnumize 32)))))
351 (define-vop (unsigned-byte-32-count)
352 (:translate logcount
)
353 (:note
"inline (unsigned-byte 32) logcount")
355 (:args
(arg :scs
(unsigned-reg) :target shift
))
356 (:arg-types unsigned-num
)
357 (:results
(res :scs
(any-reg)))
358 (:result-types positive-fixnum
)
359 (:temporary
(:scs
(non-descriptor-reg) :from
(:argument
0)) shift temp
)
361 (let ((loop (gen-label))
363 (inst add. shift zero-tn arg
)
368 (inst subi temp shift
1)
369 (inst and. shift shift temp
)
370 (inst addi res res
(fixnumize 1))
376 ;;;; Binary conditional VOPs:
378 (define-vop (fast-conditional)
383 (:policy
:fast-safe
))
385 (define-vop (fast-conditional/fixnum fast-conditional
)
386 (:args
(x :scs
(any-reg zero
))
387 (y :scs
(any-reg zero
)))
388 (:arg-types tagged-num tagged-num
)
389 (:note
"inline fixnum comparison"))
391 (define-vop (fast-conditional-c/fixnum fast-conditional
/fixnum
)
392 (:args
(x :scs
(any-reg zero
)))
393 (:arg-types tagged-num
(:constant
(signed-byte 14)))
394 (:info target not-p y
))
396 (define-vop (fast-conditional/signed fast-conditional
)
397 (:args
(x :scs
(signed-reg zero
))
398 (y :scs
(signed-reg zero
)))
399 (:arg-types signed-num signed-num
)
400 (:note
"inline (signed-byte 32) comparison"))
402 (define-vop (fast-conditional-c/signed fast-conditional
/signed
)
403 (:args
(x :scs
(signed-reg zero
)))
404 (:arg-types signed-num
(:constant
(signed-byte 16)))
405 (:info target not-p y
))
407 (define-vop (fast-conditional/unsigned fast-conditional
)
408 (:args
(x :scs
(unsigned-reg zero
))
409 (y :scs
(unsigned-reg zero
)))
410 (:arg-types unsigned-num unsigned-num
)
411 (:note
"inline (unsigned-byte 32) comparison"))
413 (define-vop (fast-conditional-c/unsigned fast-conditional
/unsigned
)
414 (:args
(x :scs
(unsigned-reg zero
)))
415 (:arg-types unsigned-num
(:constant
(unsigned-byte 16)))
416 (:info target not-p y
))
419 (define-vop (fast-if-</fixnum fast-conditional
/fixnum
)
423 (inst b?
(if not-p
:ge
:lt
) target
)))
425 (define-vop (fast-if-<-c
/fixnum fast-conditional-c
/fixnum
)
428 (inst cmpwi x
(fixnumize y
))
429 (inst b?
(if not-p
:ge
:lt
) target
)))
431 (define-vop (fast-if-</signed fast-conditional
/signed
)
435 (inst b?
(if not-p
:ge
:lt
) target
)))
437 (define-vop (fast-if-<-c
/signed fast-conditional-c
/signed
)
441 (inst b?
(if not-p
:ge
:lt
) target
)))
443 (define-vop (fast-if-</unsigned fast-conditional
/unsigned
)
447 (inst b?
(if not-p
:ge
:lt
) target
)))
449 (define-vop (fast-if-<-c
/unsigned fast-conditional-c
/unsigned
)
453 (inst b?
(if not-p
:ge
:lt
) target
)))
455 (define-vop (fast-if->/fixnum fast-conditional
/fixnum
)
459 (inst b?
(if not-p
:le
:gt
) target
)))
461 (define-vop (fast-if->-c
/fixnum fast-conditional-c
/fixnum
)
464 (inst cmpwi x
(fixnumize y
))
465 (inst b?
(if not-p
:le
:gt
) target
)))
467 (define-vop (fast-if->/signed fast-conditional
/signed
)
471 (inst b?
(if not-p
:le
:gt
) target
)))
473 (define-vop (fast-if->-c
/signed fast-conditional-c
/signed
)
477 (inst b?
(if not-p
:le
:gt
) target
)))
479 (define-vop (fast-if->/unsigned fast-conditional
/unsigned
)
483 (inst b?
(if not-p
:le
:gt
) target
)))
485 (define-vop (fast-if->-c
/unsigned fast-conditional-c
/unsigned
)
489 (inst b?
(if not-p
:le
:gt
) target
)))
491 (define-vop (fast-if-eql/signed fast-conditional
/signed
)
495 (inst b?
(if not-p
:ne
:eq
) target
)))
497 (define-vop (fast-if-eql-c/signed fast-conditional-c
/signed
)
501 (inst b?
(if not-p
:ne
:eq
) target
)))
503 (define-vop (fast-if-eql/unsigned fast-conditional
/unsigned
)
507 (inst b?
(if not-p
:ne
:eq
) target
)))
509 (define-vop (fast-if-eql-c/unsigned fast-conditional-c
/unsigned
)
513 (inst b?
(if not-p
:ne
:eq
) target
)))
516 ;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a
519 ;;; These versions specify a fixnum restriction on their first arg. We have
520 ;;; also generic-eql/fixnum VOPs which are the same, but have no restriction on
521 ;;; the first arg and a higher cost. The reason for doing this is to prevent
522 ;;; fixnum specific operations from being used on word integers, spuriously
523 ;;; consing the argument.
526 (define-vop (fast-eql/fixnum fast-conditional
)
527 (:args
(x :scs
(any-reg descriptor-reg zero
))
528 (y :scs
(any-reg zero
)))
529 (:arg-types tagged-num tagged-num
)
530 (:note
"inline fixnum comparison")
534 (inst b?
(if not-p
:ne
:eq
) target
)))
536 (define-vop (generic-eql/fixnum fast-eql
/fixnum
)
537 (:arg-types
* tagged-num
)
540 (define-vop (fast-eql-c/fixnum fast-conditional
/fixnum
)
541 (:args
(x :scs
(any-reg descriptor-reg zero
)))
542 (:arg-types tagged-num
(:constant
(signed-byte 14)))
543 (:info target not-p y
)
546 (inst cmpwi x
(fixnumize y
))
547 (inst b?
(if not-p
:ne
:eq
) target
)))
549 (define-vop (generic-eql-c/fixnum fast-eql-c
/fixnum
)
550 (:arg-types
* (:constant
(signed-byte 11)))
554 ;;;; 32-bit logical operations
556 (define-vop (merge-bits)
557 (:translate merge-bits
)
558 (:args
(shift :scs
(signed-reg unsigned-reg
))
559 (prev :scs
(unsigned-reg))
560 (next :scs
(unsigned-reg)))
561 (:arg-types tagged-num unsigned-num unsigned-num
)
562 (:temporary
(:scs
(unsigned-reg) :to
(:result
0)) temp
)
563 (:temporary
(:scs
(unsigned-reg) :to
(:result
0) :target result
) res
)
564 (:results
(result :scs
(unsigned-reg)))
565 (:result-types unsigned-num
)
568 (let ((done (gen-label)))
571 (inst srw res next shift
)
572 (inst sub temp zero-tn shift
)
573 (inst slw temp prev temp
)
574 (inst or res res temp
)
579 (define-vop (32bit-logical)
580 (:args
(x :scs
(unsigned-reg zero
))
581 (y :scs
(unsigned-reg zero
)))
582 (:arg-types unsigned-num unsigned-num
)
583 (:results
(r :scs
(unsigned-reg)))
584 (:result-types unsigned-num
)
585 (:policy
:fast-safe
))
587 (define-vop (32bit-logical-not 32bit-logical
)
588 (:translate
32bit-logical-not
)
589 (:args
(x :scs
(unsigned-reg zero
)))
590 (:arg-types unsigned-num
)
594 (define-vop (32bit-logical-and 32bit-logical
)
595 (:translate
32bit-logical-and
)
599 (deftransform 32bit-logical-nand
((x y
) (* *))
600 '(32bit-logical-not (32bit-logical-and x y
)))
602 (define-vop (32bit-logical-or 32bit-logical
)
603 (:translate
32bit-logical-or
)
607 (deftransform 32bit-logical-nor
((x y
) (* *))
608 '(32bit-logical-not (32bit-logical-or x y
)))
610 (define-vop (32bit-logical-xor 32bit-logical
)
611 (:translate
32bit-logical-xor
)
615 (define-vop (32bit-logical-eqv 32bit-logical
)
616 (:translate
32bit-logical-eqv
)
620 (define-vop (32bit-logical-orc2 32bit-logical
)
621 (:translate
32bit-logical-orc2
)
625 (deftransform 32bit-logical-orc1
((x y
) (* *))
626 '(32bit-logical-orc2 y x
))
628 (define-vop (32bit-logical-andc2 32bit-logical
)
629 (:translate
32bit-logical-andc2
)
633 (deftransform 32bit-logical-andc1
((x y
) (* *))
634 '(32bit-logical-andc2 y x
))
637 (define-vop (shift-towards-someplace)
639 (:args
(num :scs
(unsigned-reg))
640 (amount :scs
(signed-reg)))
641 (:arg-types unsigned-num tagged-num
)
642 (:results
(r :scs
(unsigned-reg)))
643 (:result-types unsigned-num
))
645 (define-vop (shift-towards-start shift-towards-someplace
)
646 (:translate shift-towards-start
)
647 (:note
"shift-towards-start")
649 (inst rlwinm amount amount
0 27 31)
650 (inst slw r num amount
)))
652 (define-vop (shift-towards-end shift-towards-someplace
)
653 (:translate shift-towards-end
)
654 (:note
"shift-towards-end")
656 (inst rlwinm amount amount
0 27 31)
657 (inst srw r num amount
)))
664 (define-vop (bignum-length get-header-data
)
665 (:translate sb
!bignum
::%bignum-length
)
666 (:policy
:fast-safe
))
668 (define-vop (bignum-set-length set-header-data
)
669 (:translate sb
!bignum
::%bignum-set-length
)
670 (:policy
:fast-safe
))
672 (define-vop (bignum-ref word-index-ref
)
673 (:variant sb
!vm
:bignum-digits-offset sb
!vm
:other-pointer-lowtag
)
674 (:translate sb
!bignum
::%bignum-ref
)
675 (:results
(value :scs
(unsigned-reg)))
676 (:result-types unsigned-num
))
678 (define-vop (bignum-set word-index-set
)
679 (:variant sb
!vm
:bignum-digits-offset sb
!vm
:other-pointer-lowtag
)
680 (:translate sb
!bignum
::%bignum-set
)
681 (:args
(object :scs
(descriptor-reg))
682 (index :scs
(any-reg immediate zero
))
683 (value :scs
(unsigned-reg)))
684 (:arg-types t positive-fixnum unsigned-num
)
685 (:results
(result :scs
(unsigned-reg)))
686 (:result-types unsigned-num
))
688 (define-vop (digit-0-or-plus)
689 (:translate sb
!bignum
::%digit-0-or-plusp
)
691 (:args
(digit :scs
(unsigned-reg)))
692 (:arg-types unsigned-num
)
693 (:results
(result :scs
(descriptor-reg)))
695 (let ((done (gen-label)))
697 (move result null-tn
)
699 (load-symbol result t
)
702 (define-vop (add-w/carry
)
703 (:translate sb
!bignum
::%add-with-carry
)
705 (:args
(a :scs
(unsigned-reg))
706 (b :scs
(unsigned-reg))
708 (:arg-types unsigned-num unsigned-num positive-fixnum
)
709 (:temporary
(:scs
(unsigned-reg)) temp
)
710 (:results
(result :scs
(unsigned-reg))
711 (carry :scs
(unsigned-reg)))
712 (:result-types unsigned-num positive-fixnum
)
714 (inst addic temp c -
1)
715 (inst adde result a b
)
716 (inst addze carry zero-tn
)))
718 (define-vop (sub-w/borrow
)
719 (:translate sb
!bignum
::%subtract-with-borrow
)
721 (:args
(a :scs
(unsigned-reg))
722 (b :scs
(unsigned-reg))
724 (:arg-types unsigned-num unsigned-num positive-fixnum
)
725 (:temporary
(:scs
(unsigned-reg)) temp
)
726 (:results
(result :scs
(unsigned-reg))
727 (borrow :scs
(unsigned-reg)))
728 (:result-types unsigned-num positive-fixnum
)
730 (inst addic temp c -
1)
731 (inst sube result a b
)
732 (inst addze borrow zero-tn
)))
734 (define-vop (bignum-mult-and-add-3-arg)
735 (:translate sb
!bignum
::%multiply-and-add
)
737 (:args
(x :scs
(unsigned-reg))
738 (y :scs
(unsigned-reg))
739 (carry-in :scs
(unsigned-reg) :to
(:eval
1)))
740 (:arg-types unsigned-num unsigned-num unsigned-num
)
741 (:temporary
(:scs
(unsigned-reg) :to
(:result
0) :target hi
) hi-temp
)
742 (:temporary
(:scs
(unsigned-reg) :from
(:eval
0) :to
(:result
1)
744 (:results
(hi :scs
(unsigned-reg))
745 (lo :scs
(unsigned-reg)))
746 (:result-types unsigned-num unsigned-num
)
748 (inst mulhwu hi-temp x y
)
749 (inst mullw lo-temp x y
)
750 (inst addc lo lo-temp carry-in
)
751 (inst addze hi hi-temp
)))
753 (define-vop (bignum-mult-and-add-4-arg)
754 (:translate sb
!bignum
::%multiply-and-add
)
756 (:args
(x :scs
(unsigned-reg))
757 (y :scs
(unsigned-reg))
758 (prev :scs
(unsigned-reg) :to
(:eval
1))
759 (carry-in :scs
(unsigned-reg) :to
(:eval
1)))
760 (:arg-types unsigned-num unsigned-num unsigned-num unsigned-num
)
761 (:temporary
(:scs
(unsigned-reg) :to
(:result
0) :target hi
) hi-temp
)
762 (:temporary
(:scs
(unsigned-reg) :from
(:eval
0) :to
(:result
1)
764 (:results
(hi :scs
(unsigned-reg))
765 (lo :scs
(unsigned-reg)))
766 (:result-types unsigned-num unsigned-num
)
768 (inst mulhwu hi-temp x y
)
769 (inst mullw lo-temp x y
)
770 (inst addc lo-temp lo-temp carry-in
)
771 (inst addze hi-temp hi-temp
)
772 (inst addc lo lo-temp prev
)
773 (inst addze hi hi-temp
)))
775 (define-vop (bignum-mult)
776 (:translate sb
!bignum
::%multiply
)
778 (:args
(x :scs
(unsigned-reg) :to
(:result
1))
779 (y :scs
(unsigned-reg) :to
(:result
1)))
780 (:arg-types unsigned-num unsigned-num
)
781 (:results
(hi :scs
(unsigned-reg))
782 (lo :scs
(unsigned-reg)))
783 (:result-types unsigned-num unsigned-num
)
786 (inst mulhwu hi x y
)))
788 (define-vop (bignum-lognot)
789 (:translate sb
!bignum
::%lognot
)
791 (:args
(x :scs
(unsigned-reg)))
792 (:arg-types unsigned-num
)
793 (:results
(r :scs
(unsigned-reg)))
794 (:result-types unsigned-num
)
798 (define-vop (fixnum-to-digit)
799 (:translate sb
!bignum
::%fixnum-to-digit
)
801 (:args
(fixnum :scs
(any-reg)))
802 (:arg-types tagged-num
)
803 (:results
(digit :scs
(unsigned-reg)))
804 (:result-types unsigned-num
)
806 (inst srawi digit fixnum
2)))
809 (define-vop (bignum-floor)
810 (:translate sb
!bignum
::%floor
)
812 (:args
(num-high :scs
(unsigned-reg) :target rem
)
813 (num-low :scs
(unsigned-reg) :target rem-low
)
814 (denom :scs
(unsigned-reg) :to
(:eval
1)))
815 (:arg-types unsigned-num unsigned-num unsigned-num
)
816 (:temporary
(:scs
(unsigned-reg) :from
(:argument
1)) rem-low
)
817 (:temporary
(:scs
(unsigned-reg) :from
(:eval
0)) temp
)
818 (:results
(quo :scs
(unsigned-reg) :from
(:eval
0))
819 (rem :scs
(unsigned-reg) :from
(:argument
0)))
820 (:result-types unsigned-num unsigned-num
)
821 (:generator
325 ; number of inst assuming targeting works.
823 (move rem-low num-low
)
824 (flet ((maybe-subtract (&optional
(guess temp
))
825 (inst subi temp guess
1)
826 (inst and temp temp denom
)
827 (inst sub rem rem temp
))
830 (inst subfe res res res
)
835 (inst slwi rem rem
1)
836 (inst srwi temp rem-low
31)
837 (inst or rem rem temp
)
838 (inst slwi rem-low rem-low
1)
839 (sltu temp rem denom
)
840 (inst slwi quo quo
1)
841 (inst or quo quo temp
)
847 (define-vop (bignum-floor)
848 (:translate sb
!bignum
::%floor
)
850 (:args
(div-high :scs
(unsigned-reg) :target rem
)
851 (div-low :scs
(unsigned-reg) :target quo
)
852 (divisor :scs
(unsigned-reg)))
853 (:arg-types unsigned-num unsigned-num unsigned-num
)
854 (:results
(quo :scs
(unsigned-reg) :from
(:argument
1))
855 (rem :scs
(unsigned-reg) :from
(:argument
0)))
856 (:result-types unsigned-num unsigned-num
)
859 (inst div quo div-high divisor
)
863 (define-vop (signify-digit)
864 (:translate sb
!bignum
::%fixnum-digit-with-correct-sign
)
866 (:args
(digit :scs
(unsigned-reg) :target res
))
867 (:arg-types unsigned-num
)
868 (:results
(res :scs
(any-reg signed-reg
)))
869 (:result-types signed-num
)
873 (inst slwi res digit
2))
878 (define-vop (digit-ashr)
879 (:translate sb
!bignum
::%ashr
)
881 (:args
(digit :scs
(unsigned-reg))
882 (count :scs
(unsigned-reg)))
883 (:arg-types unsigned-num positive-fixnum
)
884 (:results
(result :scs
(unsigned-reg)))
885 (:result-types unsigned-num
)
887 (inst sraw result digit count
)))
889 (define-vop (digit-lshr digit-ashr
)
890 (:translate sb
!bignum
::%digit-logical-shift-right
)
892 (inst srw result digit count
)))
894 (define-vop (digit-ashl digit-ashr
)
895 (:translate sb
!bignum
::%ashl
)
897 (inst slw result digit count
)))
902 (define-static-fun two-arg-gcd
(x y
) :translate gcd
)
903 (define-static-fun two-arg-lcm
(x y
) :translate lcm
)
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
/)
910 (define-static-fun two-arg-
< (x y
) :translate
<)
911 (define-static-fun two-arg-
<= (x y
) :translate
<=)
912 (define-static-fun two-arg-
> (x y
) :translate
>)
913 (define-static-fun two-arg-
>= (x y
) :translate
>=)
914 (define-static-fun two-arg-
= (x y
) :translate
=)
915 (define-static-fun two-arg-
/= (x y
) :translate
/=)
917 (define-static-fun %negate
(x) :translate %negate
)
919 (define-static-fun two-arg-and
(x y
) :translate logand
)
920 (define-static-fun two-arg-ior
(x y
) :translate logior
)
921 (define-static-fun two-arg-xor
(x y
) :translate logxor
)