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 ecx unsigned-reg ecx-offset))
35 (inst test ecx fixnum-tag-mask) ; both fixnums?
36 (inst jmp :nz DO-STATIC-FUN) ; no - do generic
39 (inst clc) ; single-value return
47 (make-ea :dword :base esp-tn :disp n-word-bytes))
48 (inst sub esp-tn (fixnumize 2))
49 (inst push eax) ; callers return addr
50 (inst mov ecx (fixnumize 2)) ; arg count
55 ',(symbolicate "TWO-ARG-" fun))))))))
57 (define-generic-arith-routine (+ 10)
61 (inst rcr res 1) ; carry has correct sign
62 (inst sar res 1) ; remove type bits
66 (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
67 (storew ecx res bignum-digits-offset other-pointer-lowtag))
71 (define-generic-arith-routine (- 10)
75 (inst cmc) ; carry has correct sign now
77 (inst sar res 1) ; remove type bits
81 (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
82 (storew ecx res bignum-digits-offset other-pointer-lowtag))
85 (define-generic-arith-routine (* 30)
86 (move eax x) ; must use eax for 64-bit result
87 (inst sar eax n-fixnum-tag-bits) ; remove *4 fixnum bias
88 (inst imul y) ; result in edx:eax
89 (inst jmp :no okay) ; still fixnum
91 ;; zzz jrd changed edx to ebx in here, as edx isn't listed as a temp, above
92 ;; pfw says that loses big -- edx is target for arg x and result res
93 ;; note that 'edx' is not defined -- using x
94 (inst shrd eax x n-fixnum-tag-bits) ; high bits from edx
95 (inst sar x n-fixnum-tag-bits) ; now shift edx too
97 (move ecx x) ; save high bits from cdq
98 (inst cdq) ; edx:eax <- sign-extend of eax
100 (inst jmp :e SINGLE-WORD-BIGNUM)
102 (with-fixed-allocation (res bignum-widetag (+ bignum-digits-offset 2))
103 (storew eax res bignum-digits-offset other-pointer-lowtag)
104 (storew ecx res (1+ bignum-digits-offset) other-pointer-lowtag))
109 (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
110 (storew eax res bignum-digits-offset other-pointer-lowtag))
119 (define-assembly-routine (generic-negate
121 (:return-style :full-call)
125 ((:arg x (descriptor-reg any-reg) edx-offset)
126 (:res res (descriptor-reg any-reg) edx-offset)
128 (:temp eax unsigned-reg eax-offset)
129 (:temp ecx unsigned-reg ecx-offset))
130 (inst test x fixnum-tag-mask)
135 (inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
136 (inst sub esp-tn (fixnumize 2))
138 (inst mov ecx (fixnumize 1)) ; arg count
139 (inst jmp (make-ea :dword
140 :disp (+ nil-value (static-fun-offset '%negate))))
144 (inst neg res) ; (- most-negative-fixnum) is BIGNUM
146 (inst shr res n-fixnum-tag-bits) ; sign bit is data - remove type bits
149 (with-fixed-allocation (res bignum-widetag (1+ bignum-digits-offset))
150 (storew ecx res bignum-digits-offset other-pointer-lowtag))
156 (macrolet ((define-cond-assem-rtn (name translate static-fn test)
157 `(define-assembly-routine (,name
159 (:return-style :full-call)
161 (:translate ,translate)
163 ((:arg x (descriptor-reg any-reg) edx-offset)
164 (:arg y (descriptor-reg any-reg) edi-offset)
166 (:res res descriptor-reg edx-offset)
168 (:temp eax unsigned-reg eax-offset)
169 (:temp ecx unsigned-reg ecx-offset))
173 (inst test ecx fixnum-tag-mask)
174 (inst jmp :nz DO-STATIC-FUN) ; are both fixnums?
177 (cond ((member :cmov *backend-subfeatures*)
179 (inst mov eax nil-value)
180 (inst cmov ,test res eax))
182 (inst mov res nil-value)
183 (inst jmp ,test RETURN)
184 (load-symbol res t)))
186 (inst clc) ; single-value return
192 (inst lea ebp-tn (make-ea :dword
195 (inst sub esp-tn (fixnumize 2)) ; FIXME: Push 2 words on stack,
198 (inst mov ecx (fixnumize 2)) ; FIXME: FIXNUMIZE and
199 ; SINGLE-FLOAT-BITS are parallel,
200 ; should be named parallelly.
201 (inst jmp (make-ea :dword
203 (static-fun-offset ',static-fn)))))))
205 (define-cond-assem-rtn generic-< < two-arg-< :ge)
206 (define-cond-assem-rtn generic-> > two-arg-> :le))
208 (define-assembly-routine (generic-eql
210 (:return-style :full-call)
214 ((:arg x (descriptor-reg any-reg) edx-offset)
215 (:arg y (descriptor-reg any-reg) edi-offset)
217 (:res res descriptor-reg edx-offset)
219 (:temp eax unsigned-reg eax-offset)
220 (:temp ecx unsigned-reg ecx-offset))
223 (inst test ecx fixnum-tag-mask)
224 (inst jmp :nz DO-STATIC-FUN)
226 ;; At least one fixnum
229 (cond ((member :cmov *backend-subfeatures*)
230 (inst mov eax nil-value)
231 (inst cmov :ne res eax))
234 (inst mov res nil-value)))
239 ;; FIXME: We could handle all non-numbers here easily enough: go to
240 ;; TWO-ARG-EQL only if lowtags and widetags match, lowtag is
241 ;; other-pointer-lowtag and widetag is < code-header-widetag.
245 (inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
246 (inst sub esp-tn (fixnumize 2))
248 (inst mov ecx (fixnumize 2))
249 (inst jmp (make-ea :dword
250 :disp (+ nil-value (static-fun-offset 'eql)))))
252 (define-assembly-routine (generic-=
254 (:return-style :full-call)
258 ((:arg x (descriptor-reg any-reg) edx-offset)
259 (:arg y (descriptor-reg any-reg) edi-offset)
261 (:res res descriptor-reg edx-offset)
263 (:temp eax unsigned-reg eax-offset)
264 (:temp ecx unsigned-reg ecx-offset))
267 (inst test ecx fixnum-tag-mask) ; both fixnums?
268 (inst jmp :nz DO-STATIC-FUN)
272 (cond ((member :cmov *backend-subfeatures*)
273 (inst mov eax nil-value)
274 (inst cmov :ne res eax))
277 (inst mov res nil-value)))
285 (inst lea ebp-tn (make-ea :dword :base esp-tn :disp n-word-bytes))
286 (inst sub esp-tn (fixnumize 2))
288 (inst mov ecx (fixnumize 2))
289 (inst jmp (make-ea :dword
290 :disp (+ nil-value (static-fun-offset 'two-arg-=)))))
293 ;;; Support for the Mersenne Twister, MT19937, random number generator
294 ;;; due to Matsumoto and Nishimura.
296 ;;; Makoto Matsumoto and T. Nishimura, "Mersenne twister: A
297 ;;; 623-dimensionally equidistributed uniform pseudorandom number
298 ;;; generator.", ACM Transactions on Modeling and Computer Simulation,
302 ;;; 0-1: Constant matrix A. [0, #x9908b0df] (not used here)
303 ;;; 2: Index; init. to 1.
306 ;;; This assembly routine is called from the inline VOP and updates
307 ;;; the state vector with new random numbers. The state vector is
308 ;;; passed in the EAX register.
309 #+sb-assembling ; We don't want a vop for this one.
310 (define-assembly-routine
311 (random-mt19937-update)
312 ((:temp state unsigned-reg eax-offset)
313 (:temp k unsigned-reg ebx-offset)
314 (:temp y unsigned-reg ecx-offset)
315 (:temp tmp unsigned-reg edx-offset))
317 ;; Save the temporary registers.
322 ;; Generate a new set of results.
325 (inst mov y (make-ea-for-vector-data state :index k :offset 3))
326 (inst mov tmp (make-ea-for-vector-data state :index k :offset (+ 1 3)))
327 (inst and y #x80000000)
328 (inst and tmp #x7fffffff)
332 (inst xor y #x9908b0df)
334 (inst xor y (make-ea-for-vector-data state :index k :offset (+ 397 3)))
335 (inst mov (make-ea-for-vector-data state :index k :offset 3) y)
337 (inst cmp k (- 624 397))
340 (inst mov y (make-ea-for-vector-data state :index k :offset 3))
341 (inst mov tmp (make-ea-for-vector-data state :index k :offset (+ 1 3)))
342 (inst and y #x80000000)
343 (inst and tmp #x7fffffff)
347 (inst xor y #x9908b0df)
349 (inst xor y (make-ea-for-vector-data state :index k :offset (+ (- 397 624) 3)))
350 (inst mov (make-ea-for-vector-data state :index k :offset 3) y)
352 (inst cmp k (- 624 1))
355 (inst mov y (make-ea-for-vector-data state :offset (+ (- 624 1) 3)))
356 (inst mov tmp (make-ea-for-vector-data state :offset (+ 0 3)))
357 (inst and y #x80000000)
358 (inst and tmp #x7fffffff)
362 (inst xor y #x9908b0df)
364 (inst xor y (make-ea-for-vector-data state :offset (+ (- 397 1) 3)))
365 (inst mov (make-ea-for-vector-data state :offset (+ (- 624 1) 3)) y)
367 ;; Restore the temporary registers and return.