-;;; These versions of fsin, fcos, and ftan try to use argument
-;;; reduction but to do this accurately requires greater precision and
-;;; it is hopelessly inaccurate.
-#+nil
-(macrolet ((frob (func trans op)
- `(define-vop (,func)
- (:translate ,trans)
- (:args (x :scs (double-reg) :target fr0))
- (:temporary (:sc unsigned-reg :offset eax-offset
- :from :eval :to :result) eax)
- (:temporary (:sc unsigned-reg :offset fr0-offset
- :from :argument :to :result) fr0)
- (:temporary (:sc unsigned-reg :offset fr1-offset
- :from :argument :to :result) fr1)
- (:results (y :scs (double-reg)))
- (:arg-types double-float)
- (:result-types double-float)
- (:policy :fast-safe)
- (:note "inline sin/cos function")
- (:vop-var vop)
- (:save-p :compute-only)
- (:ignore eax)
- (:generator 5
- (note-this-location vop :internal-error)
- (unless (zerop (tn-offset x))
- (inst fxch x) ; x to top of stack
- (unless (location= x y)
- (inst fst x))) ; maybe save it
- (inst ,op)
- (inst fnstsw) ; status word to ax
- (inst and ah-tn #x04) ; C2
- (inst jmp :z DONE)
- ;; Else x was out of range so reduce it; ST0 is unchanged.
- (inst fstp fr1) ; Load 2*PI
- (inst fldpi)
- (inst fadd fr0)
- (inst fxch fr1)
- LOOP
- (inst fprem1)
- (inst fnstsw) ; status word to ax
- (inst and ah-tn #x04) ; C2
- (inst jmp :nz LOOP)
- (inst ,op)
- DONE
- (unless (zerop (tn-offset y))
- (inst fstd y))))))
- (frob fsin %sin fsin)
- (frob fcos %cos fcos))
-
-#+nil
-(define-vop (ftan)
- (:translate %tan)
- (:args (x :scs (double-reg) :target fr0))
- (:temporary (:sc unsigned-reg :offset eax-offset
- :from :argument :to :result) eax)
- (:temporary (:sc double-reg :offset fr0-offset
- :from :argument :to :result) fr0)
- (:temporary (:sc double-reg :offset fr1-offset
- :from :argument :to :result) fr1)
- (:results (y :scs (double-reg)))
- (:arg-types double-float)
- (:result-types double-float)
- (:policy :fast-safe)
- (:note "inline tan function")
- (:vop-var vop)
- (:save-p :compute-only)
- (:ignore eax)
- (:generator 5
- (note-this-location vop :internal-error)
- (case (tn-offset x)
- (0
- (inst fstp fr1))
- (1
- (inst fstp fr0))
- (t
- (inst fstp fr0)
- (inst fstp fr0)
- (inst fldd (make-random-tn :kind :normal
- :sc (sc-or-lose 'double-reg)
- :offset (- (tn-offset x) 2)))))
- (inst fptan)
- (inst fnstsw) ; status word to ax
- (inst and ah-tn #x04) ; C2
- (inst jmp :z DONE)
- ;; Else x was out of range so reduce it; ST0 is unchanged.
- (inst fldpi) ; Load 2*PI
- (inst fadd fr0)
- (inst fxch fr1)
- LOOP
- (inst fprem1)
- (inst fnstsw) ; status word to ax
- (inst and ah-tn #x04) ; C2
- (inst jmp :nz LOOP)
- (inst fstp fr1)
- (inst fptan)
- DONE
- ;; Result is in fr1
- (case (tn-offset y)
- (0
- (inst fxch fr1))
- (1)
- (t
- (inst fxch fr1)
- (inst fstd y)))))
-
-;;; These versions of fsin, fcos, and ftan simply load a 0.0 result if
-;;; the argument is out of range 2^63 and would thus be hopelessly
-;;; inaccurate.