Raymond Toy pushed to branch issue-425-correctly-rounded-math-functions at cmucl / cmucl Commits: 7f708431 by Raymond Toy at 2026-01-27T08:45:32-08:00 Fix #466: Add C wrapper for the special functions - - - - - 318d0560 by Raymond Toy at 2026-01-27T08:45:32-08:00 Merge branch 'issue-466-c-wrapper-specfun' into 'master' Fix #466: Add C wrapper for the special functions Closes #466 See merge request cmucl/cmucl!345 - - - - - 8ceef426 by Raymond Toy at 2026-01-27T18:42:27-08:00 Merge branch 'master' into issue-425-correctly-rounded-math-functions - - - - - 5a960d14 by Raymond Toy at 2026-01-27T19:44:00-08:00 Fix up incorrect merge We need to get rid of most of the #+core-math stuff. - - - - - f364498b by Raymond Toy at 2026-01-27T20:01:10-08:00 Add core-math routines to SRCS Just for completeness. - - - - - 66d306ff by Raymond Toy at 2026-01-27T20:02:09-08:00 Call the core-math routines when FEATURE_CORE_MATH is set Otherwise, we use the old fdlibm routines. - - - - - 5 changed files: - src/code/irrat.lisp - src/lisp/GNUmakefile - src/lisp/fdlibm.h - + src/lisp/irrat.c - src/lisp/log2.c Changes: ===================================== src/code/irrat.lisp ===================================== @@ -75,73 +75,38 @@ ;;; Please refer to the Unix man pages for details about these routines. -#+core-math -(progn -;;; Trigonometric. -(def-math-rtn ("cr_sin" %sin) 1) -(def-math-rtn ("cr_cos" %cos) 1) -(def-math-rtn ("cr_tan" %tan) 1) -(def-math-rtn ("cr_atan" %atan) 1) -(def-math-rtn ("cr_atan2" %atan2) 2) -(def-math-rtn ("cr_asin" %asin) 1) -(def-math-rtn ("cr_acos" %acos) 1) -(def-math-rtn ("cr_sinh" %sinh) 1) -(def-math-rtn ("cr_cosh" %cosh) 1) -(def-math-rtn ("cr_tanh" %tanh) 1) -(def-math-rtn ("cr_asinh" %asinh) 1) -(def-math-rtn ("cr_acosh" %acosh) 1) -(def-math-rtn ("cr_atanh" %atanh) 1) - -;;; Exponential and Logarithmic. -(def-math-rtn ("cr_exp" %exp) 1) -(def-math-rtn ("cr_log" %log) 1) -(def-math-rtn ("cr_log10" %log10) 1) -(def-math-rtn ("cr_log2" %log2) 1) - -(def-math-rtn ("__ieee754_pow" %pow) 2) -#-(or x86 sparc-v7 sparc-v8 sparc-v9) -(def-math-rtn "sqrt" 1) -(def-math-rtn ("cr_hypot" %hypot) 2) - -(def-math-rtn ("cr_log1p" %log1p) 1) -(def-math-rtn ("cr_expm1" %expm1) 1) -) - -#-core-math -(progn ;;; Trigonometric. -(def-math-rtn ("fdlibm_sin" %sin) 1) -(def-math-rtn ("fdlibm_cos" %cos) 1) -(def-math-rtn ("fdlibm_tan" %tan) 1) -(def-math-rtn ("fdlibm_atan" %atan) 1) -(def-math-rtn ("__ieee754_atan2" %atan2) 2) -(def-math-rtn ("__ieee754_asin" %asin) 1) -(def-math-rtn ("__ieee754_acos" %acos) 1) -(def-math-rtn ("__ieee754_sinh" %sinh) 1) -(def-math-rtn ("__ieee754_cosh" %cosh) 1) -(def-math-rtn ("fdlibm_tanh" %tanh) 1) -(def-math-rtn ("fdlibm_asinh" %asinh) 1) -(def-math-rtn ("__ieee754_acosh" %acosh) 1) -(def-math-rtn ("__ieee754_atanh" %atanh) 1) +(def-math-rtn ("lisp_sin" %sin) 1) +(def-math-rtn ("lisp_cos" %cos) 1) +(def-math-rtn ("lisp_tan" %tan) 1) +(def-math-rtn ("lisp_atan" %atan) 1) +(def-math-rtn ("lisp_atan2" %atan2) 2) +(def-math-rtn ("lisp_asin" %asin) 1) +(def-math-rtn ("lisp_acos" %acos) 1) +(def-math-rtn ("lisp_sinh" %sinh) 1) +(def-math-rtn ("lisp_cosh" %cosh) 1) +(def-math-rtn ("lisp_tanh" %tanh) 1) +(def-math-rtn ("lisp_asinh" %asinh) 1) +(def-math-rtn ("lisp_acosh" %acosh) 1) +(def-math-rtn ("lisp_atanh" %atanh) 1) ;;; Exponential and Logarithmic. -(def-math-rtn ("__ieee754_exp" %exp) 1) -(def-math-rtn ("__ieee754_log" %log) 1) -(def-math-rtn ("__ieee754_log10" %log10) 1) -(def-math-rtn ("cmucl_log2" %log2) 1) +(def-math-rtn ("lisp_exp" %exp) 1) +(def-math-rtn ("lisp_log" %log) 1) +(def-math-rtn ("lisp_log10" %log10) 1) +(def-math-rtn ("lisp_log2" %log2) 1) -(def-math-rtn ("__ieee754_pow" %pow) 2) +(def-math-rtn ("lisp_pow" %pow) 2) #-(or x86 sparc-v7 sparc-v8 sparc-v9) (def-math-rtn "sqrt" 1) -(def-math-rtn ("__ieee754_hypot" %hypot) 2) +(def-math-rtn ("lisp_hypot" %hypot) 2) -(def-math-rtn ("fdlibm_log1p" %log1p) 1) -(def-math-rtn ("fdlibm_expm1" %expm1) 1) -) +(def-math-rtn ("lisp_log1p" %log1p) 1) +(def-math-rtn ("lisp_expm1" %expm1) 1) (declaim (inline %scalbn)) (export '%scalbn) -(alien:def-alien-routine ("fdlibm_scalbn" %scalbn) c-call:double +(alien:def-alien-routine ("lisp_scalbn" %scalbn) c-call:double (x double-float) (n c-call:int)) ===================================== src/lisp/GNUmakefile ===================================== @@ -35,6 +35,8 @@ SRCS = lisp.c coreparse.c alloc.c monitor.c print.c interr.c \ vars.c parse.c interrupt.c search.c validate.c globals.c \ dynbind.c breakpoint.c regnames.c backtrace.c save.c purify.c \ runprog.c time.c case-mapping.c exec-init.c \ + irrat.c \ + ${CORE64_OBJS:.o=.c} \ ${FDLIBM} ${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC} ${GC_SRC} ===================================== src/lisp/fdlibm.h ===================================== @@ -54,8 +54,21 @@ extern double fdlibm_tan(double x); extern double fdlibm_expm1(double x); extern double fdlibm_log1p(double x); extern double fdlibm_atan(double x); +extern double fdlibm_tanh(double x); +extern double fdlibm_asinh(double x); extern double __ieee754_exp(double x); extern double __ieee754_log(double x); +extern double __ieee754_atan2(double y, double x); +extern double __ieee754_asin(double x); +extern double __ieee754_acos(double x); +extern double __ieee754_sinh(double x); +extern double __ieee754_cosh(double x); +extern double __ieee754_atanh(double x); +extern double __ieee754_acosh(double x); +extern double __ieee754_log10(double x); +extern double __ieee754_pow(double x, double y); +extern double __ieee754_hypot(double x, double y); +extern double fdlibm_scalbn(double x, int n); enum FDLIBM_EXCEPTION { FDLIBM_DIVIDE_BY_ZERO, ===================================== src/lisp/irrat.c ===================================== @@ -0,0 +1,249 @@ +/* + + This code was written as part of the CMU Common Lisp project at + Carnegie Mellon University, and has been placed in the public domain. + +*/ + +#include "lisp.h" +#include "internals.h" +#ifdef FEATURE_CORE_MATH +#include <math.h> +extern double cr_sin(double); +extern double cr_cos(double); +extern double cr_tan(double); +extern double cr_atan(double); +extern double cr_atan2(double, double); +extern double cr_asin(double); +extern double cr_acos(double); +extern double cr_sinh(double); +extern double cr_cosh(double); +extern double cr_tanh(double); +extern double cr_asinh(double); +extern double cr_acosh(double); +extern double cr_atanh(double); +extern double cr_exp(double); +extern double cr_log(double); +extern double cr_log10(double); +extern double cr_pow(double, double); +extern double cr_hypot(double, double); +extern double cr_log1p(double); +extern double cr_expm1(double); +#else +#include "fdlibm.h" +#endif + + +/* + * Wrappers for the special functions + */ + +double +lisp_sin(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_sin(x); +#else + return fdlibm_sin(x); +#endif +} + +double +lisp_cos(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_cos(x); +#else + return fdlibm_cos(x); +#endif +} + +double +lisp_tan(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_tan(x); +#else + return fdlibm_tan(x); +#endif +} + +double +lisp_atan(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_atan(x); +#else + return fdlibm_atan(x); +#endif +} + +double +lisp_atan2(double y, double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_atan2(y, x); +#else + return __ieee754_atan2(y, x); +#endif +} + +double +lisp_asin(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_asin(x); +#else + return __ieee754_asin(x); +#endif +} + +double +lisp_acos(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_acos(x); +#else + return __ieee754_acos(x); +#endif +} + +double +lisp_sinh(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_sinh(x); +#else + return __ieee754_sinh(x); +#endif +} + +double +lisp_cosh(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_cosh(x); +#else + return __ieee754_cosh(x); +#endif +} + +double +lisp_tanh(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_tanh(x); +#else + return fdlibm_tanh(x); +#endif +} + +double +lisp_asinh(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_asinh(x); +#else + return fdlibm_asinh(x); +#endif +} + +double +lisp_acosh(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_acosh(x); +#else + return __ieee754_acosh(x); +#endif +} + +double +lisp_atanh(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_atanh(x); +#else + return __ieee754_atanh(x); +#endif +} + +double +lisp_exp(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_exp(x); +#else + return __ieee754_exp(x); +#endif +} + +double +lisp_log(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_log(x); +#else + return __ieee754_log(x); +#endif +} + +double +lisp_log10(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_log10(x); +#else + return __ieee754_log10(x); +#endif +} + +double +lisp_pow(double x, double y) +{ +#ifdef FEATURE_CORE_MATH + return cr_pow(x, y); +#else + return __ieee754_pow(x, y); +#endif +} + +double +lisp_hypot(double x, double y) +{ +#ifdef FEATURE_CORE_MATH + return cr_hypot(x, y); +#else + return __ieee754_hypot(x, y); +#endif +} + +double +lisp_log1p(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_log1p(x); +#else + return fdlibm_log1p(x); +#endif +} + +double +lisp_expm1(double x) +{ +#ifdef FEATURE_CORE_MATH + return cr_expm1(x); +#else + return fdlibm_expm1(x); +#endif +} + +double +lisp_scalbn(double x, int n) +{ +#ifdef FEATURE_CORE_MATH + return scalbn(x, n); +#else + return fdlibm_scalbn(x, n); +#endif +} ===================================== src/lisp/log2.c ===================================== @@ -39,7 +39,7 @@ cp = 9.61796693925975554329e-01, /* 0x3FEEC709, 0xDC3A03FD =2/(3ln2) */ cp_h = 9.61796700954437255859e-01, /* 0x3FEEC709, 0xE0000000 =(float)cp */ cp_l = -7.02846165095275826516e-09; /* 0xBE3E2FE0, 0x145B01F5 =tail of cp_h*/ -double cmucl_log2(double x) +double lisp_log2(double x) { double ax; int k, hx, lx, ix; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a5440432136bbcc0de718c1... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a5440432136bbcc0de718c1... You're receiving this email because of your account on gitlab.common-lisp.net.