Ignore:
Timestamp:
Feb 15, 2013, 7:24:29 AM (6 years ago)
Author:
gb
Message:

Propagate recent trunk changes.

Location:
release/1.9/source/level-0
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/1.9/source/level-0

  • release/1.9/source/level-0/l0-float.lisp

    r15685 r15706  
    745745                    (tx2 (* tx tx))
    746746                    (d (1+ (* tx2 (* ty ty))))
    747                     (n (if (> (abs i) 20)
    748                          (* 4 (exp (* -2 (abs i))))
    749                          (let ((c (cosh i)))
    750                            (/ (* c c))))))
    751                (complex (/ (* n tx) d)
     747                    (c (if (> (abs i) 20)
     748                         (* 2 (exp (- (abs i))))
     749                         (/ (cosh i)))))
     750               (complex (/ (* (* c c) tx) d)
    752751                        (/ (* ty (1+ tx2)) d))))))
    753752        ((or (typep x 'ratio)
     
    849848                      (t (if (minusp y) #.(- single-float-half-pi) single-float-half-pi)))))
    850849          ((= x 1)
    851            (setq ra (if (< y1 1e-9)
    852                       (/ (log-e (/ 2 y1)) 2)
    853                       (/ (log1+ (/ 4 (* y y))) 4)))
    854            (setq ia (/ (atan (/ 2 y) -1) 2)))
    855           (t
     850           (cond ((< y1 1e-9)
     851                  (setq ra (/ (- (if (typep y 'double-float) double-float-log2 single-float-log2)
     852                                 (log-e y1))
     853                              2))
     854                  (setq ia (/ (if (minusp y) (atan -2 y) (atan 2 (- y))) 2)))
     855                 (t
     856                  (setq ra (/ (log1+ (/ 4 (* y y))) 4))
     857                  (setq ia (/ (atan (/ 2 y) -1) 2)))))
     858          ((and (< y1 1)
     859                (< 0.5 x 2))
     860           (let ((x-1 (- x 1))
     861                 (x+1 (+ x 1))
     862                 (y2 (* y y)))
     863             (setq ra (/ (log-e (/ (+ (* x-1 x-1) y2) (+ (* x+1 x+1) y2))) -4))
     864             (setq ia (/ (atan (* 2 y) (- 1 (+ (* x x) y2))) 2))))
     865           (t
    856866           (let ((r2 (+ (* x x) (* y y))))
    857867             (setq ra (/ (log1+ (/ (* -4 x) (1+ (+ (* 2 x) r2)))) -4))
     
    11161126    (double-float (%double-float-exp! x (%make-dfloat)))
    11171127    (t
    1118      #+32-bit-target
    1119      (target::with-stack-short-floats ((sx x))
    1120        (%single-float-exp! sx (%make-sfloat)))
    1121      #+64-bit-target
    1122      (%single-float-exp (%short-float x)))))
     1128     (if (and (typep x 'rational)
     1129              (< x -104))
     1130       0.0s0
     1131       #+32-bit-target
     1132       (target::with-stack-short-floats ((sx x))
     1133         (%single-float-exp! sx (%make-sfloat)))
     1134       #+64-bit-target
     1135       (%single-float-exp (%short-float x))))))
    11231136
    11241137
Note: See TracChangeset for help on using the changeset viewer.