1 ;;;; the VM definition of arithmetic VOPs for the x86-64
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.
16 (define-vop (fast-safe-arith-op)
21 (define-vop (fixnum-unop fast-safe-arith-op)
22 (:args (x :scs (any-reg) :target res))
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) :target res))
30 (:results (res :scs (signed-reg)))
31 (:note "inline (signed-byte 64) arithmetic")
32 (:arg-types signed-num)
33 (:result-types signed-num))
35 (define-vop (fast-negate/fixnum fixnum-unop)
41 (define-vop (fast-negate/signed signed-unop)
47 (define-vop (fast-lognot/fixnum fixnum-unop)
51 (inst xor res (fixnumize -1))))
53 (define-vop (fast-lognot/signed signed-unop)
59 ;;;; binary fixnum operations
61 ;;; Assume that any constant operand is the second arg...
63 (define-vop (fast-fixnum-binop fast-safe-arith-op)
64 (:args (x :target r :scs (any-reg)
65 :load-if (not (and (sc-is x control-stack)
67 (sc-is r control-stack)
69 (y :scs (any-reg control-stack)))
70 (:arg-types tagged-num tagged-num)
71 (:results (r :scs (any-reg) :from (:argument 0)
72 :load-if (not (and (sc-is x control-stack)
74 (sc-is r control-stack)
76 (:result-types tagged-num)
77 (:note "inline fixnum arithmetic"))
79 (define-vop (fast-unsigned-binop fast-safe-arith-op)
80 (:args (x :target r :scs (unsigned-reg)
81 :load-if (not (and (sc-is x unsigned-stack)
82 (sc-is y unsigned-reg)
83 (sc-is r unsigned-stack)
85 (y :scs (unsigned-reg unsigned-stack)))
86 (:arg-types unsigned-num unsigned-num)
87 (:results (r :scs (unsigned-reg) :from (:argument 0)
88 :load-if (not (and (sc-is x unsigned-stack)
89 (sc-is y unsigned-reg)
90 (sc-is r unsigned-stack)
92 (:result-types unsigned-num)
93 (:note "inline (unsigned-byte 64) arithmetic"))
95 (define-vop (fast-signed-binop fast-safe-arith-op)
96 (:args (x :target r :scs (signed-reg)
97 :load-if (not (and (sc-is x signed-stack)
99 (sc-is r signed-stack)
101 (y :scs (signed-reg signed-stack)))
102 (:arg-types signed-num signed-num)
103 (:results (r :scs (signed-reg) :from (:argument 0)
104 :load-if (not (and (sc-is x signed-stack)
106 (sc-is r signed-stack)
108 (:result-types signed-num)
109 (:note "inline (signed-byte 64) arithmetic"))
111 (define-vop (fast-fixnum-binop-c fast-safe-arith-op)
112 (:args (x :target r :scs (any-reg control-stack)))
114 (:arg-types tagged-num (:constant (signed-byte 29)))
115 (:results (r :scs (any-reg)
116 :load-if (not (location= x r))))
117 (:result-types tagged-num)
118 (:note "inline fixnum arithmetic"))
120 ;; 31 not 64 because it's hard work loading 64 bit constants, and since
121 ;; sign-extension of immediates causes problems with 32.
122 (define-vop (fast-unsigned-binop-c fast-safe-arith-op)
123 (:args (x :target r :scs (unsigned-reg unsigned-stack)))
125 (:arg-types unsigned-num (:constant (unsigned-byte 31)))
126 (:results (r :scs (unsigned-reg)
127 :load-if (not (location= x r))))
128 (:result-types unsigned-num)
129 (:note "inline (unsigned-byte 64) arithmetic"))
131 (define-vop (fast-signed-binop-c fast-safe-arith-op)
132 (:args (x :target r :scs (signed-reg signed-stack)))
134 (:arg-types signed-num (:constant (signed-byte 32)))
135 (:results (r :scs (signed-reg)
136 :load-if (not (location= x r))))
137 (:result-types signed-num)
138 (:note "inline (signed-byte 64) arithmetic"))
140 (macrolet ((define-binop (translate untagged-penalty op)
142 (define-vop (,(symbolicate "FAST-" translate "/FIXNUM=>FIXNUM")
144 (:translate ,translate)
148 (define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum)
150 (:translate ,translate)
153 (inst ,op r (fixnumize y))))
154 (define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED")
156 (:translate ,translate)
157 (:generator ,(1+ untagged-penalty)
160 (define-vop (,(symbolicate 'fast- translate '-c/signed=>signed)
162 (:translate ,translate)
163 (:generator ,untagged-penalty
166 (define-vop (,(symbolicate "FAST-"
168 "/UNSIGNED=>UNSIGNED")
170 (:translate ,translate)
171 (:generator ,(1+ untagged-penalty)
174 (define-vop (,(symbolicate 'fast-
176 '-c/unsigned=>unsigned)
177 fast-unsigned-binop-c)
178 (:translate ,translate)
179 (:generator ,untagged-penalty
183 ;;(define-binop + 4 add)
184 (define-binop - 4 sub)
185 (define-binop logand 2 and)
186 (define-binop logior 2 or)
187 (define-binop logxor 2 xor))
189 ;;; Special handling of add on the x86; can use lea to avoid a
190 ;;; register load, otherwise it uses add.
191 (define-vop (fast-+/fixnum=>fixnum fast-safe-arith-op)
193 (:args (x :scs (any-reg) :target r
194 :load-if (not (and (sc-is x control-stack)
196 (sc-is r control-stack)
198 (y :scs (any-reg control-stack)))
199 (:arg-types tagged-num tagged-num)
200 (:results (r :scs (any-reg) :from (:argument 0)
201 :load-if (not (and (sc-is x control-stack)
203 (sc-is r control-stack)
205 (:result-types tagged-num)
206 (:note "inline fixnum arithmetic")
208 (cond ((and (sc-is x any-reg) (sc-is y any-reg) (sc-is r any-reg)
209 (not (location= x r)))
210 (inst lea r (make-ea :qword :base x :index y :scale 1)))
215 (define-vop (fast-+-c/fixnum=>fixnum fast-safe-arith-op)
217 (:args (x :target r :scs (any-reg control-stack)))
219 (:arg-types tagged-num (:constant (signed-byte 29)))
220 (:results (r :scs (any-reg)
221 :load-if (not (location= x r))))
222 (:result-types tagged-num)
223 (:note "inline fixnum arithmetic")
225 (cond ((and (sc-is x any-reg) (sc-is r any-reg) (not (location= x r)))
226 (inst lea r (make-ea :qword :base x :disp (fixnumize y))))
229 (inst add r (fixnumize y))))))
231 (define-vop (fast-+/signed=>signed fast-safe-arith-op)
233 (:args (x :scs (signed-reg) :target r
234 :load-if (not (and (sc-is x signed-stack)
236 (sc-is r signed-stack)
238 (y :scs (signed-reg signed-stack)))
239 (:arg-types signed-num signed-num)
240 (:results (r :scs (signed-reg) :from (:argument 0)
241 :load-if (not (and (sc-is x signed-stack)
244 (:result-types signed-num)
245 (:note "inline (signed-byte 64) arithmetic")
247 (cond ((and (sc-is x signed-reg) (sc-is y signed-reg) (sc-is r signed-reg)
248 (not (location= x r)))
249 (inst lea r (make-ea :qword :base x :index y :scale 1)))
255 ;;;; Special logand cases: (logand signed unsigned) => unsigned
257 (define-vop (fast-logand/signed-unsigned=>unsigned
258 fast-logand/unsigned=>unsigned)
259 (:args (x :target r :scs (signed-reg)
260 :load-if (not (and (sc-is x signed-stack)
261 (sc-is y unsigned-reg)
262 (sc-is r unsigned-stack)
264 (y :scs (unsigned-reg unsigned-stack)))
265 (:arg-types signed-num unsigned-num))
267 (define-vop (fast-logand-c/signed-unsigned=>unsigned
268 fast-logand-c/unsigned=>unsigned)
269 (:args (x :target r :scs (signed-reg signed-stack)))
270 (:arg-types signed-num (:constant (unsigned-byte 31))))
272 (define-vop (fast-logand/unsigned-signed=>unsigned
273 fast-logand/unsigned=>unsigned)
274 (:args (x :target r :scs (unsigned-reg)
275 :load-if (not (and (sc-is x unsigned-stack)
277 (sc-is r unsigned-stack)
279 (y :scs (signed-reg signed-stack)))
280 (:arg-types unsigned-num signed-num))
283 (define-vop (fast-+-c/signed=>signed fast-safe-arith-op)
285 (:args (x :target r :scs (signed-reg signed-stack)))
287 (:arg-types signed-num (:constant (signed-byte 32)))
288 (:results (r :scs (signed-reg)
289 :load-if (not (location= x r))))
290 (:result-types signed-num)
291 (:note "inline (signed-byte 64) arithmetic")
293 (cond ((and (sc-is x signed-reg) (sc-is r signed-reg)
294 (not (location= x r)))
295 (inst lea r (make-ea :qword :base x :disp y)))
302 (define-vop (fast-+/unsigned=>unsigned fast-safe-arith-op)
304 (:args (x :scs (unsigned-reg) :target r
305 :load-if (not (and (sc-is x unsigned-stack)
306 (sc-is y unsigned-reg)
307 (sc-is r unsigned-stack)
309 (y :scs (unsigned-reg unsigned-stack)))
310 (:arg-types unsigned-num unsigned-num)
311 (:results (r :scs (unsigned-reg) :from (:argument 0)
312 :load-if (not (and (sc-is x unsigned-stack)
313 (sc-is y unsigned-reg)
314 (sc-is r unsigned-stack)
316 (:result-types unsigned-num)
317 (:note "inline (unsigned-byte 64) arithmetic")
319 (cond ((and (sc-is x unsigned-reg) (sc-is y unsigned-reg)
320 (sc-is r unsigned-reg) (not (location= x r)))
321 (inst lea r (make-ea :qword :base x :index y :scale 1)))
326 (define-vop (fast-+-c/unsigned=>unsigned fast-safe-arith-op)
328 (:args (x :target r :scs (unsigned-reg unsigned-stack)))
330 (:arg-types unsigned-num (:constant (unsigned-byte 31)))
331 (:results (r :scs (unsigned-reg)
332 :load-if (not (location= x r))))
333 (:result-types unsigned-num)
334 (:note "inline (unsigned-byte 64) arithmetic")
336 (cond ((and (sc-is x unsigned-reg) (sc-is r unsigned-reg)
337 (not (location= x r)))
338 (inst lea r (make-ea :qword :base x :disp y)))
345 ;;;; multiplication and division
347 (define-vop (fast-*/fixnum=>fixnum fast-safe-arith-op)
349 ;; We need different loading characteristics.
350 (:args (x :scs (any-reg) :target r)
351 (y :scs (any-reg control-stack)))
352 (:arg-types tagged-num tagged-num)
353 (:results (r :scs (any-reg) :from (:argument 0)))
354 (:result-types tagged-num)
355 (:note "inline fixnum arithmetic")
361 (define-vop (fast-*-c/fixnum=>fixnum fast-safe-arith-op)
363 ;; We need different loading characteristics.
364 (:args (x :scs (any-reg control-stack)))
366 (:arg-types tagged-num (:constant (signed-byte 29)))
367 (:results (r :scs (any-reg)))
368 (:result-types tagged-num)
369 (:note "inline fixnum arithmetic")
373 (define-vop (fast-*/signed=>signed fast-safe-arith-op)
375 ;; We need different loading characteristics.
376 (:args (x :scs (signed-reg) :target r)
377 (y :scs (signed-reg signed-stack)))
378 (:arg-types signed-num signed-num)
379 (:results (r :scs (signed-reg) :from (:argument 0)))
380 (:result-types signed-num)
381 (:note "inline (signed-byte 64) arithmetic")
386 (define-vop (fast-*-c/signed=>signed fast-safe-arith-op)
388 ;; We need different loading characteristics.
389 (:args (x :scs (signed-reg signed-stack)))
391 (:arg-types signed-num (:constant (signed-byte 32)))
392 (:results (r :scs (signed-reg)))
393 (:result-types signed-num)
394 (:note "inline (signed-byte 64) arithmetic")
398 (define-vop (fast-*/unsigned=>unsigned fast-safe-arith-op)
400 (:args (x :scs (unsigned-reg) :target eax)
401 (y :scs (unsigned-reg unsigned-stack)))
402 (:arg-types unsigned-num unsigned-num)
403 (:temporary (:sc unsigned-reg :offset eax-offset :target r
404 :from (:argument 0) :to :result) eax)
405 (:temporary (:sc unsigned-reg :offset edx-offset
406 :from :eval :to :result) edx)
408 (:results (r :scs (unsigned-reg)))
409 (:result-types unsigned-num)
410 (:note "inline (unsigned-byte 64) arithmetic")
412 (:save-p :compute-only)
419 (define-vop (fast-truncate/fixnum=>fixnum fast-safe-arith-op)
420 (:translate truncate)
421 (:args (x :scs (any-reg) :target eax)
422 (y :scs (any-reg control-stack)))
423 (:arg-types tagged-num tagged-num)
424 (:temporary (:sc signed-reg :offset eax-offset :target quo
425 :from (:argument 0) :to (:result 0)) eax)
426 (:temporary (:sc unsigned-reg :offset edx-offset :target rem
427 :from (:argument 0) :to (:result 1)) edx)
428 (:results (quo :scs (any-reg))
429 (rem :scs (any-reg)))
430 (:result-types tagged-num tagged-num)
431 (:note "inline fixnum arithmetic")
433 (:save-p :compute-only)
435 (let ((zero (generate-error-code vop 'division-by-zero-error x y)))
436 (if (sc-is y any-reg)
437 (inst test y y) ; smaller instruction
443 (if (location= quo eax)
445 (inst lea quo (make-ea :qword :index eax :scale 8)))
448 (define-vop (fast-truncate-c/fixnum=>fixnum fast-safe-arith-op)
449 (:translate truncate)
450 (:args (x :scs (any-reg) :target eax))
452 (:arg-types tagged-num (:constant (signed-byte 29)))
453 (:temporary (:sc signed-reg :offset eax-offset :target quo
454 :from :argument :to (:result 0)) eax)
455 (:temporary (:sc any-reg :offset edx-offset :target rem
456 :from :eval :to (:result 1)) edx)
457 (:temporary (:sc any-reg :from :eval :to :result) y-arg)
458 (:results (quo :scs (any-reg))
459 (rem :scs (any-reg)))
460 (:result-types tagged-num tagged-num)
461 (:note "inline fixnum arithmetic")
463 (:save-p :compute-only)
467 (inst mov y-arg (fixnumize y))
468 (inst idiv eax y-arg)
469 (if (location= quo eax)
471 (inst lea quo (make-ea :qword :index eax :scale 8)))
474 (define-vop (fast-truncate/unsigned=>unsigned fast-safe-arith-op)
475 (:translate truncate)
476 (:args (x :scs (unsigned-reg) :target eax)
477 (y :scs (unsigned-reg signed-stack)))
478 (:arg-types unsigned-num unsigned-num)
479 (:temporary (:sc unsigned-reg :offset eax-offset :target quo
480 :from (:argument 0) :to (:result 0)) eax)
481 (:temporary (:sc unsigned-reg :offset edx-offset :target rem
482 :from (:argument 0) :to (:result 1)) edx)
483 (:results (quo :scs (unsigned-reg))
484 (rem :scs (unsigned-reg)))
485 (:result-types unsigned-num unsigned-num)
486 (:note "inline (unsigned-byte 64) arithmetic")
488 (:save-p :compute-only)
490 (let ((zero (generate-error-code vop 'division-by-zero-error x y)))
491 (if (sc-is y unsigned-reg)
492 (inst test y y) ; smaller instruction
501 (define-vop (fast-truncate-c/unsigned=>unsigned fast-safe-arith-op)
502 (:translate truncate)
503 (:args (x :scs (unsigned-reg) :target eax))
505 (:arg-types unsigned-num (:constant (unsigned-byte 31)))
506 (:temporary (:sc unsigned-reg :offset eax-offset :target quo
507 :from :argument :to (:result 0)) eax)
508 (:temporary (:sc unsigned-reg :offset edx-offset :target rem
509 :from :eval :to (:result 1)) edx)
510 (:temporary (:sc unsigned-reg :from :eval :to :result) y-arg)
511 (:results (quo :scs (unsigned-reg))
512 (rem :scs (unsigned-reg)))
513 (:result-types unsigned-num unsigned-num)
514 (:note "inline (unsigned-byte 64) arithmetic")
516 (:save-p :compute-only)
525 (define-vop (fast-truncate/signed=>signed fast-safe-arith-op)
526 (:translate truncate)
527 (:args (x :scs (signed-reg) :target eax)
528 (y :scs (signed-reg signed-stack)))
529 (:arg-types signed-num signed-num)
530 (:temporary (:sc signed-reg :offset eax-offset :target quo
531 :from (:argument 0) :to (:result 0)) eax)
532 (:temporary (:sc signed-reg :offset edx-offset :target rem
533 :from (:argument 0) :to (:result 1)) edx)
534 (:results (quo :scs (signed-reg))
535 (rem :scs (signed-reg)))
536 (:result-types signed-num signed-num)
537 (:note "inline (signed-byte 64) arithmetic")
539 (:save-p :compute-only)
541 (let ((zero (generate-error-code vop 'division-by-zero-error x y)))
542 (if (sc-is y signed-reg)
543 (inst test y y) ; smaller instruction
552 (define-vop (fast-truncate-c/signed=>signed fast-safe-arith-op)
553 (:translate truncate)
554 (:args (x :scs (signed-reg) :target eax))
556 (:arg-types signed-num (:constant (signed-byte 32)))
557 (:temporary (:sc signed-reg :offset eax-offset :target quo
558 :from :argument :to (:result 0)) eax)
559 (:temporary (:sc signed-reg :offset edx-offset :target rem
560 :from :eval :to (:result 1)) edx)
561 (:temporary (:sc signed-reg :from :eval :to :result) y-arg)
562 (:results (quo :scs (signed-reg))
563 (rem :scs (signed-reg)))
564 (:result-types signed-num signed-num)
565 (:note "inline (signed-byte 64) arithmetic")
567 (:save-p :compute-only)
572 (inst idiv eax y-arg)
579 (define-vop (fast-ash-c/fixnum=>fixnum)
582 (:args (number :scs (any-reg) :target result
583 :load-if (not (and (sc-is number any-reg control-stack)
584 (sc-is result any-reg control-stack)
585 (location= number result)))))
587 (:arg-types tagged-num (:constant integer))
588 (:results (result :scs (any-reg)
589 :load-if (not (and (sc-is number control-stack)
590 (sc-is result control-stack)
591 (location= number result)))))
592 (:result-types tagged-num)
595 (cond ((and (= amount 1) (not (location= number result)))
596 (inst lea result (make-ea :qword :base number :index number)))
597 ((and (= amount 2) (not (location= number result)))
598 (inst lea result (make-ea :qword :index number :scale 4)))
599 ((and (= amount 3) (not (location= number result)))
600 (inst lea result (make-ea :qword :index number :scale 8)))
603 (cond ((< -64 amount 64)
604 ;; this code is used both in ASH and ASH-SMOD61, so
607 (inst shl result amount)
609 (inst sar result (- amount))
610 (inst and result (lognot fixnum-tag-mask)))))
612 (if (sc-is result any-reg)
613 (inst xor result result)
614 (inst mov result 0)))
615 (t (inst sar result 63)
616 (inst and result (lognot fixnum-tag-mask))))))))
618 (define-vop (fast-ash-left/fixnum=>fixnum)
620 (:args (number :scs (any-reg) :target result
621 :load-if (not (and (sc-is number control-stack)
622 (sc-is result control-stack)
623 (location= number result))))
624 (amount :scs (unsigned-reg) :target ecx))
625 (:arg-types tagged-num positive-fixnum)
626 (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1)) ecx)
627 (:results (result :scs (any-reg) :from (:argument 0)
628 :load-if (not (and (sc-is number control-stack)
629 (sc-is result control-stack)
630 (location= number result)))))
631 (:result-types tagged-num)
637 ;; The result-type ensures us that this shift will not overflow.
638 (inst shl result :cl)))
640 (define-vop (fast-ash-c/signed=>signed)
643 (:args (number :scs (signed-reg) :target result
644 :load-if (not (and (sc-is number signed-stack)
645 (sc-is result signed-stack)
646 (location= number result)))))
648 (:arg-types signed-num (:constant integer))
649 (:results (result :scs (signed-reg)
650 :load-if (not (and (sc-is number signed-stack)
651 (sc-is result signed-stack)
652 (location= number result)))))
653 (:result-types signed-num)
656 (cond ((and (= amount 1) (not (location= number result)))
657 (inst lea result (make-ea :qword :base number :index number)))
658 ((and (= amount 2) (not (location= number result)))
659 (inst lea result (make-ea :qword :index number :scale 4)))
660 ((and (= amount 3) (not (location= number result)))
661 (inst lea result (make-ea :qword :index number :scale 8)))
664 (cond ((plusp amount) (inst shl result amount))
665 (t (inst sar result (min 63 (- amount)))))))))
667 (define-vop (fast-ash-c/unsigned=>unsigned)
670 (:args (number :scs (unsigned-reg) :target result
671 :load-if (not (and (sc-is number unsigned-stack)
672 (sc-is result unsigned-stack)
673 (location= number result)))))
675 (:arg-types unsigned-num (:constant integer))
676 (:results (result :scs (unsigned-reg)
677 :load-if (not (and (sc-is number unsigned-stack)
678 (sc-is result unsigned-stack)
679 (location= number result)))))
680 (:result-types unsigned-num)
683 (cond ((and (= amount 1) (not (location= number result)))
684 (inst lea result (make-ea :qword :base number :index number)))
685 ((and (= amount 2) (not (location= number result)))
686 (inst lea result (make-ea :qword :index number :scale 4)))
687 ((and (= amount 3) (not (location= number result)))
688 (inst lea result (make-ea :qword :index number :scale 8)))
691 (cond ((< -64 amount 64) ;; XXXX
692 ;; this code is used both in ASH and ASH-MOD32, so
695 (inst shl result amount)
696 (inst shr result (- amount))))
697 (t (if (sc-is result unsigned-reg)
699 (inst mov result 0))))))))
701 (define-vop (fast-ash-left/signed=>signed)
703 (:args (number :scs (signed-reg) :target result
704 :load-if (not (and (sc-is number signed-stack)
705 (sc-is result signed-stack)
706 (location= number result))))
707 (amount :scs (unsigned-reg) :target ecx))
708 (:arg-types signed-num positive-fixnum)
709 (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1)) ecx)
710 (:results (result :scs (signed-reg) :from (:argument 0)
711 :load-if (not (and (sc-is number signed-stack)
712 (sc-is result signed-stack)
713 (location= number result)))))
714 (:result-types signed-num)
720 (inst shl result :cl)))
722 (define-vop (fast-ash-left/unsigned=>unsigned)
724 (:args (number :scs (unsigned-reg) :target result
725 :load-if (not (and (sc-is number unsigned-stack)
726 (sc-is result unsigned-stack)
727 (location= number result))))
728 (amount :scs (unsigned-reg) :target ecx))
729 (:arg-types unsigned-num positive-fixnum)
730 (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1)) ecx)
731 (:results (result :scs (unsigned-reg) :from (:argument 0)
732 :load-if (not (and (sc-is number unsigned-stack)
733 (sc-is result unsigned-stack)
734 (location= number result)))))
735 (:result-types unsigned-num)
741 (inst shl result :cl)))
743 (define-vop (fast-ash/signed=>signed)
746 (:args (number :scs (signed-reg) :target result)
747 (amount :scs (signed-reg) :target ecx))
748 (:arg-types signed-num signed-num)
749 (:results (result :scs (signed-reg) :from (:argument 0)))
750 (:result-types signed-num)
751 (:temporary (:sc signed-reg :offset ecx-offset :from (:argument 1)) ecx)
757 (inst jmp :ns POSITIVE)
763 (inst sar result :cl)
767 ;; The result-type ensures us that this shift will not overflow.
768 (inst shl result :cl)
772 (define-vop (fast-ash/unsigned=>unsigned)
775 (:args (number :scs (unsigned-reg) :target result)
776 (amount :scs (signed-reg) :target ecx))
777 (:arg-types unsigned-num signed-num)
778 (:results (result :scs (unsigned-reg) :from (:argument 0)))
779 (:result-types unsigned-num)
780 (:temporary (:sc signed-reg :offset ecx-offset :from (:argument 1)) ecx)
786 (inst jmp :ns POSITIVE)
793 (inst shr result :cl)
797 ;; The result-type ensures us that this shift will not overflow.
798 (inst shl result :cl)
804 (defknown %lea (integer integer (member 1 2 4 8 16) (signed-byte 64))
806 (foldable flushable movable))
808 (defoptimizer (%lea derive-type) ((base index scale disp))
809 (when (and (constant-lvar-p scale)
810 (constant-lvar-p disp))
811 (let ((scale (lvar-value scale))
812 (disp (lvar-value disp))
813 (base-type (lvar-type base))
814 (index-type (lvar-type index)))
815 (when (and (numeric-type-p base-type)
816 (numeric-type-p index-type))
817 (let ((base-lo (numeric-type-low base-type))
818 (base-hi (numeric-type-high base-type))
819 (index-lo (numeric-type-low index-type))
820 (index-hi (numeric-type-high index-type)))
821 (make-numeric-type :class 'integer
823 :low (when (and base-lo index-lo)
824 (+ base-lo (* index-lo scale) disp))
825 :high (when (and base-hi index-hi)
826 (+ base-hi (* index-hi scale) disp))))))))
828 (defun %lea (base index scale disp)
829 (+ base (* index scale) disp))
833 (define-vop (%lea/unsigned=>unsigned)
836 (:args (base :scs (unsigned-reg))
837 (index :scs (unsigned-reg)))
839 (:arg-types unsigned-num unsigned-num
840 (:constant (member 1 2 4 8))
841 (:constant (signed-byte 64)))
842 (:results (r :scs (unsigned-reg)))
843 (:result-types unsigned-num)
845 (inst lea r (make-ea :qword :base base :index index
846 :scale scale :disp disp))))
848 (define-vop (%lea/signed=>signed)
851 (:args (base :scs (signed-reg))
852 (index :scs (signed-reg)))
854 (:arg-types signed-num signed-num
855 (:constant (member 1 2 4 8))
856 (:constant (signed-byte 64)))
857 (:results (r :scs (signed-reg)))
858 (:result-types signed-num)
860 (inst lea r (make-ea :qword :base base :index index
861 :scale scale :disp disp))))
863 (define-vop (%lea/fixnum=>fixnum)
866 (:args (base :scs (any-reg))
867 (index :scs (any-reg)))
869 (:arg-types tagged-num tagged-num
870 (:constant (member 1 2 4 8))
871 (:constant (signed-byte 64)))
872 (:results (r :scs (any-reg)))
873 (:result-types tagged-num)
875 (inst lea r (make-ea :qword :base base :index index
876 :scale scale :disp disp))))
878 ;;; FIXME: before making knowledge of this too public, it needs to be
879 ;;; fixed so that it's actually _faster_ than the non-CMOV version; at
880 ;;; least on my Celeron-XXX laptop, this version is marginally slower
881 ;;; than the above version with branches. -- CSR, 2003-09-04
882 (define-vop (fast-cmov-ash/unsigned=>unsigned)
885 (:args (number :scs (unsigned-reg) :target result)
886 (amount :scs (signed-reg) :target ecx))
887 (:arg-types unsigned-num signed-num)
888 (:results (result :scs (unsigned-reg) :from (:argument 0)))
889 (:result-types unsigned-num)
890 (:temporary (:sc signed-reg :offset ecx-offset :from (:argument 1)) ecx)
891 (:temporary (:sc any-reg :from (:eval 0) :to (:eval 1)) zero)
893 (:guard (member :cmov *backend-subfeatures*))
898 (inst jmp :ns POSITIVE)
901 (inst shr result :cl)
903 (inst cmov :nbe result zero)
907 ;; The result-type ensures us that this shift will not overflow.
908 (inst shl result :cl)
912 (define-vop (signed-byte-64-len)
913 (:translate integer-length)
914 (:note "inline (signed-byte 64) integer-length")
916 (:args (arg :scs (signed-reg) :target res))
917 (:arg-types signed-num)
918 (:results (res :scs (unsigned-reg)))
919 (:result-types unsigned-num)
922 (if (sc-is res unsigned-reg)
936 (define-vop (unsigned-byte-64-len)
937 (:translate integer-length)
938 (:note "inline (unsigned-byte 64) integer-length")
940 (:args (arg :scs (unsigned-reg)))
941 (:arg-types unsigned-num)
942 (:results (res :scs (unsigned-reg)))
943 (:result-types unsigned-num)
953 (define-vop (unsigned-byte-64-count)
954 (:translate logcount)
955 (:note "inline (unsigned-byte 64) logcount")
957 (:args (arg :scs (unsigned-reg) :target result))
958 (:arg-types unsigned-num)
959 (:results (result :scs (unsigned-reg)))
960 (:result-types positive-fixnum)
961 (:temporary (:sc unsigned-reg) temp)
962 (:temporary (:sc unsigned-reg) mask)
964 ;; See the comments below for how the algorithm works. The tricks
965 ;; used can be found for example in AMD's software optimization
966 ;; guide or at "http://www.hackersdelight.org/HDcode/pop.cc" in the
967 ;; function "pop1", for 32-bit words. The extension to 64 bits is
969 ;; Calculate 2-bit sums. Note that the value of a two-digit binary
970 ;; number is the sum of the right digit and twice the left digit.
971 ;; Thus we can calculate the sum of the two digits by shifting the
972 ;; left digit to the right position and doing a two-bit subtraction.
973 ;; This subtraction will never create a borrow and thus can be made
974 ;; on all 32 2-digit numbers at once.
978 (inst mov mask #x5555555555555555)
979 (inst and result mask)
980 (inst sub temp result)
981 ;; Calculate 4-bit sums by straightforward shift, mask and add.
982 ;; Note that we shift the source operand of the MOV and not its
983 ;; destination so that the SHR and the MOV can execute in the same
985 (inst mov result temp)
987 (inst mov mask #x3333333333333333)
988 (inst and result mask)
990 (inst add result temp)
991 ;; Calculate 8-bit sums. Since each sum is at most 8, which fits
992 ;; into 4 bits, we can apply the mask after the addition, saving one
994 (inst mov temp result)
996 (inst add result temp)
997 (inst mov mask #x0f0f0f0f0f0f0f0f)
998 (inst and result mask)
999 ;; Add all 8 bytes at once by multiplying with #256r11111111.
1000 ;; We need to calculate only the lower 8 bytes of the product.
1001 ;; Of these the most significant byte contains the final result.
1002 ;; Note that there can be no overflow from one byte to the next
1003 ;; as the sum is at most 64 which needs only 7 bits.
1004 (inst mov mask #x0101010101010101)
1005 (inst imul result mask)
1006 (inst shr result 56)))
1008 ;;;; binary conditional VOPs
1010 (define-vop (fast-conditional)
1015 (:policy :fast-safe))
1017 ;;; constant variants are declared for 32 bits not 64 bits, because
1018 ;;; loading a 64 bit constant is silly
1020 (define-vop (fast-conditional/fixnum fast-conditional)
1021 (:args (x :scs (any-reg)
1022 :load-if (not (and (sc-is x control-stack)
1023 (sc-is y any-reg))))
1024 (y :scs (any-reg control-stack)))
1025 (:arg-types tagged-num tagged-num)
1026 (:note "inline fixnum comparison"))
1028 (define-vop (fast-conditional-c/fixnum fast-conditional/fixnum)
1029 (:args (x :scs (any-reg control-stack)))
1030 (:arg-types tagged-num (:constant (signed-byte 29)))
1033 (define-vop (fast-conditional/signed fast-conditional)
1034 (:args (x :scs (signed-reg)
1035 :load-if (not (and (sc-is x signed-stack)
1036 (sc-is y signed-reg))))
1037 (y :scs (signed-reg signed-stack)))
1038 (:arg-types signed-num signed-num)
1039 (:note "inline (signed-byte 64) comparison"))
1041 (define-vop (fast-conditional-c/signed fast-conditional/signed)
1042 (:args (x :scs (signed-reg signed-stack)))
1043 (:arg-types signed-num (:constant (signed-byte 31)))
1046 (define-vop (fast-conditional/unsigned fast-conditional)
1047 (:args (x :scs (unsigned-reg)
1048 :load-if (not (and (sc-is x unsigned-stack)
1049 (sc-is y unsigned-reg))))
1050 (y :scs (unsigned-reg unsigned-stack)))
1051 (:arg-types unsigned-num unsigned-num)
1052 (:note "inline (unsigned-byte 64) comparison"))
1054 (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned)
1055 (:args (x :scs (unsigned-reg unsigned-stack)))
1056 (:arg-types unsigned-num (:constant (unsigned-byte 31)))
1059 (macrolet ((define-conditional-vop (tran cond unsigned not-cond not-unsigned)
1062 (lambda (suffix cost signed)
1063 `(define-vop (;; FIXME: These could be done more
1064 ;; cleanly with SYMBOLICATE.
1065 ,(intern (format nil "~:@(FAST-IF-~A~A~)"
1068 (format nil "~:@(FAST-CONDITIONAL~A~)"
1071 (:conditional ,(if signed cond unsigned))
1074 ,(if (eq suffix '-c/fixnum)
1077 '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned)
1078 ; '(/fixnum /signed /unsigned)
1080 '(t t t t nil nil)))))
1082 (define-conditional-vop < :l :b :ge :ae)
1083 (define-conditional-vop > :g :a :le :be))
1085 (define-vop (fast-if-eql/signed fast-conditional/signed)
1090 (define-vop (fast-if-eql-c/signed fast-conditional-c/signed)
1093 (cond ((and (sc-is x signed-reg) (zerop y))
1094 (inst test x x)) ; smaller instruction
1098 (define-vop (fast-if-eql/unsigned fast-conditional/unsigned)
1103 (define-vop (fast-if-eql-c/unsigned fast-conditional-c/unsigned)
1106 (cond ((and (sc-is x unsigned-reg) (zerop y))
1107 (inst test x x)) ; smaller instruction
1111 ;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a
1114 ;;; These versions specify a fixnum restriction on their first arg. We have
1115 ;;; also generic-eql/fixnum VOPs which are the same, but have no restriction on
1116 ;;; the first arg and a higher cost. The reason for doing this is to prevent
1117 ;;; fixnum specific operations from being used on word integers, spuriously
1118 ;;; consing the argument.
1120 (define-vop (fast-eql/fixnum fast-conditional)
1121 (:args (x :scs (any-reg)
1122 :load-if (not (and (sc-is x control-stack)
1123 (sc-is y any-reg))))
1124 (y :scs (any-reg control-stack)))
1125 (:arg-types tagged-num tagged-num)
1126 (:note "inline fixnum comparison")
1131 (define-vop (generic-eql/fixnum fast-eql/fixnum)
1132 (:args (x :scs (any-reg descriptor-reg)
1133 :load-if (not (and (sc-is x control-stack)
1134 (sc-is y any-reg))))
1135 (y :scs (any-reg control-stack)))
1136 (:arg-types * tagged-num)
1139 (define-vop (fast-eql-c/fixnum fast-conditional/fixnum)
1140 (:args (x :scs (any-reg control-stack)))
1141 (:arg-types tagged-num (:constant (signed-byte 29)))
1145 (cond ((and (sc-is x any-reg) (zerop y))
1146 (inst test x x)) ; smaller instruction
1148 (inst cmp x (fixnumize y))))))
1150 (define-vop (generic-eql-c/fixnum fast-eql-c/fixnum)
1151 (:args (x :scs (any-reg descriptor-reg control-stack)))
1152 (:arg-types * (:constant (signed-byte 29)))
1155 ;;;; 32-bit logical operations
1157 ;;; Only the lower 6 bits of the shift amount are significant.
1158 (define-vop (shift-towards-someplace)
1159 (:policy :fast-safe)
1160 (:args (num :scs (unsigned-reg) :target r)
1161 (amount :scs (signed-reg) :target ecx))
1162 (:arg-types unsigned-num tagged-num)
1163 (:temporary (:sc signed-reg :offset ecx-offset :from (:argument 1)) ecx)
1164 (:results (r :scs (unsigned-reg) :from (:argument 0)))
1165 (:result-types unsigned-num))
1167 (define-vop (shift-towards-start shift-towards-someplace)
1168 (:translate shift-towards-start)
1169 (:note "SHIFT-TOWARDS-START")
1175 (define-vop (shift-towards-end shift-towards-someplace)
1176 (:translate shift-towards-end)
1177 (:note "SHIFT-TOWARDS-END")
1183 ;;;; Modular functions
1185 (defmacro define-mod-binop ((name prototype) function)
1186 `(define-vop (,name ,prototype)
1187 (:args (x :target r :scs (unsigned-reg signed-reg)
1188 :load-if (not (and (or (sc-is x unsigned-stack)
1189 (sc-is x signed-stack))
1190 (or (sc-is y unsigned-reg)
1191 (sc-is y signed-reg))
1192 (or (sc-is r unsigned-stack)
1193 (sc-is r signed-stack))
1195 (y :scs (unsigned-reg signed-reg unsigned-stack signed-stack)))
1196 (:arg-types untagged-num untagged-num)
1197 (:results (r :scs (unsigned-reg signed-reg) :from (:argument 0)
1198 :load-if (not (and (or (sc-is x unsigned-stack)
1199 (sc-is x signed-stack))
1200 (or (sc-is y unsigned-reg)
1201 (sc-is y unsigned-reg))
1202 (or (sc-is r unsigned-stack)
1203 (sc-is r unsigned-stack))
1205 (:result-types unsigned-num)
1206 (:translate ,function)))
1207 (defmacro define-mod-binop-c ((name prototype) function)
1208 `(define-vop (,name ,prototype)
1209 (:args (x :target r :scs (unsigned-reg signed-reg)
1210 :load-if (not (and (or (sc-is x unsigned-stack)
1211 (sc-is x signed-stack))
1212 (or (sc-is r unsigned-stack)
1213 (sc-is r signed-stack))
1216 (:arg-types untagged-num (:constant (or (unsigned-byte 31) (signed-byte 32))))
1217 (:results (r :scs (unsigned-reg signed-reg) :from (:argument 0)
1218 :load-if (not (and (or (sc-is x unsigned-stack)
1219 (sc-is x signed-stack))
1220 (or (sc-is r unsigned-stack)
1221 (sc-is r unsigned-stack))
1223 (:result-types unsigned-num)
1224 (:translate ,function)))
1226 (macrolet ((def (name -c-p)
1227 (let ((fun64 (intern (format nil "~S-MOD64" name)))
1228 (vopu (intern (format nil "FAST-~S/UNSIGNED=>UNSIGNED" name)))
1229 (vopcu (intern (format nil "FAST-~S-C/UNSIGNED=>UNSIGNED" name)))
1230 (vopf (intern (format nil "FAST-~S/FIXNUM=>FIXNUM" name)))
1231 (vopcf (intern (format nil "FAST-~S-C/FIXNUM=>FIXNUM" name)))
1232 (vop64u (intern (format nil "FAST-~S-MOD64/WORD=>UNSIGNED" name)))
1233 (vop64f (intern (format nil "FAST-~S-MOD64/FIXNUM=>FIXNUM" name)))
1234 (vop64cu (intern (format nil "FAST-~S-MOD64-C/WORD=>UNSIGNED" name)))
1235 (vop64cf (intern (format nil "FAST-~S-MOD64-C/FIXNUM=>FIXNUM" name)))
1236 (sfun61 (intern (format nil "~S-SMOD61" name)))
1237 (svop61f (intern (format nil "FAST-~S-SMOD61/FIXNUM=>FIXNUM" name)))
1238 (svop61cf (intern (format nil "FAST-~S-SMOD61-C/FIXNUM=>FIXNUM" name))))
1240 (define-modular-fun ,fun64 (x y) ,name :untagged nil 64)
1241 (define-modular-fun ,sfun61 (x y) ,name :tagged t 61)
1242 (define-mod-binop (,vop64u ,vopu) ,fun64)
1243 (define-vop (,vop64f ,vopf) (:translate ,fun64))
1244 (define-vop (,svop61f ,vopf) (:translate ,sfun61))
1246 `((define-mod-binop-c (,vop64cu ,vopcu) ,fun64)
1247 (define-vop (,svop61cf ,vopcf) (:translate ,sfun61))))))))
1250 ;; (no -C variant as x86 MUL instruction doesn't take an immediate)
1253 (define-vop (fast-ash-left-mod64-c/unsigned=>unsigned
1254 fast-ash-c/unsigned=>unsigned)
1255 (:translate ash-left-mod64))
1256 (define-vop (fast-ash-left-mod64/unsigned=>unsigned
1257 fast-ash-left/unsigned=>unsigned))
1258 (deftransform ash-left-mod64 ((integer count)
1259 ((unsigned-byte 64) (unsigned-byte 6)))
1260 (when (sb!c::constant-lvar-p count)
1261 (sb!c::give-up-ir1-transform))
1262 '(%primitive fast-ash-left-mod64/unsigned=>unsigned integer count))
1264 (define-vop (fast-ash-left-smod61-c/fixnum=>fixnum
1265 fast-ash-c/fixnum=>fixnum)
1266 (:translate ash-left-smod61))
1267 (define-vop (fast-ash-left-smod61/fixnum=>fixnum
1268 fast-ash-left/fixnum=>fixnum))
1269 (deftransform ash-left-smod61 ((integer count)
1270 ((signed-byte 61) (unsigned-byte 6)))
1271 (when (sb!c::constant-lvar-p count)
1272 (sb!c::give-up-ir1-transform))
1273 '(%primitive fast-ash-left-smod61/fixnum=>fixnum integer count))
1277 (defknown sb!vm::%lea-mod64 (integer integer (member 1 2 4 8) (signed-byte 64))
1279 (foldable flushable movable))
1280 (defknown sb!vm::%lea-smod61 (integer integer (member 1 2 4 8) (signed-byte 64))
1282 (foldable flushable movable))
1284 (define-modular-fun-optimizer %lea ((base index scale disp) :untagged nil :width width)
1285 (when (and (<= width 64)
1286 (constant-lvar-p scale)
1287 (constant-lvar-p disp))
1288 (cut-to-width base :untagged width nil)
1289 (cut-to-width index :untagged width nil)
1290 'sb!vm::%lea-mod64))
1291 (define-modular-fun-optimizer %lea ((base index scale disp) :tagged t :width width)
1292 (when (and (<= width 61)
1293 (constant-lvar-p scale)
1294 (constant-lvar-p disp))
1295 (cut-to-width base :tagged width t)
1296 (cut-to-width index :tagged width t)
1297 'sb!vm::%lea-smod61))
1301 (defun sb!vm::%lea-mod64 (base index scale disp)
1302 (ldb (byte 64 0) (%lea base index scale disp)))
1303 (defun sb!vm::%lea-smod61 (base index scale disp)
1304 (mask-signed-field 61 (%lea base index scale disp))))
1307 (defun sb!vm::%lea-mod64 (base index scale disp)
1308 (let ((base (logand base #xffffffffffffffff))
1309 (index (logand index #xffffffffffffffff)))
1310 ;; can't use modular version of %LEA, as we only have VOPs for
1311 ;; constant SCALE and DISP.
1312 (ldb (byte 64 0) (+ base (* index scale) disp))))
1313 (defun sb!vm::%lea-smod61 (base index scale disp)
1314 (let ((base (mask-signed-field 61 base))
1315 (index (mask-signed-field 61 index)))
1316 ;; can't use modular version of %LEA, as we only have VOPs for
1317 ;; constant SCALE and DISP.
1318 (mask-signed-field 61 (+ base (* index scale) disp)))))
1320 (in-package "SB!VM")
1322 (define-vop (%lea-mod64/unsigned=>unsigned
1323 %lea/unsigned=>unsigned)
1324 (:translate %lea-mod64))
1325 (define-vop (%lea-smod61/fixnum=>fixnum
1326 %lea/fixnum=>fixnum)
1327 (:translate %lea-smod61))
1329 ;;; logical operations
1330 (define-modular-fun lognot-mod64 (x) lognot :untagged nil 64)
1331 (define-vop (lognot-mod64/unsigned=>unsigned)
1332 (:translate lognot-mod64)
1333 (:args (x :scs (unsigned-reg unsigned-stack) :target r
1334 :load-if (not (and (sc-is x unsigned-stack)
1335 (sc-is r unsigned-stack)
1337 (:arg-types unsigned-num)
1338 (:results (r :scs (unsigned-reg)
1339 :load-if (not (and (sc-is x unsigned-stack)
1340 (sc-is r unsigned-stack)
1342 (:result-types unsigned-num)
1343 (:policy :fast-safe)
1348 (define-source-transform logeqv (&rest args)
1349 (if (oddp (length args))
1351 `(lognot (logxor ,@args))))
1352 (define-source-transform logandc1 (x y)
1353 `(logand (lognot ,x) ,y))
1354 (define-source-transform logandc2 (x y)
1355 `(logand ,x (lognot ,y)))
1356 (define-source-transform logorc1 (x y)
1357 `(logior (lognot ,x) ,y))
1358 (define-source-transform logorc2 (x y)
1359 `(logior ,x (lognot ,y)))
1360 (define-source-transform lognor (x y)
1361 `(lognot (logior ,x ,y)))
1362 (define-source-transform lognand (x y)
1363 `(lognot (logand ,x ,y)))
1367 (define-vop (bignum-length get-header-data)
1368 (:translate sb!bignum:%bignum-length)
1369 (:policy :fast-safe))
1371 (define-vop (bignum-set-length set-header-data)
1372 (:translate sb!bignum:%bignum-set-length)
1373 (:policy :fast-safe))
1375 (define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag
1376 (unsigned-reg) unsigned-num sb!bignum:%bignum-ref)
1377 (define-full-reffer+offset bignum--ref-with-offset * bignum-digits-offset
1378 other-pointer-lowtag (unsigned-reg) unsigned-num
1379 sb!bignum:%bignum-ref-with-offset)
1380 (define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag
1381 (unsigned-reg) unsigned-num sb!bignum:%bignum-set)
1383 (define-vop (digit-0-or-plus)
1384 (:translate sb!bignum:%digit-0-or-plusp)
1385 (:policy :fast-safe)
1386 (:args (digit :scs (unsigned-reg)))
1387 (:arg-types unsigned-num)
1390 (inst or digit digit)))
1393 ;;; For add and sub with carry the sc of carry argument is any-reg so
1394 ;;; that it may be passed as a fixnum or word and thus may be 0, 1, or
1395 ;;; 8. This is easy to deal with and may save a fixnum-word
1397 (define-vop (add-w/carry)
1398 (:translate sb!bignum:%add-with-carry)
1399 (:policy :fast-safe)
1400 (:args (a :scs (unsigned-reg) :target result)
1401 (b :scs (unsigned-reg unsigned-stack) :to :eval)
1402 (c :scs (any-reg) :target temp))
1403 (:arg-types unsigned-num unsigned-num positive-fixnum)
1404 (:temporary (:sc any-reg :from (:argument 2) :to :eval) temp)
1405 (:results (result :scs (unsigned-reg) :from (:argument 0))
1406 (carry :scs (unsigned-reg)))
1407 (:result-types unsigned-num positive-fixnum)
1411 (inst neg temp) ; Set the carry flag to 0 if c=0 else to 1
1414 (inst adc carry carry)))
1416 ;;; Note: the borrow is 1 for no borrow and 0 for a borrow, the opposite
1417 ;;; of the x86-64 convention.
1418 (define-vop (sub-w/borrow)
1419 (:translate sb!bignum:%subtract-with-borrow)
1420 (:policy :fast-safe)
1421 (:args (a :scs (unsigned-reg) :to :eval :target result)
1422 (b :scs (unsigned-reg unsigned-stack) :to :result)
1423 (c :scs (any-reg control-stack)))
1424 (:arg-types unsigned-num unsigned-num positive-fixnum)
1425 (:results (result :scs (unsigned-reg) :from :eval)
1426 (borrow :scs (unsigned-reg)))
1427 (:result-types unsigned-num positive-fixnum)
1429 (inst cmp c 1) ; Set the carry flag to 1 if c=0 else to 0
1433 (inst sbb borrow 0)))
1436 (define-vop (bignum-mult-and-add-3-arg)
1437 (:translate sb!bignum:%multiply-and-add)
1438 (:policy :fast-safe)
1439 (:args (x :scs (unsigned-reg) :target eax)
1440 (y :scs (unsigned-reg unsigned-stack))
1441 (carry-in :scs (unsigned-reg unsigned-stack)))
1442 (:arg-types unsigned-num unsigned-num unsigned-num)
1443 (:temporary (:sc unsigned-reg :offset eax-offset :from (:argument 0)
1444 :to (:result 1) :target lo) eax)
1445 (:temporary (:sc unsigned-reg :offset edx-offset :from (:argument 1)
1446 :to (:result 0) :target hi) edx)
1447 (:results (hi :scs (unsigned-reg))
1448 (lo :scs (unsigned-reg)))
1449 (:result-types unsigned-num unsigned-num)
1453 (inst add eax carry-in)
1458 (define-vop (bignum-mult-and-add-4-arg)
1459 (:translate sb!bignum:%multiply-and-add)
1460 (:policy :fast-safe)
1461 (:args (x :scs (unsigned-reg) :target eax)
1462 (y :scs (unsigned-reg unsigned-stack))
1463 (prev :scs (unsigned-reg unsigned-stack))
1464 (carry-in :scs (unsigned-reg unsigned-stack)))
1465 (:arg-types unsigned-num unsigned-num unsigned-num unsigned-num)
1466 (:temporary (:sc unsigned-reg :offset eax-offset :from (:argument 0)
1467 :to (:result 1) :target lo) eax)
1468 (:temporary (:sc unsigned-reg :offset edx-offset :from (:argument 1)
1469 :to (:result 0) :target hi) edx)
1470 (:results (hi :scs (unsigned-reg))
1471 (lo :scs (unsigned-reg)))
1472 (:result-types unsigned-num unsigned-num)
1478 (inst add eax carry-in)
1484 (define-vop (bignum-mult)
1485 (:translate sb!bignum:%multiply)
1486 (:policy :fast-safe)
1487 (:args (x :scs (unsigned-reg) :target eax)
1488 (y :scs (unsigned-reg unsigned-stack)))
1489 (:arg-types unsigned-num unsigned-num)
1490 (:temporary (:sc unsigned-reg :offset eax-offset :from (:argument 0)
1491 :to (:result 1) :target lo) eax)
1492 (:temporary (:sc unsigned-reg :offset edx-offset :from (:argument 1)
1493 :to (:result 0) :target hi) edx)
1494 (:results (hi :scs (unsigned-reg))
1495 (lo :scs (unsigned-reg)))
1496 (:result-types unsigned-num unsigned-num)
1503 (define-vop (bignum-lognot lognot-mod64/unsigned=>unsigned)
1504 (:translate sb!bignum:%lognot))
1506 (define-vop (fixnum-to-digit)
1507 (:translate sb!bignum:%fixnum-to-digit)
1508 (:policy :fast-safe)
1509 (:args (fixnum :scs (any-reg control-stack) :target digit))
1510 (:arg-types tagged-num)
1511 (:results (digit :scs (unsigned-reg)
1512 :load-if (not (and (sc-is fixnum control-stack)
1513 (sc-is digit unsigned-stack)
1514 (location= fixnum digit)))))
1515 (:result-types unsigned-num)
1518 (inst sar digit 3)))
1520 (define-vop (bignum-floor)
1521 (:translate sb!bignum:%floor)
1522 (:policy :fast-safe)
1523 (:args (div-high :scs (unsigned-reg) :target edx)
1524 (div-low :scs (unsigned-reg) :target eax)
1525 (divisor :scs (unsigned-reg unsigned-stack)))
1526 (:arg-types unsigned-num unsigned-num unsigned-num)
1527 (:temporary (:sc unsigned-reg :offset eax-offset :from (:argument 1)
1528 :to (:result 0) :target quo) eax)
1529 (:temporary (:sc unsigned-reg :offset edx-offset :from (:argument 0)
1530 :to (:result 1) :target rem) edx)
1531 (:results (quo :scs (unsigned-reg))
1532 (rem :scs (unsigned-reg)))
1533 (:result-types unsigned-num unsigned-num)
1537 (inst div eax divisor)
1541 (define-vop (signify-digit)
1542 (:translate sb!bignum:%fixnum-digit-with-correct-sign)
1543 (:policy :fast-safe)
1544 (:args (digit :scs (unsigned-reg unsigned-stack) :target res))
1545 (:arg-types unsigned-num)
1546 (:results (res :scs (any-reg signed-reg)
1547 :load-if (not (and (sc-is digit unsigned-stack)
1548 (sc-is res control-stack signed-stack)
1549 (location= digit res)))))
1550 (:result-types signed-num)
1553 (when (sc-is res any-reg control-stack)
1556 (define-vop (digit-ashr)
1557 (:translate sb!bignum:%ashr)
1558 (:policy :fast-safe)
1559 (:args (digit :scs (unsigned-reg unsigned-stack) :target result)
1560 (count :scs (unsigned-reg) :target ecx))
1561 (:arg-types unsigned-num positive-fixnum)
1562 (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1)) ecx)
1563 (:results (result :scs (unsigned-reg) :from (:argument 0)
1564 :load-if (not (and (sc-is result unsigned-stack)
1565 (location= digit result)))))
1566 (:result-types unsigned-num)
1570 (inst sar result :cl)))
1572 (define-vop (digit-ashr/c)
1573 (:translate sb!bignum:%ashr)
1574 (:policy :fast-safe)
1575 (:args (digit :scs (unsigned-reg unsigned-stack) :target result))
1576 (:arg-types unsigned-num (:constant (integer 0 63)))
1578 (:results (result :scs (unsigned-reg) :from (:argument 0)
1579 :load-if (not (and (sc-is result unsigned-stack)
1580 (location= digit result)))))
1581 (:result-types unsigned-num)
1584 (inst sar result count)))
1586 (define-vop (digit-lshr digit-ashr)
1587 (:translate sb!bignum:%digit-logical-shift-right)
1591 (inst shr result :cl)))
1593 (define-vop (digit-ashl digit-ashr)
1594 (:translate sb!bignum:%ashl)
1598 (inst shl result :cl)))
1600 ;;;; static functions
1602 (define-static-fun two-arg-/ (x y) :translate /)
1604 (define-static-fun two-arg-gcd (x y) :translate gcd)
1605 (define-static-fun two-arg-lcm (x y) :translate lcm)
1607 (define-static-fun two-arg-and (x y) :translate logand)
1608 (define-static-fun two-arg-ior (x y) :translate logior)
1609 (define-static-fun two-arg-xor (x y) :translate logxor)
1614 (defun *-transformer (y)
1616 ((= y (ash 1 (integer-length y)))
1617 ;; there's a generic transform for y = 2^k
1618 (give-up-ir1-transform))
1619 ((member y '(3 5 9))
1620 ;; we can do these multiplications directly using LEA
1621 `(%lea x x ,(1- y) 0))
1623 ;; A normal 64-bit multiplication takes 4 cycles on Athlon 64/Opteron.
1624 ;; Optimizing multiplications (other than the above cases) to
1625 ;; shifts/adds/leas gives a maximum improvement of 1 cycle, but requires
1626 ;; quite a lot of hairy code.
1627 (give-up-ir1-transform))))
1629 (deftransform * ((x y)
1630 ((unsigned-byte 64) (constant-arg (unsigned-byte 64)))
1632 "recode as leas, shifts and adds"
1633 (let ((y (lvar-value y)))
1635 (deftransform sb!vm::*-mod64
1636 ((x y) ((unsigned-byte 64) (constant-arg (unsigned-byte 64)))
1638 "recode as leas, shifts and adds"
1639 (let ((y (lvar-value y)))
1642 (deftransform * ((x y)
1643 ((signed-byte 61) (constant-arg (unsigned-byte 64)))
1645 "recode as leas, shifts and adds"
1646 (let ((y (lvar-value y)))
1648 (deftransform sb!vm::*-smod61
1649 ((x y) ((signed-byte 61) (constant-arg (unsigned-byte 64)))
1651 "recode as leas, shifts and adds"
1652 (let ((y (lvar-value y)))