Home | History | Annotate | Line # | Download | only in libm
libm.c revision 1.2
      1  1.2  christos /* $NetBSD: libm.c,v 1.2 2022/11/23 18:15:43 christos Exp $	*/
      2  1.1  christos 
      3  1.1  christos /*-
      4  1.1  christos  * Copyright (c) 2022 The NetBSD Foundation, Inc.
      5  1.1  christos  * All rights reserved.
      6  1.1  christos  *
      7  1.1  christos  * This code is derived from software contributed to The NetBSD Foundation
      8  1.1  christos  * by Phillip Rulon
      9  1.1  christos  *
     10  1.1  christos  * Redistribution and use in source and binary forms, with or without
     11  1.1  christos  * modification, are permitted provided that the following conditions
     12  1.1  christos  * are met:
     13  1.1  christos  * 1. Redistributions of source code must retain the above copyright
     14  1.1  christos  *    notice, this list of conditions and the following disclaimer.
     15  1.1  christos  * 2. Redistributions in binary form must reproduce the above copyright
     16  1.1  christos  *    notice, this list of conditions and the following disclaimer in the
     17  1.1  christos  *    documentation and/or other materials provided with the distribution.
     18  1.1  christos  *
     19  1.1  christos  * THIS SOFTWARE IS PROVIDED BY THE NETBSD FOUNDATION, INC. AND CONTRIBUTORS
     20  1.1  christos  * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
     21  1.1  christos  * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
     22  1.1  christos  * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE FOUNDATION OR CONTRIBUTORS
     23  1.1  christos  * BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
     24  1.1  christos  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
     25  1.1  christos  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
     26  1.1  christos  * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
     27  1.1  christos  * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
     28  1.1  christos  * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
     29  1.1  christos  * POSSIBILITY OF SUCH DAMAGE.
     30  1.1  christos  */
     31  1.1  christos #include <sys/cdefs.h>
     32  1.2  christos __RCSID("$NetBSD: libm.c,v 1.2 2022/11/23 18:15:43 christos Exp $");
     33  1.1  christos 
     34  1.1  christos #include <lua.h>
     35  1.1  christos #include <lauxlib.h>
     36  1.1  christos #include <math.h>
     37  1.1  christos 
     38  1.1  christos const char	badarg[] = "argument to libm function not a number";
     39  1.1  christos 
     40  1.1  christos /*-
     41  1.1  christos  * The majority of libm functions fall into a few forms:
     42  1.1  christos  *
     43  1.1  christos  *   int func(double);
     44  1.1  christos  *   double func(double);
     45  1.1  christos  *   double func(double, double);
     46  1.1  christos  * and,
     47  1.1  christos  *   double func(int, double);
     48  1.1  christos  *
     49  1.1  christos  * Accordingly, this lends itself to systematic declaration of the lua
     50  1.1  christos  * interface functions.  These macros set this up.
     51  1.1  christos  */
     52  1.1  christos #define BFUNC_DBL(fname)			\
     53  1.1  christos static int					\
     54  1.1  christos libm_##fname(lua_State *L)			\
     55  1.1  christos {						\
     56  1.1  christos 	if (!lua_isnumber(L, 1))		\
     57  1.1  christos 		return luaL_error(L, badarg);	\
     58  1.1  christos 						\
     59  1.1  christos 	double x = lua_tonumber(L, 1);		\
     60  1.1  christos 	lua_pushboolean(L, fname(x));		\
     61  1.1  christos 	return 1;				\
     62  1.1  christos }
     63  1.1  christos 
     64  1.1  christos #define DFUNC_DBL(fname)			\
     65  1.1  christos static int					\
     66  1.1  christos libm_##fname(lua_State *L)			\
     67  1.1  christos {						\
     68  1.1  christos 	if (!lua_isnumber(L, 1)) 		\
     69  1.1  christos     		return luaL_error(L, badarg);	\
     70  1.1  christos 						\
     71  1.1  christos 	double x = lua_tonumber(L, 1);		\
     72  1.1  christos 	lua_pushnumber(L, fname(x));		\
     73  1.1  christos 	return 1;				\
     74  1.1  christos }
     75  1.1  christos 
     76  1.1  christos #define DFUNC_INT_DBL(fname)			\
     77  1.1  christos static int					\
     78  1.1  christos libm_##fname(lua_State *L)			\
     79  1.1  christos {						\
     80  1.1  christos 	if (!lua_isinteger(L, 1) ||		\
     81  1.1  christos 	    !lua_isnumber(L, 2))		\
     82  1.1  christos     		return luaL_error(L, badarg);	\
     83  1.1  christos 						\
     84  1.1  christos 	int i = (int)lua_tointeger(L, 1);	\
     85  1.1  christos 	double x = lua_tonumber(L, 2);		\
     86  1.1  christos 	lua_pushnumber(L, fname(i, x));		\
     87  1.1  christos 	return 1;				\
     88  1.1  christos }
     89  1.1  christos 
     90  1.1  christos #define DFUNC_DBL_DBL(fname)			\
     91  1.1  christos static int					\
     92  1.1  christos libm_##fname(lua_State *L)			\
     93  1.1  christos {						\
     94  1.1  christos 	if (!lua_isnumber(L, 1) ||		\
     95  1.1  christos 	    !lua_isnumber(L, 2))		\
     96  1.1  christos     		return luaL_error(L, badarg);	\
     97  1.1  christos 	double x[] = {				\
     98  1.1  christos 	    lua_tonumber(L, 1),			\
     99  1.1  christos 	    lua_tonumber(L,2)			\
    100  1.1  christos 	};					\
    101  1.1  christos 	lua_pushnumber(L, fname(x[0], x[1]));   \
    102  1.1  christos 	return 1;				\
    103  1.1  christos }
    104  1.1  christos 
    105  1.1  christos int	luaopen_libm(lua_State *);
    106  1.1  christos 
    107  1.1  christos DFUNC_DBL(acos)
    108  1.1  christos DFUNC_DBL(acosh)
    109  1.1  christos DFUNC_DBL(asin)
    110  1.1  christos DFUNC_DBL(asinh)
    111  1.1  christos DFUNC_DBL(atan)
    112  1.1  christos DFUNC_DBL(atanh)
    113  1.1  christos DFUNC_DBL_DBL(atan2)
    114  1.1  christos DFUNC_DBL(cbrt)
    115  1.1  christos DFUNC_DBL(ceil)
    116  1.1  christos DFUNC_DBL_DBL(copysign)
    117  1.1  christos DFUNC_DBL(cos)
    118  1.1  christos DFUNC_DBL(cosh)
    119  1.1  christos DFUNC_DBL(erf)
    120  1.1  christos DFUNC_DBL(erfc)
    121  1.1  christos DFUNC_DBL(exp)
    122  1.1  christos DFUNC_DBL(exp2)
    123  1.1  christos DFUNC_DBL(expm1)
    124  1.1  christos DFUNC_DBL(fabs)
    125  1.1  christos DFUNC_DBL_DBL(fdim)
    126  1.1  christos BFUNC_DBL(finite)
    127  1.1  christos DFUNC_DBL(floor)
    128  1.1  christos DFUNC_DBL_DBL(fmax)
    129  1.1  christos DFUNC_DBL_DBL(fmin)
    130  1.1  christos DFUNC_DBL_DBL(fmod)
    131  1.1  christos DFUNC_DBL(gamma)
    132  1.1  christos DFUNC_DBL_DBL(hypot)
    133  1.1  christos BFUNC_DBL(isfinite)
    134  1.1  christos BFUNC_DBL(isnan)
    135  1.1  christos BFUNC_DBL(isinf)
    136  1.1  christos DFUNC_DBL(j0)
    137  1.1  christos DFUNC_DBL(j1)
    138  1.1  christos DFUNC_INT_DBL(jn)
    139  1.1  christos DFUNC_DBL(lgamma)
    140  1.1  christos DFUNC_DBL(log)
    141  1.1  christos DFUNC_DBL(log10)
    142  1.1  christos DFUNC_DBL(log1p)
    143  1.2  christos #ifndef __vax__
    144  1.1  christos DFUNC_DBL_DBL(nextafter)
    145  1.2  christos #endif
    146  1.1  christos DFUNC_DBL_DBL(pow)
    147  1.1  christos DFUNC_DBL_DBL(remainder)
    148  1.1  christos DFUNC_DBL(rint)
    149  1.1  christos DFUNC_DBL(round)
    150  1.1  christos DFUNC_DBL(sin)
    151  1.1  christos DFUNC_DBL(sinh)
    152  1.1  christos DFUNC_DBL(sqrt)
    153  1.1  christos DFUNC_DBL(tan)
    154  1.1  christos DFUNC_DBL(tanh)
    155  1.1  christos DFUNC_DBL(trunc)
    156  1.1  christos DFUNC_DBL(y0)
    157  1.1  christos DFUNC_DBL(y1)
    158  1.1  christos DFUNC_INT_DBL(yn)
    159  1.1  christos 
    160  1.1  christos /*
    161  1.1  christos  * The following interface functions are special cases which do not lend
    162  1.1  christos  * themseleves to the systematic declaration scheme above.
    163  1.1  christos  */
    164  1.1  christos static int
    165  1.1  christos libm_fma(lua_State *L)
    166  1.1  christos {
    167  1.1  christos 	if (!lua_isnumber(L, 1) ||
    168  1.1  christos 	    !lua_isnumber(L, 2) ||
    169  1.1  christos 	    !lua_isnumber(L, 3))
    170  1.1  christos 		return luaL_error(L, badarg);
    171  1.1  christos 
    172  1.1  christos 	double	x[] = {
    173  1.1  christos 	    lua_tonumber(L, 1),
    174  1.1  christos 	    lua_tonumber(L, 2),
    175  1.1  christos 	    lua_tonumber(L, 3)
    176  1.1  christos 	};
    177  1.1  christos 	lua_pushnumber(L, fma(x[0], x[1], x[2]));
    178  1.1  christos 	return 1;
    179  1.1  christos }
    180  1.1  christos 
    181  1.1  christos static int
    182  1.1  christos libm_nan(lua_State *L)
    183  1.1  christos {
    184  1.1  christos 	if (!lua_isstring(L, 1))
    185  1.1  christos 		return luaL_error(L, badarg);
    186  1.1  christos 
    187  1.1  christos 	const char     *str = luaL_checkstring(L, 1);
    188  1.1  christos 	lua_pushnumber(L, nan(str));
    189  1.1  christos 	return 1;
    190  1.1  christos }
    191  1.1  christos 
    192  1.1  christos static int
    193  1.1  christos libm_scalbn(lua_State *L)
    194  1.1  christos {
    195  1.1  christos 	if (!lua_isnumber(L, 1) || !lua_isinteger(L, 2))
    196  1.1  christos 		return luaL_error(L, badarg);
    197  1.1  christos 
    198  1.1  christos 	double		x = lua_tonumber(L, 1);
    199  1.1  christos 	int		i = (int)lua_tointeger(L, 2);
    200  1.1  christos 	lua_pushnumber(L, scalbn(x, i));
    201  1.1  christos 	return 1;
    202  1.1  christos }
    203  1.1  christos 
    204  1.1  christos static int
    205  1.1  christos libm_ilogb(lua_State *L)
    206  1.1  christos {
    207  1.1  christos 	if (!lua_isnumber(L, 1))
    208  1.1  christos 		return luaL_error(L, badarg);
    209  1.1  christos 
    210  1.1  christos 	double		x = lua_tonumber(L, 1);
    211  1.1  christos 	lua_pushinteger(L, ilogb(x));
    212  1.1  christos 	return 1;
    213  1.1  christos }
    214  1.1  christos 
    215  1.1  christos /*
    216  1.1  christos  * set up a table for the math.h constants
    217  1.1  christos  */
    218  1.1  christos #define LIBM_CONST(K) {#K, K}
    219  1.1  christos struct kv {
    220  1.1  christos 	const char     *k;
    221  1.1  christos 	double		v;
    222  1.1  christos };
    223  1.1  christos 
    224  1.1  christos static const struct kv libm_const[] = {
    225  1.1  christos 	LIBM_CONST(M_E),
    226  1.1  christos 	LIBM_CONST(M_LOG2E),
    227  1.1  christos 	LIBM_CONST(M_LOG10E),
    228  1.1  christos 	LIBM_CONST(M_LN2),
    229  1.1  christos 	LIBM_CONST(M_LN10),
    230  1.1  christos 	LIBM_CONST(M_PI),
    231  1.1  christos 	LIBM_CONST(M_PI_2),
    232  1.1  christos 	LIBM_CONST(M_PI_4),
    233  1.1  christos 	LIBM_CONST(M_1_PI),
    234  1.1  christos 	LIBM_CONST(M_2_PI),
    235  1.1  christos 	LIBM_CONST(M_2_SQRTPI),
    236  1.1  christos 	LIBM_CONST(M_SQRT2),
    237  1.1  christos 	LIBM_CONST(M_SQRT1_2),
    238  1.1  christos 	{ NULL, 0 }
    239  1.1  christos };
    240  1.1  christos 
    241  1.1  christos 
    242  1.1  christos static const struct luaL_Reg lualibm[] = {
    243  1.1  christos 	{ "acos", libm_acos },
    244  1.1  christos 	{ "acosh", libm_acosh },
    245  1.1  christos 	{ "asin", libm_asin },
    246  1.1  christos 	{ "asinh", libm_asinh },
    247  1.1  christos 	{ "atan", libm_atan },
    248  1.1  christos 	{ "atanh", libm_atanh },
    249  1.1  christos 	{ "atan2", libm_atan2 },
    250  1.1  christos 	{ "cbrt", libm_cbrt },
    251  1.1  christos 	{ "ceil", libm_ceil },
    252  1.1  christos 	{ "copysign", libm_copysign },
    253  1.1  christos 	{ "cos", libm_cos },
    254  1.1  christos 	{ "cosh", libm_cosh },
    255  1.1  christos 	{ "erf", libm_erf },
    256  1.1  christos 	{ "erfc", libm_erfc },
    257  1.1  christos 	{ "exp", libm_exp },
    258  1.1  christos 	{ "exp2", libm_exp2 },
    259  1.1  christos 	{ "expm1", libm_expm1 },
    260  1.1  christos 	{ "fabs", libm_fabs },
    261  1.1  christos 	{ "fdim", libm_fdim },
    262  1.1  christos 	{ "finite", libm_finite },
    263  1.1  christos 	{ "floor", libm_floor },
    264  1.1  christos 	{ "fma", libm_fma },
    265  1.1  christos 	{ "fmax", libm_fmax },
    266  1.1  christos 	{ "fmin", libm_fmin },
    267  1.1  christos 	{ "fmod", libm_fmod },
    268  1.1  christos 	{ "gamma", libm_gamma },
    269  1.1  christos 	{ "hypot", libm_hypot },
    270  1.1  christos 	{ "ilogb", libm_ilogb },
    271  1.1  christos 	{ "isfinite", libm_isfinite },
    272  1.1  christos 	{ "isinf", libm_isinf },
    273  1.1  christos 	{ "isnan", libm_isnan },
    274  1.1  christos 	{ "j0", libm_j0 },
    275  1.1  christos 	{ "j1", libm_j1 },
    276  1.1  christos 	{ "jn", libm_jn },
    277  1.1  christos 	{ "lgamma", libm_lgamma },
    278  1.1  christos 	{ "log", libm_log },
    279  1.1  christos 	{ "log10", libm_log10 },
    280  1.1  christos 	{ "log1p", libm_log1p },
    281  1.1  christos 	{ "nan", libm_nan },
    282  1.2  christos #ifndef __vax__
    283  1.1  christos 	{ "nextafter", libm_nextafter },
    284  1.2  christos #endif
    285  1.1  christos 	{ "pow", libm_pow },
    286  1.1  christos 	{ "remainder", libm_remainder },
    287  1.1  christos 	{ "rint", libm_rint },
    288  1.1  christos 	{ "round", libm_round },
    289  1.1  christos 	{ "scalbn", libm_scalbn },
    290  1.1  christos 	{ "sin", libm_sin },
    291  1.1  christos 	{ "sinh", libm_sinh },
    292  1.1  christos 	{ "sqrt", libm_sqrt },
    293  1.1  christos 	{ "tan", libm_tan },
    294  1.1  christos 	{ "tanh", libm_tanh },
    295  1.1  christos 	{ "trunc", libm_trunc },
    296  1.1  christos 	{ "y0", libm_y0 },
    297  1.1  christos 	{ "y1", libm_y1 },
    298  1.1  christos 	{ "yn", libm_yn },
    299  1.1  christos 	{ NULL, NULL }
    300  1.1  christos };
    301  1.1  christos 
    302  1.1  christos int
    303  1.1  christos luaopen_libm(lua_State *L)
    304  1.1  christos {
    305  1.1  christos 	const struct kv *kvp = libm_const;
    306  1.1  christos 
    307  1.1  christos 	luaL_newlib(L, lualibm);
    308  1.1  christos 
    309  1.1  christos 	/* integrate the math.h constants */
    310  1.1  christos 	while (kvp->k) {
    311  1.1  christos 		lua_pushnumber(L, kvp->v);
    312  1.1  christos 		lua_setfield(L, -2, kvp->k);
    313  1.1  christos 		kvp++;
    314  1.1  christos 	}
    315  1.1  christos 
    316  1.1  christos 	return 1;
    317  1.1  christos }
    318