Raymond Toy pushed to branch issue-466-c-wrapper-specfun at cmucl / cmucl
Commits:
-
e2d1c242
by Raymond Toy at 2026-01-27T07:29:36-08:00
4 changed files:
Changes:
| ... | ... | @@ -2184,28 +2184,7 @@ |
| 2184 | 2184 | "STANDARD-PPRINT-DISPATCH-TABLE-MODIFIED-ERROR"
|
| 2185 | 2185 | |
| 2186 | 2186 | "%IEEE754-REM-PI/2"
|
| 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")
|
|
| 2187 | + "%SINCOS")
|
|
| 2209 | 2188 | #+heap-overflow-check
|
| 2210 | 2189 | (:export "DYNAMIC-SPACE-OVERFLOW-WARNING-HIT"
|
| 2211 | 2190 | "DYNAMIC-SPACE-OVERFLOW-ERROR-HIT"
|
| ... | ... | @@ -47,29 +47,21 @@ |
| 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")))
|
|
| 52 | 50 | `(progn
|
| 53 | - (declaim (inline ,lisp-name ,lisp-name-f))
|
|
| 54 | - (export '(,lisp-name ,lisp-name-f))
|
|
| 51 | + (declaim (inline ,lisp-name))
|
|
| 52 | + (export '(,lisp-name))
|
|
| 55 | 53 | (alien:def-alien-routine (,c-name ,lisp-name) double-float
|
| 56 | 54 | ,@(let ((results nil))
|
| 57 | 55 | (dotimes (i num-args (nreverse results))
|
| 58 | 56 | (push (list (intern (format nil "ARG-~D" i))
|
| 59 | 57 | 'double-float)
|
| 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))))))))
|
|
| 58 | + results)))))))
|
|
| 67 | 59 | |
| 68 | 60 | (eval-when (compile load eval)
|
| 69 | 61 | |
| 70 | 62 | (defun handle-reals (function var)
|
| 71 | 63 | `((((foreach fixnum single-float bignum ratio))
|
| 72 | - (,(symbolicate function "F") (coerce ,var 'single-float)))
|
|
| 64 | + (coerce (,function (coerce ,var 'double-float)) 'single-float))
|
|
| 73 | 65 | ((double-float)
|
| 74 | 66 | (,function ,var))
|
| 75 | 67 | #+double-double
|
| ... | ... | @@ -620,84 +620,42 @@ |
| 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 | - |
|
| 627 | 623 | (defknown (%sin %cos %tanh #+x87 %sin-quick #+x87 %cos-quick)
|
| 628 | 624 | (double-float) (double-float -1.0d0 1.0d0)
|
| 629 | 625 | (movable foldable flushable))
|
| 630 | 626 | |
| 631 | -(defknown (%sinf %cosf %tanhf)
|
|
| 632 | - (single-float) (single-float -1.0f0 1.0f0)
|
|
| 633 | - (movable foldable flushable))
|
|
| 634 | - |
|
| 635 | 627 | (defknown (%asin %atan)
|
| 636 | 628 | (double-float) (double-float #.(- (/ pi 2)) #.(/ pi 2))
|
| 637 | 629 | (movable foldable flushable))
|
| 638 | 630 |
|
| 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 | -
|
|
| 644 | 631 | (defknown (%acos)
|
| 645 | 632 | (double-float) (double-float 0.0d0 #.pi)
|
| 646 | 633 | (movable foldable flushable))
|
| 647 | 634 |
|
| 648 | -(defknown (%acosf)
|
|
| 649 | - (single-float) (single-float 0.0f0 #.(coerce pi 'single-float))
|
|
| 650 | - (movable foldable flushable))
|
|
| 651 | -
|
|
| 652 | 635 | (defknown (%cosh)
|
| 653 | 636 | (double-float) (double-float 1.0d0)
|
| 654 | 637 | (movable foldable flushable))
|
| 655 | 638 | |
| 656 | -(defknown (%coshf)
|
|
| 657 | - (single-float) (single-float 1.0f0)
|
|
| 658 | - (movable foldable flushable))
|
|
| 659 | - |
|
| 660 | 639 | (defknown (%acosh %exp %sqrt)
|
| 661 | 640 | (double-float) (double-float 0.0d0)
|
| 662 | 641 | (movable foldable flushable))
|
| 663 | 642 | |
| 664 | -(defknown (%acoshf %expf)
|
|
| 665 | - (single-float) (single-float 0.0f0)
|
|
| 666 | - (movable foldable flushable))
|
|
| 667 | - |
|
| 668 | 643 | (defknown %expm1
|
| 669 | 644 | (double-float) (double-float -1d0)
|
| 670 | 645 | (movable foldable flushable))
|
| 671 | 646 | |
| 672 | -(defknown %expm1f
|
|
| 673 | - (single-float) (single-float -1f0)
|
|
| 674 | - (movable foldable flushable))
|
|
| 675 | - |
|
| 676 | 647 | (defknown (%hypot)
|
| 677 | 648 | (double-float double-float) (double-float 0d0)
|
| 678 | 649 | (movable foldable flushable))
|
| 679 | 650 | |
| 680 | -(defknown (%hypotf)
|
|
| 681 | - (single-float single-float) (single-float 0f0)
|
|
| 682 | - (movable foldable flushable))
|
|
| 683 | - |
|
| 684 | 651 | (defknown (%pow)
|
| 685 | 652 | (double-float double-float) double-float
|
| 686 | 653 | (movable foldable flushable))
|
| 687 | 654 | |
| 688 | -(defknown (%powf)
|
|
| 689 | - (single-float single-float) single-float
|
|
| 690 | - (movable foldable flushable))
|
|
| 691 | - |
|
| 692 | 655 | (defknown (%atan2)
|
| 693 | 656 | (double-float double-float) (double-float #.(- pi) #.pi)
|
| 694 | 657 | (movable foldable flushable))
|
| 695 | 658 | |
| 696 | -(defknown (%atan2f)
|
|
| 697 | - (single-float single-float) (single-float #.(coerce (- pi) 'single-float)
|
|
| 698 | - #.(coerce pi 'single-float))
|
|
| 699 | - (movable foldable flushable))
|
|
| 700 | - |
|
| 701 | 659 | (defknown (%scalb)
|
| 702 | 660 | (double-float double-float) double-float
|
| 703 | 661 | (movable foldable flushable))
|
| ... | ... | @@ -710,12 +668,9 @@ |
| 710 | 668 | (double-float) double-float
|
| 711 | 669 | (movable foldable flushable))
|
| 712 | 670 | |
| 713 | -(defknown (%log1pf)
|
|
| 714 | - (single-float) single-float
|
|
| 715 | - (movable foldable flushable))
|
|
| 716 | - |
|
| 717 | 671 | (dolist (stuff '((exp %exp *)
|
| 718 | 672 | (log %log float)
|
| 673 | + (sqrt %sqrt float)
|
|
| 719 | 674 | (sin %sin float)
|
| 720 | 675 | (cos %cos float)
|
| 721 | 676 | (tan %tan float)
|
| ... | ... | @@ -729,19 +684,10 @@ |
| 729 | 684 | (acosh %acosh float)
|
| 730 | 685 | (atanh %atanh float)))
|
| 731 | 686 | (destructuring-bind (name prim rtype) stuff
|
| 732 | - (let ((primf (symbolicate prim "F")))
|
|
| 733 | - (deftransform name ((x) '(single-float) rtype :eval-name t)
|
|
| 734 | - `(,primf x))
|
|
| 735 | - (deftransform name ((x) '(double-float) rtype :eval-name t :when :both)
|
|
| 736 | - `(,prim x)))))
|
|
| 737 | - |
|
| 738 | -(deftransform sqrt ((x) (double-float) double-float :when :both)
|
|
| 739 | - `(%sqrt x))
|
|
| 740 | - |
|
| 741 | -;; We don't currently have sqrt specialized for single-floats, so use
|
|
| 742 | -;; the double-float version.
|
|
| 743 | -(deftransform sqrt ((x) (single-float) single-float)
|
|
| 744 | - `(coerce (%sqrt (coerce x 'double-float)) 'single-float))
|
|
| 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))))
|
|
| 745 | 691 | |
| 746 | 692 | (defknown (%sincos)
|
| 747 | 693 | (double-float) (values double-float double-float)
|
| ... | ... | @@ -136,126 +136,3 @@ 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 | -} |