Raymond Toy pushed to branch issue-425-correctly-rounded-math-functions at cmucl / cmucl

Commits:

5 changed files:

Changes:

  • src/code/irrat.lisp
    ... ... @@ -75,73 +75,38 @@
    75 75
    76 76 
     ;;; Please refer to the Unix man pages for details about these routines.
    77 77
    78 
    -#+core-math
    79 
    -(progn
    80 
    -;;; Trigonometric.
    81 
    -(def-math-rtn ("cr_sin" %sin) 1)
    82 
    -(def-math-rtn ("cr_cos" %cos) 1)
    83 
    -(def-math-rtn ("cr_tan" %tan) 1)
    84 
    -(def-math-rtn ("cr_atan" %atan) 1)
    85 
    -(def-math-rtn ("cr_atan2" %atan2) 2)
    86 
    -(def-math-rtn ("cr_asin" %asin) 1)
    87 
    -(def-math-rtn ("cr_acos" %acos) 1)
    88 
    -(def-math-rtn ("cr_sinh" %sinh) 1)
    89 
    -(def-math-rtn ("cr_cosh" %cosh) 1)
    90 
    -(def-math-rtn ("cr_tanh" %tanh) 1)
    91 
    -(def-math-rtn ("cr_asinh" %asinh) 1)
    92 
    -(def-math-rtn ("cr_acosh" %acosh) 1)
    93 
    -(def-math-rtn ("cr_atanh" %atanh) 1)
    94 
    -
    95 
    -;;; Exponential and Logarithmic.
    96 
    -(def-math-rtn ("cr_exp" %exp) 1)
    97 
    -(def-math-rtn ("cr_log" %log) 1)
    98 
    -(def-math-rtn ("cr_log10" %log10) 1)
    99 
    -(def-math-rtn ("cr_log2" %log2) 1)
    100 
    -
    101 
    -(def-math-rtn ("__ieee754_pow" %pow) 2)
    102 
    -#-(or x86 sparc-v7 sparc-v8 sparc-v9)
    103 
    -(def-math-rtn "sqrt" 1)
    104 
    -(def-math-rtn ("cr_hypot" %hypot) 2)
    105 
    -
    106 
    -(def-math-rtn ("cr_log1p" %log1p) 1)
    107 
    -(def-math-rtn ("cr_expm1" %expm1) 1)
    108 
    -)
    109 
    -
    110 
    -#-core-math
    111 
    -(progn
    112 78 
     ;;; Trigonometric.
    113 
    -(def-math-rtn ("fdlibm_sin" %sin) 1)
    114 
    -(def-math-rtn ("fdlibm_cos" %cos) 1)
    115 
    -(def-math-rtn ("fdlibm_tan" %tan) 1)
    116 
    -(def-math-rtn ("fdlibm_atan" %atan) 1)
    117 
    -(def-math-rtn ("__ieee754_atan2" %atan2) 2)
    118 
    -(def-math-rtn ("__ieee754_asin" %asin) 1)
    119 
    -(def-math-rtn ("__ieee754_acos" %acos) 1)
    120 
    -(def-math-rtn ("__ieee754_sinh" %sinh) 1)
    121 
    -(def-math-rtn ("__ieee754_cosh" %cosh) 1)
    122 
    -(def-math-rtn ("fdlibm_tanh" %tanh) 1)
    123 
    -(def-math-rtn ("fdlibm_asinh" %asinh) 1)
    124 
    -(def-math-rtn ("__ieee754_acosh" %acosh) 1)
    125 
    -(def-math-rtn ("__ieee754_atanh" %atanh) 1)
    79 
    +(def-math-rtn ("lisp_sin" %sin) 1)
    80 
    +(def-math-rtn ("lisp_cos" %cos) 1)
    81 
    +(def-math-rtn ("lisp_tan" %tan) 1)
    82 
    +(def-math-rtn ("lisp_atan" %atan) 1)
    83 
    +(def-math-rtn ("lisp_atan2" %atan2) 2)
    84 
    +(def-math-rtn ("lisp_asin" %asin) 1)
    85 
    +(def-math-rtn ("lisp_acos" %acos) 1)
    86 
    +(def-math-rtn ("lisp_sinh" %sinh) 1)
    87 
    +(def-math-rtn ("lisp_cosh" %cosh) 1)
    88 
    +(def-math-rtn ("lisp_tanh" %tanh) 1)
    89 
    +(def-math-rtn ("lisp_asinh" %asinh) 1)
    90 
    +(def-math-rtn ("lisp_acosh" %acosh) 1)
    91 
    +(def-math-rtn ("lisp_atanh" %atanh) 1)
    126 92
    127 93 
     ;;; Exponential and Logarithmic.
    128 
    -(def-math-rtn ("__ieee754_exp" %exp) 1)
    129 
    -(def-math-rtn ("__ieee754_log" %log) 1)
    130 
    -(def-math-rtn ("__ieee754_log10" %log10) 1)
    131 
    -(def-math-rtn ("cmucl_log2" %log2) 1)
    94 
    +(def-math-rtn ("lisp_exp" %exp) 1)
    95 
    +(def-math-rtn ("lisp_log" %log) 1)
    96 
    +(def-math-rtn ("lisp_log10" %log10) 1)
    97 
    +(def-math-rtn ("lisp_log2" %log2) 1)
    132 98
    133 
    -(def-math-rtn ("__ieee754_pow" %pow) 2)
    99 
    +(def-math-rtn ("lisp_pow" %pow) 2)
    134 100 
     #-(or x86 sparc-v7 sparc-v8 sparc-v9)
    135 101 
     (def-math-rtn "sqrt" 1)
    136 
    -(def-math-rtn ("__ieee754_hypot" %hypot) 2)
    102 
    +(def-math-rtn ("lisp_hypot" %hypot) 2)
    137 103
    138 
    -(def-math-rtn ("fdlibm_log1p" %log1p) 1)
    139 
    -(def-math-rtn ("fdlibm_expm1" %expm1) 1)
    140 
    -)
    104 
    +(def-math-rtn ("lisp_log1p" %log1p) 1)
    105 
    +(def-math-rtn ("lisp_expm1" %expm1) 1)
    141 106
    142 107 
     (declaim (inline %scalbn))
    143 108 
     (export '%scalbn)
    144 
    -(alien:def-alien-routine ("fdlibm_scalbn" %scalbn) c-call:double
    109 
    +(alien:def-alien-routine ("lisp_scalbn" %scalbn) c-call:double
    145 110 
       (x double-float)
    146 111 
       (n c-call:int))
    147 112

  • src/lisp/GNUmakefile
    ... ... @@ -35,6 +35,8 @@ SRCS = lisp.c coreparse.c alloc.c monitor.c print.c interr.c \
    35 35 
     	vars.c parse.c interrupt.c search.c validate.c globals.c \
    36 36 
     	dynbind.c breakpoint.c regnames.c backtrace.c save.c purify.c \
    37 37 
     	runprog.c time.c case-mapping.c exec-init.c \
    38 
    +	irrat.c \
    39 
    +	${CORE64_OBJS:.o=.c} \
    38 40 
     	${FDLIBM} ${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC} ${GC_SRC}
    39 41
    40 42

  • src/lisp/fdlibm.h
    ... ... @@ -54,8 +54,21 @@ extern double fdlibm_tan(double x);
    54 54 
     extern double fdlibm_expm1(double x);
    55 55 
     extern double fdlibm_log1p(double x);
    56 56 
     extern double fdlibm_atan(double x);
    57 
    +extern double fdlibm_tanh(double x);
    58 
    +extern double fdlibm_asinh(double x);
    57 59 
     extern double __ieee754_exp(double x);
    58 60 
     extern double __ieee754_log(double x);
    61 
    +extern double __ieee754_atan2(double y, double x);
    62 
    +extern double __ieee754_asin(double x);
    63 
    +extern double __ieee754_acos(double x);
    64 
    +extern double __ieee754_sinh(double x);
    65 
    +extern double __ieee754_cosh(double x);
    66 
    +extern double __ieee754_atanh(double x);
    67 
    +extern double __ieee754_acosh(double x);
    68 
    +extern double __ieee754_log10(double x);
    69 
    +extern double __ieee754_pow(double x, double y);
    70 
    +extern double __ieee754_hypot(double x, double y);
    71 
    +extern double fdlibm_scalbn(double x, int n);
    59 72
    60 73 
     enum FDLIBM_EXCEPTION {
    61 74 
       FDLIBM_DIVIDE_BY_ZERO,

  • src/lisp/irrat.c
    1 
    +/*
    2 
    +
    3 
    + This code was written as part of the CMU Common Lisp project at
    4 
    + Carnegie Mellon University, and has been placed in the public domain.
    5 
    +
    6 
    +*/
    7 
    +
    8 
    +#include "lisp.h"
    9 
    +#include "internals.h"
    10 
    +#ifdef FEATURE_CORE_MATH
    11 
    +#include <math.h>
    12 
    +extern double cr_sin(double);
    13 
    +extern double cr_cos(double);
    14 
    +extern double cr_tan(double);
    15 
    +extern double cr_atan(double);
    16 
    +extern double cr_atan2(double, double);
    17 
    +extern double cr_asin(double);
    18 
    +extern double cr_acos(double);
    19 
    +extern double cr_sinh(double);
    20 
    +extern double cr_cosh(double);
    21 
    +extern double cr_tanh(double);
    22 
    +extern double cr_asinh(double);
    23 
    +extern double cr_acosh(double);
    24 
    +extern double cr_atanh(double);
    25 
    +extern double cr_exp(double);
    26 
    +extern double cr_log(double);
    27 
    +extern double cr_log10(double);
    28 
    +extern double cr_pow(double, double);
    29 
    +extern double cr_hypot(double, double);
    30 
    +extern double cr_log1p(double);
    31 
    +extern double cr_expm1(double);
    32 
    +#else
    33 
    +#include "fdlibm.h"
    34 
    +#endif
    35 
    +
    36 
    +
    37 
    +/*
    38 
    + * Wrappers for the special functions
    39 
    + */
    40 
    +
    41 
    +double
    42 
    +lisp_sin(double x)
    43 
    +{
    44 
    +#ifdef FEATURE_CORE_MATH
    45 
    +    return cr_sin(x);
    46 
    +#else
    47 
    +    return fdlibm_sin(x);
    48 
    +#endif
    49 
    +}
    50 
    +
    51 
    +double
    52 
    +lisp_cos(double x)
    53 
    +{
    54 
    +#ifdef FEATURE_CORE_MATH
    55 
    +    return cr_cos(x);
    56 
    +#else
    57 
    +    return fdlibm_cos(x);
    58 
    +#endif
    59 
    +}
    60 
    +
    61 
    +double
    62 
    +lisp_tan(double x)
    63 
    +{
    64 
    +#ifdef FEATURE_CORE_MATH
    65 
    +    return cr_tan(x);
    66 
    +#else
    67 
    +    return fdlibm_tan(x);
    68 
    +#endif
    69 
    +}
    70 
    +
    71 
    +double
    72 
    +lisp_atan(double x)
    73 
    +{
    74 
    +#ifdef FEATURE_CORE_MATH
    75 
    +    return cr_atan(x);
    76 
    +#else
    77 
    +    return fdlibm_atan(x);
    78 
    +#endif
    79 
    +}
    80 
    +
    81 
    +double
    82 
    +lisp_atan2(double y, double x)
    83 
    +{
    84 
    +#ifdef FEATURE_CORE_MATH
    85 
    +    return cr_atan2(y, x);
    86 
    +#else
    87 
    +    return __ieee754_atan2(y, x);
    88 
    +#endif
    89 
    +}
    90 
    +
    91 
    +double
    92 
    +lisp_asin(double x)
    93 
    +{
    94 
    +#ifdef FEATURE_CORE_MATH
    95 
    +    return cr_asin(x);
    96 
    +#else
    97 
    +    return __ieee754_asin(x);
    98 
    +#endif
    99 
    +}
    100 
    +
    101 
    +double
    102 
    +lisp_acos(double x)
    103 
    +{
    104 
    +#ifdef FEATURE_CORE_MATH
    105 
    +    return cr_acos(x);
    106 
    +#else
    107 
    +    return __ieee754_acos(x);
    108 
    +#endif
    109 
    +}
    110 
    +
    111 
    +double
    112 
    +lisp_sinh(double x)
    113 
    +{
    114 
    +#ifdef FEATURE_CORE_MATH
    115 
    +    return cr_sinh(x);
    116 
    +#else
    117 
    +    return __ieee754_sinh(x);
    118 
    +#endif
    119 
    +}
    120 
    +
    121 
    +double
    122 
    +lisp_cosh(double x)
    123 
    +{
    124 
    +#ifdef FEATURE_CORE_MATH
    125 
    +    return cr_cosh(x);
    126 
    +#else
    127 
    +    return __ieee754_cosh(x);
    128 
    +#endif
    129 
    +}
    130 
    +
    131 
    +double
    132 
    +lisp_tanh(double x)
    133 
    +{
    134 
    +#ifdef FEATURE_CORE_MATH
    135 
    +    return cr_tanh(x);
    136 
    +#else
    137 
    +    return fdlibm_tanh(x);
    138 
    +#endif
    139 
    +}
    140 
    +
    141 
    +double
    142 
    +lisp_asinh(double x)
    143 
    +{
    144 
    +#ifdef FEATURE_CORE_MATH
    145 
    +    return cr_asinh(x);
    146 
    +#else
    147 
    +    return fdlibm_asinh(x);
    148 
    +#endif
    149 
    +}
    150 
    +
    151 
    +double
    152 
    +lisp_acosh(double x)
    153 
    +{
    154 
    +#ifdef FEATURE_CORE_MATH
    155 
    +    return cr_acosh(x);
    156 
    +#else
    157 
    +    return __ieee754_acosh(x);
    158 
    +#endif
    159 
    +}
    160 
    +
    161 
    +double
    162 
    +lisp_atanh(double x)
    163 
    +{
    164 
    +#ifdef FEATURE_CORE_MATH
    165 
    +    return cr_atanh(x);
    166 
    +#else
    167 
    +    return __ieee754_atanh(x);
    168 
    +#endif
    169 
    +}
    170 
    +
    171 
    +double
    172 
    +lisp_exp(double x)
    173 
    +{
    174 
    +#ifdef FEATURE_CORE_MATH
    175 
    +    return cr_exp(x);
    176 
    +#else
    177 
    +    return __ieee754_exp(x);
    178 
    +#endif
    179 
    +}
    180 
    +
    181 
    +double
    182 
    +lisp_log(double x)
    183 
    +{
    184 
    +#ifdef FEATURE_CORE_MATH
    185 
    +    return cr_log(x);
    186 
    +#else
    187 
    +    return __ieee754_log(x);
    188 
    +#endif
    189 
    +}
    190 
    +
    191 
    +double
    192 
    +lisp_log10(double x)
    193 
    +{
    194 
    +#ifdef FEATURE_CORE_MATH
    195 
    +    return cr_log10(x);
    196 
    +#else
    197 
    +    return __ieee754_log10(x);
    198 
    +#endif
    199 
    +}
    200 
    +
    201 
    +double
    202 
    +lisp_pow(double x, double y)
    203 
    +{
    204 
    +#ifdef FEATURE_CORE_MATH
    205 
    +    return cr_pow(x, y);
    206 
    +#else
    207 
    +    return __ieee754_pow(x, y);
    208 
    +#endif
    209 
    +}
    210 
    +
    211 
    +double
    212 
    +lisp_hypot(double x, double y)
    213 
    +{
    214 
    +#ifdef FEATURE_CORE_MATH
    215 
    +    return cr_hypot(x, y);
    216 
    +#else
    217 
    +    return __ieee754_hypot(x, y);
    218 
    +#endif
    219 
    +}
    220 
    +
    221 
    +double
    222 
    +lisp_log1p(double x)
    223 
    +{
    224 
    +#ifdef FEATURE_CORE_MATH
    225 
    +    return cr_log1p(x);
    226 
    +#else
    227 
    +    return fdlibm_log1p(x);
    228 
    +#endif
    229 
    +}
    230 
    +
    231 
    +double
    232 
    +lisp_expm1(double x)
    233 
    +{
    234 
    +#ifdef FEATURE_CORE_MATH
    235 
    +    return cr_expm1(x);
    236 
    +#else
    237 
    +    return fdlibm_expm1(x);
    238 
    +#endif
    239 
    +}
    240 
    +
    241 
    +double
    242 
    +lisp_scalbn(double x, int n)
    243 
    +{
    244 
    +#ifdef FEATURE_CORE_MATH
    245 
    +    return scalbn(x, n);
    246 
    +#else
    247 
    +    return fdlibm_scalbn(x, n);
    248 
    +#endif
    249 
    +}

  • src/lisp/log2.c
    ... ... @@ -39,7 +39,7 @@ cp = 9.61796693925975554329e-01, /* 0x3FEEC709, 0xDC3A03FD =2/(3ln2) */
    39 39 
     cp_h  =  9.61796700954437255859e-01, /* 0x3FEEC709, 0xE0000000 =(float)cp */
    40 40 
     cp_l  = -7.02846165095275826516e-09; /* 0xBE3E2FE0, 0x145B01F5 =tail of cp_h*/
    41 41
    42 
    -double cmucl_log2(double x)
    42 
    +double lisp_log2(double x)
    43 43 
     {
    44 44 
         double ax;
    45 45 
         int k, hx, lx, ix;

    • —
    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/-/compare/a5440432136bbcc0de718c13f7a37006acd549c0...66d306ffceda908c6d56b8ad71d78ef4cdc694d9 at 1769572984