1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/templates/native/float.c Thu Jul 12 00:15:16 2018 +0200
1.3 @@ -0,0 +1,345 @@
1.4 +/* Native functions for floating point operations.
1.5 +
1.6 +Copyright (C) 2016, 2017, 2018 Paul Boddie <paul@boddie.org.uk>
1.7 +
1.8 +This program is free software; you can redistribute it and/or modify it under
1.9 +the terms of the GNU General Public License as published by the Free Software
1.10 +Foundation; either version 3 of the License, or (at your option) any later
1.11 +version.
1.12 +
1.13 +This program is distributed in the hope that it will be useful, but WITHOUT
1.14 +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
1.15 +FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
1.16 +details.
1.17 +
1.18 +You should have received a copy of the GNU General Public License along with
1.19 +this program. If not, see <http://www.gnu.org/licenses/>.
1.20 +*/
1.21 +
1.22 +#include <fenv.h> /* feclearexcept, fetestexcept */
1.23 +#include <math.h> /* pow */
1.24 +#include <stdio.h> /* snprintf */
1.25 +#include <errno.h> /* errno */
1.26 +#include "native/common.h"
1.27 +#include "types.h"
1.28 +#include "exceptions.h"
1.29 +#include "ops.h"
1.30 +#include "progconsts.h"
1.31 +#include "progops.h"
1.32 +#include "progtypes.h"
1.33 +#include "main.h"
1.34 +
1.35 +/* Conversion from a pair of consecutive attributes to a double-precision
1.36 + floating point number. */
1.37 +
1.38 +static double __TOFLOAT(__attr attr)
1.39 +{
1.40 + return __get_trailing_data(attr, __builtins___float_float);
1.41 +}
1.42 +
1.43 +/* Numeric formatting using snprintf.
1.44 + NOTE: This might be moved elsewhere and used by other types. */
1.45 +
1.46 +static __attr format_number(double n, int size)
1.47 +{
1.48 + char *s = (char *) __ALLOCATE(size, sizeof(char));
1.49 + int digits;
1.50 +
1.51 + /* Allocation should raise a memory error if it fails, so this loop should
1.52 + terminate via the return statement or an allocation failure. */
1.53 +
1.54 + while (1)
1.55 + {
1.56 + digits = snprintf(s, size, "%f", n);
1.57 +
1.58 + if (digits < size)
1.59 + {
1.60 + s = (char *) __REALLOCATE(s, (digits + 1) * sizeof(char));
1.61 + return __new_str(s, digits);
1.62 + }
1.63 +
1.64 + size = digits + 1;
1.65 + s = (char *) __REALLOCATE(s, size * sizeof(char));
1.66 + }
1.67 +
1.68 + return __NULL;
1.69 +}
1.70 +
1.71 +/* Floating point exception handling. */
1.72 +
1.73 +static void init_env(fenv_t *envp, int excepts)
1.74 +{
1.75 + fegetenv(envp);
1.76 + feclearexcept(excepts);
1.77 +}
1.78 +
1.79 +static int test_env(fenv_t *envp, int excepts)
1.80 +{
1.81 + if (fetestexcept(excepts))
1.82 + {
1.83 + fesetenv(envp);
1.84 + return 1;
1.85 + }
1.86 + return 0;
1.87 +}
1.88 +
1.89 +static int have_result(fenv_t *envp, int excepts)
1.90 +{
1.91 + return !fetestexcept(excepts);
1.92 +}
1.93 +
1.94 +static __attr make_result(fenv_t *envp, double result)
1.95 +{
1.96 + fesetenv(envp);
1.97 + return __new_float(result);
1.98 +}
1.99 +
1.100 +/* Floating point operations. */
1.101 +
1.102 +__attr __fn_native_float_float_add(__attr __self, __attr self, __attr other)
1.103 +{
1.104 + /* self and other interpreted as float */
1.105 + double i = __TOFLOAT(self);
1.106 + double j = __TOFLOAT(other);
1.107 + double result;
1.108 +
1.109 + /* Preserve environment, clear exception state. */
1.110 + fenv_t env;
1.111 + init_env(&env, FE_OVERFLOW);
1.112 +
1.113 + result = i + j;
1.114 +
1.115 + /* Test for result, restore state, return the new float. */
1.116 + if (have_result(&env, FE_OVERFLOW))
1.117 + return make_result(&env, result);
1.118 +
1.119 + /* Restore state, raise exception. */
1.120 + if (test_env(&env, FE_OVERFLOW))
1.121 + __raise_overflow_error();
1.122 + return __NULL;
1.123 +}
1.124 +
1.125 +__attr __fn_native_float_float_sub(__attr __self, __attr self, __attr other)
1.126 +{
1.127 + /* self and other interpreted as float */
1.128 + double i = __TOFLOAT(self);
1.129 + double j = __TOFLOAT(other);
1.130 + double result;
1.131 +
1.132 + /* Preserve environment, clear exception state. */
1.133 + fenv_t env;
1.134 + init_env(&env, FE_OVERFLOW);
1.135 +
1.136 + result = i - j;
1.137 +
1.138 + /* Test for result, restore state, return the new float. */
1.139 + if (have_result(&env, FE_OVERFLOW))
1.140 + return make_result(&env, result);
1.141 +
1.142 + /* Restore state, raise exception. */
1.143 + if (test_env(&env, FE_OVERFLOW))
1.144 + __raise_overflow_error();
1.145 + return __NULL;
1.146 +}
1.147 +
1.148 +__attr __fn_native_float_float_mul(__attr __self, __attr self, __attr other)
1.149 +{
1.150 + /* self and other interpreted as float */
1.151 + double i = __TOFLOAT(self);
1.152 + double j = __TOFLOAT(other);
1.153 + double result;
1.154 +
1.155 + /* Preserve environment, clear exception state. */
1.156 + fenv_t env;
1.157 + init_env(&env, FE_OVERFLOW | FE_UNDERFLOW);
1.158 +
1.159 + result = i * j;
1.160 +
1.161 + /* Test for result, restore state, return the new float. */
1.162 + if (have_result(&env, FE_OVERFLOW | FE_UNDERFLOW))
1.163 + return make_result(&env, result);
1.164 +
1.165 + /* Restore state, raise exception. */
1.166 + if (test_env(&env, FE_OVERFLOW))
1.167 + __raise_overflow_error();
1.168 + if (test_env(&env, FE_UNDERFLOW))
1.169 + __raise_underflow_error();
1.170 + return __NULL;
1.171 +}
1.172 +
1.173 +__attr __fn_native_float_float_div(__attr __self, __attr self, __attr other)
1.174 +{
1.175 + /* self and other interpreted as float */
1.176 + double i = __TOFLOAT(self);
1.177 + double j = __TOFLOAT(other);
1.178 + double result;
1.179 +
1.180 + /* Preserve environment, clear exception state. */
1.181 + fenv_t env;
1.182 + init_env(&env, FE_OVERFLOW | FE_UNDERFLOW | FE_DIVBYZERO);
1.183 +
1.184 + result = i / j;
1.185 +
1.186 + /* Test for result, restore state, return the new float. */
1.187 + if (have_result(&env, FE_OVERFLOW | FE_UNDERFLOW | FE_DIVBYZERO))
1.188 + return make_result(&env, result);
1.189 +
1.190 + /* Restore state, raise exception. */
1.191 + if (test_env(&env, FE_OVERFLOW))
1.192 + __raise_overflow_error();
1.193 + if (test_env(&env, FE_UNDERFLOW))
1.194 + __raise_underflow_error();
1.195 + if (test_env(&env, FE_DIVBYZERO))
1.196 + __raise_zero_division_error();
1.197 + return __NULL;
1.198 +}
1.199 +
1.200 +__attr __fn_native_float_float_mod(__attr __self, __attr self, __attr other)
1.201 +{
1.202 + /* self and other interpreted as float */
1.203 + double i = __TOFLOAT(self);
1.204 + double j = __TOFLOAT(other);
1.205 + double result;
1.206 +
1.207 + /* Preserve environment, clear exception state. */
1.208 + fenv_t env;
1.209 + init_env(&env, FE_OVERFLOW | FE_DIVBYZERO);
1.210 +
1.211 + result = fmod(i, j);
1.212 +
1.213 + /* Test for result, restore state, return the new float. */
1.214 + if (have_result(&env, FE_OVERFLOW | FE_DIVBYZERO))
1.215 + return make_result(&env, result);
1.216 +
1.217 + /* Restore state, raise exception. */
1.218 + if (test_env(&env, FE_OVERFLOW))
1.219 + __raise_overflow_error();
1.220 + if (test_env(&env, FE_DIVBYZERO))
1.221 + __raise_zero_division_error();
1.222 + return __NULL;
1.223 +}
1.224 +
1.225 +__attr __fn_native_float_float_neg(__attr __self, __attr self)
1.226 +{
1.227 + /* self interpreted as float */
1.228 + double i = __TOFLOAT(self);
1.229 + double result;
1.230 +
1.231 + /* Preserve environment, clear exception state. */
1.232 + fenv_t env;
1.233 + init_env(&env, FE_OVERFLOW);
1.234 +
1.235 + result = -i;
1.236 +
1.237 + /* Test for result, restore state, return the new float. */
1.238 + if (have_result(&env, FE_OVERFLOW))
1.239 + return make_result(&env, result);
1.240 +
1.241 + /* Restore state, raise exception. */
1.242 + if (test_env(&env, FE_OVERFLOW))
1.243 + __raise_overflow_error();
1.244 + return __NULL;
1.245 +}
1.246 +
1.247 +__attr __fn_native_float_float_pow(__attr __self, __attr self, __attr other)
1.248 +{
1.249 + /* self and other interpreted as float */
1.250 + double i = __TOFLOAT(self);
1.251 + double j = __TOFLOAT(other);
1.252 + double result;
1.253 +
1.254 + errno = 0;
1.255 + result = pow(i, j);
1.256 +
1.257 + /* Test for overflow. */
1.258 +
1.259 + if (errno == ERANGE)
1.260 + __raise_overflow_error();
1.261 +
1.262 + /* Return the result. */
1.263 + return __new_float(result);
1.264 +}
1.265 +
1.266 +__attr __fn_native_float_float_le(__attr __self, __attr self, __attr other)
1.267 +{
1.268 + /* self and other interpreted as float */
1.269 + double i = __TOFLOAT(self);
1.270 + double j = __TOFLOAT(other);
1.271 +
1.272 + /* Return a boolean result. */
1.273 + return i <= j ? __builtins___boolean_True : __builtins___boolean_False;
1.274 +}
1.275 +
1.276 +__attr __fn_native_float_float_lt(__attr __self, __attr self, __attr other)
1.277 +{
1.278 + /* self and other interpreted as float */
1.279 + double i = __TOFLOAT(self);
1.280 + double j = __TOFLOAT(other);
1.281 +
1.282 + /* Return a boolean result. */
1.283 + return i < j ? __builtins___boolean_True : __builtins___boolean_False;
1.284 +}
1.285 +
1.286 +__attr __fn_native_float_float_ge(__attr __self, __attr self, __attr other)
1.287 +{
1.288 + /* self and other interpreted as float */
1.289 + double i = __TOFLOAT(self);
1.290 + double j = __TOFLOAT(other);
1.291 +
1.292 + /* Return a boolean result. */
1.293 + return i >= j ? __builtins___boolean_True : __builtins___boolean_False;
1.294 +}
1.295 +
1.296 +__attr __fn_native_float_float_gt(__attr __self, __attr self, __attr other)
1.297 +{
1.298 + /* self and other interpreted as float */
1.299 + double i = __TOFLOAT(self);
1.300 + double j = __TOFLOAT(other);
1.301 +
1.302 + /* Return a boolean result. */
1.303 + return i > j ? __builtins___boolean_True : __builtins___boolean_False;
1.304 +}
1.305 +
1.306 +__attr __fn_native_float_float_eq(__attr __self, __attr self, __attr other)
1.307 +{
1.308 + /* self and other interpreted as float */
1.309 + double i = __TOFLOAT(self);
1.310 + double j = __TOFLOAT(other);
1.311 +
1.312 + /* Return a boolean result. */
1.313 + return i == j ? __builtins___boolean_True : __builtins___boolean_False;
1.314 +}
1.315 +
1.316 +__attr __fn_native_float_float_ne(__attr __self, __attr self, __attr other)
1.317 +{
1.318 + /* self and other interpreted as float */
1.319 + double i = __TOFLOAT(self);
1.320 + double j = __TOFLOAT(other);
1.321 +
1.322 + /* Return a boolean result. */
1.323 + return i != j ? __builtins___boolean_True : __builtins___boolean_False;
1.324 +}
1.325 +
1.326 +__attr __fn_native_float_float_str(__attr __self, __attr self)
1.327 +{
1.328 + /* self interpreted as float */
1.329 + double i = __TOFLOAT(self);
1.330 +
1.331 + /* Return a new string. */
1.332 + return format_number(i, 64);
1.333 +}
1.334 +
1.335 +__attr __fn_native_float_float_int(__attr __self, __attr self)
1.336 +{
1.337 + /* self interpreted as float */
1.338 + double i = __TOFLOAT(self);
1.339 +
1.340 + /* NOTE: Test for conversion failure. */
1.341 + return __new_int((int) i);
1.342 +}
1.343 +
1.344 +/* Module initialisation. */
1.345 +
1.346 +void __main_native_float()
1.347 +{
1.348 +}