Raymond Toy pushed to branch issue-466-c-wrapper-specfun at cmucl / cmucl

Commits:

4 changed files:

Changes:

  • src/code/exports.lisp
    ... ... @@ -2184,7 +2184,28 @@
    2184 2184 
     	   "STANDARD-PPRINT-DISPATCH-TABLE-MODIFIED-ERROR"
    2185 2185
    2186 2186 
     	   "%IEEE754-REM-PI/2"
    2187 
    -	   "%SINCOS")
    2187 
    +	   "%SINCOS"
    2188 
    +	   "%SINF"
    2189 
    +	   "%COSF"
    2190 
    +	   "%TANF"
    2191 
    +	   "%ATANF"
    2192 
    +	   "%ATAN2F"
    2193 
    +	   "%ASINF"
    2194 
    +	   "%ACOSF"
    2195 
    +	   "%SINHF"
    2196 
    +	   "%COSHF"
    2197 
    +	   "%TANHF"
    2198 
    +	   "%ASINHF"
    2199 
    +	   "%ACOSHF"
    2200 
    +	   "%ATANHF"
    2201 
    +	   "%EXPF"
    2202 
    +	   "%LOGF"
    2203 
    +	   "%LOG10F"
    2204 
    +	   "%LOG2F"
    2205 
    +	   "%POWF"
    2206 
    +	   "%HYPOTF"
    2207 
    +	   "%LOG1PF"
    2208 
    +	   "%EXPM1F")
    2188 2209 
       #+heap-overflow-check
    2189 2210 
       (:export "DYNAMIC-SPACE-OVERFLOW-WARNING-HIT"
    2190 2211 
     	   "DYNAMIC-SPACE-OVERFLOW-ERROR-HIT"

  • src/code/irrat.lisp
    ... ... @@ -47,21 +47,29 @@
    47 47 
     		  (intern (concatenate 'simple-string
    48 48 
     				       "%"
    49 49 
     				       (string-upcase name)))))
    50 
    +    (let ((c-name-f (concatenate 'simple-string c-name "f"))
    51 
    +	  (lisp-name-f (symbolicate lisp-name "F")))
    50 52 
         `(progn
    51 
    -       (declaim (inline ,lisp-name))
    52 
    -       (export ',lisp-name)
    53 
    +       (declaim (inline ,lisp-name ,lisp-name-f))
    54 
    +       (export '(,lisp-name ,lisp-name-f))
    53 55 
            (alien:def-alien-routine (,c-name ,lisp-name) double-float
    54 56 
     	 ,@(let ((results nil))
    55 57 
     	     (dotimes (i num-args (nreverse results))
    56 58 
     	       (push (list (intern (format nil "ARG-~D" i))
    57 59 
     			   'double-float)
    58 
    -		     results)))))))
    60 
    +		     results))))
    61 
    +       (alien:def-alien-routine (,c-name-f ,lisp-name-f) single-float
    62 
    +	 ,@(let ((results nil))
    63 
    +	     (dotimes (i num-args (nreverse results))
    64 
    +	       (push (list (intern (format nil "ARG-~D" i))
    65 
    +			   'single-float)
    66 
    +		     results))))))))
    59 67
    60 68 
     (eval-when (compile load eval)
    61 69
    62 70 
     (defun handle-reals (function var)
    63 71 
       `((((foreach fixnum single-float bignum ratio))
    64 
    -     (coerce (,function (coerce ,var 'double-float)) 'single-float))
    72 
    +     (,(symbolicate function "F") (coerce ,var 'single-float)))
    65 73 
         ((double-float)
    66 74 
          (,function ,var))
    67 75 
         #+double-double

  • src/compiler/float-tran.lisp
    ... ... @@ -620,42 +620,84 @@
    620 620 
     	  (double-float) double-float
    621 621 
       (movable foldable flushable))
    622 622
    623 
    +(defknown (%tanf %sinhf %asinhf %atanhf %logf %log10f)
    624 
    +	  (single-float) single-float
    625 
    +  (movable foldable flushable))
    626 
    +
    623 627 
     (defknown (%sin %cos %tanh #+x87 %sin-quick #+x87 %cos-quick)
    624 628 
         (double-float) (double-float -1.0d0 1.0d0)
    625 629 
         (movable foldable flushable))
    626 630
    631 
    +(defknown (%sinf %cosf %tanhf)
    632 
    +    (single-float) (single-float -1.0f0 1.0f0)
    633 
    +    (movable foldable flushable))
    634 
    +
    627 635 
     (defknown (%asin %atan)
    628 636 
         (double-float) (double-float #.(- (/ pi 2)) #.(/ pi 2))
    629 637 
         (movable foldable flushable))
    630 638
    639 
    +(defknown (%asinf %atanf)
    640 
    +    (single-float) (single-float #.(coerce (- (/ pi 2)) 'single-float)
    641 
    +				 #.(coerce (/ pi 2) 'single-float))
    642 
    +    (movable foldable flushable))
    643 
    +
    631 644 
     (defknown (%acos)
    632 645 
         (double-float) (double-float 0.0d0 #.pi)
    633 646 
         (movable foldable flushable))
    634 647
    648 
    +(defknown (%acosf)
    649 
    +    (single-float) (single-float 0.0f0 #.(coerce pi 'single-float))
    650 
    +    (movable foldable flushable))
    651 
    +
    635 652 
     (defknown (%cosh)
    636 653 
         (double-float) (double-float 1.0d0)
    637 654 
         (movable foldable flushable))
    638 655
    656 
    +(defknown (%coshf)
    657 
    +    (single-float) (single-float 1.0f0)
    658 
    +    (movable foldable flushable))
    659 
    +
    639 660 
     (defknown (%acosh %exp %sqrt)
    640 661 
         (double-float) (double-float 0.0d0)
    641 662 
         (movable foldable flushable))
    642 663
    664 
    +(defknown (%acoshf %expf)
    665 
    +    (single-float) (single-float 0.0f0)
    666 
    +    (movable foldable flushable))
    667 
    +
    643 668 
     (defknown %expm1
    644 669 
         (double-float) (double-float -1d0)
    645 670 
         (movable foldable flushable))
    646 671
    672 
    +(defknown %expm1f
    673 
    +    (single-float) (single-float -1f0)
    674 
    +    (movable foldable flushable))
    675 
    +
    647 676 
     (defknown (%hypot)
    648 677 
         (double-float double-float) (double-float 0d0)
    649 678 
       (movable foldable flushable))
    650 679
    680 
    +(defknown (%hypotf)
    681 
    +    (single-float single-float) (single-float 0f0)
    682 
    +  (movable foldable flushable))
    683 
    +
    651 684 
     (defknown (%pow)
    652 685 
         (double-float double-float) double-float
    653 686 
       (movable foldable flushable))
    654 687
    688 
    +(defknown (%powf)
    689 
    +    (single-float single-float) single-float
    690 
    +  (movable foldable flushable))
    691 
    +
    655 692 
     (defknown (%atan2)
    656 693 
         (double-float double-float) (double-float #.(- pi) #.pi)
    657 694 
       (movable foldable flushable))
    658 695
    696 
    +(defknown (%atan2f)
    697 
    +    (single-float single-float) (single-float #.(coerce (- pi) 'single-float)
    698 
    +					      #.(coerce pi 'single-float))
    699 
    +  (movable foldable flushable))
    700 
    +
    659 701 
     (defknown (%scalb)
    660 702 
         (double-float double-float) double-float
    661 703 
       (movable foldable flushable))
    ... ... @@ -668,6 +710,10 @@
    668 710 
         (double-float) double-float
    669 711 
         (movable foldable flushable))
    670 712
    713 
    +(defknown (%log1pf)
    714 
    +    (single-float) single-float
    715 
    +    (movable foldable flushable))
    716 
    +
    671 717 
     (dolist (stuff '((exp %exp *)
    672 718 
     		 (log %log float)
    673 719 
     		 (sqrt %sqrt float)
    ... ... @@ -684,10 +730,11 @@
    684 730 
     		 (acosh %acosh float)
    685 731 
     		 (atanh %atanh float)))
    686 732 
       (destructuring-bind (name prim rtype) stuff
    687 
    -    (deftransform name ((x) '(single-float) rtype :eval-name t)
    688 
    -      `(coerce (,prim (coerce x 'double-float)) 'single-float))
    689 
    -    (deftransform name ((x) '(double-float) rtype :eval-name t :when :both)
    690 
    -      `(,prim x))))
    733 
    +    (let ((primf (symbolicate prim "F")))
    734 
    +      (deftransform name ((x) '(single-float) rtype :eval-name t)
    735 
    +	`(,primf x))
    736 
    +      (deftransform name ((x) '(double-float) rtype :eval-name t :when :both)
    737 
    +	`(,prim x)))))
    691 738
    692 739 
     (defknown (%sincos)
    693 740 
         (double-float) (values double-float double-float)

  • src/lisp/irrat.c
    ... ... @@ -136,3 +136,126 @@ lisp_scalbn(double x, int n)
    136 136 
     {
    137 137 
         return fdlibm_scalbn(x, n);
    138 138 
     }
    139 
    +
    140 
    +/*
    141 
    + * Wrappers for the single-float versions
    142 
    + */
    143 
    +float
    144 
    +lisp_sinf(float x)
    145 
    +{
    146 
    +    return (float) fdlibm_sin((double) x);
    147 
    +}
    148 
    +
    149 
    +float
    150 
    +lisp_cosf(float x)
    151 
    +{
    152 
    +    return (float) fdlibm_cos((double) x);
    153 
    +}
    154 
    +
    155 
    +float
    156 
    +lisp_tanf(float x)
    157 
    +{
    158 
    +    return (float) fdlibm_tan((double) x);
    159 
    +}
    160 
    +
    161 
    +float
    162 
    +lisp_atanf(float x)
    163 
    +{
    164 
    +    return (float) fdlibm_atan((double) x);
    165 
    +}
    166 
    +
    167 
    +float
    168 
    +lisp_atan2f(float y, float x)
    169 
    +{
    170 
    +    return (float) __ieee754_atan2((double) y, (double) x);
    171 
    +}
    172 
    +
    173 
    +float
    174 
    +lisp_asinf(float x)
    175 
    +{
    176 
    +    return (float) __ieee754_asin((double) x);
    177 
    +}
    178 
    +
    179 
    +float
    180 
    +lisp_acosf(float x)
    181 
    +{
    182 
    +    return (float) __ieee754_acos((double) x);
    183 
    +}
    184 
    +
    185 
    +float
    186 
    +lisp_sinhf(float x)
    187 
    +{
    188 
    +    return (float) __ieee754_sinh((double) x);
    189 
    +}
    190 
    +
    191 
    +float
    192 
    +lisp_coshf(float x)
    193 
    +{
    194 
    +    return (float) __ieee754_cosh((double) x);
    195 
    +}
    196 
    +
    197 
    +float
    198 
    +lisp_tanhf(float x)
    199 
    +{
    200 
    +    return (float) fdlibm_tanh((double) x);
    201 
    +}
    202 
    +
    203 
    +float
    204 
    +lisp_asinhf(float x)
    205 
    +{
    206 
    +    return (float) fdlibm_asinh((double) x);
    207 
    +}
    208 
    +
    209 
    +float
    210 
    +lisp_acoshf(float x)
    211 
    +{
    212 
    +    return (float) __ieee754_acosh((double) x);
    213 
    +}
    214 
    +
    215 
    +float
    216 
    +lisp_atanhf(float x)
    217 
    +{
    218 
    +    return (float) __ieee754_atanh((double) x);
    219 
    +}
    220 
    +
    221 
    +float
    222 
    +lisp_expf(float x)
    223 
    +{
    224 
    +    return (float) __ieee754_exp((double) x);
    225 
    +}
    226 
    +
    227 
    +float
    228 
    +lisp_logf(float x)
    229 
    +{
    230 
    +    return (float) __ieee754_log((double) x);
    231 
    +}
    232 
    +
    233 
    +float
    234 
    +lisp_log10f(float x)
    235 
    +{
    236 
    +    return (float) __ieee754_log10((double) x);
    237 
    +}
    238 
    +
    239 
    +float
    240 
    +lisp_powf(float x, float y)
    241 
    +{
    242 
    +    return (float) __ieee754_pow((double) x, (double) y);
    243 
    +}
    244 
    +
    245 
    +float
    246 
    +lisp_hypotf(float x, float y)
    247 
    +{
    248 
    +    return (float) __ieee754_hypot((double) x, (double) y);
    249 
    +}
    250 
    +
    251 
    +float
    252 
    +lisp_log1pf(float x)
    253 
    +{
    254 
    +    return (float) fdlibm_log1p((double) x);
    255 
    +}
    256 
    +
    257 
    +float
    258 
    +lisp_expm1f(float x)
    259 
    +{
    260 
    +    return (float) fdlibm_expm1((double) x);
    261 
    +}

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help Notification message regarding https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c970737c75c9273bf89cfb86421d8e74cac6acf1 at 1769461264