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 Address review comments Remove the changes for single-float which will be done in a different MR. - - - - - 4 changed files: - src/code/exports.lisp - src/code/irrat.lisp - src/compiler/float-tran.lisp - src/lisp/irrat.c Changes: ===================================== src/code/exports.lisp ===================================== @@ -2184,28 +2184,7 @@ "STANDARD-PPRINT-DISPATCH-TABLE-MODIFIED-ERROR" "%IEEE754-REM-PI/2" - "%SINCOS" - "%SINF" - "%COSF" - "%TANF" - "%ATANF" - "%ATAN2F" - "%ASINF" - "%ACOSF" - "%SINHF" - "%COSHF" - "%TANHF" - "%ASINHF" - "%ACOSHF" - "%ATANHF" - "%EXPF" - "%LOGF" - "%LOG10F" - "%LOG2F" - "%POWF" - "%HYPOTF" - "%LOG1PF" - "%EXPM1F") + "%SINCOS") #+heap-overflow-check (:export "DYNAMIC-SPACE-OVERFLOW-WARNING-HIT" "DYNAMIC-SPACE-OVERFLOW-ERROR-HIT" ===================================== src/code/irrat.lisp ===================================== @@ -47,29 +47,21 @@ (intern (concatenate 'simple-string "%" (string-upcase name))))) - (let ((c-name-f (concatenate 'simple-string c-name "f")) - (lisp-name-f (symbolicate lisp-name "F"))) `(progn - (declaim (inline ,lisp-name ,lisp-name-f)) - (export '(,lisp-name ,lisp-name-f)) + (declaim (inline ,lisp-name)) + (export '(,lisp-name)) (alien:def-alien-routine (,c-name ,lisp-name) double-float ,@(let ((results nil)) (dotimes (i num-args (nreverse results)) (push (list (intern (format nil "ARG-~D" i)) 'double-float) - results)))) - (alien:def-alien-routine (,c-name-f ,lisp-name-f) single-float - ,@(let ((results nil)) - (dotimes (i num-args (nreverse results)) - (push (list (intern (format nil "ARG-~D" i)) - 'single-float) - results)))))))) + results))))))) (eval-when (compile load eval) (defun handle-reals (function var) `((((foreach fixnum single-float bignum ratio)) - (,(symbolicate function "F") (coerce ,var 'single-float))) + (coerce (,function (coerce ,var 'double-float)) 'single-float)) ((double-float) (,function ,var)) #+double-double ===================================== src/compiler/float-tran.lisp ===================================== @@ -620,84 +620,42 @@ (double-float) double-float (movable foldable flushable)) -(defknown (%tanf %sinhf %asinhf %atanhf %logf %log10f) - (single-float) single-float - (movable foldable flushable)) - (defknown (%sin %cos %tanh #+x87 %sin-quick #+x87 %cos-quick) (double-float) (double-float -1.0d0 1.0d0) (movable foldable flushable)) -(defknown (%sinf %cosf %tanhf) - (single-float) (single-float -1.0f0 1.0f0) - (movable foldable flushable)) - (defknown (%asin %atan) (double-float) (double-float #.(- (/ pi 2)) #.(/ pi 2)) (movable foldable flushable)) -(defknown (%asinf %atanf) - (single-float) (single-float #.(coerce (- (/ pi 2)) 'single-float) - #.(coerce (/ pi 2) 'single-float)) - (movable foldable flushable)) - (defknown (%acos) (double-float) (double-float 0.0d0 #.pi) (movable foldable flushable)) -(defknown (%acosf) - (single-float) (single-float 0.0f0 #.(coerce pi 'single-float)) - (movable foldable flushable)) - (defknown (%cosh) (double-float) (double-float 1.0d0) (movable foldable flushable)) -(defknown (%coshf) - (single-float) (single-float 1.0f0) - (movable foldable flushable)) - (defknown (%acosh %exp %sqrt) (double-float) (double-float 0.0d0) (movable foldable flushable)) -(defknown (%acoshf %expf) - (single-float) (single-float 0.0f0) - (movable foldable flushable)) - (defknown %expm1 (double-float) (double-float -1d0) (movable foldable flushable)) -(defknown %expm1f - (single-float) (single-float -1f0) - (movable foldable flushable)) - (defknown (%hypot) (double-float double-float) (double-float 0d0) (movable foldable flushable)) -(defknown (%hypotf) - (single-float single-float) (single-float 0f0) - (movable foldable flushable)) - (defknown (%pow) (double-float double-float) double-float (movable foldable flushable)) -(defknown (%powf) - (single-float single-float) single-float - (movable foldable flushable)) - (defknown (%atan2) (double-float double-float) (double-float #.(- pi) #.pi) (movable foldable flushable)) -(defknown (%atan2f) - (single-float single-float) (single-float #.(coerce (- pi) 'single-float) - #.(coerce pi 'single-float)) - (movable foldable flushable)) - (defknown (%scalb) (double-float double-float) double-float (movable foldable flushable)) @@ -710,12 +668,9 @@ (double-float) double-float (movable foldable flushable)) -(defknown (%log1pf) - (single-float) single-float - (movable foldable flushable)) - (dolist (stuff '((exp %exp *) (log %log float) + (sqrt %sqrt float) (sin %sin float) (cos %cos float) (tan %tan float) @@ -729,19 +684,10 @@ (acosh %acosh float) (atanh %atanh float))) (destructuring-bind (name prim rtype) stuff - (let ((primf (symbolicate prim "F"))) - (deftransform name ((x) '(single-float) rtype :eval-name t) - `(,primf x)) - (deftransform name ((x) '(double-float) rtype :eval-name t :when :both) - `(,prim x))))) - -(deftransform sqrt ((x) (double-float) double-float :when :both) - `(%sqrt x)) - -;; We don't currently have sqrt specialized for single-floats, so use -;; the double-float version. -(deftransform sqrt ((x) (single-float) single-float) - `(coerce (%sqrt (coerce x 'double-float)) 'single-float)) + (deftransform name ((x) '(single-float) rtype :eval-name t) + `(coerce (,prim (coerce x 'double-float)) 'single-float)) + (deftransform name ((x) '(double-float) rtype :eval-name t :when :both) + `(,prim x)))) (defknown (%sincos) (double-float) (values double-float double-float) ===================================== src/lisp/irrat.c ===================================== @@ -136,126 +136,3 @@ lisp_scalbn(double x, int n) { return fdlibm_scalbn(x, n); } - -/* - * Wrappers for the single-float versions - */ -float -lisp_sinf(float x) -{ - return (float) fdlibm_sin((double) x); -} - -float -lisp_cosf(float x) -{ - return (float) fdlibm_cos((double) x); -} - -float -lisp_tanf(float x) -{ - return (float) fdlibm_tan((double) x); -} - -float -lisp_atanf(float x) -{ - return (float) fdlibm_atan((double) x); -} - -float -lisp_atan2f(float y, float x) -{ - return (float) __ieee754_atan2((double) y, (double) x); -} - -float -lisp_asinf(float x) -{ - return (float) __ieee754_asin((double) x); -} - -float -lisp_acosf(float x) -{ - return (float) __ieee754_acos((double) x); -} - -float -lisp_sinhf(float x) -{ - return (float) __ieee754_sinh((double) x); -} - -float -lisp_coshf(float x) -{ - return (float) __ieee754_cosh((double) x); -} - -float -lisp_tanhf(float x) -{ - return (float) fdlibm_tanh((double) x); -} - -float -lisp_asinhf(float x) -{ - return (float) fdlibm_asinh((double) x); -} - -float -lisp_acoshf(float x) -{ - return (float) __ieee754_acosh((double) x); -} - -float -lisp_atanhf(float x) -{ - return (float) __ieee754_atanh((double) x); -} - -float -lisp_expf(float x) -{ - return (float) __ieee754_exp((double) x); -} - -float -lisp_logf(float x) -{ - return (float) __ieee754_log((double) x); -} - -float -lisp_log10f(float x) -{ - return (float) __ieee754_log10((double) x); -} - -float -lisp_powf(float x, float y) -{ - return (float) __ieee754_pow((double) x, (double) y); -} - -float -lisp_hypotf(float x, float y) -{ - return (float) __ieee754_hypot((double) x, (double) y); -} - -float -lisp_log1pf(float x) -{ - return (float) fdlibm_log1p((double) x); -} - -float -lisp_expm1f(float x) -{ - return (float) fdlibm_expm1((double) x); -} View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/e2d1c2429cf7b0de17fbc447... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/e2d1c2429cf7b0de17fbc447... You're receiving this email because of your account on gitlab.common-lisp.net.
participants (1)
-
Raymond Toy (＠rtoy)