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 <setjmp.h> 20 #include <signal.h> 21 #include <math.h> /* pow */ 22 #include <stdio.h> /* snprintf */ 23 #include <errno.h> /* errno */ 24 #include "native/common.h" 25 #include "types.h" 26 #include "exceptions.h" 27 #include "ops.h" 28 #include "progconsts.h" 29 #include "progops.h" 30 #include "progtypes.h" 31 #include "main.h" 32 33 /* Conversion of trailing data to a double-precision floating point number. */ 34 35 static double __TOFLOAT(__attr attr) 36 { 37 return __get_trailing_data(attr, __builtins___float_float); 38 } 39 40 /* Numeric formatting using snprintf. 41 NOTE: This might be moved elsewhere and used by other types. */ 42 43 static __attr format_number(double n, int size) 44 { 45 char *s = (char *) __ALLOCATE(size, sizeof(char)); 46 int digits; 47 48 /* Allocation should raise a memory error if it fails, so this loop should 49 terminate via the return statement or an allocation failure. */ 50 51 while (1) 52 { 53 digits = snprintf(s, size, "%f", n); 54 55 if (digits < size) 56 { 57 s = (char *) __REALLOCATE(s, (digits + 1) * sizeof(char)); 58 return __new_str(s, digits); 59 } 60 61 size = digits + 1; 62 s = (char *) __REALLOCATE(s, size * sizeof(char)); 63 } 64 65 return __NULL; 66 } 67 68 /* Floating point exception handling. */ 69 70 extern jmp_buf __fpe_env; 71 72 /* Floating point operations. */ 73 74 __attr __fn_native_float_float_add(__attr __self, __attr self, __attr other) 75 { 76 /* self and other interpreted as float */ 77 double i = __TOFLOAT(self); 78 double j = __TOFLOAT(other); 79 int signum; 80 81 /* Perform the operation while handling exceptions. */ 82 signum = setjmp(__fpe_env); 83 if (!signum) 84 return __new_float(i + j); 85 86 /* Exception occurred. */ 87 if (signum == FPE_FLTOVF) 88 __raise_overflow_error(); 89 90 return __NULL; 91 } 92 93 __attr __fn_native_float_float_sub(__attr __self, __attr self, __attr other) 94 { 95 /* self and other interpreted as float */ 96 double i = __TOFLOAT(self); 97 double j = __TOFLOAT(other); 98 int signum; 99 100 /* Perform the operation while handling exceptions. */ 101 signum = setjmp(__fpe_env); 102 if (!signum) 103 return __new_float(i - j); 104 105 /* Exception occurred. */ 106 if (signum == FPE_FLTOVF) 107 __raise_overflow_error(); 108 109 return __NULL; 110 } 111 112 __attr __fn_native_float_float_mul(__attr __self, __attr self, __attr other) 113 { 114 /* self and other interpreted as float */ 115 double i = __TOFLOAT(self); 116 double j = __TOFLOAT(other); 117 int signum; 118 119 /* Perform the operation while handling exceptions. */ 120 signum = setjmp(__fpe_env); 121 if (!signum) 122 return __new_float(i * j); 123 124 /* Exception occurred. */ 125 if (signum == FPE_FLTOVF) 126 __raise_overflow_error(); 127 else if (signum == FPE_FLTUND) 128 __raise_underflow_error(); 129 130 return __NULL; 131 } 132 133 __attr __fn_native_float_float_div(__attr __self, __attr self, __attr other) 134 { 135 /* self and other interpreted as float */ 136 double i = __TOFLOAT(self); 137 double j = __TOFLOAT(other); 138 int signum; 139 140 /* Perform the operation while handling exceptions. */ 141 signum = setjmp(__fpe_env); 142 if (!signum) 143 return __new_float(i / j); 144 145 /* Exception occurred. */ 146 if (signum == FPE_FLTOVF) 147 __raise_overflow_error(); 148 else if (signum == FPE_FLTUND) 149 __raise_underflow_error(); 150 else if (signum == FPE_FLTDIV) 151 __raise_zero_division_error(); 152 153 return __NULL; 154 } 155 156 __attr __fn_native_float_float_mod(__attr __self, __attr self, __attr other) 157 { 158 /* self and other interpreted as float */ 159 double i = __TOFLOAT(self); 160 double j = __TOFLOAT(other); 161 int signum; 162 163 /* Perform the operation while handling exceptions. */ 164 signum = setjmp(__fpe_env); 165 if (!signum) 166 return __new_float(fmod(i, j)); 167 168 /* Exception occurred. */ 169 if (signum == FPE_FLTOVF) 170 __raise_overflow_error(); 171 else if (signum == FPE_FLTDIV) 172 __raise_zero_division_error(); 173 174 return __NULL; 175 } 176 177 __attr __fn_native_float_float_neg(__attr __self, __attr self) 178 { 179 /* self interpreted as float */ 180 double i = __TOFLOAT(self); 181 int signum; 182 183 /* Perform the operation while handling exceptions. */ 184 signum = setjmp(__fpe_env); 185 if (!signum) 186 return __new_float(-i); 187 188 /* Exception occurred. */ 189 if (signum == FPE_FLTOVF) 190 __raise_overflow_error(); 191 192 return __NULL; 193 } 194 195 __attr __fn_native_float_float_pow(__attr __self, __attr self, __attr other) 196 { 197 /* self and other interpreted as float */ 198 double i = __TOFLOAT(self); 199 double j = __TOFLOAT(other); 200 double result; 201 202 errno = 0; 203 result = pow(i, j); 204 205 /* Test for overflow. */ 206 207 if (errno == ERANGE) 208 __raise_overflow_error(); 209 210 /* Return the result. */ 211 return __new_float(result); 212 } 213 214 __attr __fn_native_float_float_le(__attr __self, __attr self, __attr other) 215 { 216 /* self and other interpreted as float */ 217 double i = __TOFLOAT(self); 218 double j = __TOFLOAT(other); 219 220 /* Return a boolean result. */ 221 return i <= j ? __builtins___boolean_True : __builtins___boolean_False; 222 } 223 224 __attr __fn_native_float_float_lt(__attr __self, __attr self, __attr other) 225 { 226 /* self and other interpreted as float */ 227 double i = __TOFLOAT(self); 228 double j = __TOFLOAT(other); 229 230 /* Return a boolean result. */ 231 return i < j ? __builtins___boolean_True : __builtins___boolean_False; 232 } 233 234 __attr __fn_native_float_float_ge(__attr __self, __attr self, __attr other) 235 { 236 /* self and other interpreted as float */ 237 double i = __TOFLOAT(self); 238 double j = __TOFLOAT(other); 239 240 /* Return a boolean result. */ 241 return i >= j ? __builtins___boolean_True : __builtins___boolean_False; 242 } 243 244 __attr __fn_native_float_float_gt(__attr __self, __attr self, __attr other) 245 { 246 /* self and other interpreted as float */ 247 double i = __TOFLOAT(self); 248 double j = __TOFLOAT(other); 249 250 /* Return a boolean result. */ 251 return i > j ? __builtins___boolean_True : __builtins___boolean_False; 252 } 253 254 __attr __fn_native_float_float_eq(__attr __self, __attr self, __attr other) 255 { 256 /* self and other interpreted as float */ 257 double i = __TOFLOAT(self); 258 double j = __TOFLOAT(other); 259 260 /* Return a boolean result. */ 261 return i == j ? __builtins___boolean_True : __builtins___boolean_False; 262 } 263 264 __attr __fn_native_float_float_ne(__attr __self, __attr self, __attr other) 265 { 266 /* self and other interpreted as float */ 267 double i = __TOFLOAT(self); 268 double j = __TOFLOAT(other); 269 270 /* Return a boolean result. */ 271 return i != j ? __builtins___boolean_True : __builtins___boolean_False; 272 } 273 274 __attr __fn_native_float_float_str(__attr __self, __attr self) 275 { 276 /* self interpreted as float */ 277 double i = __TOFLOAT(self); 278 279 /* Return a new string. */ 280 return format_number(i, 64); 281 } 282 283 __attr __fn_native_float_float_int(__attr __self, __attr self) 284 { 285 /* self interpreted as float */ 286 double i = __TOFLOAT(self); 287 288 /* NOTE: Test for conversion failure. */ 289 return __new_int((int) i); 290 } 291 292 /* Module initialisation. */ 293 294 void __main_native_float() 295 { 296 }