4 (define-assembly-routine (generic-+
6 (:return-style :full-call)
10 ((:arg x (descriptor-reg any-reg) a0-offset)
11 (:arg y (descriptor-reg any-reg) a1-offset)
13 (:res res (descriptor-reg any-reg) a0-offset)
15 (:temp temp non-descriptor-reg nl0-offset)
16 (:temp temp1 non-descriptor-reg nl1-offset)
17 (:temp temp2 non-descriptor-reg nl2-offset)
18 (:temp pa-flag non-descriptor-reg nl4-offset)
19 (:temp lip interior-reg lip-offset)
20 (:temp nargs any-reg nargs-offset)
21 (:temp ocfp any-reg ocfp-offset))
23 (inst and temp fixnum-tag-mask)
24 (inst beq temp DO-ADD)
25 (inst sra temp1 x n-fixnum-tag-bits)
28 (inst lw lip null-tn (static-fun-offset 'two-arg-+))
29 (inst li nargs (fixnumize 2))
32 (move cfp-tn csp-tn t)
35 (inst sra temp2 y n-fixnum-tag-bits)
36 (inst addu temp temp1 temp2)
38 (inst sra temp1 temp (- n-word-bits n-lowtag-bits))
39 (inst beq temp1 RETURN)
40 (inst nor temp1 temp1)
41 (inst beq temp1 RETURN)
43 (with-fixed-allocation (res pa-flag temp2 bignum-widetag (1+ bignum-digits-offset))
44 (storew temp res bignum-digits-offset other-pointer-lowtag))
49 (inst sll res temp n-fixnum-tag-bits)
54 (define-assembly-routine (generic--
56 (:return-style :full-call)
60 ((:arg x (descriptor-reg any-reg) a0-offset)
61 (:arg y (descriptor-reg any-reg) a1-offset)
63 (:res res (descriptor-reg any-reg) a0-offset)
65 (:temp temp non-descriptor-reg nl0-offset)
66 (:temp temp1 non-descriptor-reg nl1-offset)
67 (:temp temp2 non-descriptor-reg nl2-offset)
68 (:temp pa-flag non-descriptor-reg nl4-offset)
69 (:temp lip interior-reg lip-offset)
70 (:temp nargs any-reg nargs-offset)
71 (:temp ocfp any-reg ocfp-offset))
73 (inst and temp fixnum-tag-mask)
74 (inst beq temp DO-SUB)
75 (inst sra temp1 x n-fixnum-tag-bits)
78 (inst lw lip null-tn (static-fun-offset 'two-arg--))
79 (inst li nargs (fixnumize 2))
82 (move cfp-tn csp-tn t)
85 (inst sra temp2 y n-fixnum-tag-bits)
86 (inst subu temp temp1 temp2)
88 (inst sra temp1 temp (- n-word-bits n-lowtag-bits))
89 (inst beq temp1 RETURN)
90 (inst nor temp1 temp1)
91 (inst beq temp1 RETURN)
93 (with-fixed-allocation (res pa-flag temp2 bignum-widetag (1+ bignum-digits-offset))
94 (storew temp res bignum-digits-offset other-pointer-lowtag))
99 (inst sll res temp n-fixnum-tag-bits)
104 (define-assembly-routine (generic-*
106 (:return-style :full-call)
110 ((:arg x (descriptor-reg any-reg) a0-offset)
111 (:arg y (descriptor-reg any-reg) a1-offset)
113 (:res res (descriptor-reg any-reg) a0-offset)
115 (:temp temp non-descriptor-reg nl0-offset)
116 (:temp lo non-descriptor-reg nl1-offset)
117 (:temp hi non-descriptor-reg nl2-offset)
118 (:temp pa-flag non-descriptor-reg nl4-offset)
119 (:temp lip interior-reg lip-offset)
120 (:temp nargs any-reg nargs-offset)
121 (:temp ocfp any-reg ocfp-offset))
122 ;; If either arg is not a fixnum, call the static function.
124 (inst and temp fixnum-tag-mask)
125 (inst bne temp DO-STATIC-FUN)
126 ;; Remove the tag from one arg so that the result will have the correct
128 (inst sra temp x n-fixnum-tag-bits)
132 ;; Check to see if the result will fit in a fixnum. (I.e. the high word
133 ;; is just 32 copies of the sign bit of the low word).
134 (inst sra temp res 31)
135 (inst beq temp hi DONE)
136 ;; Shift the double word hi:res down two bits into hi:low to get rid of the
138 (inst srl lo res n-fixnum-tag-bits)
139 (inst sll temp hi (- n-word-bits n-fixnum-tag-bits))
141 (inst sra hi n-fixnum-tag-bits)
143 ;; Do we need one word or two? Assume two.
144 (inst sra temp lo 31)
145 (inst bne temp hi TWO-WORDS)
146 ;; Assume a two word header.
147 (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
149 ;; Only need one word, fix the header.
150 (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
152 (pseudo-atomic (pa-flag :extra (pad-data-block (+ 1 bignum-digits-offset)))
153 (inst or res alloc-tn other-pointer-lowtag)
154 (storew temp res 0 other-pointer-lowtag))
156 (storew lo res bignum-digits-offset other-pointer-lowtag)
159 (pseudo-atomic (pa-flag :extra (pad-data-block (+ 2 bignum-digits-offset)))
160 (inst or res alloc-tn other-pointer-lowtag)
161 (storew temp res 0 other-pointer-lowtag))
163 (storew lo res bignum-digits-offset other-pointer-lowtag)
165 (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
168 (inst lw lip null-tn (static-fun-offset 'two-arg-*))
169 (inst li nargs (fixnumize 2))
172 (move cfp-tn csp-tn t)
178 ;;;; Comparison routines.
181 ((define-cond-assem-rtn (name translate static-fn cmp)
182 `(define-assembly-routine (,name
184 (:return-style :full-call)
186 (:translate ,translate)
188 ((:arg x (descriptor-reg any-reg) a0-offset)
189 (:arg y (descriptor-reg any-reg) a1-offset)
191 (:res res descriptor-reg a0-offset)
193 (:temp temp non-descriptor-reg nl0-offset)
194 (:temp lip interior-reg lip-offset)
195 (:temp nargs any-reg nargs-offset)
196 (:temp ocfp any-reg ocfp-offset))
198 (inst and temp fixnum-tag-mask)
199 (inst beq temp DO-COMPARE)
203 (inst lw lip null-tn (static-fun-offset ',static-fn))
204 (inst li nargs (fixnumize 2))
207 (move cfp-tn csp-tn t)
216 (define-cond-assem-rtn generic-< < two-arg-< (inst slt temp x y))
217 (define-cond-assem-rtn generic-> > two-arg-> (inst slt temp y x)))
220 (define-assembly-routine (generic-eql
222 (:return-style :full-call)
226 ((:arg x (descriptor-reg any-reg) a0-offset)
227 (:arg y (descriptor-reg any-reg) a1-offset)
229 (:res res descriptor-reg a0-offset)
231 (:temp temp non-descriptor-reg nl0-offset)
232 (:temp lip interior-reg lip-offset)
233 (:temp nargs any-reg nargs-offset)
234 (:temp ocfp any-reg ocfp-offset))
235 (inst beq x y RETURN-T)
237 (inst and temp fixnum-tag-mask)
238 (inst beq temp RETURN)
242 (inst lw lip null-tn (static-fun-offset 'eql))
243 (inst li nargs (fixnumize 2))
246 (move cfp-tn csp-tn t)
258 (define-assembly-routine (generic-=
260 (:return-style :full-call)
264 ((:arg x (descriptor-reg any-reg) a0-offset)
265 (:arg y (descriptor-reg any-reg) a1-offset)
267 (:res res descriptor-reg a0-offset)
269 (:temp temp non-descriptor-reg nl0-offset)
270 (:temp lip interior-reg lip-offset)
271 (:temp nargs any-reg nargs-offset)
272 (:temp ocfp any-reg ocfp-offset))
274 (inst and temp fixnum-tag-mask)
275 (inst beq temp RETURN)
279 (inst lw lip null-tn (static-fun-offset 'two-arg-=))
280 (inst li nargs (fixnumize 2))
283 (move cfp-tn csp-tn t)
293 (define-assembly-routine (generic-/=
295 (:return-style :full-call)
299 ((:arg x (descriptor-reg any-reg) a0-offset)
300 (:arg y (descriptor-reg any-reg) a1-offset)
302 (:res res descriptor-reg a0-offset)
304 (:temp temp non-descriptor-reg nl0-offset)
305 (:temp lip interior-reg lip-offset)
306 (:temp nargs any-reg nargs-offset)
307 (:temp ocfp any-reg ocfp-offset))
309 (inst and temp fixnum-tag-mask)
310 (inst beq temp RETURN)
314 (inst lw lip null-tn (static-fun-offset 'two-arg-/=))
315 (inst li nargs (fixnumize 2))
318 (move cfp-tn csp-tn t)