1 /* Native functions for floating point operations. 2 3 Copyright (C) 2016, 2017, 2018, 2019 Paul Boddie <paul@boddie.org.uk> 4 5 This program is free software; you can redistribute it and/or modify it under 6 the terms of the GNU General Public License as published by the Free Software 7 Foundation; either version 3 of the License, or (at your option) any later 8 version. 9 10 This program is distributed in the hope that it will be useful, but WITHOUT 11 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 12 FOR A PARTICULAR PURPOSE. See the GNU General Public License for more 13 details. 14 15 You should have received a copy of the GNU General Public License along with 16 this program. If not, see <http://www.gnu.org/licenses/>. 17 */ 18 19 #include <fenv.h> /* feclearexcept, fetestexcept */ 20 #include <math.h> /* pow */ 21 #include <stdio.h> /* snprintf */ 22 #include <errno.h> /* errno */ 23 #include "native/common.h" 24 #include "types.h" 25 #include "exceptions.h" 26 #include "ops.h" 27 #include "progconsts.h" 28 #include "progops.h" 29 #include "progtypes.h" 30 #include "main.h" 31 32 /* Conversion of trailing data to a double-precision floating point number. */ 33 34 static double __TOFLOAT(__attr attr) 35 { 36 return __get_trailing_data(attr, __builtins___float_float); 37 } 38 39 /* Numeric formatting using snprintf. 40 NOTE: This might be moved elsewhere and used by other types. */ 41 42 static __attr format_number(double n, int size) 43 { 44 char *s = (char *) __ALLOCATE(size, sizeof(char)); 45 int digits; 46 47 /* Allocation should raise a memory error if it fails, so this loop should 48 terminate via the return statement or an allocation failure. */ 49 50 while (1) 51 { 52 digits = snprintf(s, size, "%f", n); 53 54 if (digits < size) 55 { 56 s = (char *) __REALLOCATE(s, (digits + 1) * sizeof(char)); 57 return __new_str(s, digits); 58 } 59 60 size = digits + 1; 61 s = (char *) __REALLOCATE(s, size * sizeof(char)); 62 } 63 64 return __NULL; 65 } 66 67 /* Floating point exception handling. */ 68 69 static void init_env(fenv_t *envp, int excepts) 70 { 71 fegetenv(envp); 72 feclearexcept(excepts); 73 } 74 75 static int test_env(fenv_t *envp, int excepts) 76 { 77 if (fetestexcept(excepts)) 78 { 79 fesetenv(envp); 80 return 1; 81 } 82 return 0; 83 } 84 85 static int have_result(fenv_t *envp, int excepts) 86 { 87 return !fetestexcept(excepts); 88 } 89 90 static __attr make_result(fenv_t *envp, double result) 91 { 92 fesetenv(envp); 93 return __new_float(result); 94 } 95 96 /* Floating point operations. */ 97 98 __attr __fn_native_float_float_add(__attr __self, __attr self, __attr other) 99 { 100 /* self and other interpreted as float */ 101 double i = __TOFLOAT(self); 102 double j = __TOFLOAT(other); 103 double result; 104 105 /* Preserve environment, clear exception state. */ 106 fenv_t env; 107 init_env(&env, FE_OVERFLOW); 108 109 result = i + j; 110 111 /* Test for result, restore state, return the new float. */ 112 if (have_result(&env, FE_OVERFLOW)) 113 return make_result(&env, result); 114 115 /* Restore state, raise exception. */ 116 if (test_env(&env, FE_OVERFLOW)) 117 __raise_overflow_error(); 118 return __NULL; 119 } 120 121 __attr __fn_native_float_float_sub(__attr __self, __attr self, __attr other) 122 { 123 /* self and other interpreted as float */ 124 double i = __TOFLOAT(self); 125 double j = __TOFLOAT(other); 126 double result; 127 128 /* Preserve environment, clear exception state. */ 129 fenv_t env; 130 init_env(&env, FE_OVERFLOW); 131 132 result = i - j; 133 134 /* Test for result, restore state, return the new float. */ 135 if (have_result(&env, FE_OVERFLOW)) 136 return make_result(&env, result); 137 138 /* Restore state, raise exception. */ 139 if (test_env(&env, FE_OVERFLOW)) 140 __raise_overflow_error(); 141 return __NULL; 142 } 143 144 __attr __fn_native_float_float_mul(__attr __self, __attr self, __attr other) 145 { 146 /* self and other interpreted as float */ 147 double i = __TOFLOAT(self); 148 double j = __TOFLOAT(other); 149 double result; 150 151 /* Preserve environment, clear exception state. */ 152 fenv_t env; 153 init_env(&env, FE_OVERFLOW | FE_UNDERFLOW); 154 155 result = i * j; 156 157 /* Test for result, restore state, return the new float. */ 158 if (have_result(&env, FE_OVERFLOW | FE_UNDERFLOW)) 159 return make_result(&env, result); 160 161 /* Restore state, raise exception. */ 162 if (test_env(&env, FE_OVERFLOW)) 163 __raise_overflow_error(); 164 if (test_env(&env, FE_UNDERFLOW)) 165 __raise_underflow_error(); 166 return __NULL; 167 } 168 169 __attr __fn_native_float_float_div(__attr __self, __attr self, __attr other) 170 { 171 /* self and other interpreted as float */ 172 double i = __TOFLOAT(self); 173 double j = __TOFLOAT(other); 174 double result; 175 176 /* Preserve environment, clear exception state. */ 177 fenv_t env; 178 init_env(&env, FE_OVERFLOW | FE_UNDERFLOW | FE_DIVBYZERO); 179 180 result = i / j; 181 182 /* Test for result, restore state, return the new float. */ 183 if (have_result(&env, FE_OVERFLOW | FE_UNDERFLOW | FE_DIVBYZERO)) 184 return make_result(&env, result); 185 186 /* Restore state, raise exception. */ 187 if (test_env(&env, FE_OVERFLOW)) 188 __raise_overflow_error(); 189 if (test_env(&env, FE_UNDERFLOW)) 190 __raise_underflow_error(); 191 if (test_env(&env, FE_DIVBYZERO)) 192 __raise_zero_division_error(); 193 return __NULL; 194 } 195 196 __attr __fn_native_float_float_mod(__attr __self, __attr self, __attr other) 197 { 198 /* self and other interpreted as float */ 199 double i = __TOFLOAT(self); 200 double j = __TOFLOAT(other); 201 double result; 202 203 /* Preserve environment, clear exception state. */ 204 fenv_t env; 205 init_env(&env, FE_OVERFLOW | FE_DIVBYZERO); 206 207 result = fmod(i, j); 208 209 /* Test for result, restore state, return the new float. */ 210 if (have_result(&env, FE_OVERFLOW | FE_DIVBYZERO)) 211 return make_result(&env, result); 212 213 /* Restore state, raise exception. */ 214 if (test_env(&env, FE_OVERFLOW)) 215 __raise_overflow_error(); 216 if (test_env(&env, FE_DIVBYZERO)) 217 __raise_zero_division_error(); 218 return __NULL; 219 } 220 221 __attr __fn_native_float_float_neg(__attr __self, __attr self) 222 { 223 /* self interpreted as float */ 224 double i = __TOFLOAT(self); 225 double result; 226 227 /* Preserve environment, clear exception state. */ 228 fenv_t env; 229 init_env(&env, FE_OVERFLOW); 230 231 result = -i; 232 233 /* Test for result, restore state, return the new float. */ 234 if (have_result(&env, FE_OVERFLOW)) 235 return make_result(&env, result); 236 237 /* Restore state, raise exception. */ 238 if (test_env(&env, FE_OVERFLOW)) 239 __raise_overflow_error(); 240 return __NULL; 241 } 242 243 __attr __fn_native_float_float_pow(__attr __self, __attr self, __attr other) 244 { 245 /* self and other interpreted as float */ 246 double i = __TOFLOAT(self); 247 double j = __TOFLOAT(other); 248 double result; 249 250 errno = 0; 251 result = pow(i, j); 252 253 /* Test for overflow. */ 254 255 if (errno == ERANGE) 256 __raise_overflow_error(); 257 258 /* Return the result. */ 259 return __new_float(result); 260 } 261 262 __attr __fn_native_float_float_le(__attr __self, __attr self, __attr other) 263 { 264 /* self and other interpreted as float */ 265 double i = __TOFLOAT(self); 266 double j = __TOFLOAT(other); 267 268 /* Return a boolean result. */ 269 return i <= j ? __builtins___boolean_True : __builtins___boolean_False; 270 } 271 272 __attr __fn_native_float_float_lt(__attr __self, __attr self, __attr other) 273 { 274 /* self and other interpreted as float */ 275 double i = __TOFLOAT(self); 276 double j = __TOFLOAT(other); 277 278 /* Return a boolean result. */ 279 return i < j ? __builtins___boolean_True : __builtins___boolean_False; 280 } 281 282 __attr __fn_native_float_float_ge(__attr __self, __attr self, __attr other) 283 { 284 /* self and other interpreted as float */ 285 double i = __TOFLOAT(self); 286 double j = __TOFLOAT(other); 287 288 /* Return a boolean result. */ 289 return i >= j ? __builtins___boolean_True : __builtins___boolean_False; 290 } 291 292 __attr __fn_native_float_float_gt(__attr __self, __attr self, __attr other) 293 { 294 /* self and other interpreted as float */ 295 double i = __TOFLOAT(self); 296 double j = __TOFLOAT(other); 297 298 /* Return a boolean result. */ 299 return i > j ? __builtins___boolean_True : __builtins___boolean_False; 300 } 301 302 __attr __fn_native_float_float_eq(__attr __self, __attr self, __attr other) 303 { 304 /* self and other interpreted as float */ 305 double i = __TOFLOAT(self); 306 double j = __TOFLOAT(other); 307 308 /* Return a boolean result. */ 309 return i == j ? __builtins___boolean_True : __builtins___boolean_False; 310 } 311 312 __attr __fn_native_float_float_ne(__attr __self, __attr self, __attr other) 313 { 314 /* self and other interpreted as float */ 315 double i = __TOFLOAT(self); 316 double j = __TOFLOAT(other); 317 318 /* Return a boolean result. */ 319 return i != j ? __builtins___boolean_True : __builtins___boolean_False; 320 } 321 322 __attr __fn_native_float_float_str(__attr __self, __attr self) 323 { 324 /* self interpreted as float */ 325 double i = __TOFLOAT(self); 326 327 /* Return a new string. */ 328 return format_number(i, 64); 329 } 330 331 __attr __fn_native_float_float_int(__attr __self, __attr self) 332 { 333 /* self interpreted as float */ 334 double i = __TOFLOAT(self); 335 336 /* NOTE: Test for conversion failure. */ 337 return __new_int((int) i); 338 } 339 340 /* Module initialisation. */ 341 342 void __main_native_float() 343 { 344 }