0.7.7.9:
[sbcl.git] / src / assembly / mips / arith.lisp
1 (in-package "SB!VM")
2
3
4 (define-assembly-routine (generic-+
5                           (:cost 10)
6                           (:return-style :full-call)
7                           (:translate +)
8                           (:policy :safe)
9                           (:save-p t))
10                          ((:arg x (descriptor-reg any-reg) a0-offset)
11                           (:arg y (descriptor-reg any-reg) a1-offset)
12
13                           (:res res (descriptor-reg any-reg) a0-offset)
14
15                           (:temp temp non-descriptor-reg nl0-offset)
16                           (:temp lip interior-reg lip-offset)
17                           (:temp lra descriptor-reg lra-offset)
18                           (:temp nargs any-reg nargs-offset)
19                           (:temp ocfp any-reg ocfp-offset))
20   (inst b DO-STATIC-FUN)
21   (inst nop)
22   #+nil
23   (progn
24     (inst and temp x 3)
25     (inst bne temp DO-STATIC-FUN)
26     (inst and temp y 3)
27     (inst bne temp DO-STATIC-FUN)
28     (inst nop)
29     (inst add res x y)
30     (lisp-return lra lip :offset 2))
31
32   DO-STATIC-FUN
33   (inst lw lip null-tn (static-fun-offset 'two-arg-+))
34   (inst li nargs (fixnumize 2))
35   (inst move ocfp cfp-tn)
36   (inst j lip)
37   (inst move cfp-tn csp-tn))
38
39
40 (define-assembly-routine (generic--
41                           (:cost 10)
42                           (:return-style :full-call)
43                           (:translate -)
44                           (:policy :safe)
45                           (:save-p t))
46                          ((:arg x (descriptor-reg any-reg) a0-offset)
47                           (:arg y (descriptor-reg any-reg) a1-offset)
48
49                           (:res res (descriptor-reg any-reg) a0-offset)
50
51                           (:temp temp non-descriptor-reg nl0-offset)
52                           (:temp lip interior-reg lip-offset)
53                           (:temp lra descriptor-reg lra-offset)
54                           (:temp nargs any-reg nargs-offset)
55                           (:temp ocfp any-reg ocfp-offset))
56   (inst b DO-STATIC-FUN)
57   (inst nop)
58   #+nil
59   (progn
60     (inst and temp x 3)
61     (inst bne temp DO-STATIC-FUN)
62     (inst and temp y 3)
63     (inst bne temp DO-STATIC-FUN)
64     (inst nop)
65     (inst sub res x y)
66     (lisp-return lra lip :offset 2))
67
68   DO-STATIC-FUN
69   (inst lw lip null-tn (static-fun-offset 'two-arg--))
70   (inst li nargs (fixnumize 2))
71   (inst move ocfp cfp-tn)
72   (inst j lip)
73   (inst move cfp-tn csp-tn))
74
75
76 (define-assembly-routine (generic-*
77                           (:cost 25)
78                           (:return-style :full-call)
79                           (:translate *)
80                           (:policy :safe)
81                           (:save-p t))
82                          ((:arg x (descriptor-reg any-reg) a0-offset)
83                           (:arg y (descriptor-reg any-reg) a1-offset)
84
85                           (:res res (descriptor-reg any-reg) a0-offset)
86
87                           (:temp temp non-descriptor-reg nl0-offset)
88                           (:temp lo non-descriptor-reg nl1-offset)
89                           (:temp hi non-descriptor-reg nl2-offset)
90                           (:temp pa-flag non-descriptor-reg nl4-offset)
91                           (:temp lip interior-reg lip-offset)
92                           (:temp lra descriptor-reg lra-offset)
93                           (:temp nargs any-reg nargs-offset)
94                           (:temp ocfp any-reg ocfp-offset))
95   ;; If either arg is not a fixnum, call the static function.
96   (inst and temp x 3)
97   (inst bne temp DO-STATIC-FUN)
98   (inst and temp y 3)
99   (inst bne temp DO-STATIC-FUN)
100   (inst nop)
101
102   ;; Remove the tag from one arg so that the result will have the correct
103   ;; fixnum tag.
104   (inst sra temp x 2)
105   (inst mult temp y)
106   (inst mflo res)
107   (inst mfhi hi)
108   ;; Check to see if the result will fit in a fixnum.  (I.e. the high word
109   ;; is just 32 copies of the sign bit of the low word).
110   (inst sra temp res 31)
111   (inst xor temp hi)
112   (inst beq temp DONE)
113   ;; Shift the double word hi:res down two bits into hi:low to get rid of the
114   ;; fixnum tag.
115   (inst srl lo res 2)
116   (inst sll temp hi 30)
117   (inst or lo temp)
118   (inst sra hi 2)
119
120   ;; Do we need one word or two?  Assume two.
121   (inst sra temp lo 31)
122   (inst xor temp hi)
123   (inst bne temp two-words)
124   ;; Assume a two word header.
125   (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
126
127   ;; Only need one word, fix the header.
128   (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
129
130   (pseudo-atomic (pa-flag :extra (pad-data-block (+ 1 bignum-digits-offset)))
131     (inst or res alloc-tn other-pointer-lowtag)
132     (storew temp res 0 other-pointer-lowtag))
133
134   (storew lo res bignum-digits-offset other-pointer-lowtag)
135
136   ;; Out of here
137   (lisp-return lra lip :offset 2)
138
139
140   TWO-WORDS
141   (pseudo-atomic (pa-flag :extra (pad-data-block (+ 2 bignum-digits-offset)))
142     (inst or res alloc-tn other-pointer-lowtag)
143     (storew temp res 0 other-pointer-lowtag))
144
145   (storew lo res bignum-digits-offset other-pointer-lowtag)
146   (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
147
148   ;; Out of here
149   (lisp-return lra lip :offset 2)
150
151
152   DO-STATIC-FUN
153   (inst lw lip null-tn (static-fun-offset 'two-arg-*))
154   (inst li nargs (fixnumize 2))
155   (inst move ocfp cfp-tn)
156   (inst j lip)
157   (inst move cfp-tn csp-tn)
158
159   DONE)
160
161
162 \f
163 ;;;; Comparison routines.
164
165 (macrolet
166     ((define-cond-assem-rtn (name translate static-fn cmp not-p)
167        `(define-assembly-routine (,name
168                                   (:cost 10)
169                                   (:return-style :full-call)
170                                   (:policy :safe)
171                                   (:translate ,translate)
172                                   (:save-p t))
173                                  ((:arg x (descriptor-reg any-reg) a0-offset)
174                                   (:arg y (descriptor-reg any-reg) a1-offset)
175                                   
176                                   (:res res descriptor-reg a0-offset)
177                                   
178                                   (:temp temp non-descriptor-reg nl0-offset)
179                                   (:temp lip interior-reg lip-offset)
180                                   (:temp nargs any-reg nargs-offset)
181                                   (:temp ocfp any-reg ocfp-offset))
182           (inst and temp x 3)
183           (inst bne temp DO-STATIC-FN)
184           (inst and temp y 3)
185           (inst beq temp DO-COMPARE)
186           ,cmp
187           
188           DO-STATIC-FN
189           (inst lw lip null-tn (static-fun-offset ',static-fn))
190           (inst li nargs (fixnumize 2))
191           (inst move ocfp cfp-tn)
192           (inst j lip)
193           (inst move cfp-tn csp-tn)
194           
195           DO-COMPARE
196           (inst ,(if not-p 'bne 'beq) temp done)
197           (inst move res null-tn)
198           (load-symbol res t)
199           DONE)))
200
201   (define-cond-assem-rtn generic-< < two-arg-< (inst slt temp x y) nil)
202   (define-cond-assem-rtn generic-> > two-arg-> (inst slt temp y x) nil))
203
204
205 (define-assembly-routine (generic-eql
206                           (:cost 10)
207                           (:return-style :full-call)
208                           (:policy :safe)
209                           (:translate eql)
210                           (:save-p t))
211                          ((:arg x (descriptor-reg any-reg) a0-offset)
212                           (:arg y (descriptor-reg any-reg) a1-offset)
213                           
214                           (:res res descriptor-reg a0-offset)
215                           
216                           (:temp temp non-descriptor-reg nl0-offset)
217                           (:temp lip interior-reg lip-offset)
218                           (:temp lra descriptor-reg lra-offset)
219                           (:temp nargs any-reg nargs-offset)
220                           (:temp ocfp any-reg ocfp-offset))
221   (inst beq x y RETURN-T)
222   (inst and temp x 3)
223   (inst beq temp RETURN-NIL)
224   (inst and temp y 3)
225   (inst bne temp DO-STATIC-FN)
226   (inst nop)
227
228   RETURN-NIL
229   (inst move res null-tn)
230   (lisp-return lra lip :offset 2)
231
232   DO-STATIC-FN
233   (inst lw lip null-tn (static-fun-offset 'eql))
234   (inst li nargs (fixnumize 2))
235   (inst move ocfp cfp-tn)
236   (inst j lip)
237   (inst move cfp-tn csp-tn)
238
239   RETURN-T
240   (load-symbol res t))
241
242 (define-assembly-routine (generic-=
243                           (:cost 10)
244                           (:return-style :full-call)
245                           (:policy :safe)
246                           (:translate =)
247                           (:save-p t))
248                          ((:arg x (descriptor-reg any-reg) a0-offset)
249                           (:arg y (descriptor-reg any-reg) a1-offset)
250                           
251                           (:res res descriptor-reg a0-offset)
252                           
253                           (:temp temp non-descriptor-reg nl0-offset)
254                           (:temp lip interior-reg lip-offset)
255                           (:temp lra descriptor-reg lra-offset)
256                           (:temp nargs any-reg nargs-offset)
257                           (:temp ocfp any-reg ocfp-offset))
258   (inst and temp x 3)
259   (inst bne temp DO-STATIC-FN)
260   (inst and temp y 3)
261   (inst bne temp DO-STATIC-FN)
262   (inst nop)
263   (inst beq x y RETURN-T)
264
265   (inst move res null-tn)
266   (lisp-return lra lip :offset 2)
267
268   DO-STATIC-FN
269   (inst lw lip null-tn (static-fun-offset 'two-arg-=))
270   (inst li nargs (fixnumize 2))
271   (inst move ocfp cfp-tn)
272   (inst j lip)
273   (inst move cfp-tn csp-tn)
274
275   RETURN-T
276   (load-symbol res t))
277
278 (define-assembly-routine (generic-/=
279                           (:cost 10)
280                           (:return-style :full-call)
281                           (:policy :safe)
282                           (:translate /=)
283                           (:save-p t))
284                          ((:arg x (descriptor-reg any-reg) a0-offset)
285                           (:arg y (descriptor-reg any-reg) a1-offset)
286                           
287                           (:res res descriptor-reg a0-offset)
288                           
289                           (:temp temp non-descriptor-reg nl0-offset)
290                           (:temp lip interior-reg lip-offset)
291                           (:temp lra descriptor-reg lra-offset)
292                           (:temp nargs any-reg nargs-offset)
293                           (:temp ocfp any-reg ocfp-offset))
294   (inst and temp x 3)
295   (inst bne temp DO-STATIC-FN)
296   (inst and temp y 3)
297   (inst bne temp DO-STATIC-FN)
298   (inst nop)
299   (inst beq x y RETURN-NIL)
300
301   (load-symbol res t)
302   (lisp-return lra lip :offset 2)
303
304   DO-STATIC-FN
305   (inst lw lip null-tn (static-fun-offset 'two-arg-=))
306   (inst li nargs (fixnumize 2))
307   (inst move ocfp cfp-tn)
308   (inst j lip)
309   (inst move cfp-tn csp-tn)
310
311   RETURN-NIL
312   (inst move res null-tn))