1 ;;;; simple cases for generic arithmetic
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 ;;;; addition, subtraction, and multiplication
16 (macrolet ((define-generic-arith-routine ((fun cost) &body body)
17 `(define-assembly-routine (,(symbolicate "GENERIC-" fun)
19 (:return-style :full-call)
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?
28 (:res res (descriptor-reg any-reg) edx-offset)
30 (:temp eax unsigned-reg eax-offset)
31 (:temp ebx unsigned-reg ebx-offset)
32 (:temp ecx unsigned-reg ecx-offset))
34 (declare (ignorable ebx))
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
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
54 ',(symbolicate "TWO-ARG-" fun)))))
59 (define-generic-arith-routine (+ 10)
63 (inst rcr res 1) ; carry has correct sign
64 (inst sar res 1) ; remove type bits
68 (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
69 (storew ecx res bignum-digits-offset other-pointer-lowtag))
73 (define-generic-arith-routine (- 10)
77 (inst cmc) ; carry has correct sign now
79 (inst sar res 1) ; remove type bits
83 (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
84 (storew ecx res bignum-digits-offset other-pointer-lowtag))
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
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
99 (move ecx x) ; save high bits from cdq
100 (inst cdq) ; edx:eax <- sign-extend of eax
102 (inst jmp :e SINGLE-WORD-BIGNUM)
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))
111 (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
112 (storew eax res bignum-digits-offset other-pointer-lowtag))
121 (define-assembly-routine (generic-negate
123 (:return-style :full-call)
127 ((:arg x (descriptor-reg any-reg) edx-offset)
128 (:res res (descriptor-reg any-reg) edx-offset)
130 (:temp eax unsigned-reg eax-offset)
131 (:temp ecx unsigned-reg ecx-offset))
137 (inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
138 (inst sub esp-tn (fixnumize 2))
140 (inst mov ecx (fixnumize 1)) ; arg count
141 (inst jmp (make-ea :dword
142 :disp (+ nil-value (static-fun-offset '%negate))))
146 (inst neg res) ; (- most-negative-fixnum) is BIGNUM
148 (inst shr res 2) ; sign bit is data - remove type bits
151 (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
152 (storew ecx res bignum-digits-offset other-pointer-lowtag))
158 (macrolet ((define-cond-assem-rtn (name translate static-fn test)
159 `(define-assembly-routine (,name
161 (:return-style :full-call)
163 (:translate ,translate)
165 ((:arg x (descriptor-reg any-reg) edx-offset)
166 (:arg y (descriptor-reg any-reg) edi-offset)
168 (:res res descriptor-reg edx-offset)
170 (:temp eax unsigned-reg eax-offset)
171 (:temp ecx unsigned-reg ecx-offset))
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
178 (inst jmp :nz TAIL-CALL-TO-STATIC-FN)
180 (inst jmp :z INLINE-FIXNUM-COMPARE)
182 TAIL-CALL-TO-STATIC-FN
185 (inst lea ebp-tn (make-ea :dword
188 (inst sub esp-tn (fixnumize 2)) ; FIXME: Push 2 words on stack,
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
196 (static-fun-offset ',static-fn))))
198 INLINE-FIXNUM-COMPARE
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.
213 (load-symbol res t))))
215 (define-cond-assem-rtn generic-< < two-arg-< :l)
216 (define-cond-assem-rtn generic-> > two-arg-> :g))
218 (define-assembly-routine (generic-eql
220 (:return-style :full-call)
224 ((:arg x (descriptor-reg any-reg) edx-offset)
225 (:arg y (descriptor-reg any-reg) edi-offset)
227 (:res res descriptor-reg edx-offset)
229 (:temp eax unsigned-reg eax-offset)
230 (:temp ecx unsigned-reg ecx-offset))
232 (inst jmp :e RETURN-T)
234 (inst jmp :z RETURN-NIL)
236 (inst jmp :nz DO-STATIC-FN)
239 (inst mov res nil-value)
247 (inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
248 (inst sub esp-tn (fixnumize 2))
250 (inst mov ecx (fixnumize 2))
251 (inst jmp (make-ea :dword
252 :disp (+ nil-value (static-fun-offset 'eql))))
256 ;; FIXME: I don't understand how we return from here..
259 (define-assembly-routine (generic-=
261 (:return-style :full-call)
265 ((:arg x (descriptor-reg any-reg) edx-offset)
266 (:arg y (descriptor-reg any-reg) edi-offset)
268 (:res res descriptor-reg edx-offset)
270 (:temp eax unsigned-reg eax-offset)
271 (:temp ecx unsigned-reg ecx-offset)
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)
278 (inst jmp :e RETURN-T) ; ok
280 (inst mov res nil-value)
288 (inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
289 (inst sub esp-tn (fixnumize 2))
291 (inst mov ecx (fixnumize 2))
292 (inst jmp (make-ea :dword
293 :disp (+ nil-value (static-fun-offset 'two-arg-=))))
299 ;;; Support for the Mersenne Twister, MT19937, random number generator
300 ;;; due to Matsumoto and Nishimura.
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,
308 ;;; 0-1: Constant matrix A. [0, #x9908b0df] (not used here)
309 ;;; 2: Index; init. to 1.
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))
323 ;; Save the temporary registers.
328 ;; Generate a new set of results.
331 (inst mov y (make-ea :dword :base state :index k :scale 4
332 :disp (- (* (+ 3 vector-data-offset)
334 other-pointer-lowtag)))
335 (inst mov tmp (make-ea :dword :base state :index k :scale 4
336 :disp (- (* (+ 1 3 vector-data-offset)
338 other-pointer-lowtag)))
339 (inst and y #x80000000)
340 (inst and tmp #x7fffffff)
344 (inst xor y #x9908b0df)
346 (inst xor y (make-ea :dword :base state :index k :scale 4
347 :disp (- (* (+ 397 3 vector-data-offset)
349 other-pointer-lowtag)))
350 (inst mov (make-ea :dword :base state :index k :scale 4
351 :disp (- (* (+ 3 vector-data-offset)
353 other-pointer-lowtag))
356 (inst cmp k (- 624 397))
359 (inst mov y (make-ea :dword :base state :index k :scale 4
360 :disp (- (* (+ 3 vector-data-offset)
362 other-pointer-lowtag)))
363 (inst mov tmp (make-ea :dword :base state :index k :scale 4
364 :disp (- (* (+ 1 3 vector-data-offset)
366 other-pointer-lowtag)))
367 (inst and y #x80000000)
368 (inst and tmp #x7fffffff)
372 (inst xor y #x9908b0df)
374 (inst xor y (make-ea :dword :base state :index k :scale 4
375 :disp (- (* (+ (- 397 624) 3 vector-data-offset)
377 other-pointer-lowtag)))
378 (inst mov (make-ea :dword :base state :index k :scale 4
379 :disp (- (* (+ 3 vector-data-offset)
381 other-pointer-lowtag))
384 (inst cmp k (- 624 1))
387 (inst mov y (make-ea :dword :base state
388 :disp (- (* (+ (- 624 1) 3 vector-data-offset)
390 other-pointer-lowtag)))
391 (inst mov tmp (make-ea :dword :base state
392 :disp (- (* (+ 0 3 vector-data-offset)
394 other-pointer-lowtag)))
395 (inst and y #x80000000)
396 (inst and tmp #x7fffffff)
400 (inst xor y #x9908b0df)
402 (inst xor y (make-ea :dword :base state
403 :disp (- (* (+ (- 397 1) 3 vector-data-offset)
405 other-pointer-lowtag)))
406 (inst mov (make-ea :dword :base state
407 :disp (- (* (+ (- 624 1) 3 vector-data-offset)
409 other-pointer-lowtag))
412 ;; Restore the temporary registers and return.