dbc752cdadeef4825d0f267a1c2ce11710cd79f6
[sbcl.git] / src / assembly / x86 / arith.lisp
1 ;;;; simple cases for generic arithmetic
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
11
12 (in-package "SB!VM")
13 \f
14 ;;;; addition, subtraction, and multiplication
15
16 (macrolet ((define-generic-arith-routine ((fun cost) &body body)
17              `(define-assembly-routine (,(symbolicate "GENERIC-" fun)
18                                         (:cost ,cost)
19                                         (:return-style :full-call)
20                                         (:translate ,fun)
21                                         (:policy :safe)
22                                         (:save-p t))
23                 ((:arg x (descriptor-reg any-reg) edx-offset)
24                  (:arg y (descriptor-reg any-reg)
25                        ;; this seems wrong esi-offset -- FIXME: What's it mean?
26                        edi-offset)
27
28                  (:res res (descriptor-reg any-reg) edx-offset)
29
30                  (:temp eax unsigned-reg eax-offset)
31                  (:temp ebx unsigned-reg ebx-offset)
32                  (:temp ecx unsigned-reg ecx-offset))
33
34                 (declare (ignorable ebx))
35
36                 (inst test x 3)  ; fixnum?
37                 (inst jmp :nz DO-STATIC-FUN) ; no - do generic
38                 (inst test y 3)  ; fixnum?
39                 (inst jmp :z DO-BODY)   ; yes - doit here
40
41                 DO-STATIC-FUN
42                 (inst pop eax)
43                 (inst push ebp-tn)
44                 (inst lea
45                       ebp-tn
46                       (make-ea :dword :base esp-tn :disp n-word-bytes))
47                 (inst sub esp-tn (fixnumize 2))
48                 (inst push eax)  ; callers return addr
49                 (inst mov ecx (fixnumize 2)) ; arg count
50                 (inst jmp
51                       (make-ea :dword
52                                :disp (+ nil-value
53                                         (static-fun-offset
54                                          ',(symbolicate "TWO-ARG-" fun)))))
55
56                 DO-BODY
57                 ,@body)))
58
59   (define-generic-arith-routine (+ 10)
60     (move res x)
61     (inst add res y)
62     (inst jmp :no OKAY)
63     (inst rcr res 1)                  ; carry has correct sign
64     (inst sar res 1)                  ; remove type bits
65
66     (move ecx res)
67
68     (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
69       (storew ecx res bignum-digits-offset other-pointer-lowtag))
70
71     OKAY)
72
73   (define-generic-arith-routine (- 10)
74     (move res x)
75     (inst sub res y)
76     (inst jmp :no OKAY)
77     (inst cmc)                        ; carry has correct sign now
78     (inst rcr res 1)
79     (inst sar res 1)                  ; remove type bits
80
81     (move ecx res)
82
83     (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
84       (storew ecx res bignum-digits-offset other-pointer-lowtag))
85     OKAY)
86
87   (define-generic-arith-routine (* 30)
88     (move eax x)                          ; must use eax for 64-bit result
89     (inst sar eax 2)                  ; remove *4 fixnum bias
90     (inst imul y)                        ; result in edx:eax
91     (inst jmp :no okay)            ; still fixnum
92
93     ;; zzz jrd changed edx to ebx in here, as edx isn't listed as a temp, above
94     ;;     pfw says that loses big -- edx is target for arg x and result res
95     ;;     note that 'edx' is not defined -- using x
96     (inst shrd eax x 2)            ; high bits from edx
97     (inst sar x 2)                      ; now shift edx too
98
99     (move ecx x)                          ; save high bits from cdq
100     (inst cdq)                      ; edx:eax <- sign-extend of eax
101     (inst cmp x ecx)
102     (inst jmp :e SINGLE-WORD-BIGNUM)
103
104     (with-fixed-allocation (res bignum-widetag (+ bignum-digits-offset 2))
105       (storew eax res bignum-digits-offset other-pointer-lowtag)
106       (storew ecx res (1+ bignum-digits-offset) other-pointer-lowtag))
107     (inst jmp DONE)
108
109     SINGLE-WORD-BIGNUM
110
111     (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
112       (storew eax res bignum-digits-offset other-pointer-lowtag))
113     (inst jmp DONE)
114
115     OKAY
116     (move res eax)
117     DONE))
118 \f
119 ;;;; negation
120
121 (define-assembly-routine (generic-negate
122                           (:cost 10)
123                           (:return-style :full-call)
124                           (:policy :safe)
125                           (:translate %negate)
126                           (:save-p t))
127                          ((:arg x (descriptor-reg any-reg) edx-offset)
128                           (:res res (descriptor-reg any-reg) edx-offset)
129
130                           (:temp eax unsigned-reg eax-offset)
131                           (:temp ecx unsigned-reg ecx-offset))
132   (inst test x 3)
133   (inst jmp :z FIXNUM)
134
135   (inst pop eax)
136   (inst push ebp-tn)
137   (inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
138   (inst sub esp-tn (fixnumize 2))
139   (inst push eax)
140   (inst mov ecx (fixnumize 1))    ; arg count
141   (inst jmp (make-ea :dword
142                      :disp (+ nil-value (static-fun-offset '%negate))))
143
144   FIXNUM
145   (move res x)
146   (inst neg res)                        ; (- most-negative-fixnum) is BIGNUM
147   (inst jmp :no OKAY)
148   (inst shr res 2)                    ; sign bit is data - remove type bits
149   (move ecx res)
150
151   (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
152     (storew ecx res bignum-digits-offset other-pointer-lowtag))
153
154   OKAY)
155 \f
156 ;;;; comparison
157
158 (macrolet ((define-cond-assem-rtn (name translate static-fn test)
159              `(define-assembly-routine (,name
160                                         (:cost 10)
161                                         (:return-style :full-call)
162                                         (:policy :safe)
163                                         (:translate ,translate)
164                                         (:save-p t))
165                 ((:arg x (descriptor-reg any-reg) edx-offset)
166                  (:arg y (descriptor-reg any-reg) edi-offset)
167
168                  (:res res descriptor-reg edx-offset)
169
170                  (:temp eax unsigned-reg eax-offset)
171                  (:temp ecx unsigned-reg ecx-offset))
172
173                 ;; KLUDGE: The "3" here is a mask for the bits which will be
174                 ;; zero in a fixnum. It should have a symbolic name. (Actually,
175                 ;; it might already have a symbolic name which the coder
176                 ;; couldn't be bothered to use..) -- WHN 19990917
177                 (inst test x 3)
178                 (inst jmp :nz TAIL-CALL-TO-STATIC-FN)
179                 (inst test y 3)
180                 (inst jmp :z INLINE-FIXNUM-COMPARE)
181
182                 TAIL-CALL-TO-STATIC-FN
183                 (inst pop eax)
184                 (inst push ebp-tn)
185                 (inst lea ebp-tn (make-ea :dword
186                                           :base esp-tn
187                                           :disp n-word-bytes))
188                 (inst sub esp-tn (fixnumize 2)) ; FIXME: Push 2 words on stack,
189                                                 ; weirdly?
190                 (inst push eax)
191                 (inst mov ecx (fixnumize 2)) ; FIXME: FIXNUMIZE and
192                                         ; SINGLE-FLOAT-BITS are parallel,
193                                         ; should be named parallelly.
194                 (inst jmp (make-ea :dword
195                                    :disp (+ nil-value
196                                             (static-fun-offset ',static-fn))))
197
198                 INLINE-FIXNUM-COMPARE
199                 (inst cmp x y)
200                 (inst jmp ,test RETURN-TRUE)
201                 (inst mov res nil-value)
202                 ;; FIXME: A note explaining this return convention, or a
203                 ;; symbolic name for it, would be nice. (It looks as though we
204                 ;; should be hand-crafting the same return sequence as would be
205                 ;; produced by GENERATE-RETURN-SEQUENCE, but in that case it's
206                 ;; not clear why we don't just jump to the end of this function
207                 ;; to share the return sequence there.
208                 (inst pop eax)
209                 (inst add eax 2)
210                 (inst jmp eax)
211
212                 RETURN-TRUE
213                 (load-symbol res t))))
214
215   (define-cond-assem-rtn generic-< < two-arg-< :l)
216   (define-cond-assem-rtn generic-> > two-arg-> :g))
217
218 (define-assembly-routine (generic-eql
219                           (:cost 10)
220                           (:return-style :full-call)
221                           (:policy :safe)
222                           (:translate eql)
223                           (:save-p t))
224                          ((:arg x (descriptor-reg any-reg) edx-offset)
225                           (:arg y (descriptor-reg any-reg) edi-offset)
226
227                           (:res res descriptor-reg edx-offset)
228
229                           (:temp eax unsigned-reg eax-offset)
230                           (:temp ecx unsigned-reg ecx-offset))
231   (inst cmp x y)
232   (inst jmp :e RETURN-T)
233   (inst test x 3)
234   (inst jmp :z RETURN-NIL)
235   (inst test y 3)
236   (inst jmp :nz DO-STATIC-FN)
237
238   RETURN-NIL
239   (inst mov res nil-value)
240   (inst pop eax)
241   (inst add eax 2)
242   (inst jmp eax)
243
244   DO-STATIC-FN
245   (inst pop eax)
246   (inst push ebp-tn)
247   (inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
248   (inst sub esp-tn (fixnumize 2))
249   (inst push eax)
250   (inst mov ecx (fixnumize 2))
251   (inst jmp (make-ea :dword
252                      :disp (+ nil-value (static-fun-offset 'eql))))
253
254   RETURN-T
255   (load-symbol res t)
256   ;; FIXME: I don't understand how we return from here..
257   )
258
259 (define-assembly-routine (generic-=
260                           (:cost 10)
261                           (:return-style :full-call)
262                           (:policy :safe)
263                           (:translate =)
264                           (:save-p t))
265                          ((:arg x (descriptor-reg any-reg) edx-offset)
266                           (:arg y (descriptor-reg any-reg) edi-offset)
267
268                           (:res res descriptor-reg edx-offset)
269
270                           (:temp eax unsigned-reg eax-offset)
271                           (:temp ecx unsigned-reg ecx-offset)
272                           )
273   (inst test x 3)                      ; descriptor?
274   (inst jmp :nz DO-STATIC-FN)          ; yes, do it here
275   (inst test y 3)                      ; descriptor?
276   (inst jmp :nz DO-STATIC-FN)
277   (inst cmp x y)
278   (inst jmp :e RETURN-T)                ; ok
279
280   (inst mov res nil-value)
281   (inst pop eax)
282   (inst add eax 2)
283   (inst jmp eax)
284
285   DO-STATIC-FN
286   (inst pop eax)
287   (inst push ebp-tn)
288   (inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
289   (inst sub esp-tn (fixnumize 2))
290   (inst push eax)
291   (inst mov ecx (fixnumize 2))
292   (inst jmp (make-ea :dword
293                      :disp (+ nil-value (static-fun-offset 'two-arg-=))))
294
295   RETURN-T
296   (load-symbol res t))
297
298 \f
299 ;;; Support for the Mersenne Twister, MT19937, random number generator
300 ;;; due to Matsumoto and Nishimura.
301 ;;;
302 ;;; Makoto Matsumoto and T. Nishimura, "Mersenne twister: A
303 ;;; 623-dimensionally equidistributed uniform pseudorandom number
304 ;;; generator.", ACM Transactions on Modeling and Computer Simulation,
305 ;;; 1997, to appear.
306 ;;;
307 ;;; State:
308 ;;;  0-1:   Constant matrix A. [0, #x9908b0df] (not used here)
309 ;;;  2:     Index; init. to 1.
310 ;;;  3-626: State.
311
312 ;;; This assembly routine is called from the inline VOP and updates
313 ;;; the state vector with new random numbers. The state vector is
314 ;;; passed in the EAX register.
315 #+sb-assembling ; We don't want a vop for this one.
316 (define-assembly-routine
317     (random-mt19937-update)
318     ((:temp state unsigned-reg eax-offset)
319      (:temp k unsigned-reg ebx-offset)
320      (:temp y unsigned-reg ecx-offset)
321      (:temp tmp unsigned-reg edx-offset))
322
323   ;; Save the temporary registers.
324   (inst push k)
325   (inst push y)
326   (inst push tmp)
327
328   ;; Generate a new set of results.
329   (inst xor k k)
330   LOOP1
331   (inst mov y (make-ea :dword :base state :index k :scale 4
332                        :disp (- (* (+ 3 vector-data-offset)
333                                    n-word-bytes)
334                                 other-pointer-lowtag)))
335   (inst mov tmp (make-ea :dword :base state :index k :scale 4
336                          :disp (- (* (+ 1 3 vector-data-offset)
337                                      n-word-bytes)
338                                   other-pointer-lowtag)))
339   (inst and y #x80000000)
340   (inst and tmp #x7fffffff)
341   (inst or y tmp)
342   (inst shr y 1)
343   (inst jmp :nc skip1)
344   (inst xor y #x9908b0df)
345   SKIP1
346   (inst xor y (make-ea :dword :base state :index k :scale 4
347                        :disp (- (* (+ 397 3 vector-data-offset)
348                                    n-word-bytes)
349                                 other-pointer-lowtag)))
350   (inst mov (make-ea :dword :base state :index k :scale 4
351                      :disp (- (* (+ 3 vector-data-offset)
352                                  n-word-bytes)
353                               other-pointer-lowtag))
354         y)
355   (inst inc k)
356   (inst cmp k (- 624 397))
357   (inst jmp :b loop1)
358   LOOP2
359   (inst mov y (make-ea :dword :base state :index k :scale 4
360                        :disp (- (* (+ 3 vector-data-offset)
361                                    n-word-bytes)
362                                 other-pointer-lowtag)))
363   (inst mov tmp (make-ea :dword :base state :index k :scale 4
364                          :disp (- (* (+ 1 3 vector-data-offset)
365                                      n-word-bytes)
366                                   other-pointer-lowtag)))
367   (inst and y #x80000000)
368   (inst and tmp #x7fffffff)
369   (inst or y tmp)
370   (inst shr y 1)
371   (inst jmp :nc skip2)
372   (inst xor y #x9908b0df)
373   SKIP2
374   (inst xor y (make-ea :dword :base state :index k :scale 4
375                        :disp (- (* (+ (- 397 624) 3 vector-data-offset)
376                                    n-word-bytes)
377                                 other-pointer-lowtag)))
378   (inst mov (make-ea :dword :base state :index k :scale 4
379                      :disp (- (* (+ 3 vector-data-offset)
380                                  n-word-bytes)
381                               other-pointer-lowtag))
382         y)
383   (inst inc k)
384   (inst cmp k (- 624 1))
385   (inst jmp :b loop2)
386
387   (inst mov y (make-ea :dword :base state
388                        :disp (- (* (+ (- 624 1) 3 vector-data-offset)
389                                    n-word-bytes)
390                                 other-pointer-lowtag)))
391   (inst mov tmp (make-ea :dword :base state
392                          :disp (- (* (+ 0 3 vector-data-offset)
393                                      n-word-bytes)
394                                   other-pointer-lowtag)))
395   (inst and y #x80000000)
396   (inst and tmp #x7fffffff)
397   (inst or y tmp)
398   (inst shr y 1)
399   (inst jmp :nc skip3)
400   (inst xor y #x9908b0df)
401   SKIP3
402   (inst xor y (make-ea :dword :base state
403                        :disp (- (* (+ (- 397 1) 3 vector-data-offset)
404                                    n-word-bytes)
405                                 other-pointer-lowtag)))
406   (inst mov (make-ea :dword :base state
407                      :disp (- (* (+ (- 624 1) 3 vector-data-offset)
408                                  n-word-bytes)
409                               other-pointer-lowtag))
410         y)
411
412   ;; Restore the temporary registers and return.
413   (inst pop tmp)
414   (inst pop y)
415   (inst pop k)
416   (inst ret))