1 ;;;; the VM definition arithmetic VOPs for the SPARC
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 ;;;; unary operations.
16 (define-vop (fast-safe-arith-op)
21 (define-vop (fixnum-unop fast-safe-arith-op
)
22 (:args
(x :scs
(any-reg)))
23 (:results
(res :scs
(any-reg)))
24 (:note
"inline fixnum arithmetic")
25 (:arg-types tagged-num
)
26 (:result-types tagged-num
))
28 (define-vop (signed-unop fast-safe-arith-op
)
29 (:args
(x :scs
(signed-reg)))
30 (:results
(res :scs
(signed-reg)))
31 (:note
"inline (signed-byte 32) arithmetic")
32 (:arg-types signed-num
)
33 (:result-types signed-num
))
35 (define-vop (fast-negate/fixnum fixnum-unop
)
40 (define-vop (fast-negate/signed signed-unop
)
45 (define-vop (fast-lognot/fixnum fixnum-unop
)
48 (inst xor res x
(fixnumize -
1))))
50 (define-vop (fast-lognot/signed signed-unop
)
55 ;;;; Binary fixnum operations.
57 ;;; Assume that any constant operand is the second arg...
59 (define-vop (fast-fixnum-binop fast-safe-arith-op
)
60 (:args
(x :target r
:scs
(any-reg zero
))
61 (y :target r
:scs
(any-reg zero
)))
62 (:arg-types tagged-num tagged-num
)
63 (:results
(r :scs
(any-reg)))
64 (:result-types tagged-num
)
65 (:note
"inline fixnum arithmetic"))
67 (define-vop (fast-unsigned-binop fast-safe-arith-op
)
68 (:args
(x :target r
:scs
(unsigned-reg zero
))
69 (y :target r
:scs
(unsigned-reg zero
)))
70 (:arg-types unsigned-num unsigned-num
)
71 (:results
(r :scs
(unsigned-reg)))
72 (:result-types unsigned-num
)
73 (:note
"inline (unsigned-byte 32) arithmetic"))
75 (define-vop (fast-signed-binop fast-safe-arith-op
)
76 (:args
(x :target r
:scs
(signed-reg zero
))
77 (y :target r
:scs
(signed-reg zero
)))
78 (:arg-types signed-num signed-num
)
79 (:results
(r :scs
(signed-reg)))
80 (:result-types signed-num
)
81 (:note
"inline (signed-byte 32) arithmetic"))
84 (define-vop (fast-fixnum-binop-c fast-safe-arith-op
)
85 (:args
(x :target r
:scs
(any-reg zero
)))
87 (:arg-types tagged-num
88 (:constant
(and (signed-byte 11) (not (integer 0 0)))))
89 (:results
(r :scs
(any-reg)))
90 (:result-types tagged-num
)
91 (:note
"inline fixnum arithmetic"))
93 (define-vop (fast-unsigned-binop-c fast-safe-arith-op
)
94 (:args
(x :target r
:scs
(unsigned-reg zero
)))
96 (:arg-types unsigned-num
97 (:constant
(and (signed-byte 13) (not (integer 0 0)))))
98 (:results
(r :scs
(unsigned-reg)))
99 (:result-types unsigned-num
)
100 (:note
"inline (unsigned-byte 32) arithmetic"))
102 (define-vop (fast-signed-binop-c fast-safe-arith-op
)
103 (:args
(x :target r
:scs
(signed-reg zero
)))
105 (:arg-types signed-num
106 (:constant
(and (signed-byte 13) (not (integer 0 0)))))
107 (:results
(r :scs
(signed-reg)))
108 (:result-types signed-num
)
109 (:note
"inline (signed-byte 32) arithmetic"))
112 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
114 (defmacro define-binop
(translate untagged-penalty op
115 &optional arg-swap restore-fixnum-mask
)
117 (define-vop (,(symbolicate 'fast translate
'/fixnum
=>fixnum
)
119 ,@(when restore-fixnum-mask
120 `((:temporary
(:sc non-descriptor-reg
) temp
)))
121 (:translate
,translate
)
124 `(inst ,op
,(if restore-fixnum-mask
'temp
'r
) y x
)
125 `(inst ,op
,(if restore-fixnum-mask
'temp
'r
) x y
))
126 ,@(when restore-fixnum-mask
127 `((inst andn r temp fixnum-tag-mask
)))))
129 `((define-vop (,(symbolicate 'fast- translate
'-c
/fixnum
=>fixnum
)
131 ,@(when restore-fixnum-mask
132 `((:temporary
(:sc non-descriptor-reg
) temp
)))
133 (:translate
,translate
)
135 (inst ,op
,(if restore-fixnum-mask
'temp
'r
) x
(fixnumize y
))
136 ,@(when restore-fixnum-mask
137 `((inst andn r temp fixnum-tag-mask
)))))))
138 (define-vop (,(symbolicate 'fast- translate
'/signed
=>signed
)
140 (:translate
,translate
)
141 (:generator
,(1+ untagged-penalty
)
146 `((define-vop (,(symbolicate 'fast- translate
'-c
/signed
=>signed
)
148 (:translate
,translate
)
149 (:generator
,untagged-penalty
151 (define-vop (,(symbolicate 'fast- translate
'/unsigned
=>unsigned
)
153 (:translate
,translate
)
154 (:generator
,(1+ untagged-penalty
)
159 `((define-vop (,(symbolicate 'fast- translate
'-c
/unsigned
=>unsigned
)
160 fast-unsigned-binop-c
)
161 (:translate
,translate
)
162 (:generator
,untagged-penalty
163 (inst ,op r x y
)))))))
167 (define-binop + 4 add
)
168 (define-binop -
4 sub
)
169 (define-binop logand
2 and
)
170 (define-binop logandc1
2 andn t
)
171 (define-binop logandc2
2 andn
)
172 (define-binop logior
2 or
)
173 (define-binop logorc1
2 orn t t
)
174 (define-binop logorc2
2 orn nil t
)
175 (define-binop logxor
2 xor
)
176 (define-binop logeqv
2 xnor nil t
)
178 (define-vop (fast-logand/signed-unsigned
=>unsigned fast-logand
/unsigned
=>unsigned
)
179 (:args
(x :scs
(signed-reg) :target r
)
180 (y :scs
(unsigned-reg) :target r
))
181 (:arg-types signed-num unsigned-num
)
184 ;;; Special case fixnum + and - that trap on overflow. Useful when we
185 ;;; don't know that the output type is a fixnum.
187 ;;; I (Raymond Toy) took these out. They don't seem to be used
191 (define-vop (+/fixnum fast-
+/fixnum
=>fixnum
)
193 (:results
(r :scs
(any-reg descriptor-reg
)))
194 (:result-types tagged-num
)
195 (:note
"safe inline fixnum arithmetic")
197 (inst taddcctv r x y
)))
199 (define-vop (+-c
/fixnum fast-
+-c
/fixnum
=>fixnum
)
201 (:results
(r :scs
(any-reg descriptor-reg
)))
202 (:result-types tagged-num
)
203 (:note
"safe inline fixnum arithmetic")
205 (inst taddcctv r x
(fixnumize y
))))
207 (define-vop (-/fixnum fast--
/fixnum
=>fixnum
)
209 (:results
(r :scs
(any-reg descriptor-reg
)))
210 (:result-types tagged-num
)
211 (:note
"safe inline fixnum arithmetic")
213 (inst tsubcctv r x y
)))
215 (define-vop (--c/fixnum fast---c
/fixnum
=>fixnum
)
217 (:results
(r :scs
(any-reg descriptor-reg
)))
218 (:result-types tagged-num
)
219 (:note
"safe inline fixnum arithmetic")
221 (inst tsubcctv r x
(fixnumize y
))))
227 ;; This doesn't work for some reason.
229 (define-vop (fast-v8-truncate/fixnum
=>fixnum fast-safe-arith-op
)
230 (:translate truncate
)
231 (:args
(x :scs
(any-reg))
233 (:arg-types tagged-num tagged-num
)
234 (:results
(quo :scs
(any-reg))
235 (rem :scs
(any-reg)))
236 (:result-types tagged-num tagged-num
)
237 (:note
"inline fixnum arithmetic")
238 (:temporary
(:scs
(any-reg) :target quo
) q
)
239 (:temporary
(:scs
(any-reg)) r
)
240 (:temporary
(:scs
(signed-reg)) y-int
)
242 (:save-p
:compute-only
)
243 (:guard
(or (member :sparc-v8
*backend-subfeatures
*)
244 (and (member :sparc-v9
*backend-subfeatures
*)
245 (not (member :sparc-64
*backend-subfeatures
*)))))
247 (let ((zero (generate-error-code vop division-by-zero-error x y
)))
250 ;; Extend the sign of X into the Y register
253 ;; Remove tag bits so Q and R will be tagged correctly.
254 (inst sra y-int y n-fixnum-tag-bits
)
258 (inst sdiv q x y-int
) ; Q is tagged.
259 ;; We have the quotient so we need to compute the remainder
260 (inst smul r q y-int
) ; R is tagged
262 (unless (location= quo q
)
265 (define-vop (fast-v8-truncate/signed
=>signed fast-safe-arith-op
)
266 (:translate truncate
)
267 (:args
(x :scs
(signed-reg))
268 (y :scs
(signed-reg)))
269 (:arg-types signed-num signed-num
)
270 (:results
(quo :scs
(signed-reg))
271 (rem :scs
(signed-reg)))
272 (:result-types signed-num signed-num
)
273 (:note
"inline (signed-byte 32) arithmetic")
274 (:temporary
(:scs
(signed-reg) :target quo
) q
)
275 (:temporary
(:scs
(signed-reg)) r
)
277 (:save-p
:compute-only
)
278 (:guard
(or (member :sparc-v8
*backend-subfeatures
*)
279 (and (member :sparc-v9
*backend-subfeatures
*)
280 (not (member :sparc-64
*backend-subfeatures
*)))))
282 (let ((zero (generate-error-code vop division-by-zero-error x y
)))
284 (if (member :sparc-v9
*backend-subfeatures
*)
285 (inst b
:eq zero
:pn
)
287 ;; Extend the sign of X into the Y register
295 ;; We have the quotient so we need to compue the remainder
296 (inst smul r q y
) ; rem
298 (unless (location= quo q
)
301 (define-vop (fast-v8-truncate/unsigned
=>unsigned fast-safe-arith-op
)
302 (:translate truncate
)
303 (:args
(x :scs
(unsigned-reg))
304 (y :scs
(unsigned-reg)))
305 (:arg-types unsigned-num unsigned-num
)
306 (:results
(quo :scs
(unsigned-reg))
307 (rem :scs
(unsigned-reg)))
308 (:result-types unsigned-num unsigned-num
)
309 (:note
"inline (unsigned-byte 32) arithmetic")
310 (:temporary
(:scs
(unsigned-reg) :target quo
) q
)
311 (:temporary
(:scs
(unsigned-reg)) r
)
313 (:save-p
:compute-only
)
314 (:guard
(or (member :sparc-v8
*backend-subfeatures
*)
315 (and (member :sparc-v9
*backend-subfeatures
*)
316 (not (member :sparc-64
*backend-subfeatures
*)))))
318 (let ((zero (generate-error-code vop division-by-zero-error x y
)))
320 (if (member :sparc-v9
*backend-subfeatures
*)
321 (inst b
:eq zero
:pn
)
323 (inst wry zero-tn
) ; Clear out high part
332 (unless (location= quo q
)
333 (inst move quo q
)))))
335 (define-vop (fast-v9-truncate/signed
=>signed fast-safe-arith-op
)
336 (:translate truncate
)
337 (:args
(x :scs
(signed-reg))
338 (y :scs
(signed-reg)))
339 (:arg-types signed-num signed-num
)
340 (:results
(quo :scs
(signed-reg))
341 (rem :scs
(signed-reg)))
342 (:result-types signed-num signed-num
)
343 (:note
"inline (signed-byte 32) arithmetic")
344 (:temporary
(:scs
(signed-reg) :target quo
) q
)
345 (:temporary
(:scs
(signed-reg)) r
)
347 (:save-p
:compute-only
)
348 (:guard
(member :sparc-64
*backend-subfeatures
*))
350 (let ((zero (generate-error-code vop division-by-zero-error x y
)))
352 (inst b
:eq zero
:pn
)
353 ;; Sign extend the numbers, just in case.
360 (unless (location= quo q
)
361 (inst move quo q
)))))
363 (define-vop (fast-v9-truncate/unsigned
=>unsigned fast-safe-arith-op
)
364 (:translate truncate
)
365 (:args
(x :scs
(unsigned-reg))
366 (y :scs
(unsigned-reg)))
367 (:arg-types unsigned-num unsigned-num
)
368 (:results
(quo :scs
(unsigned-reg))
369 (rem :scs
(unsigned-reg)))
370 (:result-types unsigned-num unsigned-num
)
371 (:note
"inline (unsigned-byte 32) arithmetic")
372 (:temporary
(:scs
(unsigned-reg) :target quo
) q
)
373 (:temporary
(:scs
(unsigned-reg)) r
)
375 (:save-p
:compute-only
)
376 (:guard
(member :sparc-64
*backend-subfeatures
*))
378 (let ((zero (generate-error-code vop division-by-zero-error x y
)))
380 (inst b
:eq zero
:pn
)
381 ;; Zap the higher 32 bits, just in case
388 (unless (location= quo q
)
389 (inst move quo q
)))))
393 (define-vop (fast-ash/signed
=>signed
)
395 (:args
(number :scs
(signed-reg) :to
:save
)
396 (amount :scs
(signed-reg) :to
:save
))
397 (:arg-types signed-num signed-num
)
398 (:results
(result :scs
(signed-reg)))
399 (:result-types signed-num
)
402 (:temporary
(:sc non-descriptor-reg
) ndesc
)
404 (let ((done (gen-label)))
407 ;; The result-type assures us that this shift will not
409 (inst sll result number amount
)
410 (inst neg ndesc amount
)
412 (if (member :sparc-v9
*backend-subfeatures
*)
414 (inst cmove
:ge ndesc
31)
415 (inst sra result number ndesc
))
418 (inst sra result number ndesc
)
419 (inst sra result number
31)))
422 (define-vop (fast-ash-c/signed
=>signed
)
423 (:note
"inline constant ASH")
424 (:args
(number :scs
(signed-reg)))
426 (:arg-types signed-num
(:constant integer
))
427 (:results
(result :scs
(signed-reg)))
428 (:result-types signed-num
)
433 ((< count
0) (inst sra result number
(min (- count
) 31)))
434 ((> count
0) (inst sll result number
(min count
31)))
435 (t (bug "identity ASH not transformed away")))))
437 (define-vop (fast-ash/unsigned
=>unsigned
)
439 (:args
(number :scs
(unsigned-reg) :to
:save
)
440 (amount :scs
(signed-reg) :to
:save
))
441 (:arg-types unsigned-num signed-num
)
442 (:results
(result :scs
(unsigned-reg)))
443 (:result-types unsigned-num
)
446 (:temporary
(:sc non-descriptor-reg
) ndesc
)
448 (let ((done (gen-label)))
451 ;; The result-type assures us that this shift will not
453 (inst sll result number amount
)
454 (inst neg ndesc amount
)
456 (if (member :sparc-v9
*backend-subfeatures
*)
458 (inst srl result number ndesc
)
459 (inst cmove
:ge result zero-tn
))
462 (inst srl result number ndesc
)
463 (move result zero-tn
)))
466 (define-vop (fast-ash-c/unsigned
=>unsigned
)
467 (:note
"inline constant ASH")
468 (:args
(number :scs
(unsigned-reg)))
470 (:arg-types unsigned-num
(:constant integer
))
471 (:results
(result :scs
(unsigned-reg)))
472 (:result-types unsigned-num
)
477 ((< count -
31) (move result zero-tn
))
478 ((< count
0) (inst srl result number
(min (- count
) 31)))
479 ((> count
0) (inst sll result number
(min count
31)))
480 (t (bug "identity ASH not transformed away")))))
482 ;; Some special cases where we know we want a left shift. Just do the
483 ;; shift, instead of checking for the sign of the shift.
485 ((def (name sc-type type result-type cost
)
489 (:args
(number :scs
(,sc-type
))
490 (amount :scs
(signed-reg unsigned-reg immediate
)))
491 (:arg-types
,type positive-fixnum
)
492 (:results
(result :scs
(,result-type
)))
493 (:result-types
,type
)
496 ;; The result-type assures us that this shift will not
497 ;; overflow. And for fixnums, the zero bits that get
498 ;; shifted in are just fine for the fixnum tag.
500 ((signed-reg unsigned-reg
)
501 (inst sll result number amount
))
503 (let ((amount (tn-value amount
)))
505 (inst sll result number amount
))))))))
506 (def fast-ash-left
/signed
=>signed signed-reg signed-num signed-reg
3)
507 (def fast-ash-left
/fixnum
=>fixnum any-reg tagged-num any-reg
2)
508 (def fast-ash-left
/unsigned
=>unsigned unsigned-reg unsigned-num unsigned-reg
3))
511 (define-vop (signed-byte-32-len)
512 (:translate integer-length
)
513 (:note
"inline (signed-byte 32) integer-length")
515 (:args
(arg :scs
(signed-reg) :target shift
))
516 (:arg-types signed-num
)
517 (:results
(res :scs
(any-reg)))
518 (:result-types positive-fixnum
)
519 (:temporary
(:scs
(non-descriptor-reg) :from
(:argument
0)) shift
)
521 (let ((loop (gen-label))
523 (inst addcc shift zero-tn arg
)
530 (inst add res
(fixnumize 1))
535 (inst srl shift
1))))
537 (define-vop (unsigned-byte-32-count)
538 (:translate logcount
)
539 (:note
"inline (unsigned-byte 32) logcount")
541 (:args
(arg :scs
(unsigned-reg)))
542 (:arg-types unsigned-num
)
543 (:results
(res :scs
(unsigned-reg)))
544 (:result-types positive-fixnum
)
545 (:temporary
(:scs
(non-descriptor-reg) :from
(:argument
0)) mask temp
)
549 (dolist (stuff '((1 #x55555555
) (2 #x33333333
) (4 #x0f0f0f0f
)
550 (8 #x00ff00ff
) (16 #x0000ffff
)))
551 (destructuring-bind (shift bit-mask
)
554 (inst sethi mask
(ldb (byte 22 10) bit-mask
))
555 (inst add mask
(ldb (byte 10 0) bit-mask
))
557 (inst and temp res mask
)
560 (inst add res temp
)))))
563 ;;; Multiply and Divide.
565 (define-vop (fast-v8-*/fixnum
=>fixnum fast-fixnum-binop
)
566 (:temporary
(:scs
(non-descriptor-reg)) temp
)
568 (:guard
(or (member :sparc-v8
*backend-subfeatures
*)
569 (and (member :sparc-v9
*backend-subfeatures
*)
570 (not (member :sparc-64
*backend-subfeatures
*)))))
572 ;; The cost here should be less than the cost for
573 ;; */signed=>signed. Why? A fixnum product using signed=>signed
574 ;; has to convert both args to signed-nums. But using this, we
575 ;; don't have to and that saves an instruction.
576 (inst sra temp y n-fixnum-tag-bits
)
577 (inst smul r x temp
)))
579 (define-vop (fast-v8-*-c
/fixnum
=>fixnum fast-safe-arith-op
)
580 (:args
(x :target r
:scs
(any-reg zero
)))
582 (:arg-types tagged-num
583 (:constant
(and (signed-byte 13) (not (integer 0 0)))))
584 (:results
(r :scs
(any-reg)))
585 (:result-types tagged-num
)
586 (:note
"inline fixnum arithmetic")
588 (:guard
(or (member :sparc-v8
*backend-subfeatures
*)
589 (and (member :sparc-v9
*backend-subfeatures
*)
590 (not (member :sparc-64
*backend-subfeatures
*)))))
594 (define-vop (fast-v8-*/signed
=>signed fast-signed-binop
)
596 (:guard
(or (member :sparc-v8
*backend-subfeatures
*)
597 (and (member :sparc-v9
*backend-subfeatures
*)
598 (not (member :sparc-64
*backend-subfeatures
*)))))
602 (define-vop (fast-v8-*-c
/signed
=>signed fast-signed-binop-c
)
604 (:guard
(or (member :sparc-v8
*backend-subfeatures
*)
605 (and (member :sparc-v9
*backend-subfeatures
*)
606 (not (member :sparc-64
*backend-subfeatures
*)))))
610 (define-vop (fast-v8-*/unsigned
=>unsigned fast-unsigned-binop
)
612 (:guard
(or (member :sparc-v8
*backend-subfeatures
*)
613 (and (member :sparc-v9
*backend-subfeatures
*)
614 (not (member :sparc-64
*backend-subfeatures
*)))))
618 (define-vop (fast-v8-*-c
/unsigned
=>unsigned fast-unsigned-binop-c
)
620 (:guard
(or (member :sparc-v8
*backend-subfeatures
*)
621 (and (member :sparc-v9
*backend-subfeatures
*)
622 (not (member :sparc-64
*backend-subfeatures
*)))))
626 ;; The smul and umul instructions are deprecated on the Sparc V9. Use
628 (define-vop (fast-v9-*/fixnum
=>fixnum fast-fixnum-binop
)
629 (:temporary
(:scs
(non-descriptor-reg)) temp
)
631 (:guard
(member :sparc-64
*backend-subfeatures
*))
633 (inst sra temp y n-fixnum-tag-bits
)
634 (inst mulx r x temp
)))
636 (define-vop (fast-v9-*/signed
=>signed fast-signed-binop
)
638 (:guard
(member :sparc-64
*backend-subfeatures
*))
642 (define-vop (fast-v9-*/unsigned
=>unsigned fast-unsigned-binop
)
644 (:guard
(member :sparc-64
*backend-subfeatures
*))
649 ;;;; Modular functions:
650 (define-modular-fun lognot-mod32
(x) lognot
:unsigned
32)
651 (define-vop (lognot-mod32/unsigned
=>unsigned
)
652 (:translate lognot-mod32
)
653 (:args
(x :scs
(unsigned-reg)))
654 (:arg-types unsigned-num
)
655 (:results
(res :scs
(unsigned-reg)))
656 (:result-types unsigned-num
)
662 ((define-modular-backend (fun &optional constantp
)
663 (let ((mfun-name (symbolicate fun
'-mod32
))
664 (modvop (symbolicate 'fast- fun
'-mod32
/unsigned
=>unsigned
))
665 (modcvop (symbolicate 'fast- fun
'-mod32-c
/unsigned
=>unsigned
))
666 (vop (symbolicate 'fast- fun
'/unsigned
=>unsigned
))
667 (cvop (symbolicate 'fast- fun
'-c
/unsigned
=>unsigned
)))
669 (define-modular-fun ,mfun-name
(x y
) ,fun
:unsigned
32)
670 (define-vop (,modvop
,vop
)
671 (:translate
,mfun-name
))
673 `((define-vop (,modcvop
,cvop
)
674 (:translate
,mfun-name
))))))))
675 (define-modular-backend + t
)
676 (define-modular-backend - t
)
677 (define-modular-backend logxor t
)
678 (define-modular-backend logeqv t
)
679 (define-modular-backend logandc1
)
680 (define-modular-backend logandc2 t
)
681 (define-modular-backend logorc1
)
682 (define-modular-backend logorc2 t
))
684 (define-source-transform lognand
(x y
)
685 `(lognot (logand ,x
,y
)))
686 (define-source-transform lognor
(x y
)
687 `(lognot (logior ,x
,y
)))
689 (define-vop (fast-ash-left-mod32-c/unsigned
=>unsigned
690 fast-ash-c
/unsigned
=>unsigned
)
691 (:translate ash-left-mod32
))
693 (define-vop (fast-ash-left-mod32/unsigned
=>unsigned
694 fast-ash-left
/unsigned
=>unsigned
))
695 (deftransform ash-left-mod32
((integer count
)
696 ((unsigned-byte 32) (unsigned-byte 5)))
697 (when (sb!c
::constant-lvar-p count
)
698 (sb!c
::give-up-ir1-transform
))
699 '(%primitive fast-ash-left-mod32
/unsigned
=>unsigned integer count
))
701 ;;;; Binary conditional VOPs:
703 (define-vop (fast-conditional)
708 (:policy
:fast-safe
))
710 (define-vop (fast-conditional/fixnum fast-conditional
)
711 (:args
(x :scs
(any-reg zero
))
712 (y :scs
(any-reg zero
)))
713 (:arg-types tagged-num tagged-num
)
714 (:note
"inline fixnum comparison"))
716 (define-vop (fast-conditional-c/fixnum fast-conditional
/fixnum
)
717 (:args
(x :scs
(any-reg zero
)))
718 (:arg-types tagged-num
(:constant
(signed-byte 11)))
719 (:info target not-p y
))
721 (define-vop (fast-conditional/signed fast-conditional
)
722 (:args
(x :scs
(signed-reg zero
))
723 (y :scs
(signed-reg zero
)))
724 (:arg-types signed-num signed-num
)
725 (:note
"inline (signed-byte 32) comparison"))
727 (define-vop (fast-conditional-c/signed fast-conditional
/signed
)
728 (:args
(x :scs
(signed-reg zero
)))
729 (:arg-types signed-num
(:constant
(signed-byte 13)))
730 (:info target not-p y
))
732 (define-vop (fast-conditional/unsigned fast-conditional
)
733 (:args
(x :scs
(unsigned-reg zero
))
734 (y :scs
(unsigned-reg zero
)))
735 (:arg-types unsigned-num unsigned-num
)
736 (:note
"inline (unsigned-byte 32) comparison"))
738 (define-vop (fast-conditional-c/unsigned fast-conditional
/unsigned
)
739 (:args
(x :scs
(unsigned-reg zero
)))
740 (:arg-types unsigned-num
(:constant
(unsigned-byte 12)))
741 (:info target not-p y
))
744 (defmacro define-conditional-vop
(tran cond unsigned not-cond not-unsigned
)
746 ,@(mapcar (lambda (suffix cost signed
)
747 (unless (and (member suffix
'(/fixnum -c
/fixnum
))
749 `(define-vop (,(intern (format nil
"~:@(FAST-IF-~A~A~)"
752 (format nil
"~:@(FAST-CONDITIONAL~A~)"
757 ,(if (eq suffix
'-c
/fixnum
) '(fixnumize y
) 'y
))
759 ,(if signed not-cond not-unsigned
)
760 ,(if signed cond unsigned
))
763 '(/fixnum -c
/fixnum
/signed -c
/signed
/unsigned -c
/unsigned
)
765 '(t t t t nil nil
))))
767 (define-conditional-vop < :lt
:ltu
:ge
:geu
)
769 (define-conditional-vop > :gt
:gtu
:le
:leu
)
771 (define-conditional-vop eql
:eq
:eq
:ne
:ne
)
773 ;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a
776 ;;; These versions specify a fixnum restriction on their first arg. We have
777 ;;; also generic-eql/fixnum VOPs which are the same, but have no restriction on
778 ;;; the first arg and a higher cost. The reason for doing this is to prevent
779 ;;; fixnum specific operations from being used on word integers, spuriously
780 ;;; consing the argument.
783 (define-vop (fast-eql/fixnum fast-conditional
)
784 (:args
(x :scs
(any-reg descriptor-reg zero
))
785 (y :scs
(any-reg zero
)))
786 (:arg-types tagged-num tagged-num
)
787 (:note
"inline fixnum comparison")
791 (inst b
(if not-p
:ne
:eq
) target
)
794 (define-vop (generic-eql/fixnum fast-eql
/fixnum
)
795 (:arg-types
* tagged-num
)
798 (define-vop (fast-eql-c/fixnum fast-conditional
/fixnum
)
799 (:args
(x :scs
(any-reg descriptor-reg zero
)))
800 (:arg-types tagged-num
(:constant
(signed-byte 11)))
801 (:info target not-p y
)
804 (inst cmp x
(fixnumize y
))
805 (inst b
(if not-p
:ne
:eq
) target
)
808 (define-vop (generic-eql-c/fixnum fast-eql-c
/fixnum
)
809 (:arg-types
* (:constant
(signed-byte 11)))
813 ;;;; 32-bit logical operations
814 (define-vop (merge-bits)
815 (:translate merge-bits
)
816 (:args
(shift :scs
(signed-reg unsigned-reg
))
817 (prev :scs
(unsigned-reg))
818 (next :scs
(unsigned-reg)))
819 (:arg-types tagged-num unsigned-num unsigned-num
)
820 (:temporary
(:scs
(unsigned-reg) :to
(:result
0)) temp
)
821 (:temporary
(:scs
(unsigned-reg) :to
(:result
0) :target result
) res
)
822 (:results
(result :scs
(unsigned-reg)))
823 (:result-types unsigned-num
)
826 (let ((done (gen-label)))
829 (inst srl res next shift
)
830 (inst sub temp zero-tn shift
)
831 (inst sll temp prev temp
)
836 (define-vop (shift-towards-someplace)
838 (:args
(num :scs
(unsigned-reg))
839 (amount :scs
(signed-reg)))
840 (:arg-types unsigned-num tagged-num
)
841 (:results
(r :scs
(unsigned-reg)))
842 (:result-types unsigned-num
))
844 (define-vop (shift-towards-start shift-towards-someplace
)
845 (:translate shift-towards-start
)
846 (:note
"shift-towards-start")
848 (inst sll r num amount
)))
850 (define-vop (shift-towards-end shift-towards-someplace
)
851 (:translate shift-towards-end
)
852 (:note
"shift-towards-end")
854 (inst srl r num amount
)))
857 (define-vop (bignum-length get-header-data
)
858 (:translate sb
!bignum
:%bignum-length
)
859 (:policy
:fast-safe
))
861 (define-vop (bignum-set-length set-header-data
)
862 (:translate sb
!bignum
:%bignum-set-length
)
863 (:policy
:fast-safe
))
865 (define-vop (bignum-ref word-index-ref
)
866 (:variant bignum-digits-offset other-pointer-lowtag
)
867 (:translate sb
!bignum
:%bignum-ref
)
868 (:results
(value :scs
(unsigned-reg)))
869 (:result-types unsigned-num
))
871 (define-vop (bignum-set word-index-set
)
872 (:variant bignum-digits-offset other-pointer-lowtag
)
873 (:translate sb
!bignum
:%bignum-set
)
874 (:args
(object :scs
(descriptor-reg))
875 (index :scs
(any-reg immediate zero
))
876 (value :scs
(unsigned-reg)))
877 (:arg-types t positive-fixnum unsigned-num
)
878 (:results
(result :scs
(unsigned-reg)))
879 (:result-types unsigned-num
))
881 (define-vop (digit-0-or-plus)
882 (:translate sb
!bignum
:%digit-0-or-plusp
)
884 (:args
(digit :scs
(unsigned-reg)))
885 (:arg-types unsigned-num
)
886 (:results
(result :scs
(descriptor-reg)))
887 (:guard
(not (member :sparc-v9
*backend-subfeatures
*)))
889 (let ((done (gen-label)))
892 (move result null-tn
)
893 (load-symbol result t
)
896 (define-vop (v9-digit-0-or-plus-cmove)
897 (:translate sb
!bignum
:%digit-0-or-plusp
)
899 (:args
(digit :scs
(unsigned-reg)))
900 (:arg-types unsigned-num
)
901 (:results
(result :scs
(descriptor-reg)))
902 (:guard
(member :sparc-v9
*backend-subfeatures
*))
905 (load-symbol result t
)
906 (inst cmove
:lt result null-tn
)))
908 ;; This doesn't work?
910 (define-vop (v9-digit-0-or-plus-movr)
911 (:translate sb
!bignum
:%digit-0-or-plusp
)
913 (:args
(digit :scs
(unsigned-reg)))
914 (:arg-types unsigned-num
)
915 (:results
(result :scs
(descriptor-reg)))
916 (:temporary
(:scs
(descriptor-reg)) temp
)
917 (:guard
#!+:sparc-v9 t
#!-
:sparc-v9 nil
)
920 (inst movr result null-tn digit
:lz
)
921 (inst movr result temp digit
:gez
)))
923 (define-vop (add-w/carry
)
924 (:translate sb
!bignum
:%add-with-carry
)
926 (:args
(a :scs
(unsigned-reg))
927 (b :scs
(unsigned-reg))
929 (:arg-types unsigned-num unsigned-num positive-fixnum
)
930 (:results
(result :scs
(unsigned-reg))
931 (carry :scs
(unsigned-reg)))
932 (:result-types unsigned-num positive-fixnum
)
934 (inst addcc zero-tn c -
1)
935 (inst addxcc result a b
)
936 (inst addx carry zero-tn zero-tn
)))
938 (define-vop (sub-w/borrow
)
939 (:translate sb
!bignum
:%subtract-with-borrow
)
941 (:args
(a :scs
(unsigned-reg))
942 (b :scs
(unsigned-reg))
944 (:arg-types unsigned-num unsigned-num positive-fixnum
)
945 (:results
(result :scs
(unsigned-reg))
946 (borrow :scs
(unsigned-reg)))
947 (:result-types unsigned-num positive-fixnum
)
949 (inst subcc zero-tn c
1)
950 (inst subxcc result a b
)
951 (inst addx borrow zero-tn zero-tn
)
952 (inst xor borrow
1)))
954 ;;; EMIT-MULTIPLY -- This is used both for bignum stuff and in assembly
957 (defun emit-multiply (multiplier multiplicand result-high result-low
)
958 "Emit code to multiply MULTIPLIER with MULTIPLICAND, putting the result
959 in RESULT-HIGH and RESULT-LOW. KIND is either :signed or :unsigned.
960 Note: the lifetimes of MULTIPLICAND and RESULT-HIGH overlap."
961 (declare (type tn multiplier result-high result-low
)
962 (type (or tn
(signed-byte 13)) multiplicand
))
963 ;; It seems that emit-multiply is only used to do an unsigned
964 ;; multiply, so the code only does an unsigned multiply.
966 ((member :sparc-64
*backend-subfeatures
*)
967 ;; Take advantage of V9's 64-bit multiplier.
969 ;; Make sure the multiplier and multiplicand are really
970 ;; unsigned 64-bit numbers.
971 (inst srl multiplier
0)
972 (inst srl multiplicand
0)
974 ;; Multiply the two numbers and put the result in
975 ;; result-high. Copy the low 32-bits to result-low. Then
976 ;; shift result-high so the high 32-bits end up in the low
978 (inst mulx result-high multiplier multiplicand
)
979 (inst move result-low result-high
)
980 (inst srax result-high
32))
981 ((or (member :sparc-v8
*backend-subfeatures
*)
982 (member :sparc-v9
*backend-subfeatures
*))
983 ;; V8 has a multiply instruction. This should also work for
984 ;; the V9, but umul and the Y register is deprecated on the
986 (inst umul result-low multiplier multiplicand
)
987 (inst rdy result-high
))
989 (let ((label (gen-label)))
990 (inst wry multiplier
)
991 (inst andcc result-high zero-tn
)
992 ;; Note: we can't use the Y register until three insts
993 ;; after it's written.
997 (inst mulscc result-high multiplicand
))
998 (inst mulscc result-high zero-tn
)
999 (inst cmp multiplicand
)
1002 (inst add result-high multiplier
)
1004 (inst rdy result-low
)))))
1006 (define-vop (bignum-mult-and-add-3-arg)
1007 (:translate sb
!bignum
:%multiply-and-add
)
1008 (:policy
:fast-safe
)
1009 (:args
(x :scs
(unsigned-reg) :to
(:eval
1))
1010 (y :scs
(unsigned-reg) :to
(:eval
1))
1011 (carry-in :scs
(unsigned-reg) :to
(:eval
2)))
1012 (:arg-types unsigned-num unsigned-num unsigned-num
)
1013 (:results
(hi :scs
(unsigned-reg) :from
(:eval
0))
1014 (lo :scs
(unsigned-reg) :from
(:eval
1)))
1015 (:result-types unsigned-num unsigned-num
)
1017 (emit-multiply x y hi lo
)
1018 (inst addcc lo carry-in
)
1019 (inst addx hi zero-tn
)))
1021 (define-vop (bignum-mult-and-add-4-arg)
1022 (:translate sb
!bignum
:%multiply-and-add
)
1023 (:policy
:fast-safe
)
1024 (:args
(x :scs
(unsigned-reg) :to
(:eval
1))
1025 (y :scs
(unsigned-reg) :to
(:eval
1))
1026 (prev :scs
(unsigned-reg) :to
(:eval
2))
1027 (carry-in :scs
(unsigned-reg) :to
(:eval
2)))
1028 (:arg-types unsigned-num unsigned-num unsigned-num unsigned-num
)
1029 (:results
(hi :scs
(unsigned-reg) :from
(:eval
0))
1030 (lo :scs
(unsigned-reg) :from
(:eval
1)))
1031 (:result-types unsigned-num unsigned-num
)
1033 (emit-multiply x y hi lo
)
1034 (inst addcc lo carry-in
)
1035 (inst addx hi zero-tn
)
1036 (inst addcc lo prev
)
1037 (inst addx hi zero-tn
)))
1039 (define-vop (bignum-mult)
1040 (:translate sb
!bignum
:%multiply
)
1041 (:policy
:fast-safe
)
1042 (:args
(x :scs
(unsigned-reg) :to
(:result
1))
1043 (y :scs
(unsigned-reg) :to
(:result
1)))
1044 (:arg-types unsigned-num unsigned-num
)
1045 (:results
(hi :scs
(unsigned-reg))
1046 (lo :scs
(unsigned-reg)))
1047 (:result-types unsigned-num unsigned-num
)
1049 (emit-multiply x y hi lo
)))
1051 (define-vop (bignum-lognot lognot-mod32
/unsigned
=>unsigned
)
1052 (:translate sb
!bignum
:%lognot
))
1054 (define-vop (fixnum-to-digit)
1055 (:translate sb
!bignum
:%fixnum-to-digit
)
1056 (:policy
:fast-safe
)
1057 (:args
(fixnum :scs
(any-reg)))
1058 (:arg-types tagged-num
)
1059 (:results
(digit :scs
(unsigned-reg)))
1060 (:result-types unsigned-num
)
1062 (inst sra digit fixnum n-fixnum-tag-bits
)))
1064 (define-vop (bignum-floor)
1065 (:translate sb
!bignum
:%floor
)
1066 (:policy
:fast-safe
)
1067 (:args
(div-high :scs
(unsigned-reg) :target rem
)
1068 (div-low :scs
(unsigned-reg) :target quo
)
1069 (divisor :scs
(unsigned-reg)))
1070 (:arg-types unsigned-num unsigned-num unsigned-num
)
1071 (:results
(quo :scs
(unsigned-reg) :from
(:argument
1))
1072 (rem :scs
(unsigned-reg) :from
(:argument
0)))
1073 (:result-types unsigned-num unsigned-num
)
1078 (let ((label (gen-label)))
1079 (inst cmp rem divisor
)
1081 (inst addxcc quo quo
)
1082 (inst sub rem divisor
)
1085 (inst addx rem rem
))))
1088 (define-vop (bignum-floor-v8)
1089 (:translate sb
!bignum
:%floor
)
1090 (:policy
:fast-safe
)
1091 (:args
(div-high :scs
(unsigned-reg) :target rem
)
1092 (div-low :scs
(unsigned-reg) :target quo
)
1093 (divisor :scs
(unsigned-reg)))
1094 (:arg-types unsigned-num unsigned-num unsigned-num
)
1095 (:results
(quo :scs
(unsigned-reg) :from
(:argument
1))
1096 (rem :scs
(unsigned-reg) :from
(:argument
0)))
1097 (:result-types unsigned-num unsigned-num
)
1098 (:temporary
(:scs
(unsigned-reg) :target quo
) q
)
1099 ;; This vop is for a v8 or v9, provided we're also not using
1100 ;; sparc-64, for which there a special sparc-64 vop.
1101 (:guard
(or (member :sparc-v8
*backend-subfeatures
*)
1102 (member :sparc-v9
*backend-subfeatures
*)))
1108 ;; Compute the quotient [Y, div-low] / divisor
1109 (inst udiv q div-low divisor
)
1110 ;; Compute the remainder. The high part of the result is in the Y
1112 (inst umul rem q divisor
)
1113 (inst sub rem div-low rem
)
1114 (unless (location= quo q
)
1117 (define-vop (bignum-floor-v9)
1118 (:translate sb
!bignum
:%floor
)
1119 (:policy
:fast-safe
)
1120 (:args
(div-high :scs
(unsigned-reg))
1121 (div-low :scs
(unsigned-reg))
1122 (divisor :scs
(unsigned-reg) :to
(:result
1)))
1123 (:arg-types unsigned-num unsigned-num unsigned-num
)
1124 (:temporary
(:sc unsigned-reg
:from
(:argument
0)) dividend
)
1125 (:results
(quo :scs
(unsigned-reg))
1126 (rem :scs
(unsigned-reg)))
1127 (:result-types unsigned-num unsigned-num
)
1128 (:guard
(member :sparc-64
*backend-subfeatures
*))
1130 ;; Set dividend to be div-high and div-low
1131 (inst sllx dividend div-high
32)
1132 (inst add dividend div-low
)
1134 (inst udivx quo dividend divisor
)
1135 ;; Compute the remainder
1136 (inst mulx rem quo divisor
)
1137 (inst sub rem dividend rem
)))
1139 (define-vop (signify-digit)
1140 (:translate sb
!bignum
:%fixnum-digit-with-correct-sign
)
1141 (:policy
:fast-safe
)
1142 (:args
(digit :scs
(unsigned-reg) :target res
))
1143 (:arg-types unsigned-num
)
1144 (:results
(res :scs
(any-reg signed-reg
)))
1145 (:result-types signed-num
)
1149 (inst sll res digit n-fixnum-tag-bits
))
1151 (move res digit
)))))
1153 (define-vop (digit-ashr)
1154 (:translate sb
!bignum
:%ashr
)
1155 (:policy
:fast-safe
)
1156 (:args
(digit :scs
(unsigned-reg))
1157 (count :scs
(unsigned-reg)))
1158 (:arg-types unsigned-num positive-fixnum
)
1159 (:results
(result :scs
(unsigned-reg)))
1160 (:result-types unsigned-num
)
1162 (inst sra result digit count
)))
1164 (define-vop (digit-lshr digit-ashr
)
1165 (:translate sb
!bignum
:%digit-logical-shift-right
)
1167 (inst srl result digit count
)))
1169 (define-vop (digit-ashl digit-ashr
)
1170 (:translate sb
!bignum
:%ashl
)
1172 (inst sll result digit count
)))
1175 ;;;; Static functions.
1177 (define-static-fun two-arg-gcd
(x y
) :translate gcd
)
1178 (define-static-fun two-arg-lcm
(x y
) :translate lcm
)
1180 (define-static-fun two-arg-
+ (x y
) :translate
+)
1181 (define-static-fun two-arg--
(x y
) :translate -
)
1182 (define-static-fun two-arg-
* (x y
) :translate
*)
1183 (define-static-fun two-arg-
/ (x y
) :translate
/)
1185 (define-static-fun two-arg-
< (x y
) :translate
<)
1186 (define-static-fun two-arg-
<= (x y
) :translate
<=)
1187 (define-static-fun two-arg-
> (x y
) :translate
>)
1188 (define-static-fun two-arg-
>= (x y
) :translate
>=)
1189 (define-static-fun two-arg-
= (x y
) :translate
=)
1190 (define-static-fun two-arg-
/= (x y
) :translate
/=)
1192 (define-static-fun %negate
(x) :translate %negate
)
1194 (define-static-fun two-arg-and
(x y
) :translate logand
)
1195 (define-static-fun two-arg-ior
(x y
) :translate logior
)
1196 (define-static-fun two-arg-xor
(x y
) :translate logxor
)
1197 (define-static-fun two-arg-eqv
(x y
) :translate logeqv
)
1202 (deftransform * ((x y
)
1203 ((unsigned-byte 32) (constant-arg (unsigned-byte 32)))
1205 "recode as shifts and adds"
1206 (let ((y (lvar-value y
)))
1207 (multiple-value-bind (result adds shifts
)
1208 (ub32-strength-reduce-constant-multiply 'x y
)
1210 ;; we assume, perhaps foolishly, that good SPARCs don't have an
1211 ;; issue with multiplications. (Remember that there's a
1212 ;; different transform for converting x*2^k to a shift).
1213 ((member :sparc-64
*backend-subfeatures
*) (give-up-ir1-transform))
1214 ((or (member :sparc-v9
*backend-subfeatures
*)
1215 (member :sparc-v8
*backend-subfeatures
*))
1216 ;; breakeven point as measured by Raymond Toy
1217 (when (> (+ adds shifts
) 9)
1218 (give-up-ir1-transform))))