1 ;;;; floating point support for the x86
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 (macrolet ((ea-for-xf-desc (tn slot)
15 `(make-ea-for-object-slot ,tn ,slot other-pointer-lowtag)))
16 (defun ea-for-sf-desc (tn)
17 (ea-for-xf-desc tn single-float-value-slot))
18 (defun ea-for-df-desc (tn)
19 (ea-for-xf-desc tn double-float-value-slot))
21 (defun ea-for-lf-desc (tn)
22 (ea-for-xf-desc tn long-float-value-slot))
24 (defun ea-for-csf-real-desc (tn)
25 (ea-for-xf-desc tn complex-single-float-real-slot))
26 (defun ea-for-csf-imag-desc (tn)
27 (ea-for-xf-desc tn complex-single-float-imag-slot))
28 (defun ea-for-cdf-real-desc (tn)
29 (ea-for-xf-desc tn complex-double-float-real-slot))
30 (defun ea-for-cdf-imag-desc (tn)
31 (ea-for-xf-desc tn complex-double-float-imag-slot))
33 (defun ea-for-clf-real-desc (tn)
34 (ea-for-xf-desc tn complex-long-float-real-slot))
36 (defun ea-for-clf-imag-desc (tn)
37 (ea-for-xf-desc tn complex-long-float-imag-slot)))
39 (macrolet ((ea-for-xf-stack (tn kind)
42 :disp (frame-byte-offset
44 (ecase ,kind (:single 0) (:double 1) (:long 2)))))))
45 (defun ea-for-sf-stack (tn)
46 (ea-for-xf-stack tn :single))
47 (defun ea-for-df-stack (tn)
48 (ea-for-xf-stack tn :double))
50 (defun ea-for-lf-stack (tn)
51 (ea-for-xf-stack tn :long)))
53 ;;; Telling the FPU to wait is required in order to make signals occur
54 ;;; at the expected place, but naturally slows things down.
56 ;;; NODE is the node whose compilation policy controls the decision
57 ;;; whether to just blast through carelessly or carefully emit wait
58 ;;; instructions and whatnot.
60 ;;; NOTE-NEXT-INSTRUCTION, if supplied, is to be passed to
61 ;;; #'NOTE-NEXT-INSTRUCTION.
63 ;;; Until 2004-03-15, the implementation of this was buggy; it
64 ;;; unconditionally emitted the WAIT instruction. It turns out that
65 ;;; this is the right thing to do anyway; omitting them can lead to
66 ;;; system corruption on conforming code. -- CSR
67 (defun maybe-fp-wait (node &optional note-next-instruction)
68 (declare (ignore node))
70 (when (policy node (or (= debug 3) (> safety speed))))
71 (when note-next-instruction
72 (note-next-instruction note-next-instruction :internal-error))
75 ;;; complex float stack EAs
76 (macrolet ((ea-for-cxf-stack (tn kind slot &optional base)
79 :disp (frame-byte-offset
86 (ecase ,slot (:real 1) (:imag 2))))))))
87 (defun ea-for-csf-real-stack (tn &optional (base ebp-tn))
88 (ea-for-cxf-stack tn :single :real base))
89 (defun ea-for-csf-imag-stack (tn &optional (base ebp-tn))
90 (ea-for-cxf-stack tn :single :imag base))
91 (defun ea-for-cdf-real-stack (tn &optional (base ebp-tn))
92 (ea-for-cxf-stack tn :double :real base))
93 (defun ea-for-cdf-imag-stack (tn &optional (base ebp-tn))
94 (ea-for-cxf-stack tn :double :imag base))
96 (defun ea-for-clf-real-stack (tn &optional (base ebp-tn))
97 (ea-for-cxf-stack tn :long :real base))
99 (defun ea-for-clf-imag-stack (tn &optional (base ebp-tn))
100 (ea-for-cxf-stack tn :long :imag base)))
102 ;;; Abstract out the copying of a FP register to the FP stack top, and
103 ;;; provide two alternatives for its implementation. Note: it's not
104 ;;; necessary to distinguish between a single or double register move
107 ;;; Using a Pop then load.
108 (defun copy-fp-reg-to-fr0 (reg)
109 (aver (not (zerop (tn-offset reg))))
111 (inst fld (make-random-tn :kind :normal
112 :sc (sc-or-lose 'double-reg)
113 :offset (1- (tn-offset reg)))))
114 ;;; Using Fxch then Fst to restore the original reg contents.
116 (defun copy-fp-reg-to-fr0 (reg)
117 (aver (not (zerop (tn-offset reg))))
121 ;;; The x86 can't store a long-float to memory without popping the
122 ;;; stack and marking a register as empty, so it is necessary to
123 ;;; restore the register from memory.
125 (defun store-long-float (ea)
131 ;;; X is source, Y is destination.
132 (define-move-fun (load-single 2) (vop x y)
133 ((single-stack) (single-reg))
134 (with-empty-tn@fp-top(y)
135 (inst fld (ea-for-sf-stack x))))
137 (define-move-fun (store-single 2) (vop x y)
138 ((single-reg) (single-stack))
139 (cond ((zerop (tn-offset x))
140 (inst fst (ea-for-sf-stack y)))
143 (inst fst (ea-for-sf-stack y))
144 ;; This may not be necessary as ST0 is likely invalid now.
147 (define-move-fun (load-double 2) (vop x y)
148 ((double-stack) (double-reg))
149 (with-empty-tn@fp-top(y)
150 (inst fldd (ea-for-df-stack x))))
152 (define-move-fun (store-double 2) (vop x y)
153 ((double-reg) (double-stack))
154 (cond ((zerop (tn-offset x))
155 (inst fstd (ea-for-df-stack y)))
158 (inst fstd (ea-for-df-stack y))
159 ;; This may not be necessary as ST0 is likely invalid now.
163 (define-move-fun (load-long 2) (vop x y)
164 ((long-stack) (long-reg))
165 (with-empty-tn@fp-top(y)
166 (inst fldl (ea-for-lf-stack x))))
169 (define-move-fun (store-long 2) (vop x y)
170 ((long-reg) (long-stack))
171 (cond ((zerop (tn-offset x))
172 (store-long-float (ea-for-lf-stack y)))
175 (store-long-float (ea-for-lf-stack y))
176 ;; This may not be necessary as ST0 is likely invalid now.
179 ;;; The i387 has instructions to load some useful constants. This
180 ;;; doesn't save much time but might cut down on memory access and
181 ;;; reduce the size of the constant vector (CV). Intel claims they are
182 ;;; stored in a more precise form on chip. Anyhow, might as well use
183 ;;; the feature. It can be turned off by hacking the
184 ;;; "immediate-constant-sc" in vm.lisp.
185 (eval-when (:compile-toplevel :execute)
186 (setf *read-default-float-format*
187 #!+long-float 'long-float #!-long-float 'double-float))
188 (define-move-fun (load-fp-constant 2) (vop x y)
189 ((fp-constant) (single-reg double-reg #!+long-float long-reg))
190 (let ((value (sb!c::constant-value (sb!c::tn-leaf x))))
191 (with-empty-tn@fp-top(y)
196 ((= value (coerce pi *read-default-float-format*))
198 ((= value (log 10e0 2e0))
200 ((= value (log 2.718281828459045235360287471352662e0 2e0))
202 ((= value (log 2e0 10e0))
204 ((= value (log 2e0 2.718281828459045235360287471352662e0))
206 (t (warn "ignoring bogus i387 constant ~A" value))))))
207 (eval-when (:compile-toplevel :execute)
208 (setf *read-default-float-format* 'single-float))
210 ;;;; complex float move functions
212 (defun complex-single-reg-real-tn (x)
213 (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg)
214 :offset (tn-offset x)))
215 (defun complex-single-reg-imag-tn (x)
216 (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg)
217 :offset (1+ (tn-offset x))))
219 (defun complex-double-reg-real-tn (x)
220 (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
221 :offset (tn-offset x)))
222 (defun complex-double-reg-imag-tn (x)
223 (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg)
224 :offset (1+ (tn-offset x))))
227 (defun complex-long-reg-real-tn (x)
228 (make-random-tn :kind :normal :sc (sc-or-lose 'long-reg)
229 :offset (tn-offset x)))
231 (defun complex-long-reg-imag-tn (x)
232 (make-random-tn :kind :normal :sc (sc-or-lose 'long-reg)
233 :offset (1+ (tn-offset x))))
235 ;;; X is source, Y is destination.
236 (define-move-fun (load-complex-single 2) (vop x y)
237 ((complex-single-stack) (complex-single-reg))
238 (let ((real-tn (complex-single-reg-real-tn y)))
239 (with-empty-tn@fp-top (real-tn)
240 (inst fld (ea-for-csf-real-stack x))))
241 (let ((imag-tn (complex-single-reg-imag-tn y)))
242 (with-empty-tn@fp-top (imag-tn)
243 (inst fld (ea-for-csf-imag-stack x)))))
245 (define-move-fun (store-complex-single 2) (vop x y)
246 ((complex-single-reg) (complex-single-stack))
247 (let ((real-tn (complex-single-reg-real-tn x)))
248 (cond ((zerop (tn-offset real-tn))
249 (inst fst (ea-for-csf-real-stack y)))
252 (inst fst (ea-for-csf-real-stack y))
253 (inst fxch real-tn))))
254 (let ((imag-tn (complex-single-reg-imag-tn x)))
256 (inst fst (ea-for-csf-imag-stack y))
257 (inst fxch imag-tn)))
259 (define-move-fun (load-complex-double 2) (vop x y)
260 ((complex-double-stack) (complex-double-reg))
261 (let ((real-tn (complex-double-reg-real-tn y)))
262 (with-empty-tn@fp-top(real-tn)
263 (inst fldd (ea-for-cdf-real-stack x))))
264 (let ((imag-tn (complex-double-reg-imag-tn y)))
265 (with-empty-tn@fp-top(imag-tn)
266 (inst fldd (ea-for-cdf-imag-stack x)))))
268 (define-move-fun (store-complex-double 2) (vop x y)
269 ((complex-double-reg) (complex-double-stack))
270 (let ((real-tn (complex-double-reg-real-tn x)))
271 (cond ((zerop (tn-offset real-tn))
272 (inst fstd (ea-for-cdf-real-stack y)))
275 (inst fstd (ea-for-cdf-real-stack y))
276 (inst fxch real-tn))))
277 (let ((imag-tn (complex-double-reg-imag-tn x)))
279 (inst fstd (ea-for-cdf-imag-stack y))
280 (inst fxch imag-tn)))
283 (define-move-fun (load-complex-long 2) (vop x y)
284 ((complex-long-stack) (complex-long-reg))
285 (let ((real-tn (complex-long-reg-real-tn y)))
286 (with-empty-tn@fp-top(real-tn)
287 (inst fldl (ea-for-clf-real-stack x))))
288 (let ((imag-tn (complex-long-reg-imag-tn y)))
289 (with-empty-tn@fp-top(imag-tn)
290 (inst fldl (ea-for-clf-imag-stack x)))))
293 (define-move-fun (store-complex-long 2) (vop x y)
294 ((complex-long-reg) (complex-long-stack))
295 (let ((real-tn (complex-long-reg-real-tn x)))
296 (cond ((zerop (tn-offset real-tn))
297 (store-long-float (ea-for-clf-real-stack y)))
300 (store-long-float (ea-for-clf-real-stack y))
301 (inst fxch real-tn))))
302 (let ((imag-tn (complex-long-reg-imag-tn x)))
304 (store-long-float (ea-for-clf-imag-stack y))
305 (inst fxch imag-tn)))
310 ;;; float register to register moves
311 (define-vop (float-move)
316 (unless (location= x y)
317 (cond ((zerop (tn-offset y))
318 (copy-fp-reg-to-fr0 x))
319 ((zerop (tn-offset x))
326 (define-vop (single-move float-move)
327 (:args (x :scs (single-reg) :target y :load-if (not (location= x y))))
328 (:results (y :scs (single-reg) :load-if (not (location= x y)))))
329 (define-move-vop single-move :move (single-reg) (single-reg))
331 (define-vop (double-move float-move)
332 (:args (x :scs (double-reg) :target y :load-if (not (location= x y))))
333 (:results (y :scs (double-reg) :load-if (not (location= x y)))))
334 (define-move-vop double-move :move (double-reg) (double-reg))
337 (define-vop (long-move float-move)
338 (:args (x :scs (long-reg) :target y :load-if (not (location= x y))))
339 (:results (y :scs (long-reg) :load-if (not (location= x y)))))
341 (define-move-vop long-move :move (long-reg) (long-reg))
343 ;;; complex float register to register moves
344 (define-vop (complex-float-move)
345 (:args (x :target y :load-if (not (location= x y))))
346 (:results (y :load-if (not (location= x y))))
347 (:note "complex float move")
349 (unless (location= x y)
350 ;; Note the complex-float-regs are aligned to every second
351 ;; float register so there is not need to worry about overlap.
352 (let ((x-real (complex-double-reg-real-tn x))
353 (y-real (complex-double-reg-real-tn y)))
354 (cond ((zerop (tn-offset y-real))
355 (copy-fp-reg-to-fr0 x-real))
356 ((zerop (tn-offset x-real))
361 (inst fxch x-real))))
362 (let ((x-imag (complex-double-reg-imag-tn x))
363 (y-imag (complex-double-reg-imag-tn y)))
366 (inst fxch x-imag)))))
368 (define-vop (complex-single-move complex-float-move)
369 (:args (x :scs (complex-single-reg) :target y
370 :load-if (not (location= x y))))
371 (:results (y :scs (complex-single-reg) :load-if (not (location= x y)))))
372 (define-move-vop complex-single-move :move
373 (complex-single-reg) (complex-single-reg))
375 (define-vop (complex-double-move complex-float-move)
376 (:args (x :scs (complex-double-reg)
377 :target y :load-if (not (location= x y))))
378 (:results (y :scs (complex-double-reg) :load-if (not (location= x y)))))
379 (define-move-vop complex-double-move :move
380 (complex-double-reg) (complex-double-reg))
383 (define-vop (complex-long-move complex-float-move)
384 (:args (x :scs (complex-long-reg)
385 :target y :load-if (not (location= x y))))
386 (:results (y :scs (complex-long-reg) :load-if (not (location= x y)))))
388 (define-move-vop complex-long-move :move
389 (complex-long-reg) (complex-long-reg))
391 ;;; Move from float to a descriptor reg. allocating a new float
392 ;;; object in the process.
393 (define-vop (move-from-single)
394 (:args (x :scs (single-reg) :to :save))
395 (:results (y :scs (descriptor-reg)))
397 (:note "float to pointer coercion")
399 (with-fixed-allocation (y
401 single-float-size node)
403 (inst fst (ea-for-sf-desc y))))))
404 (define-move-vop move-from-single :move
405 (single-reg) (descriptor-reg))
407 (define-vop (move-from-double)
408 (:args (x :scs (double-reg) :to :save))
409 (:results (y :scs (descriptor-reg)))
411 (:note "float to pointer coercion")
413 (with-fixed-allocation (y
418 (inst fstd (ea-for-df-desc y))))))
419 (define-move-vop move-from-double :move
420 (double-reg) (descriptor-reg))
423 (define-vop (move-from-long)
424 (:args (x :scs (long-reg) :to :save))
425 (:results (y :scs (descriptor-reg)))
427 (:note "float to pointer coercion")
429 (with-fixed-allocation (y
434 (store-long-float (ea-for-lf-desc y))))))
436 (define-move-vop move-from-long :move
437 (long-reg) (descriptor-reg))
439 (define-vop (move-from-fp-constant)
440 (:args (x :scs (fp-constant)))
441 (:results (y :scs (descriptor-reg)))
443 (ecase (sb!c::constant-value (sb!c::tn-leaf x))
444 (0f0 (load-symbol-value y *fp-constant-0f0*))
445 (1f0 (load-symbol-value y *fp-constant-1f0*))
446 (0d0 (load-symbol-value y *fp-constant-0d0*))
447 (1d0 (load-symbol-value y *fp-constant-1d0*))
449 (0l0 (load-symbol-value y *fp-constant-0l0*))
451 (1l0 (load-symbol-value y *fp-constant-1l0*))
453 (#.pi (load-symbol-value y *fp-constant-pi*))
455 (#.(log 10l0 2l0) (load-symbol-value y *fp-constant-l2t*))
457 (#.(log 2.718281828459045235360287471352662L0 2l0)
458 (load-symbol-value y *fp-constant-l2e*))
460 (#.(log 2l0 10l0) (load-symbol-value y *fp-constant-lg2*))
462 (#.(log 2l0 2.718281828459045235360287471352662L0)
463 (load-symbol-value y *fp-constant-ln2*)))))
464 (define-move-vop move-from-fp-constant :move
465 (fp-constant) (descriptor-reg))
467 ;;; Move from a descriptor to a float register.
468 (define-vop (move-to-single)
469 (:args (x :scs (descriptor-reg)))
470 (:results (y :scs (single-reg)))
471 (:note "pointer to float coercion")
473 (with-empty-tn@fp-top(y)
474 (inst fld (ea-for-sf-desc x)))))
475 (define-move-vop move-to-single :move (descriptor-reg) (single-reg))
477 (define-vop (move-to-double)
478 (:args (x :scs (descriptor-reg)))
479 (:results (y :scs (double-reg)))
480 (:note "pointer to float coercion")
482 (with-empty-tn@fp-top(y)
483 (inst fldd (ea-for-df-desc x)))))
484 (define-move-vop move-to-double :move (descriptor-reg) (double-reg))
487 (define-vop (move-to-long)
488 (:args (x :scs (descriptor-reg)))
489 (:results (y :scs (long-reg)))
490 (:note "pointer to float coercion")
492 (with-empty-tn@fp-top(y)
493 (inst fldl (ea-for-lf-desc x)))))
495 (define-move-vop move-to-long :move (descriptor-reg) (long-reg))
497 ;;; Move from complex float to a descriptor reg. allocating a new
498 ;;; complex float object in the process.
499 (define-vop (move-from-complex-single)
500 (:args (x :scs (complex-single-reg) :to :save))
501 (:results (y :scs (descriptor-reg)))
503 (:note "complex float to pointer coercion")
505 (with-fixed-allocation (y
506 complex-single-float-widetag
507 complex-single-float-size
509 (let ((real-tn (complex-single-reg-real-tn x)))
510 (with-tn@fp-top(real-tn)
511 (inst fst (ea-for-csf-real-desc y))))
512 (let ((imag-tn (complex-single-reg-imag-tn x)))
513 (with-tn@fp-top(imag-tn)
514 (inst fst (ea-for-csf-imag-desc y)))))))
515 (define-move-vop move-from-complex-single :move
516 (complex-single-reg) (descriptor-reg))
518 (define-vop (move-from-complex-double)
519 (:args (x :scs (complex-double-reg) :to :save))
520 (:results (y :scs (descriptor-reg)))
522 (:note "complex float to pointer coercion")
524 (with-fixed-allocation (y
525 complex-double-float-widetag
526 complex-double-float-size
528 (let ((real-tn (complex-double-reg-real-tn x)))
529 (with-tn@fp-top(real-tn)
530 (inst fstd (ea-for-cdf-real-desc y))))
531 (let ((imag-tn (complex-double-reg-imag-tn x)))
532 (with-tn@fp-top(imag-tn)
533 (inst fstd (ea-for-cdf-imag-desc y)))))))
534 (define-move-vop move-from-complex-double :move
535 (complex-double-reg) (descriptor-reg))
538 (define-vop (move-from-complex-long)
539 (:args (x :scs (complex-long-reg) :to :save))
540 (:results (y :scs (descriptor-reg)))
542 (:note "complex float to pointer coercion")
544 (with-fixed-allocation (y
545 complex-long-float-widetag
546 complex-long-float-size
548 (let ((real-tn (complex-long-reg-real-tn x)))
549 (with-tn@fp-top(real-tn)
550 (store-long-float (ea-for-clf-real-desc y))))
551 (let ((imag-tn (complex-long-reg-imag-tn x)))
552 (with-tn@fp-top(imag-tn)
553 (store-long-float (ea-for-clf-imag-desc y)))))))
555 (define-move-vop move-from-complex-long :move
556 (complex-long-reg) (descriptor-reg))
558 ;;; Move from a descriptor to a complex float register.
559 (macrolet ((frob (name sc format)
562 (:args (x :scs (descriptor-reg)))
563 (:results (y :scs (,sc)))
564 (:note "pointer to complex float coercion")
566 (let ((real-tn (complex-double-reg-real-tn y)))
567 (with-empty-tn@fp-top(real-tn)
569 (:single '((inst fld (ea-for-csf-real-desc x))))
570 (:double '((inst fldd (ea-for-cdf-real-desc x))))
572 (:long '((inst fldl (ea-for-clf-real-desc x)))))))
573 (let ((imag-tn (complex-double-reg-imag-tn y)))
574 (with-empty-tn@fp-top(imag-tn)
576 (:single '((inst fld (ea-for-csf-imag-desc x))))
577 (:double '((inst fldd (ea-for-cdf-imag-desc x))))
579 (:long '((inst fldl (ea-for-clf-imag-desc x)))))))))
580 (define-move-vop ,name :move (descriptor-reg) (,sc)))))
581 (frob move-to-complex-single complex-single-reg :single)
582 (frob move-to-complex-double complex-double-reg :double)
584 (frob move-to-complex-double complex-long-reg :long))
586 ;;;; the move argument vops
588 ;;;; Note these are also used to stuff fp numbers onto the c-call
589 ;;;; stack so the order is different than the lisp-stack.
591 ;;; the general MOVE-ARG VOP
592 (macrolet ((frob (name sc stack-sc format)
595 (:args (x :scs (,sc) :target y)
597 :load-if (not (sc-is y ,sc))))
599 (:note "float argument move")
600 (:generator ,(case format (:single 2) (:double 3) (:long 4))
603 (unless (location= x y)
604 (cond ((zerop (tn-offset y))
605 (copy-fp-reg-to-fr0 x))
606 ((zerop (tn-offset x))
613 (if (= (tn-offset fp) esp-offset)
615 (let* ((offset (* (tn-offset y) n-word-bytes))
616 (ea (make-ea :dword :base fp :disp offset)))
619 (:single '((inst fst ea)))
620 (:double '((inst fstd ea)))
622 (:long '((store-long-float ea))))))
626 :disp (frame-byte-offset
634 (:single '((inst fst ea)))
635 (:double '((inst fstd ea)))
637 (:long '((store-long-float ea)))))))))))
638 (define-move-vop ,name :move-arg
639 (,sc descriptor-reg) (,sc)))))
640 (frob move-single-float-arg single-reg single-stack :single)
641 (frob move-double-float-arg double-reg double-stack :double)
643 (frob move-long-float-arg long-reg long-stack :long))
645 ;;;; complex float MOVE-ARG VOP
646 (macrolet ((frob (name sc stack-sc format)
649 (:args (x :scs (,sc) :target y)
651 :load-if (not (sc-is y ,sc))))
653 (:note "complex float argument move")
654 (:generator ,(ecase format (:single 2) (:double 3) (:long 4))
657 (unless (location= x y)
658 (let ((x-real (complex-double-reg-real-tn x))
659 (y-real (complex-double-reg-real-tn y)))
660 (cond ((zerop (tn-offset y-real))
661 (copy-fp-reg-to-fr0 x-real))
662 ((zerop (tn-offset x-real))
667 (inst fxch x-real))))
668 (let ((x-imag (complex-double-reg-imag-tn x))
669 (y-imag (complex-double-reg-imag-tn y)))
672 (inst fxch x-imag))))
674 (let ((real-tn (complex-double-reg-real-tn x)))
675 (cond ((zerop (tn-offset real-tn))
679 (ea-for-csf-real-stack y fp))))
682 (ea-for-cdf-real-stack y fp))))
686 (ea-for-clf-real-stack y fp))))))
692 (ea-for-csf-real-stack y fp))))
695 (ea-for-cdf-real-stack y fp))))
699 (ea-for-clf-real-stack y fp)))))
700 (inst fxch real-tn))))
701 (let ((imag-tn (complex-double-reg-imag-tn x)))
705 '((inst fst (ea-for-csf-imag-stack y fp))))
707 '((inst fstd (ea-for-cdf-imag-stack y fp))))
711 (ea-for-clf-imag-stack y fp)))))
712 (inst fxch imag-tn))))))
713 (define-move-vop ,name :move-arg
714 (,sc descriptor-reg) (,sc)))))
715 (frob move-complex-single-float-arg
716 complex-single-reg complex-single-stack :single)
717 (frob move-complex-double-float-arg
718 complex-double-reg complex-double-stack :double)
720 (frob move-complex-long-float-arg
721 complex-long-reg complex-long-stack :long))
723 (define-move-vop move-arg :move-arg
724 (single-reg double-reg #!+long-float long-reg
725 complex-single-reg complex-double-reg #!+long-float complex-long-reg)
731 ;;; dtc: the floating point arithmetic vops
733 ;;; Note: Although these can accept x and y on the stack or pointed to
734 ;;; from a descriptor register, they will work with register loading
735 ;;; without these. Same deal with the result - it need only be a
736 ;;; register. When load-tns are needed they will probably be in ST0
737 ;;; and the code below should be able to correctly handle all cases.
739 ;;; However it seems to produce better code if all arg. and result
740 ;;; options are used; on the P86 there is no extra cost in using a
741 ;;; memory operand to the FP instructions - not so on the PPro.
743 ;;; It may also be useful to handle constant args?
745 ;;; 22-Jul-97: descriptor args lose in some simple cases when
746 ;;; a function result computed in a loop. Then Python insists
747 ;;; on consing the intermediate values! For example
750 ;;; (declare (type (simple-array double-float (*)) a)
753 ;;; (declare (type double-float sum))
755 ;;; (incf sum (* (aref a i)(aref a i))))
758 ;;; So, disabling descriptor args until this can be fixed elsewhere.
760 ((frob (op fop-sti fopr-sti
762 fopd foprd dname dcost
764 #!-long-float (declare (ignore lcost lname))
768 (:args (x :scs (single-reg single-stack #+nil descriptor-reg)
770 (y :scs (single-reg single-stack #+nil descriptor-reg)
772 (:temporary (:sc single-reg :offset fr0-offset
773 :from :eval :to :result) fr0)
774 (:results (r :scs (single-reg single-stack)))
775 (:arg-types single-float single-float)
776 (:result-types single-float)
778 (:note "inline float arithmetic")
780 (:save-p :compute-only)
783 ;; Handle a few special cases
785 ;; x, y, and r are the same register.
786 ((and (sc-is x single-reg) (location= x r) (location= y r))
787 (cond ((zerop (tn-offset r))
792 ;; XX the source register will not be valid.
793 (note-next-instruction vop :internal-error)
796 ;; x and r are the same register.
797 ((and (sc-is x single-reg) (location= x r))
798 (cond ((zerop (tn-offset r))
801 ;; ST(0) = ST(0) op ST(y)
804 ;; ST(0) = ST(0) op Mem
805 (inst ,fop (ea-for-sf-stack y)))
807 (inst ,fop (ea-for-sf-desc y)))))
812 (unless (zerop (tn-offset y))
813 (copy-fp-reg-to-fr0 y)))
814 ((single-stack descriptor-reg)
816 (if (sc-is y single-stack)
817 (inst fld (ea-for-sf-stack y))
818 (inst fld (ea-for-sf-desc y)))))
819 ;; ST(i) = ST(i) op ST0
821 (maybe-fp-wait node vop))
822 ;; y and r are the same register.
823 ((and (sc-is y single-reg) (location= y r))
824 (cond ((zerop (tn-offset r))
827 ;; ST(0) = ST(x) op ST(0)
830 ;; ST(0) = Mem op ST(0)
831 (inst ,fopr (ea-for-sf-stack x)))
833 (inst ,fopr (ea-for-sf-desc x)))))
838 (unless (zerop (tn-offset x))
839 (copy-fp-reg-to-fr0 x)))
840 ((single-stack descriptor-reg)
842 (if (sc-is x single-stack)
843 (inst fld (ea-for-sf-stack x))
844 (inst fld (ea-for-sf-desc x)))))
845 ;; ST(i) = ST(0) op ST(i)
847 (maybe-fp-wait node vop))
850 ;; Get the result to ST0.
852 ;; Special handling is needed if x or y are in ST0, and
853 ;; simpler code is generated.
856 ((and (sc-is x single-reg) (zerop (tn-offset x)))
862 (inst ,fop (ea-for-sf-stack y)))
864 (inst ,fop (ea-for-sf-desc y)))))
866 ((and (sc-is y single-reg) (zerop (tn-offset y)))
872 (inst ,fopr (ea-for-sf-stack x)))
874 (inst ,fopr (ea-for-sf-desc x)))))
879 (copy-fp-reg-to-fr0 x))
882 (inst fld (ea-for-sf-stack x)))
885 (inst fld (ea-for-sf-desc x))))
891 (inst ,fop (ea-for-sf-stack y)))
893 (inst ,fop (ea-for-sf-desc y))))))
895 (note-next-instruction vop :internal-error)
897 ;; Finally save the result.
900 (cond ((zerop (tn-offset r))
901 (maybe-fp-wait node))
905 (inst fst (ea-for-sf-stack r))))))))
909 (:args (x :scs (double-reg double-stack #+nil descriptor-reg)
911 (y :scs (double-reg double-stack #+nil descriptor-reg)
913 (:temporary (:sc double-reg :offset fr0-offset
914 :from :eval :to :result) fr0)
915 (:results (r :scs (double-reg double-stack)))
916 (:arg-types double-float double-float)
917 (:result-types double-float)
919 (:note "inline float arithmetic")
921 (:save-p :compute-only)
924 ;; Handle a few special cases.
926 ;; x, y, and r are the same register.
927 ((and (sc-is x double-reg) (location= x r) (location= y r))
928 (cond ((zerop (tn-offset r))
933 ;; XX the source register will not be valid.
934 (note-next-instruction vop :internal-error)
937 ;; x and r are the same register.
938 ((and (sc-is x double-reg) (location= x r))
939 (cond ((zerop (tn-offset r))
942 ;; ST(0) = ST(0) op ST(y)
945 ;; ST(0) = ST(0) op Mem
946 (inst ,fopd (ea-for-df-stack y)))
948 (inst ,fopd (ea-for-df-desc y)))))
953 (unless (zerop (tn-offset y))
954 (copy-fp-reg-to-fr0 y)))
955 ((double-stack descriptor-reg)
957 (if (sc-is y double-stack)
958 (inst fldd (ea-for-df-stack y))
959 (inst fldd (ea-for-df-desc y)))))
960 ;; ST(i) = ST(i) op ST0
962 (maybe-fp-wait node vop))
963 ;; y and r are the same register.
964 ((and (sc-is y double-reg) (location= y r))
965 (cond ((zerop (tn-offset r))
968 ;; ST(0) = ST(x) op ST(0)
971 ;; ST(0) = Mem op ST(0)
972 (inst ,foprd (ea-for-df-stack x)))
974 (inst ,foprd (ea-for-df-desc x)))))
979 (unless (zerop (tn-offset x))
980 (copy-fp-reg-to-fr0 x)))
981 ((double-stack descriptor-reg)
983 (if (sc-is x double-stack)
984 (inst fldd (ea-for-df-stack x))
985 (inst fldd (ea-for-df-desc x)))))
986 ;; ST(i) = ST(0) op ST(i)
988 (maybe-fp-wait node vop))
991 ;; Get the result to ST0.
993 ;; Special handling is needed if x or y are in ST0, and
994 ;; simpler code is generated.
997 ((and (sc-is x double-reg) (zerop (tn-offset x)))
1003 (inst ,fopd (ea-for-df-stack y)))
1005 (inst ,fopd (ea-for-df-desc y)))))
1007 ((and (sc-is y double-reg) (zerop (tn-offset y)))
1013 (inst ,foprd (ea-for-df-stack x)))
1015 (inst ,foprd (ea-for-df-desc x)))))
1020 (copy-fp-reg-to-fr0 x))
1023 (inst fldd (ea-for-df-stack x)))
1026 (inst fldd (ea-for-df-desc x))))
1032 (inst ,fopd (ea-for-df-stack y)))
1034 (inst ,fopd (ea-for-df-desc y))))))
1036 (note-next-instruction vop :internal-error)
1038 ;; Finally save the result.
1041 (cond ((zerop (tn-offset r))
1042 (maybe-fp-wait node))
1046 (inst fstd (ea-for-df-stack r))))))))
1049 (define-vop (,lname)
1051 (:args (x :scs (long-reg) :to :eval)
1052 (y :scs (long-reg) :to :eval))
1053 (:temporary (:sc long-reg :offset fr0-offset
1054 :from :eval :to :result) fr0)
1055 (:results (r :scs (long-reg)))
1056 (:arg-types long-float long-float)
1057 (:result-types long-float)
1058 (:policy :fast-safe)
1059 (:note "inline float arithmetic")
1061 (:save-p :compute-only)
1064 ;; Handle a few special cases.
1066 ;; x, y, and r are the same register.
1067 ((and (location= x r) (location= y r))
1068 (cond ((zerop (tn-offset r))
1073 ;; XX the source register will not be valid.
1074 (note-next-instruction vop :internal-error)
1077 ;; x and r are the same register.
1079 (cond ((zerop (tn-offset r))
1080 ;; ST(0) = ST(0) op ST(y)
1084 (unless (zerop (tn-offset y))
1085 (copy-fp-reg-to-fr0 y))
1086 ;; ST(i) = ST(i) op ST0
1088 (maybe-fp-wait node vop))
1089 ;; y and r are the same register.
1091 (cond ((zerop (tn-offset r))
1092 ;; ST(0) = ST(x) op ST(0)
1096 (unless (zerop (tn-offset x))
1097 (copy-fp-reg-to-fr0 x))
1098 ;; ST(i) = ST(0) op ST(i)
1099 (inst ,fopr-sti r)))
1100 (maybe-fp-wait node vop))
1103 ;; Get the result to ST0.
1105 ;; Special handling is needed if x or y are in ST0, and
1106 ;; simpler code is generated.
1109 ((zerop (tn-offset x))
1113 ((zerop (tn-offset y))
1118 (copy-fp-reg-to-fr0 x)
1122 (note-next-instruction vop :internal-error)
1124 ;; Finally save the result.
1125 (cond ((zerop (tn-offset r))
1126 (maybe-fp-wait node))
1128 (inst fst r))))))))))
1130 (frob + fadd-sti fadd-sti
1131 fadd fadd +/single-float 2
1132 faddd faddd +/double-float 2
1134 (frob - fsub-sti fsubr-sti
1135 fsub fsubr -/single-float 2
1136 fsubd fsubrd -/double-float 2
1138 (frob * fmul-sti fmul-sti
1139 fmul fmul */single-float 3
1140 fmuld fmuld */double-float 3
1142 (frob / fdiv-sti fdivr-sti
1143 fdiv fdivr //single-float 12
1144 fdivd fdivrd //double-float 12
1147 (macrolet ((frob (name inst translate sc type)
1148 `(define-vop (,name)
1149 (:args (x :scs (,sc) :target fr0))
1150 (:results (y :scs (,sc)))
1151 (:translate ,translate)
1152 (:policy :fast-safe)
1154 (:result-types ,type)
1155 (:temporary (:sc double-reg :offset fr0-offset
1156 :from :argument :to :result) fr0)
1158 (:note "inline float arithmetic")
1160 (:save-p :compute-only)
1162 (note-this-location vop :internal-error)
1163 (unless (zerop (tn-offset x))
1164 (inst fxch x) ; x to top of stack
1165 (unless (location= x y)
1166 (inst fst x))) ; Maybe save it.
1167 (inst ,inst) ; Clobber st0.
1168 (unless (zerop (tn-offset y))
1171 (frob abs/single-float fabs abs single-reg single-float)
1172 (frob abs/double-float fabs abs double-reg double-float)
1174 (frob abs/long-float fabs abs long-reg long-float)
1175 (frob %negate/single-float fchs %negate single-reg single-float)
1176 (frob %negate/double-float fchs %negate double-reg double-float)
1178 (frob %negate/long-float fchs %negate long-reg long-float))
1182 (define-vop (=/float)
1184 (:temporary (:sc word-reg :offset eax-offset :from :eval) temp)
1186 (:policy :fast-safe)
1188 (:save-p :compute-only)
1189 (:note "inline float comparison")
1192 (note-this-location vop :internal-error)
1194 ;; x is in ST0; y is in any reg.
1195 ((zerop (tn-offset x))
1197 ;; y is in ST0; x is in another reg.
1198 ((zerop (tn-offset y))
1200 ;; x and y are the same register, not ST0
1205 ;; x and y are different registers, neither ST0.
1210 (inst fnstsw) ; status word to ax
1211 (inst and ah-tn #x45) ; C3 C2 C0
1212 (inst cmp ah-tn #x40)))
1214 (define-vop (=/single-float =/float)
1216 (:args (x :scs (single-reg))
1217 (y :scs (single-reg)))
1218 (:arg-types single-float single-float))
1220 (define-vop (=/double-float =/float)
1222 (:args (x :scs (double-reg))
1223 (y :scs (double-reg)))
1224 (:arg-types double-float double-float))
1227 (define-vop (=/long-float =/float)
1229 (:args (x :scs (long-reg))
1230 (y :scs (long-reg)))
1231 (:arg-types long-float long-float))
1233 (define-vop (<single-float)
1235 (:args (x :scs (single-reg single-stack descriptor-reg))
1236 (y :scs (single-reg single-stack descriptor-reg)))
1237 (:arg-types single-float single-float)
1238 (:temporary (:sc single-reg :offset fr0-offset :from :eval) fr0)
1239 (:temporary (:sc word-reg :offset eax-offset :from :eval) temp)
1241 (:policy :fast-safe)
1242 (:note "inline float comparison")
1245 ;; Handle a few special cases.
1248 ((and (sc-is y single-reg) (zerop (tn-offset y)))
1252 ((single-stack descriptor-reg)
1253 (if (sc-is x single-stack)
1254 (inst fcom (ea-for-sf-stack x))
1255 (inst fcom (ea-for-sf-desc x)))))
1256 (inst fnstsw) ; status word to ax
1257 (inst and ah-tn #x45))
1259 ;; general case when y is not in ST0
1264 (unless (zerop (tn-offset x))
1265 (copy-fp-reg-to-fr0 x)))
1266 ((single-stack descriptor-reg)
1268 (if (sc-is x single-stack)
1269 (inst fld (ea-for-sf-stack x))
1270 (inst fld (ea-for-sf-desc x)))))
1274 ((single-stack descriptor-reg)
1275 (if (sc-is y single-stack)
1276 (inst fcom (ea-for-sf-stack y))
1277 (inst fcom (ea-for-sf-desc y)))))
1278 (inst fnstsw) ; status word to ax
1279 (inst and ah-tn #x45) ; C3 C2 C0
1280 (inst cmp ah-tn #x01)))))
1282 (define-vop (<double-float)
1284 (:args (x :scs (double-reg double-stack descriptor-reg))
1285 (y :scs (double-reg double-stack descriptor-reg)))
1286 (:arg-types double-float double-float)
1287 (:temporary (:sc double-reg :offset fr0-offset :from :eval) fr0)
1288 (:temporary (:sc word-reg :offset eax-offset :from :eval) temp)
1290 (:policy :fast-safe)
1291 (:note "inline float comparison")
1294 ;; Handle a few special cases
1297 ((and (sc-is y double-reg) (zerop (tn-offset y)))
1301 ((double-stack descriptor-reg)
1302 (if (sc-is x double-stack)
1303 (inst fcomd (ea-for-df-stack x))
1304 (inst fcomd (ea-for-df-desc x)))))
1305 (inst fnstsw) ; status word to ax
1306 (inst and ah-tn #x45))
1308 ;; General case when y is not in ST0.
1313 (unless (zerop (tn-offset x))
1314 (copy-fp-reg-to-fr0 x)))
1315 ((double-stack descriptor-reg)
1317 (if (sc-is x double-stack)
1318 (inst fldd (ea-for-df-stack x))
1319 (inst fldd (ea-for-df-desc x)))))
1323 ((double-stack descriptor-reg)
1324 (if (sc-is y double-stack)
1325 (inst fcomd (ea-for-df-stack y))
1326 (inst fcomd (ea-for-df-desc y)))))
1327 (inst fnstsw) ; status word to ax
1328 (inst and ah-tn #x45) ; C3 C2 C0
1329 (inst cmp ah-tn #x01)))))
1332 (define-vop (<long-float)
1334 (:args (x :scs (long-reg))
1335 (y :scs (long-reg)))
1336 (:arg-types long-float long-float)
1337 (:temporary (:sc word-reg :offset eax-offset :from :eval) temp)
1339 (:policy :fast-safe)
1340 (:note "inline float comparison")
1344 ;; x is in ST0; y is in any reg.
1345 ((zerop (tn-offset x))
1347 (inst fnstsw) ; status word to ax
1348 (inst and ah-tn #x45) ; C3 C2 C0
1349 (inst cmp ah-tn #x01))
1350 ;; y is in ST0; x is in another reg.
1351 ((zerop (tn-offset y))
1353 (inst fnstsw) ; status word to ax
1354 (inst and ah-tn #x45))
1355 ;; x and y are the same register, not ST0
1356 ;; x and y are different registers, neither ST0.
1361 (inst fnstsw) ; status word to ax
1362 (inst and ah-tn #x45))))) ; C3 C2 C0
1365 (define-vop (>single-float)
1367 (:args (x :scs (single-reg single-stack descriptor-reg))
1368 (y :scs (single-reg single-stack descriptor-reg)))
1369 (:arg-types single-float single-float)
1370 (:temporary (:sc single-reg :offset fr0-offset :from :eval) fr0)
1371 (:temporary (:sc word-reg :offset eax-offset :from :eval) temp)
1373 (:policy :fast-safe)
1374 (:note "inline float comparison")
1377 ;; Handle a few special cases.
1380 ((and (sc-is y single-reg) (zerop (tn-offset y)))
1384 ((single-stack descriptor-reg)
1385 (if (sc-is x single-stack)
1386 (inst fcom (ea-for-sf-stack x))
1387 (inst fcom (ea-for-sf-desc x)))))
1388 (inst fnstsw) ; status word to ax
1389 (inst and ah-tn #x45)
1390 (inst cmp ah-tn #x01))
1392 ;; general case when y is not in ST0
1397 (unless (zerop (tn-offset x))
1398 (copy-fp-reg-to-fr0 x)))
1399 ((single-stack descriptor-reg)
1401 (if (sc-is x single-stack)
1402 (inst fld (ea-for-sf-stack x))
1403 (inst fld (ea-for-sf-desc x)))))
1407 ((single-stack descriptor-reg)
1408 (if (sc-is y single-stack)
1409 (inst fcom (ea-for-sf-stack y))
1410 (inst fcom (ea-for-sf-desc y)))))
1411 (inst fnstsw) ; status word to ax
1412 (inst and ah-tn #x45)))))
1414 (define-vop (>double-float)
1416 (:args (x :scs (double-reg double-stack descriptor-reg))
1417 (y :scs (double-reg double-stack descriptor-reg)))
1418 (:arg-types double-float double-float)
1419 (:temporary (:sc double-reg :offset fr0-offset :from :eval) fr0)
1420 (:temporary (:sc word-reg :offset eax-offset :from :eval) temp)
1422 (:policy :fast-safe)
1423 (:note "inline float comparison")
1426 ;; Handle a few special cases.
1429 ((and (sc-is y double-reg) (zerop (tn-offset y)))
1433 ((double-stack descriptor-reg)
1434 (if (sc-is x double-stack)
1435 (inst fcomd (ea-for-df-stack x))
1436 (inst fcomd (ea-for-df-desc x)))))
1437 (inst fnstsw) ; status word to ax
1438 (inst and ah-tn #x45)
1439 (inst cmp ah-tn #x01))
1441 ;; general case when y is not in ST0
1446 (unless (zerop (tn-offset x))
1447 (copy-fp-reg-to-fr0 x)))
1448 ((double-stack descriptor-reg)
1450 (if (sc-is x double-stack)
1451 (inst fldd (ea-for-df-stack x))
1452 (inst fldd (ea-for-df-desc x)))))
1456 ((double-stack descriptor-reg)
1457 (if (sc-is y double-stack)
1458 (inst fcomd (ea-for-df-stack y))
1459 (inst fcomd (ea-for-df-desc y)))))
1460 (inst fnstsw) ; status word to ax
1461 (inst and ah-tn #x45)))))
1464 (define-vop (>long-float)
1466 (:args (x :scs (long-reg))
1467 (y :scs (long-reg)))
1468 (:arg-types long-float long-float)
1469 (:temporary (:sc word-reg :offset eax-offset :from :eval) temp)
1471 (:policy :fast-safe)
1472 (:note "inline float comparison")
1476 ;; y is in ST0; x is in any reg.
1477 ((zerop (tn-offset y))
1479 (inst fnstsw) ; status word to ax
1480 (inst and ah-tn #x45)
1481 (inst cmp ah-tn #x01))
1482 ;; x is in ST0; y is in another reg.
1483 ((zerop (tn-offset x))
1485 (inst fnstsw) ; status word to ax
1486 (inst and ah-tn #x45))
1487 ;; y and x are the same register, not ST0
1488 ;; y and x are different registers, neither ST0.
1493 (inst fnstsw) ; status word to ax
1494 (inst and ah-tn #x45)))))
1496 ;;; Comparisons with 0 can use the FTST instruction.
1498 (define-vop (float-test)
1500 (:temporary (:sc word-reg :offset eax-offset :from :eval) temp)
1503 (:variant-vars code)
1504 (:policy :fast-safe)
1506 (:save-p :compute-only)
1507 (:note "inline float comparison")
1510 (note-this-location vop :internal-error)
1513 ((zerop (tn-offset x))
1520 (inst fnstsw) ; status word to ax
1521 (inst and ah-tn #x45) ; C3 C2 C0
1522 (unless (zerop code)
1523 (inst cmp ah-tn code))))
1525 (define-vop (=0/single-float float-test)
1527 (:args (x :scs (single-reg)))
1528 (:arg-types single-float (:constant (single-float 0f0 0f0)))
1530 (define-vop (=0/double-float float-test)
1532 (:args (x :scs (double-reg)))
1533 (:arg-types double-float (:constant (double-float 0d0 0d0)))
1536 (define-vop (=0/long-float float-test)
1538 (:args (x :scs (long-reg)))
1539 (:arg-types long-float (:constant (long-float 0l0 0l0)))
1542 (define-vop (<0/single-float float-test)
1544 (:args (x :scs (single-reg)))
1545 (:arg-types single-float (:constant (single-float 0f0 0f0)))
1547 (define-vop (<0/double-float float-test)
1549 (:args (x :scs (double-reg)))
1550 (:arg-types double-float (:constant (double-float 0d0 0d0)))
1553 (define-vop (<0/long-float float-test)
1555 (:args (x :scs (long-reg)))
1556 (:arg-types long-float (:constant (long-float 0l0 0l0)))
1559 (define-vop (>0/single-float float-test)
1561 (:args (x :scs (single-reg)))
1562 (:arg-types single-float (:constant (single-float 0f0 0f0)))
1564 (define-vop (>0/double-float float-test)
1566 (:args (x :scs (double-reg)))
1567 (:arg-types double-float (:constant (double-float 0d0 0d0)))
1570 (define-vop (>0/long-float float-test)
1572 (:args (x :scs (long-reg)))
1573 (:arg-types long-float (:constant (long-float 0l0 0l0)))
1577 (deftransform eql ((x y) (long-float long-float))
1578 `(and (= (long-float-low-bits x) (long-float-low-bits y))
1579 (= (long-float-high-bits x) (long-float-high-bits y))
1580 (= (long-float-exp-bits x) (long-float-exp-bits y))))
1584 (macrolet ((frob (name translate to-sc to-type)
1585 `(define-vop (,name)
1586 (:args (x :scs (signed-stack signed-reg) :target temp))
1587 (:temporary (:sc signed-stack) temp)
1588 (:results (y :scs (,to-sc)))
1589 (:arg-types signed-num)
1590 (:result-types ,to-type)
1591 (:policy :fast-safe)
1592 (:note "inline float coercion")
1593 (:translate ,translate)
1595 (:save-p :compute-only)
1600 (with-empty-tn@fp-top(y)
1601 (note-this-location vop :internal-error)
1604 (with-empty-tn@fp-top(y)
1605 (note-this-location vop :internal-error)
1606 (inst fild x))))))))
1607 (frob %single-float/signed %single-float single-reg single-float)
1608 (frob %double-float/signed %double-float double-reg double-float)
1610 (frob %long-float/signed %long-float long-reg long-float))
1612 (macrolet ((frob (name translate to-sc to-type)
1613 `(define-vop (,name)
1614 (:args (x :scs (unsigned-reg)))
1615 (:results (y :scs (,to-sc)))
1616 (:arg-types unsigned-num)
1617 (:result-types ,to-type)
1618 (:policy :fast-safe)
1619 (:note "inline float coercion")
1620 (:translate ,translate)
1622 (:save-p :compute-only)
1626 (with-empty-tn@fp-top(y)
1627 (note-this-location vop :internal-error)
1628 (inst fildl (make-ea :dword :base esp-tn)))
1629 (inst add esp-tn 8)))))
1630 (frob %single-float/unsigned %single-float single-reg single-float)
1631 (frob %double-float/unsigned %double-float double-reg double-float)
1633 (frob %long-float/unsigned %long-float long-reg long-float))
1635 ;;; These should be no-ops but the compiler might want to move some
1637 (macrolet ((frob (name translate from-sc from-type to-sc to-type)
1638 `(define-vop (,name)
1639 (:args (x :scs (,from-sc) :target y))
1640 (:results (y :scs (,to-sc)))
1641 (:arg-types ,from-type)
1642 (:result-types ,to-type)
1643 (:policy :fast-safe)
1644 (:note "inline float coercion")
1645 (:translate ,translate)
1647 (:save-p :compute-only)
1649 (note-this-location vop :internal-error)
1650 (unless (location= x y)
1652 ((zerop (tn-offset x))
1653 ;; x is in ST0, y is in another reg. not ST0
1655 ((zerop (tn-offset y))
1656 ;; y is in ST0, x is in another reg. not ST0
1657 (copy-fp-reg-to-fr0 x))
1659 ;; Neither x or y are in ST0, and they are not in
1663 (inst fxch x))))))))
1665 (frob %single-float/double-float %single-float double-reg
1666 double-float single-reg single-float)
1668 (frob %single-float/long-float %single-float long-reg
1669 long-float single-reg single-float)
1670 (frob %double-float/single-float %double-float single-reg single-float
1671 double-reg double-float)
1673 (frob %double-float/long-float %double-float long-reg long-float
1674 double-reg double-float)
1676 (frob %long-float/single-float %long-float single-reg single-float
1677 long-reg long-float)
1679 (frob %long-float/double-float %long-float double-reg double-float
1680 long-reg long-float))
1682 (macrolet ((frob (trans from-sc from-type round-p)
1683 `(define-vop (,(symbolicate trans "/" from-type))
1684 (:args (x :scs (,from-sc)))
1685 (:temporary (:sc signed-stack) stack-temp)
1687 '((:temporary (:sc unsigned-stack) scw)
1688 (:temporary (:sc any-reg) rcw)))
1689 (:results (y :scs (signed-reg)))
1690 (:arg-types ,from-type)
1691 (:result-types signed-num)
1693 (:policy :fast-safe)
1694 (:note "inline float truncate")
1696 (:save-p :compute-only)
1699 '((note-this-location vop :internal-error)
1700 ;; Catch any pending FPE exceptions.
1702 (,(if round-p 'progn 'pseudo-atomic)
1703 ;; Normal mode (for now) is "round to best".
1706 '((inst fnstcw scw) ; save current control word
1707 (move rcw scw) ; into 16-bit register
1708 (inst or rcw (ash #b11 10)) ; CHOP
1709 (move stack-temp rcw)
1710 (inst fldcw stack-temp)))
1715 (inst fist stack-temp)
1716 (inst mov y stack-temp)))
1718 '((inst fldcw scw)))))))))
1719 (frob %unary-truncate single-reg single-float nil)
1720 (frob %unary-truncate double-reg double-float nil)
1722 (frob %unary-truncate long-reg long-float nil)
1723 (frob %unary-round single-reg single-float t)
1724 (frob %unary-round double-reg double-float t)
1726 (frob %unary-round long-reg long-float t))
1728 (macrolet ((frob (trans from-sc from-type round-p)
1729 `(define-vop (,(symbolicate trans "/" from-type "=>UNSIGNED"))
1730 (:args (x :scs (,from-sc) :target fr0))
1731 (:temporary (:sc double-reg :offset fr0-offset
1732 :from :argument :to :result) fr0)
1734 '((:temporary (:sc unsigned-stack) stack-temp)
1735 (:temporary (:sc unsigned-stack) scw)
1736 (:temporary (:sc any-reg) rcw)))
1737 (:results (y :scs (unsigned-reg)))
1738 (:arg-types ,from-type)
1739 (:result-types unsigned-num)
1741 (:policy :fast-safe)
1742 (:note "inline float truncate")
1744 (:save-p :compute-only)
1747 '((note-this-location vop :internal-error)
1748 ;; Catch any pending FPE exceptions.
1750 ;; Normal mode (for now) is "round to best".
1751 (unless (zerop (tn-offset x))
1752 (copy-fp-reg-to-fr0 x))
1754 '((inst fnstcw scw) ; save current control word
1755 (move rcw scw) ; into 16-bit register
1756 (inst or rcw (ash #b11 10)) ; CHOP
1757 (move stack-temp rcw)
1758 (inst fldcw stack-temp)))
1760 (inst fistpl (make-ea :dword :base esp-tn))
1762 (inst fld fr0) ; copy fr0 to at least restore stack.
1765 '((inst fldcw scw)))))))
1766 (frob %unary-truncate single-reg single-float nil)
1767 (frob %unary-truncate double-reg double-float nil)
1769 (frob %unary-truncate long-reg long-float nil)
1770 (frob %unary-round single-reg single-float t)
1771 (frob %unary-round double-reg double-float t)
1773 (frob %unary-round long-reg long-float t))
1775 (define-vop (make-single-float)
1776 (:args (bits :scs (signed-reg) :target res
1777 :load-if (not (or (and (sc-is bits signed-stack)
1778 (sc-is res single-reg))
1779 (and (sc-is bits signed-stack)
1780 (sc-is res single-stack)
1781 (location= bits res))))))
1782 (:results (res :scs (single-reg single-stack)))
1783 (:temporary (:sc signed-stack) stack-temp)
1784 (:arg-types signed-num)
1785 (:result-types single-float)
1786 (:translate make-single-float)
1787 (:policy :fast-safe)
1794 (inst mov res bits))
1796 (aver (location= bits res)))))
1800 ;; source must be in memory
1801 (inst mov stack-temp bits)
1802 (with-empty-tn@fp-top(res)
1803 (inst fld stack-temp)))
1805 (with-empty-tn@fp-top(res)
1806 (inst fld bits))))))))
1808 (define-vop (make-double-float)
1809 (:args (hi-bits :scs (signed-reg))
1810 (lo-bits :scs (unsigned-reg)))
1811 (:results (res :scs (double-reg)))
1812 (:temporary (:sc double-stack) temp)
1813 (:arg-types signed-num unsigned-num)
1814 (:result-types double-float)
1815 (:translate make-double-float)
1816 (:policy :fast-safe)
1819 (let ((offset (tn-offset temp)))
1820 (storew hi-bits ebp-tn (frame-word-offset offset))
1821 (storew lo-bits ebp-tn (frame-word-offset (1+ offset)))
1822 (with-empty-tn@fp-top(res)
1823 (inst fldd (make-ea :dword :base ebp-tn
1824 :disp (frame-byte-offset (1+ offset))))))))
1827 (define-vop (make-long-float)
1828 (:args (exp-bits :scs (signed-reg))
1829 (hi-bits :scs (unsigned-reg))
1830 (lo-bits :scs (unsigned-reg)))
1831 (:results (res :scs (long-reg)))
1832 (:temporary (:sc long-stack) temp)
1833 (:arg-types signed-num unsigned-num unsigned-num)
1834 (:result-types long-float)
1835 (:translate make-long-float)
1836 (:policy :fast-safe)
1839 (let ((offset (tn-offset temp)))
1840 (storew exp-bits ebp-tn (frame-word-offset offset))
1841 (storew hi-bits ebp-tn (frame-word-offset (1+ offset)))
1842 (storew lo-bits ebp-tn (frame-word-offset (+ offset 2)))
1843 (with-empty-tn@fp-top(res)
1844 (inst fldl (make-ea :dword :base ebp-tn
1845 :disp (frame-byte-offset (+ offset 2))))))))
1847 (define-vop (single-float-bits)
1848 (:args (float :scs (single-reg descriptor-reg)
1849 :load-if (not (sc-is float single-stack))))
1850 (:results (bits :scs (signed-reg)))
1851 (:temporary (:sc signed-stack :from :argument :to :result) stack-temp)
1852 (:arg-types single-float)
1853 (:result-types signed-num)
1854 (:translate single-float-bits)
1855 (:policy :fast-safe)
1862 (with-tn@fp-top(float)
1863 (inst fst stack-temp)
1864 (inst mov bits stack-temp)))
1866 (inst mov bits float))
1869 bits float single-float-value-slot
1870 other-pointer-lowtag))))
1874 (with-tn@fp-top(float)
1875 (inst fst bits))))))))
1877 (define-vop (double-float-high-bits)
1878 (:args (float :scs (double-reg descriptor-reg)
1879 :load-if (not (sc-is float double-stack))))
1880 (:results (hi-bits :scs (signed-reg)))
1881 (:temporary (:sc double-stack) temp)
1882 (:arg-types double-float)
1883 (:result-types signed-num)
1884 (:translate double-float-high-bits)
1885 (:policy :fast-safe)
1890 (with-tn@fp-top(float)
1891 (let ((where (make-ea :dword :base ebp-tn
1892 :disp (frame-byte-offset (1+ (tn-offset temp))))))
1894 (loadw hi-bits ebp-tn (frame-word-offset (tn-offset temp))))
1896 (loadw hi-bits ebp-tn (frame-word-offset (tn-offset float))))
1898 (loadw hi-bits float (1+ double-float-value-slot)
1899 other-pointer-lowtag)))))
1901 (define-vop (double-float-low-bits)
1902 (:args (float :scs (double-reg descriptor-reg)
1903 :load-if (not (sc-is float double-stack))))
1904 (:results (lo-bits :scs (unsigned-reg)))
1905 (:temporary (:sc double-stack) temp)
1906 (:arg-types double-float)
1907 (:result-types unsigned-num)
1908 (:translate double-float-low-bits)
1909 (:policy :fast-safe)
1914 (with-tn@fp-top(float)
1915 (let ((where (make-ea :dword :base ebp-tn
1916 :disp (frame-byte-offset (1+ (tn-offset temp))))))
1918 (loadw lo-bits ebp-tn (frame-word-offset (1+ (tn-offset temp)))))
1920 (loadw lo-bits ebp-tn (frame-word-offset (1+ (tn-offset float)))))
1922 (loadw lo-bits float double-float-value-slot
1923 other-pointer-lowtag)))))
1926 (define-vop (long-float-exp-bits)
1927 (:args (float :scs (long-reg descriptor-reg)
1928 :load-if (not (sc-is float long-stack))))
1929 (:results (exp-bits :scs (signed-reg)))
1930 (:temporary (:sc long-stack) temp)
1931 (:arg-types long-float)
1932 (:result-types signed-num)
1933 (:translate long-float-exp-bits)
1934 (:policy :fast-safe)
1939 (with-tn@fp-top(float)
1940 (let ((where (make-ea :dword :base ebp-tn
1941 :disp (frame-byte-offset (+ 2 (tn-offset temp))))))
1942 (store-long-float where)))
1943 (inst movsx exp-bits
1944 (make-ea :word :base ebp-tn
1945 :disp (frame-byte-offset (tn-offset temp)))))
1947 (inst movsx exp-bits
1948 (make-ea :word :base ebp-tn
1949 :disp (frame-byte-offset (tn-offset temp)))))
1951 (inst movsx exp-bits
1952 (make-ea-for-object-slot float (+ 2 long-float-value-slot)
1953 other-pointer-lowtag :word))))))
1956 (define-vop (long-float-high-bits)
1957 (:args (float :scs (long-reg descriptor-reg)
1958 :load-if (not (sc-is float long-stack))))
1959 (:results (hi-bits :scs (unsigned-reg)))
1960 (:temporary (:sc long-stack) temp)
1961 (:arg-types long-float)
1962 (:result-types unsigned-num)
1963 (:translate long-float-high-bits)
1964 (:policy :fast-safe)
1969 (with-tn@fp-top(float)
1970 (let ((where (make-ea :dword :base ebp-tn
1971 :disp (frame-byte-offset (+ 2 (tn-offset temp))))))
1972 (store-long-float where)))
1973 (loadw hi-bits ebp-tn (frame-word-offset (1+ (tn-offset temp)))))
1975 (loadw hi-bits ebp-tn (frame-word-offset (1+ (tn-offset temp)))))
1977 (loadw hi-bits float (1+ long-float-value-slot)
1978 other-pointer-lowtag)))))
1981 (define-vop (long-float-low-bits)
1982 (:args (float :scs (long-reg descriptor-reg)
1983 :load-if (not (sc-is float long-stack))))
1984 (:results (lo-bits :scs (unsigned-reg)))
1985 (:temporary (:sc long-stack) temp)
1986 (:arg-types long-float)
1987 (:result-types unsigned-num)
1988 (:translate long-float-low-bits)
1989 (:policy :fast-safe)
1994 (with-tn@fp-top(float)
1995 (let ((where (make-ea :dword :base ebp-tn
1996 :disp (frame-byte-offset (+ 2 (tn-offset temp))))))
1997 (store-long-float where)))
1998 (loadw lo-bits ebp-tn (frame-word-offset (+ (tn-offset temp) 2))))
2000 (loadw lo-bits ebp-tn (frame-word-offset (+ (tn-offset float) 2))))
2002 (loadw lo-bits float long-float-value-slot
2003 other-pointer-lowtag)))))
2005 ;;;; float mode hackery
2007 (sb!xc:deftype float-modes () '(unsigned-byte 32)) ; really only 16
2008 (defknown floating-point-modes () float-modes (flushable))
2009 (defknown ((setf floating-point-modes)) (float-modes)
2012 (def!constant npx-env-size (* 7 n-word-bytes))
2013 (def!constant npx-cw-offset 0)
2014 (def!constant npx-sw-offset 4)
2016 (define-vop (floating-point-modes)
2017 (:results (res :scs (unsigned-reg)))
2018 (:result-types unsigned-num)
2019 (:translate floating-point-modes)
2020 (:policy :fast-safe)
2021 (:temporary (:sc unsigned-reg :offset eax-offset :target res
2024 (inst sub esp-tn npx-env-size) ; Make space on stack.
2025 (inst wait) ; Catch any pending FPE exceptions
2026 (inst fstenv (make-ea :dword :base esp-tn)) ; masks all exceptions
2027 (inst fldenv (make-ea :dword :base esp-tn)) ; Restore previous state.
2028 ;; Move current status to high word.
2029 (inst mov eax (make-ea :dword :base esp-tn :disp (- npx-sw-offset 2)))
2030 ;; Move exception mask to low word.
2031 (inst mov ax-tn (make-ea :word :base esp-tn :disp npx-cw-offset))
2032 (inst add esp-tn npx-env-size) ; Pop stack.
2033 (inst xor eax #x3f) ; Flip exception mask to trap enable bits.
2036 (define-vop (set-floating-point-modes)
2037 (:args (new :scs (unsigned-reg) :to :result :target res))
2038 (:results (res :scs (unsigned-reg)))
2039 (:arg-types unsigned-num)
2040 (:result-types unsigned-num)
2041 (:translate (setf floating-point-modes))
2042 (:policy :fast-safe)
2043 (:temporary (:sc unsigned-reg :offset eax-offset
2044 :from :eval :to :result) eax)
2046 (inst sub esp-tn npx-env-size) ; Make space on stack.
2047 (inst wait) ; Catch any pending FPE exceptions.
2048 (inst fstenv (make-ea :dword :base esp-tn))
2050 (inst xor eax #x3f) ; Turn trap enable bits into exception mask.
2051 (inst mov (make-ea :word :base esp-tn :disp npx-cw-offset) ax-tn)
2052 (inst shr eax 16) ; position status word
2053 (inst mov (make-ea :word :base esp-tn :disp npx-sw-offset) ax-tn)
2054 (inst fldenv (make-ea :dword :base esp-tn))
2055 (inst add esp-tn npx-env-size) ; Pop stack.
2061 ;;; Let's use some of the 80387 special functions.
2063 ;;; These defs will not take effect unless code/irrat.lisp is modified
2064 ;;; to remove the inlined alien routine def.
2066 (macrolet ((frob (func trans op)
2067 `(define-vop (,func)
2068 (:args (x :scs (double-reg) :target fr0))
2069 (:temporary (:sc double-reg :offset fr0-offset
2070 :from :argument :to :result) fr0)
2072 (:results (y :scs (double-reg)))
2073 (:arg-types double-float)
2074 (:result-types double-float)
2076 (:policy :fast-safe)
2077 (:note "inline NPX function")
2079 (:save-p :compute-only)
2082 (note-this-location vop :internal-error)
2083 (unless (zerop (tn-offset x))
2084 (inst fxch x) ; x to top of stack
2085 (unless (location= x y)
2086 (inst fst x))) ; maybe save it
2087 (inst ,op) ; clobber st0
2088 (cond ((zerop (tn-offset y))
2089 (maybe-fp-wait node))
2093 ;; Quick versions of fsin and fcos that require the argument to be
2094 ;; within range 2^63.
2095 (frob fsin-quick %sin-quick fsin)
2096 (frob fcos-quick %cos-quick fcos)
2097 (frob fsqrt %sqrt fsqrt))
2099 ;;; Quick version of ftan that requires the argument to be within
2101 (define-vop (ftan-quick)
2102 (:translate %tan-quick)
2103 (:args (x :scs (double-reg) :target fr0))
2104 (:temporary (:sc double-reg :offset fr0-offset
2105 :from :argument :to :result) fr0)
2106 (:temporary (:sc double-reg :offset fr1-offset
2107 :from :argument :to :result) fr1)
2108 (:results (y :scs (double-reg)))
2109 (:arg-types double-float)
2110 (:result-types double-float)
2111 (:policy :fast-safe)
2112 (:note "inline tan function")
2114 (:save-p :compute-only)
2116 (note-this-location vop :internal-error)
2125 (inst fldd (make-random-tn :kind :normal
2126 :sc (sc-or-lose 'double-reg)
2127 :offset (- (tn-offset x) 2)))))
2138 ;;; KLUDGE: these versions of fsin, fcos, and ftan simply load a 0.0
2139 ;;; result if the argument is out of range 2^63 and would thus be
2140 ;;; hopelessly inaccurate.
2141 (macrolet ((frob (func trans op)
2142 `(define-vop (,func)
2144 (:args (x :scs (double-reg) :target fr0))
2145 (:temporary (:sc double-reg :offset fr0-offset
2146 :from :argument :to :result) fr0)
2147 (:temporary (:sc unsigned-reg :offset eax-offset
2148 :from :argument :to :result) eax)
2149 (:results (y :scs (double-reg)))
2150 (:arg-types double-float)
2151 (:result-types double-float)
2152 (:policy :fast-safe)
2153 (:note "inline sin/cos function")
2155 (:save-p :compute-only)
2158 (note-this-location vop :internal-error)
2159 (unless (zerop (tn-offset x))
2160 (inst fxch x) ; x to top of stack
2161 (unless (location= x y)
2162 (inst fst x))) ; maybe save it
2164 (inst fnstsw) ; status word to ax
2165 (inst and ah-tn #x04) ; C2
2167 ;; Else x was out of range so reduce it; ST0 is unchanged.
2168 (inst fstp fr0) ; Load 0.0
2171 (unless (zerop (tn-offset y))
2173 (frob fsin %sin fsin)
2174 (frob fcos %cos fcos))
2178 (:args (x :scs (double-reg) :target fr0))
2179 (:temporary (:sc double-reg :offset fr0-offset
2180 :from :argument :to :result) fr0)
2181 (:temporary (:sc double-reg :offset fr1-offset
2182 :from :argument :to :result) fr1)
2183 (:temporary (:sc unsigned-reg :offset eax-offset
2184 :from :argument :to :result) eax)
2185 (:results (y :scs (double-reg)))
2186 (:arg-types double-float)
2187 (:result-types double-float)
2189 (:policy :fast-safe)
2190 (:note "inline tan function")
2192 (:save-p :compute-only)
2195 (note-this-location vop :internal-error)
2204 (inst fldd (make-random-tn :kind :normal
2205 :sc (sc-or-lose 'double-reg)
2206 :offset (- (tn-offset x) 2)))))
2208 (inst fnstsw) ; status word to ax
2209 (inst and ah-tn #x04) ; C2
2211 ;; Else x was out of range so load 0.0
2223 ;;; %exp that handles the following special cases: exp(+Inf) is +Inf;
2224 ;;; exp(-Inf) is 0; exp(NaN) is NaN.
2227 (:args (x :scs (double-reg) :target fr0))
2228 (:temporary (:sc word-reg :offset eax-offset :from :eval :to :result) temp)
2229 (:temporary (:sc double-reg :offset fr0-offset
2230 :from :argument :to :result) fr0)
2231 (:temporary (:sc double-reg :offset fr1-offset
2232 :from :argument :to :result) fr1)
2233 (:temporary (:sc double-reg :offset fr2-offset
2234 :from :argument :to :result) fr2)
2235 (:results (y :scs (double-reg)))
2236 (:arg-types double-float)
2237 (:result-types double-float)
2238 (:policy :fast-safe)
2239 (:note "inline exp function")
2241 (:save-p :compute-only)
2244 (note-this-location vop :internal-error)
2245 (unless (zerop (tn-offset x))
2246 (inst fxch x) ; x to top of stack
2247 (unless (location= x y)
2248 (inst fst x))) ; maybe save it
2249 ;; Check for Inf or NaN
2253 (inst jmp :nc NOINFNAN) ; Neither Inf or NaN.
2254 (inst jmp :np NOINFNAN) ; NaN gives NaN? Continue.
2255 (inst and ah-tn #x02) ; Test sign of Inf.
2256 (inst jmp :z DONE) ; +Inf gives +Inf.
2257 (inst fstp fr0) ; -Inf gives 0
2259 (inst jmp-short DONE)
2264 ;; Now fr0=x log2(e)
2268 (inst fsubp-sti fr1)
2271 (inst faddp-sti fr1)
2275 (unless (zerop (tn-offset y))
2278 ;;; Expm1 = exp(x) - 1.
2279 ;;; Handles the following special cases:
2280 ;;; expm1(+Inf) is +Inf; expm1(-Inf) is -1.0; expm1(NaN) is NaN.
2281 (define-vop (fexpm1)
2283 (:args (x :scs (double-reg) :target fr0))
2284 (:temporary (:sc word-reg :offset eax-offset :from :eval :to :result) temp)
2285 (:temporary (:sc double-reg :offset fr0-offset
2286 :from :argument :to :result) fr0)
2287 (:temporary (:sc double-reg :offset fr1-offset
2288 :from :argument :to :result) fr1)
2289 (:temporary (:sc double-reg :offset fr2-offset
2290 :from :argument :to :result) fr2)
2291 (:results (y :scs (double-reg)))
2292 (:arg-types double-float)
2293 (:result-types double-float)
2294 (:policy :fast-safe)
2295 (:note "inline expm1 function")
2297 (:save-p :compute-only)
2300 (note-this-location vop :internal-error)
2301 (unless (zerop (tn-offset x))
2302 (inst fxch x) ; x to top of stack
2303 (unless (location= x y)
2304 (inst fst x))) ; maybe save it
2305 ;; Check for Inf or NaN
2309 (inst jmp :nc NOINFNAN) ; Neither Inf or NaN.
2310 (inst jmp :np NOINFNAN) ; NaN gives NaN? Continue.
2311 (inst and ah-tn #x02) ; Test sign of Inf.
2312 (inst jmp :z DONE) ; +Inf gives +Inf.
2313 (inst fstp fr0) ; -Inf gives -1.0
2316 (inst jmp-short DONE)
2318 ;; Free two stack slots leaving the argument on top.
2322 (inst fmul fr1) ; Now fr0 = x log2(e)
2337 (unless (zerop (tn-offset y))
2342 (:args (x :scs (double-reg double-stack descriptor-reg) :target fr0))
2343 (:temporary (:sc double-reg :offset fr0-offset
2344 :from :argument :to :result) fr0)
2345 (:temporary (:sc double-reg :offset fr1-offset
2346 :from :argument :to :result) fr1)
2347 (:results (y :scs (double-reg)))
2348 (:arg-types double-float)
2349 (:result-types double-float)
2350 (:policy :fast-safe)
2351 (:note "inline log function")
2353 (:save-p :compute-only)
2355 (note-this-location vop :internal-error)
2370 ;; x is in a FP reg, not fr0 or fr1
2374 (inst fldd (make-random-tn :kind :normal
2375 :sc (sc-or-lose 'double-reg)
2376 :offset (1- (tn-offset x))))))
2378 ((double-stack descriptor-reg)
2382 (if (sc-is x double-stack)
2383 (inst fldd (ea-for-df-stack x))
2384 (inst fldd (ea-for-df-desc x)))
2389 (t (inst fstd y)))))
2391 (define-vop (flog10)
2393 (:args (x :scs (double-reg double-stack descriptor-reg) :target fr0))
2394 (:temporary (:sc double-reg :offset fr0-offset
2395 :from :argument :to :result) fr0)
2396 (:temporary (:sc double-reg :offset fr1-offset
2397 :from :argument :to :result) fr1)
2398 (:results (y :scs (double-reg)))
2399 (:arg-types double-float)
2400 (:result-types double-float)
2401 (:policy :fast-safe)
2402 (:note "inline log10 function")
2404 (:save-p :compute-only)
2406 (note-this-location vop :internal-error)
2421 ;; x is in a FP reg, not fr0 or fr1
2425 (inst fldd (make-random-tn :kind :normal
2426 :sc (sc-or-lose 'double-reg)
2427 :offset (1- (tn-offset x))))))
2429 ((double-stack descriptor-reg)
2433 (if (sc-is x double-stack)
2434 (inst fldd (ea-for-df-stack x))
2435 (inst fldd (ea-for-df-desc x)))
2440 (t (inst fstd y)))))
2444 (:args (x :scs (double-reg double-stack descriptor-reg) :target fr0)
2445 (y :scs (double-reg double-stack descriptor-reg) :target fr1))
2446 (:temporary (:sc double-reg :offset fr0-offset
2447 :from (:argument 0) :to :result) fr0)
2448 (:temporary (:sc double-reg :offset fr1-offset
2449 :from (:argument 1) :to :result) fr1)
2450 (:temporary (:sc double-reg :offset fr2-offset
2451 :from :load :to :result) fr2)
2452 (:results (r :scs (double-reg)))
2453 (:arg-types double-float double-float)
2454 (:result-types double-float)
2455 (:policy :fast-safe)
2456 (:note "inline pow function")
2458 (:save-p :compute-only)
2460 (note-this-location vop :internal-error)
2461 ;; Setup x in fr0 and y in fr1
2463 ;; x in fr0; y in fr1
2464 ((and (sc-is x double-reg) (zerop (tn-offset x))
2465 (sc-is y double-reg) (= 1 (tn-offset y))))
2466 ;; y in fr1; x not in fr0
2467 ((and (sc-is y double-reg) (= 1 (tn-offset y)))
2471 (copy-fp-reg-to-fr0 x))
2474 (inst fldd (ea-for-df-stack x)))
2477 (inst fldd (ea-for-df-desc x)))))
2478 ;; x in fr0; y not in fr1
2479 ((and (sc-is x double-reg) (zerop (tn-offset x)))
2481 ;; Now load y to fr0
2484 (copy-fp-reg-to-fr0 y))
2487 (inst fldd (ea-for-df-stack y)))
2490 (inst fldd (ea-for-df-desc y))))
2492 ;; x in fr1; y not in fr1
2493 ((and (sc-is x double-reg) (= 1 (tn-offset x)))
2497 (copy-fp-reg-to-fr0 y))
2500 (inst fldd (ea-for-df-stack y)))
2503 (inst fldd (ea-for-df-desc y))))
2506 ((and (sc-is y double-reg) (zerop (tn-offset y)))
2508 ;; Now load x to fr0
2511 (copy-fp-reg-to-fr0 x))
2514 (inst fldd (ea-for-df-stack x)))
2517 (inst fldd (ea-for-df-desc x)))))
2518 ;; Neither x or y are in either fr0 or fr1
2525 (inst fldd (make-random-tn :kind :normal
2526 :sc (sc-or-lose 'double-reg)
2527 :offset (- (tn-offset y) 2))))
2529 (inst fldd (ea-for-df-stack y)))
2531 (inst fldd (ea-for-df-desc y))))
2535 (inst fldd (make-random-tn :kind :normal
2536 :sc (sc-or-lose 'double-reg)
2537 :offset (1- (tn-offset x)))))
2539 (inst fldd (ea-for-df-stack x)))
2541 (inst fldd (ea-for-df-desc x))))))
2543 ;; Now have x at fr0; and y at fr1
2545 ;; Now fr0=y log2(x)
2549 (inst fsubp-sti fr1)
2552 (inst faddp-sti fr1)
2557 (t (inst fstd r)))))
2559 (define-vop (fscalen)
2560 (:translate %scalbn)
2561 (:args (x :scs (double-reg double-stack descriptor-reg) :target fr0)
2562 (y :scs (signed-stack signed-reg) :target temp))
2563 (:temporary (:sc double-reg :offset fr0-offset
2564 :from (:argument 0) :to :result) fr0)
2565 (:temporary (:sc double-reg :offset fr1-offset :from :eval :to :result) fr1)
2566 (:temporary (:sc signed-stack :from (:argument 1) :to :result) temp)
2567 (:results (r :scs (double-reg)))
2568 (:arg-types double-float signed-num)
2569 (:result-types double-float)
2570 (:policy :fast-safe)
2571 (:note "inline scalbn function")
2573 ;; Setup x in fr0 and y in fr1
2604 (inst fld (make-random-tn :kind :normal
2605 :sc (sc-or-lose 'double-reg)
2606 :offset (1- (tn-offset x)))))))
2607 ((double-stack descriptor-reg)
2616 (if (sc-is x double-stack)
2617 (inst fldd (ea-for-df-stack x))
2618 (inst fldd (ea-for-df-desc x)))))
2620 (unless (zerop (tn-offset r))
2623 (define-vop (fscale)
2625 (:args (x :scs (double-reg double-stack descriptor-reg) :target fr0)
2626 (y :scs (double-reg double-stack descriptor-reg) :target fr1))
2627 (:temporary (:sc double-reg :offset fr0-offset
2628 :from (:argument 0) :to :result) fr0)
2629 (:temporary (:sc double-reg :offset fr1-offset
2630 :from (:argument 1) :to :result) fr1)
2631 (:results (r :scs (double-reg)))
2632 (:arg-types double-float double-float)
2633 (:result-types double-float)
2634 (:policy :fast-safe)
2635 (:note "inline scalb function")
2637 (:save-p :compute-only)
2639 (note-this-location vop :internal-error)
2640 ;; Setup x in fr0 and y in fr1
2642 ;; x in fr0; y in fr1
2643 ((and (sc-is x double-reg) (zerop (tn-offset x))
2644 (sc-is y double-reg) (= 1 (tn-offset y))))
2645 ;; y in fr1; x not in fr0
2646 ((and (sc-is y double-reg) (= 1 (tn-offset y)))
2650 (copy-fp-reg-to-fr0 x))
2653 (inst fldd (ea-for-df-stack x)))
2656 (inst fldd (ea-for-df-desc x)))))
2657 ;; x in fr0; y not in fr1
2658 ((and (sc-is x double-reg) (zerop (tn-offset x)))
2660 ;; Now load y to fr0
2663 (copy-fp-reg-to-fr0 y))
2666 (inst fldd (ea-for-df-stack y)))
2669 (inst fldd (ea-for-df-desc y))))
2671 ;; x in fr1; y not in fr1
2672 ((and (sc-is x double-reg) (= 1 (tn-offset x)))
2676 (copy-fp-reg-to-fr0 y))
2679 (inst fldd (ea-for-df-stack y)))
2682 (inst fldd (ea-for-df-desc y))))
2685 ((and (sc-is y double-reg) (zerop (tn-offset y)))
2687 ;; Now load x to fr0
2690 (copy-fp-reg-to-fr0 x))
2693 (inst fldd (ea-for-df-stack x)))
2696 (inst fldd (ea-for-df-desc x)))))
2697 ;; Neither x or y are in either fr0 or fr1
2704 (inst fldd (make-random-tn :kind :normal
2705 :sc (sc-or-lose 'double-reg)
2706 :offset (- (tn-offset y) 2))))
2708 (inst fldd (ea-for-df-stack y)))
2710 (inst fldd (ea-for-df-desc y))))
2714 (inst fldd (make-random-tn :kind :normal
2715 :sc (sc-or-lose 'double-reg)
2716 :offset (1- (tn-offset x)))))
2718 (inst fldd (ea-for-df-stack x)))
2720 (inst fldd (ea-for-df-desc x))))))
2722 ;; Now have x at fr0; and y at fr1
2724 (unless (zerop (tn-offset r))
2727 (define-vop (flog1p)
2729 (:args (x :scs (double-reg) :to :result))
2730 (:temporary (:sc double-reg :offset fr0-offset
2731 :from :argument :to :result) fr0)
2732 (:temporary (:sc double-reg :offset fr1-offset
2733 :from :argument :to :result) fr1)
2734 (:temporary (:sc word-reg :offset eax-offset :from :eval) temp)
2735 (:results (y :scs (double-reg)))
2736 (:arg-types double-float)
2737 (:result-types double-float)
2738 (:policy :fast-safe)
2739 (:note "inline log1p function")
2742 ;; x is in a FP reg, not fr0, fr1.
2745 (inst fldd (make-random-tn :kind :normal
2746 :sc (sc-or-lose 'double-reg)
2747 :offset (- (tn-offset x) 2)))
2749 (inst push #x3e947ae1) ; Constant 0.29
2751 (inst fld (make-ea :dword :base esp-tn))
2754 (inst fnstsw) ; status word to ax
2755 (inst and ah-tn #x45)
2756 (inst jmp :z WITHIN-RANGE)
2757 ;; Out of range for fyl2xp1.
2759 (inst faddd (make-random-tn :kind :normal
2760 :sc (sc-or-lose 'double-reg)
2761 :offset (- (tn-offset x) 1)))
2769 (inst fldd (make-random-tn :kind :normal
2770 :sc (sc-or-lose 'double-reg)
2771 :offset (- (tn-offset x) 1)))
2777 (t (inst fstd y)))))
2779 ;;; The Pentium has a less restricted implementation of the fyl2xp1
2780 ;;; instruction and a range check can be avoided.
2781 (define-vop (flog1p-pentium)
2783 (:args (x :scs (double-reg double-stack descriptor-reg) :target fr0))
2784 (:temporary (:sc double-reg :offset fr0-offset
2785 :from :argument :to :result) fr0)
2786 (:temporary (:sc double-reg :offset fr1-offset
2787 :from :argument :to :result) fr1)
2788 (:results (y :scs (double-reg)))
2789 (:arg-types double-float)
2790 (:result-types double-float)
2791 (:policy :fast-safe)
2792 (:guard (member :pentium-style-fyl2xp1 *backend-subfeatures*))
2793 (:note "inline log1p with limited x range function")
2795 (:save-p :compute-only)
2797 (note-this-location vop :internal-error)
2812 ;; x is in a FP reg, not fr0 or fr1
2816 (inst fldd (make-random-tn :kind :normal
2817 :sc (sc-or-lose 'double-reg)
2818 :offset (1- (tn-offset x)))))))
2819 ((double-stack descriptor-reg)
2823 (if (sc-is x double-stack)
2824 (inst fldd (ea-for-df-stack x))
2825 (inst fldd (ea-for-df-desc x)))))
2830 (t (inst fstd y)))))
2834 (:args (x :scs (double-reg double-stack descriptor-reg) :target fr0))
2835 (:temporary (:sc double-reg :offset fr0-offset
2836 :from :argument :to :result) fr0)
2837 (:temporary (:sc double-reg :offset fr1-offset
2838 :from :argument :to :result) fr1)
2839 (:results (y :scs (double-reg)))
2840 (:arg-types double-float)
2841 (:result-types double-float)
2842 (:policy :fast-safe)
2843 (:note "inline logb function")
2845 (:save-p :compute-only)
2847 (note-this-location vop :internal-error)
2858 ;; x is in a FP reg, not fr0 or fr1
2861 (inst fldd (make-random-tn :kind :normal
2862 :sc (sc-or-lose 'double-reg)
2863 :offset (- (tn-offset x) 2))))))
2864 ((double-stack descriptor-reg)
2867 (if (sc-is x double-stack)
2868 (inst fldd (ea-for-df-stack x))
2869 (inst fldd (ea-for-df-desc x)))))
2880 (:args (x :scs (double-reg double-stack descriptor-reg) :target fr0))
2881 (:temporary (:sc double-reg :offset fr0-offset
2882 :from (:argument 0) :to :result) fr0)
2883 (:temporary (:sc double-reg :offset fr1-offset
2884 :from (:argument 0) :to :result) fr1)
2885 (:results (r :scs (double-reg)))
2886 (:arg-types double-float)
2887 (:result-types double-float)
2888 (:policy :fast-safe)
2889 (:note "inline atan function")
2891 (:save-p :compute-only)
2893 (note-this-location vop :internal-error)
2894 ;; Setup x in fr1 and 1.0 in fr0
2897 ((and (sc-is x double-reg) (zerop (tn-offset x)))
2900 ((and (sc-is x double-reg) (= 1 (tn-offset x)))
2902 ;; x not in fr0 or fr1
2909 (inst fldd (make-random-tn :kind :normal
2910 :sc (sc-or-lose 'double-reg)
2911 :offset (- (tn-offset x) 2))))
2913 (inst fldd (ea-for-df-stack x)))
2915 (inst fldd (ea-for-df-desc x))))))
2917 ;; Now have x at fr1; and 1.0 at fr0
2922 (t (inst fstd r)))))
2924 (define-vop (fatan2)
2926 (:args (x :scs (double-reg double-stack descriptor-reg) :target fr1)
2927 (y :scs (double-reg double-stack descriptor-reg) :target fr0))
2928 (:temporary (:sc double-reg :offset fr0-offset
2929 :from (:argument 1) :to :result) fr0)
2930 (:temporary (:sc double-reg :offset fr1-offset
2931 :from (:argument 0) :to :result) fr1)
2932 (:results (r :scs (double-reg)))
2933 (:arg-types double-float double-float)
2934 (:result-types double-float)
2935 (:policy :fast-safe)
2936 (:note "inline atan2 function")
2938 (:save-p :compute-only)
2940 (note-this-location vop :internal-error)
2941 ;; Setup x in fr1 and y in fr0
2943 ;; y in fr0; x in fr1
2944 ((and (sc-is y double-reg) (zerop (tn-offset y))
2945 (sc-is x double-reg) (= 1 (tn-offset x))))
2946 ;; x in fr1; y not in fr0
2947 ((and (sc-is x double-reg) (= 1 (tn-offset x)))
2951 (copy-fp-reg-to-fr0 y))
2954 (inst fldd (ea-for-df-stack y)))
2957 (inst fldd (ea-for-df-desc y)))))
2958 ((and (sc-is x double-reg) (zerop (tn-offset x))
2959 (sc-is y double-reg) (zerop (tn-offset x)))
2962 ;; y in fr0; x not in fr1
2963 ((and (sc-is y double-reg) (zerop (tn-offset y)))
2965 ;; Now load x to fr0
2968 (copy-fp-reg-to-fr0 x))
2971 (inst fldd (ea-for-df-stack x)))
2974 (inst fldd (ea-for-df-desc x))))
2976 ;; y in fr1; x not in fr1
2977 ((and (sc-is y double-reg) (= 1 (tn-offset y)))
2981 (copy-fp-reg-to-fr0 x))
2984 (inst fldd (ea-for-df-stack x)))
2987 (inst fldd (ea-for-df-desc x))))
2990 ((and (sc-is x double-reg) (zerop (tn-offset x)))
2992 ;; Now load y to fr0
2995 (copy-fp-reg-to-fr0 y))
2998 (inst fldd (ea-for-df-stack y)))
3001 (inst fldd (ea-for-df-desc y)))))
3002 ;; Neither y or x are in either fr0 or fr1
3009 (inst fldd (make-random-tn :kind :normal
3010 :sc (sc-or-lose 'double-reg)
3011 :offset (- (tn-offset x) 2))))
3013 (inst fldd (ea-for-df-stack x)))
3015 (inst fldd (ea-for-df-desc x))))
3019 (inst fldd (make-random-tn :kind :normal
3020 :sc (sc-or-lose 'double-reg)
3021 :offset (1- (tn-offset y)))))
3023 (inst fldd (ea-for-df-stack y)))
3025 (inst fldd (ea-for-df-desc y))))))
3027 ;; Now have y at fr0; and x at fr1
3032 (t (inst fstd r)))))
3033 ) ; PROGN #!-LONG-FLOAT
3038 ;;; Lets use some of the 80387 special functions.
3040 ;;; These defs will not take effect unless code/irrat.lisp is modified
3041 ;;; to remove the inlined alien routine def.
3043 (macrolet ((frob (func trans op)
3044 `(define-vop (,func)
3045 (:args (x :scs (long-reg) :target fr0))
3046 (:temporary (:sc long-reg :offset fr0-offset
3047 :from :argument :to :result) fr0)
3049 (:results (y :scs (long-reg)))
3050 (:arg-types long-float)
3051 (:result-types long-float)
3053 (:policy :fast-safe)
3054 (:note "inline NPX function")
3056 (:save-p :compute-only)
3059 (note-this-location vop :internal-error)
3060 (unless (zerop (tn-offset x))
3061 (inst fxch x) ; x to top of stack
3062 (unless (location= x y)
3063 (inst fst x))) ; maybe save it
3064 (inst ,op) ; clobber st0
3065 (cond ((zerop (tn-offset y))
3066 (maybe-fp-wait node))
3070 ;; Quick versions of FSIN and FCOS that require the argument to be
3071 ;; within range 2^63.
3072 (frob fsin-quick %sin-quick fsin)
3073 (frob fcos-quick %cos-quick fcos)
3074 (frob fsqrt %sqrt fsqrt))
3076 ;;; Quick version of ftan that requires the argument to be within
3078 (define-vop (ftan-quick)
3079 (:translate %tan-quick)
3080 (:args (x :scs (long-reg) :target fr0))
3081 (:temporary (:sc long-reg :offset fr0-offset
3082 :from :argument :to :result) fr0)
3083 (:temporary (:sc long-reg :offset fr1-offset
3084 :from :argument :to :result) fr1)
3085 (:results (y :scs (long-reg)))
3086 (:arg-types long-float)
3087 (:result-types long-float)
3088 (:policy :fast-safe)
3089 (:note "inline tan function")
3091 (:save-p :compute-only)
3093 (note-this-location vop :internal-error)
3102 (inst fldd (make-random-tn :kind :normal
3103 :sc (sc-or-lose 'double-reg)
3104 :offset (- (tn-offset x) 2)))))
3115 ;;; These versions of fsin, fcos, and ftan simply load a 0.0 result if
3116 ;;; the argument is out of range 2^63 and would thus be hopelessly
3118 (macrolet ((frob (func trans op)
3119 `(define-vop (,func)
3121 (:args (x :scs (long-reg) :target fr0))
3122 (:temporary (:sc long-reg :offset fr0-offset
3123 :from :argument :to :result) fr0)
3124 (:temporary (:sc unsigned-reg :offset eax-offset
3125 :from :argument :to :result) eax)
3126 (:results (y :scs (long-reg)))
3127 (:arg-types long-float)
3128 (:result-types long-float)
3129 (:policy :fast-safe)
3130 (:note "inline sin/cos function")
3132 (:save-p :compute-only)
3135 (note-this-location vop :internal-error)
3136 (unless (zerop (tn-offset x))
3137 (inst fxch x) ; x to top of stack
3138 (unless (location= x y)
3139 (inst fst x))) ; maybe save it
3141 (inst fnstsw) ; status word to ax
3142 (inst and ah-tn #x04) ; C2
3144 ;; Else x was out of range so reduce it; ST0 is unchanged.
3145 (inst fstp fr0) ; Load 0.0
3148 (unless (zerop (tn-offset y))
3150 (frob fsin %sin fsin)
3151 (frob fcos %cos fcos))
3155 (:args (x :scs (long-reg) :target fr0))
3156 (:temporary (:sc long-reg :offset fr0-offset
3157 :from :argument :to :result) fr0)
3158 (:temporary (:sc long-reg :offset fr1-offset
3159 :from :argument :to :result) fr1)
3160 (:temporary (:sc unsigned-reg :offset eax-offset
3161 :from :argument :to :result) eax)
3162 (:results (y :scs (long-reg)))
3163 (:arg-types long-float)
3164 (:result-types long-float)
3166 (:policy :fast-safe)
3167 (:note "inline tan function")
3169 (:save-p :compute-only)
3172 (note-this-location vop :internal-error)
3181 (inst fldd (make-random-tn :kind :normal
3182 :sc (sc-or-lose 'double-reg)
3183 :offset (- (tn-offset x) 2)))))
3185 (inst fnstsw) ; status word to ax
3186 (inst and ah-tn #x04) ; C2
3188 ;; Else x was out of range so reduce it; ST0 is unchanged.
3189 (inst fldz) ; Load 0.0
3201 ;;; Modified exp that handles the following special cases:
3202 ;;; exp(+Inf) is +Inf; exp(-Inf) is 0; exp(NaN) is NaN.
3205 (:args (x :scs (long-reg) :target fr0))
3206 (:temporary (:sc word-reg :offset eax-offset :from :eval :to :result) temp)
3207 (:temporary (:sc long-reg :offset fr0-offset
3208 :from :argument :to :result) fr0)
3209 (:temporary (:sc long-reg :offset fr1-offset
3210 :from :argument :to :result) fr1)
3211 (:temporary (:sc long-reg :offset fr2-offset
3212 :from :argument :to :result) fr2)
3213 (:results (y :scs (long-reg)))
3214 (:arg-types long-float)
3215 (:result-types long-float)
3216 (:policy :fast-safe)
3217 (:note "inline exp function")
3219 (:save-p :compute-only)
3222 (note-this-location vop :internal-error)
3223 (unless (zerop (tn-offset x))
3224 (inst fxch x) ; x to top of stack
3225 (unless (location= x y)
3226 (inst fst x))) ; maybe save it
3227 ;; Check for Inf or NaN
3231 (inst jmp :nc NOINFNAN) ; Neither Inf or NaN.
3232 (inst jmp :np NOINFNAN) ; NaN gives NaN? Continue.
3233 (inst and ah-tn #x02) ; Test sign of Inf.
3234 (inst jmp :z DONE) ; +Inf gives +Inf.
3235 (inst fstp fr0) ; -Inf gives 0
3237 (inst jmp-short DONE)
3242 ;; Now fr0=x log2(e)
3246 (inst fsubp-sti fr1)
3249 (inst faddp-sti fr1)
3253 (unless (zerop (tn-offset y))
3256 ;;; Expm1 = exp(x) - 1.
3257 ;;; Handles the following special cases:
3258 ;;; expm1(+Inf) is +Inf; expm1(-Inf) is -1.0; expm1(NaN) is NaN.
3259 (define-vop (fexpm1)
3261 (:args (x :scs (long-reg) :target fr0))
3262 (:temporary (:sc word-reg :offset eax-offset :from :eval :to :result) temp)
3263 (:temporary (:sc long-reg :offset fr0-offset
3264 :from :argument :to :result) fr0)
3265 (:temporary (:sc long-reg :offset fr1-offset
3266 :from :argument :to :result) fr1)
3267 (:temporary (:sc long-reg :offset fr2-offset
3268 :from :argument :to :result) fr2)
3269 (:results (y :scs (long-reg)))
3270 (:arg-types long-float)
3271 (:result-types long-float)
3272 (:policy :fast-safe)
3273 (:note "inline expm1 function")
3275 (:save-p :compute-only)
3278 (note-this-location vop :internal-error)
3279 (unless (zerop (tn-offset x))
3280 (inst fxch x) ; x to top of stack
3281 (unless (location= x y)
3282 (inst fst x))) ; maybe save it
3283 ;; Check for Inf or NaN
3287 (inst jmp :nc NOINFNAN) ; Neither Inf or NaN.
3288 (inst jmp :np NOINFNAN) ; NaN gives NaN? Continue.
3289 (inst and ah-tn #x02) ; Test sign of Inf.
3290 (inst jmp :z DONE) ; +Inf gives +Inf.
3291 (inst fstp fr0) ; -Inf gives -1.0
3294 (inst jmp-short DONE)
3296 ;; Free two stack slots leaving the argument on top.
3300 (inst fmul fr1) ; Now fr0 = x log2(e)
3315 (unless (zerop (tn-offset y))
3320 (:args (x :scs (long-reg long-stack descriptor-reg) :target fr0))
3321 (:temporary (:sc long-reg :offset fr0-offset
3322 :from :argument :to :result) fr0)
3323 (:temporary (:sc long-reg :offset fr1-offset
3324 :from :argument :to :result) fr1)
3325 (:results (y :scs (long-reg)))
3326 (:arg-types long-float)
3327 (:result-types long-float)
3328 (:policy :fast-safe)
3329 (:note "inline log function")
3331 (:save-p :compute-only)
3333 (note-this-location vop :internal-error)
3348 ;; x is in a FP reg, not fr0 or fr1
3352 (inst fldd (make-random-tn :kind :normal
3353 :sc (sc-or-lose 'double-reg)
3354 :offset (1- (tn-offset x))))))
3356 ((long-stack descriptor-reg)
3360 (if (sc-is x long-stack)
3361 (inst fldl (ea-for-lf-stack x))
3362 (inst fldl (ea-for-lf-desc x)))
3367 (t (inst fstd y)))))
3369 (define-vop (flog10)
3371 (:args (x :scs (long-reg long-stack descriptor-reg) :target fr0))
3372 (:temporary (:sc long-reg :offset fr0-offset
3373 :from :argument :to :result) fr0)
3374 (:temporary (:sc long-reg :offset fr1-offset
3375 :from :argument :to :result) fr1)
3376 (:results (y :scs (long-reg)))
3377 (:arg-types long-float)
3378 (:result-types long-float)
3379 (:policy :fast-safe)
3380 (:note "inline log10 function")
3382 (:save-p :compute-only)
3384 (note-this-location vop :internal-error)
3399 ;; x is in a FP reg, not fr0 or fr1
3403 (inst fldd (make-random-tn :kind :normal
3404 :sc (sc-or-lose 'double-reg)
3405 :offset (1- (tn-offset x))))))
3407 ((long-stack descriptor-reg)
3411 (if (sc-is x long-stack)
3412 (inst fldl (ea-for-lf-stack x))
3413 (inst fldl (ea-for-lf-desc x)))
3418 (t (inst fstd y)))))
3422 (:args (x :scs (long-reg long-stack descriptor-reg) :target fr0)
3423 (y :scs (long-reg long-stack descriptor-reg) :target fr1))
3424 (:temporary (:sc long-reg :offset fr0-offset
3425 :from (:argument 0) :to :result) fr0)
3426 (:temporary (:sc long-reg :offset fr1-offset
3427 :from (:argument 1) :to :result) fr1)
3428 (:temporary (:sc long-reg :offset fr2-offset
3429 :from :load :to :result) fr2)
3430 (:results (r :scs (long-reg)))
3431 (:arg-types long-float long-float)
3432 (:result-types long-float)
3433 (:policy :fast-safe)
3434 (:note "inline pow function")
3436 (:save-p :compute-only)
3438 (note-this-location vop :internal-error)
3439 ;; Setup x in fr0 and y in fr1
3441 ;; x in fr0; y in fr1
3442 ((and (sc-is x long-reg) (zerop (tn-offset x))
3443 (sc-is y long-reg) (= 1 (tn-offset y))))
3444 ;; y in fr1; x not in fr0
3445 ((and (sc-is y long-reg) (= 1 (tn-offset y)))
3449 (copy-fp-reg-to-fr0 x))
3452 (inst fldl (ea-for-lf-stack x)))
3455 (inst fldl (ea-for-lf-desc x)))))
3456 ;; x in fr0; y not in fr1
3457 ((and (sc-is x long-reg) (zerop (tn-offset x)))
3459 ;; Now load y to fr0
3462 (copy-fp-reg-to-fr0 y))
3465 (inst fldl (ea-for-lf-stack y)))
3468 (inst fldl (ea-for-lf-desc y))))
3470 ;; x in fr1; y not in fr1
3471 ((and (sc-is x long-reg) (= 1 (tn-offset x)))
3475 (copy-fp-reg-to-fr0 y))
3478 (inst fldl (ea-for-lf-stack y)))
3481 (inst fldl (ea-for-lf-desc y))))
3484 ((and (sc-is y long-reg) (zerop (tn-offset y)))
3486 ;; Now load x to fr0
3489 (copy-fp-reg-to-fr0 x))
3492 (inst fldl (ea-for-lf-stack x)))
3495 (inst fldl (ea-for-lf-desc x)))))
3496 ;; Neither x or y are in either fr0 or fr1
3503 (inst fldd (make-random-tn :kind :normal
3504 :sc (sc-or-lose 'double-reg)
3505 :offset (- (tn-offset y) 2))))
3507 (inst fldl (ea-for-lf-stack y)))
3509 (inst fldl (ea-for-lf-desc y))))
3513 (inst fldd (make-random-tn :kind :normal
3514 :sc (sc-or-lose 'double-reg)
3515 :offset (1- (tn-offset x)))))
3517 (inst fldl (ea-for-lf-stack x)))
3519 (inst fldl (ea-for-lf-desc x))))))
3521 ;; Now have x at fr0; and y at fr1
3523 ;; Now fr0=y log2(x)
3527 (inst fsubp-sti fr1)
3530 (inst faddp-sti fr1)
3535 (t (inst fstd r)))))
3537 (define-vop (fscalen)
3538 (:translate %scalbn)
3539 (:args (x :scs (long-reg long-stack descriptor-reg) :target fr0)
3540 (y :scs (signed-stack signed-reg) :target temp))
3541 (:temporary (:sc long-reg :offset fr0-offset
3542 :from (:argument 0) :to :result) fr0)
3543 (:temporary (:sc long-reg :offset fr1-offset :from :eval :to :result) fr1)
3544 (:temporary (:sc signed-stack :from (:argument 1) :to :result) temp)
3545 (:results (r :scs (long-reg)))
3546 (:arg-types long-float signed-num)
3547 (:result-types long-float)
3548 (:policy :fast-safe)
3549 (:note "inline scalbn function")
3551 ;; Setup x in fr0 and y in fr1
3582 (inst fld (make-random-tn :kind :normal
3583 :sc (sc-or-lose 'double-reg)
3584 :offset (1- (tn-offset x)))))))
3585 ((long-stack descriptor-reg)
3594 (if (sc-is x long-stack)
3595 (inst fldl (ea-for-lf-stack x))
3596 (inst fldl (ea-for-lf-desc x)))))
3598 (unless (zerop (tn-offset r))
3601 (define-vop (fscale)
3603 (:args (x :scs (long-reg long-stack descriptor-reg) :target fr0)
3604 (y :scs (long-reg long-stack descriptor-reg) :target fr1))
3605 (:temporary (:sc long-reg :offset fr0-offset
3606 :from (:argument 0) :to :result) fr0)
3607 (:temporary (:sc long-reg :offset fr1-offset
3608 :from (:argument 1) :to :result) fr1)
3609 (:results (r :scs (long-reg)))
3610 (:arg-types long-float long-float)
3611 (:result-types long-float)
3612 (:policy :fast-safe)
3613 (:note "inline scalb function")
3615 (:save-p :compute-only)
3617 (note-this-location vop :internal-error)
3618 ;; Setup x in fr0 and y in fr1
3620 ;; x in fr0; y in fr1
3621 ((and (sc-is x long-reg) (zerop (tn-offset x))
3622 (sc-is y long-reg) (= 1 (tn-offset y))))
3623 ;; y in fr1; x not in fr0
3624 ((and (sc-is y long-reg) (= 1 (tn-offset y)))
3628 (copy-fp-reg-to-fr0 x))
3631 (inst fldl (ea-for-lf-stack x)))
3634 (inst fldl (ea-for-lf-desc x)))))
3635 ;; x in fr0; y not in fr1
3636 ((and (sc-is x long-reg) (zerop (tn-offset x)))
3638 ;; Now load y to fr0
3641 (copy-fp-reg-to-fr0 y))
3644 (inst fldl (ea-for-lf-stack y)))
3647 (inst fldl (ea-for-lf-desc y))))
3649 ;; x in fr1; y not in fr1
3650 ((and (sc-is x long-reg) (= 1 (tn-offset x)))
3654 (copy-fp-reg-to-fr0 y))
3657 (inst fldl (ea-for-lf-stack y)))
3660 (inst fldl (ea-for-lf-desc y))))
3663 ((and (sc-is y long-reg) (zerop (tn-offset y)))
3665 ;; Now load x to fr0
3668 (copy-fp-reg-to-fr0 x))
3671 (inst fldl (ea-for-lf-stack x)))
3674 (inst fldl (ea-for-lf-desc x)))))
3675 ;; Neither x or y are in either fr0 or fr1
3682 (inst fldd (make-random-tn :kind :normal
3683 :sc (sc-or-lose 'double-reg)
3684 :offset (- (tn-offset y) 2))))
3686 (inst fldl (ea-for-lf-stack y)))
3688 (inst fldl (ea-for-lf-desc y))))
3692 (inst fldd (make-random-tn :kind :normal
3693 :sc (sc-or-lose 'double-reg)
3694 :offset (1- (tn-offset x)))))
3696 (inst fldl (ea-for-lf-stack x)))
3698 (inst fldl (ea-for-lf-desc x))))))
3700 ;; Now have x at fr0; and y at fr1
3702 (unless (zerop (tn-offset r))
3705 (define-vop (flog1p)
3707 (:args (x :scs (long-reg) :to :result))
3708 (:temporary (:sc long-reg :offset fr0-offset
3709 :from :argument :to :result) fr0)
3710 (:temporary (:sc long-reg :offset fr1-offset
3711 :from :argument :to :result) fr1)
3712 (:temporary (:sc word-reg :offset eax-offset :from :eval) temp)
3713 (:results (y :scs (long-reg)))
3714 (:arg-types long-float)
3715 (:result-types long-float)
3716 (:policy :fast-safe)
3717 ;; FIXME 1: This appears to be the second DEFINE-VOP of FLOG1P.
3718 ;; Perhaps this is OK because of the #!+LONG-FLOAT wrapped around
3719 ;; an enormous PROGN above. Still, it would be probably be good to
3720 ;; add some code to warn about redefining VOPs.
3721 (:note "inline log1p function")
3724 ;; x is in a FP reg, not fr0, fr1.
3727 (inst fldd (make-random-tn :kind :normal
3728 :sc (sc-or-lose 'double-reg)
3729 :offset (- (tn-offset x) 2)))
3731 (inst push #x3e947ae1) ; Constant 0.29
3733 (inst fld (make-ea :dword :base esp-tn))
3736 (inst fnstsw) ; status word to ax
3737 (inst and ah-tn #x45)
3738 (inst jmp :z WITHIN-RANGE)
3739 ;; Out of range for fyl2xp1.
3741 (inst faddd (make-random-tn :kind :normal
3742 :sc (sc-or-lose 'double-reg)
3743 :offset (- (tn-offset x) 1)))
3751 (inst fldd (make-random-tn :kind :normal
3752 :sc (sc-or-lose 'double-reg)
3753 :offset (- (tn-offset x) 1)))
3759 (t (inst fstd y)))))
3761 ;;; The Pentium has a less restricted implementation of the fyl2xp1
3762 ;;; instruction and a range check can be avoided.
3763 (define-vop (flog1p-pentium)
3765 (:args (x :scs (long-reg long-stack descriptor-reg) :target fr0))
3766 (:temporary (:sc long-reg :offset fr0-offset
3767 :from :argument :to :result) fr0)
3768 (:temporary (:sc long-reg :offset fr1-offset
3769 :from :argument :to :result) fr1)
3770 (:results (y :scs (long-reg)))
3771 (:arg-types long-float)
3772 (:result-types long-float)
3773 (:policy :fast-safe)
3774 (:guard (member :pentium-style-fyl2xp1 *backend-subfeatures*))
3775 (:note "inline log1p function")
3791 ;; x is in a FP reg, not fr0 or fr1
3795 (inst fldd (make-random-tn :kind :normal
3796 :sc (sc-or-lose 'double-reg)
3797 :offset (1- (tn-offset x)))))))
3798 ((long-stack descriptor-reg)
3802 (if (sc-is x long-stack)
3803 (inst fldl (ea-for-lf-stack x))
3804 (inst fldl (ea-for-lf-desc x)))))
3809 (t (inst fstd y)))))
3813 (:args (x :scs (long-reg long-stack descriptor-reg) :target fr0))
3814 (:temporary (:sc long-reg :offset fr0-offset
3815 :from :argument :to :result) fr0)
3816 (:temporary (:sc long-reg :offset fr1-offset
3817 :from :argument :to :result) fr1)
3818 (:results (y :scs (long-reg)))
3819 (:arg-types long-float)
3820 (:result-types long-float)
3821 (:policy :fast-safe)
3822 (:note "inline logb function")
3824 (:save-p :compute-only)
3826 (note-this-location vop :internal-error)
3837 ;; x is in a FP reg, not fr0 or fr1
3840 (inst fldd (make-random-tn :kind :normal
3841 :sc (sc-or-lose 'double-reg)
3842 :offset (- (tn-offset x) 2))))))
3843 ((long-stack descriptor-reg)
3846 (if (sc-is x long-stack)
3847 (inst fldl (ea-for-lf-stack x))
3848 (inst fldl (ea-for-lf-desc x)))))
3859 (:args (x :scs (long-reg long-stack descriptor-reg) :target fr0))
3860 (:temporary (:sc long-reg :offset fr0-offset
3861 :from (:argument 0) :to :result) fr0)
3862 (:temporary (:sc long-reg :offset fr1-offset
3863 :from (:argument 0) :to :result) fr1)
3864 (:results (r :scs (long-reg)))
3865 (:arg-types long-float)
3866 (:result-types long-float)
3867 (:policy :fast-safe)
3868 (:note "inline atan function")
3870 (:save-p :compute-only)
3872 (note-this-location vop :internal-error)
3873 ;; Setup x in fr1 and 1.0 in fr0
3876 ((and (sc-is x long-reg) (zerop (tn-offset x)))
3879 ((and (sc-is x long-reg) (= 1 (tn-offset x)))
3881 ;; x not in fr0 or fr1
3888 (inst fldd (make-random-tn :kind :normal
3889 :sc (sc-or-lose 'double-reg)
3890 :offset (- (tn-offset x) 2))))
3892 (inst fldl (ea-for-lf-stack x)))
3894 (inst fldl (ea-for-lf-desc x))))))
3896 ;; Now have x at fr1; and 1.0 at fr0
3901 (t (inst fstd r)))))
3903 (define-vop (fatan2)
3905 (:args (x :scs (long-reg long-stack descriptor-reg) :target fr1)
3906 (y :scs (long-reg long-stack descriptor-reg) :target fr0))
3907 (:temporary (:sc long-reg :offset fr0-offset
3908 :from (:argument 1) :to :result) fr0)
3909 (:temporary (:sc long-reg :offset fr1-offset
3910 :from (:argument 0) :to :result) fr1)
3911 (:results (r :scs (long-reg)))
3912 (:arg-types long-float long-float)
3913 (:result-types long-float)
3914 (:policy :fast-safe)
3915 (:note "inline atan2 function")
3917 (:save-p :compute-only)
3919 (note-this-location vop :internal-error)
3920 ;; Setup x in fr1 and y in fr0
3922 ;; y in fr0; x in fr1
3923 ((and (sc-is y long-reg) (zerop (tn-offset y))
3924 (sc-is x long-reg) (= 1 (tn-offset x))))
3925 ;; x in fr1; y not in fr0
3926 ((and (sc-is x long-reg) (= 1 (tn-offset x)))
3930 (copy-fp-reg-to-fr0 y))
3933 (inst fldl (ea-for-lf-stack y)))
3936 (inst fldl (ea-for-lf-desc y)))))
3937 ;; y in fr0; x not in fr1
3938 ((and (sc-is y long-reg) (zerop (tn-offset y)))
3940 ;; Now load x to fr0
3943 (copy-fp-reg-to-fr0 x))
3946 (inst fldl (ea-for-lf-stack x)))
3949 (inst fldl (ea-for-lf-desc x))))
3951 ;; y in fr1; x not in fr1
3952 ((and (sc-is y long-reg) (= 1 (tn-offset y)))
3956 (copy-fp-reg-to-fr0 x))
3959 (inst fldl (ea-for-lf-stack x)))
3962 (inst fldl (ea-for-lf-desc x))))
3965 ((and (sc-is x long-reg) (zerop (tn-offset x)))
3967 ;; Now load y to fr0
3970 (copy-fp-reg-to-fr0 y))
3973 (inst fldl (ea-for-lf-stack y)))
3976 (inst fldl (ea-for-lf-desc y)))))
3977 ;; Neither y or x are in either fr0 or fr1
3984 (inst fldd (make-random-tn :kind :normal
3985 :sc (sc-or-lose 'double-reg)
3986 :offset (- (tn-offset x) 2))))
3988 (inst fldl (ea-for-lf-stack x)))
3990 (inst fldl (ea-for-lf-desc x))))
3994 (inst fldd (make-random-tn :kind :normal
3995 :sc (sc-or-lose 'double-reg)
3996 :offset (1- (tn-offset y)))))
3998 (inst fldl (ea-for-lf-stack y)))
4000 (inst fldl (ea-for-lf-desc y))))))
4002 ;; Now have y at fr0; and x at fr1
4007 (t (inst fstd r)))))
4009 ) ; PROGN #!+LONG-FLOAT
4011 ;;;; complex float VOPs
4013 (define-vop (make-complex-single-float)
4014 (:translate complex)
4015 (:args (real :scs (single-reg) :to :result :target r
4016 :load-if (not (location= real r)))
4017 (imag :scs (single-reg) :to :save))
4018 (:arg-types single-float single-float)
4019 (:results (r :scs (complex-single-reg) :from (:argument 0)
4020 :load-if (not (sc-is r complex-single-stack))))
4021 (:result-types complex-single-float)
4022 (:note "inline complex single-float creation")
4023 (:policy :fast-safe)
4027 (let ((r-real (complex-double-reg-real-tn r)))
4028 (unless (location= real r-real)
4029 (cond ((zerop (tn-offset r-real))
4030 (copy-fp-reg-to-fr0 real))
4031 ((zerop (tn-offset real))
4036 (inst fxch real)))))
4037 (let ((r-imag (complex-double-reg-imag-tn r)))
4038 (unless (location= imag r-imag)
4039 (cond ((zerop (tn-offset imag))
4044 (inst fxch imag))))))
4045 (complex-single-stack
4046 (unless (location= real r)
4047 (cond ((zerop (tn-offset real))
4048 (inst fst (ea-for-csf-real-stack r)))
4051 (inst fst (ea-for-csf-real-stack r))
4054 (inst fst (ea-for-csf-imag-stack r))
4055 (inst fxch imag)))))
4057 (define-vop (make-complex-double-float)
4058 (:translate complex)
4059 (:args (real :scs (double-reg) :target r
4060 :load-if (not (location= real r)))
4061 (imag :scs (double-reg) :to :save))
4062 (:arg-types double-float double-float)
4063 (:results (r :scs (complex-double-reg) :from (:argument 0)
4064 :load-if (not (sc-is r complex-double-stack))))
4065 (:result-types complex-double-float)
4066 (:note "inline complex double-float creation")
4067 (:policy :fast-safe)
4071 (let ((r-real (complex-double-reg-real-tn r)))
4072 (unless (location= real r-real)
4073 (cond ((zerop (tn-offset r-real))
4074 (copy-fp-reg-to-fr0 real))
4075 ((zerop (tn-offset real))
4080 (inst fxch real)))))
4081 (let ((r-imag (complex-double-reg-imag-tn r)))
4082 (unless (location= imag r-imag)
4083 (cond ((zerop (tn-offset imag))
4088 (inst fxch imag))))))
4089 (complex-double-stack
4090 (unless (location= real r)
4091 (cond ((zerop (tn-offset real))
4092 (inst fstd (ea-for-cdf-real-stack r)))
4095 (inst fstd (ea-for-cdf-real-stack r))
4098 (inst fstd (ea-for-cdf-imag-stack r))
4099 (inst fxch imag)))))
4102 (define-vop (make-complex-long-float)
4103 (:translate complex)
4104 (:args (real :scs (long-reg) :target r
4105 :load-if (not (location= real r)))
4106 (imag :scs (long-reg) :to :save))
4107 (:arg-types long-float long-float)
4108 (:results (r :scs (complex-long-reg) :from (:argument 0)
4109 :load-if (not (sc-is r complex-long-stack))))
4110 (:result-types complex-long-float)
4111 (:note "inline complex long-float creation")
4112 (:policy :fast-safe)
4116 (let ((r-real (complex-double-reg-real-tn r)))
4117 (unless (location= real r-real)
4118 (cond ((zerop (tn-offset r-real))
4119 (copy-fp-reg-to-fr0 real))
4120 ((zerop (tn-offset real))
4125 (inst fxch real)))))
4126 (let ((r-imag (complex-double-reg-imag-tn r)))
4127 (unless (location= imag r-imag)
4128 (cond ((zerop (tn-offset imag))
4133 (inst fxch imag))))))
4135 (unless (location= real r)
4136 (cond ((zerop (tn-offset real))
4137 (store-long-float (ea-for-clf-real-stack r)))
4140 (store-long-float (ea-for-clf-real-stack r))
4143 (store-long-float (ea-for-clf-imag-stack r))
4144 (inst fxch imag)))))
4147 (define-vop (complex-float-value)
4148 (:args (x :target r))
4150 (:variant-vars offset)
4151 (:policy :fast-safe)
4153 (cond ((sc-is x complex-single-reg complex-double-reg
4154 #!+long-float complex-long-reg)
4156 (make-random-tn :kind :normal
4157 :sc (sc-or-lose 'double-reg)
4158 :offset (+ offset (tn-offset x)))))
4159 (unless (location= value-tn r)
4160 (cond ((zerop (tn-offset r))
4161 (copy-fp-reg-to-fr0 value-tn))
4162 ((zerop (tn-offset value-tn))
4165 (inst fxch value-tn)
4167 (inst fxch value-tn))))))
4168 ((sc-is r single-reg)
4169 (let ((ea (sc-case x
4170 (complex-single-stack
4172 (0 (ea-for-csf-real-stack x))
4173 (1 (ea-for-csf-imag-stack x))))
4176 (0 (ea-for-csf-real-desc x))
4177 (1 (ea-for-csf-imag-desc x)))))))
4178 (with-empty-tn@fp-top(r)
4180 ((sc-is r double-reg)
4181 (let ((ea (sc-case x
4182 (complex-double-stack
4184 (0 (ea-for-cdf-real-stack x))
4185 (1 (ea-for-cdf-imag-stack x))))
4188 (0 (ea-for-cdf-real-desc x))
4189 (1 (ea-for-cdf-imag-desc x)))))))
4190 (with-empty-tn@fp-top(r)
4194 (let ((ea (sc-case x
4197 (0 (ea-for-clf-real-stack x))
4198 (1 (ea-for-clf-imag-stack x))))
4201 (0 (ea-for-clf-real-desc x))
4202 (1 (ea-for-clf-imag-desc x)))))))
4203 (with-empty-tn@fp-top(r)
4205 (t (error "COMPLEX-FLOAT-VALUE VOP failure")))))
4207 (define-vop (realpart/complex-single-float complex-float-value)
4208 (:translate realpart)
4209 (:args (x :scs (complex-single-reg complex-single-stack descriptor-reg)
4211 (:arg-types complex-single-float)
4212 (:results (r :scs (single-reg)))
4213 (:result-types single-float)
4214 (:note "complex float realpart")
4217 (define-vop (realpart/complex-double-float complex-float-value)
4218 (:translate realpart)
4219 (:args (x :scs (complex-double-reg complex-double-stack descriptor-reg)
4221 (:arg-types complex-double-float)
4222 (:results (r :scs (double-reg)))
4223 (:result-types double-float)
4224 (:note "complex float realpart")
4228 (define-vop (realpart/complex-long-float complex-float-value)
4229 (:translate realpart)
4230 (:args (x :scs (complex-long-reg complex-long-stack descriptor-reg)
4232 (:arg-types complex-long-float)
4233 (:results (r :scs (long-reg)))
4234 (:result-types long-float)
4235 (:note "complex float realpart")
4238 (define-vop (imagpart/complex-single-float complex-float-value)
4239 (:translate imagpart)
4240 (:args (x :scs (complex-single-reg complex-single-stack descriptor-reg)
4242 (:arg-types complex-single-float)
4243 (:results (r :scs (single-reg)))
4244 (:result-types single-float)
4245 (:note "complex float imagpart")
4248 (define-vop (imagpart/complex-double-float complex-float-value)
4249 (:translate imagpart)
4250 (:args (x :scs (complex-double-reg complex-double-stack descriptor-reg)
4252 (:arg-types complex-double-float)
4253 (:results (r :scs (double-reg)))
4254 (:result-types double-float)
4255 (:note "complex float imagpart")
4259 (define-vop (imagpart/complex-long-float complex-float-value)
4260 (:translate imagpart)
4261 (:args (x :scs (complex-long-reg complex-long-stack descriptor-reg)
4263 (:arg-types complex-long-float)
4264 (:results (r :scs (long-reg)))
4265 (:result-types long-float)
4266 (:note "complex float imagpart")
4269 ;;; hack dummy VOPs to bias the representation selection of their
4270 ;;; arguments towards a FP register, which can help avoid consing at
4271 ;;; inappropriate locations
4272 (defknown double-float-reg-bias (double-float) (values))
4273 (define-vop (double-float-reg-bias)
4274 (:translate double-float-reg-bias)
4275 (:args (x :scs (double-reg double-stack) :load-if nil))
4276 (:arg-types double-float)
4277 (:policy :fast-safe)
4278 (:note "inline dummy FP register bias")
4281 (defknown single-float-reg-bias (single-float) (values))
4282 (define-vop (single-float-reg-bias)
4283 (:translate single-float-reg-bias)
4284 (:args (x :scs (single-reg single-stack) :load-if nil))
4285 (:arg-types single-float)
4286 (:policy :fast-safe)
4287 (:note "inline dummy FP register bias")