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