Lichen

Annotated templates/native/float.c

919:326570523de5
2021-06-22 Paul Boddie Merged changes from the default branch. trailing-data
paul@850 1
/* Native functions for floating point operations.
paul@850 2
paul@871 3
Copyright (C) 2016, 2017, 2018, 2019 Paul Boddie <paul@boddie.org.uk>
paul@850 4
paul@850 5
This program is free software; you can redistribute it and/or modify it under
paul@850 6
the terms of the GNU General Public License as published by the Free Software
paul@850 7
Foundation; either version 3 of the License, or (at your option) any later
paul@850 8
version.
paul@850 9
paul@850 10
This program is distributed in the hope that it will be useful, but WITHOUT
paul@850 11
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
paul@850 12
FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
paul@850 13
details.
paul@850 14
paul@850 15
You should have received a copy of the GNU General Public License along with
paul@850 16
this program.  If not, see <http://www.gnu.org/licenses/>.
paul@850 17
*/
paul@850 18
paul@850 19
#include <math.h>   /* pow */
paul@850 20
#include <stdio.h>  /* snprintf */
paul@850 21
#include <errno.h>  /* errno */
paul@850 22
#include "native/common.h"
paul@850 23
#include "types.h"
paul@850 24
#include "exceptions.h"
paul@850 25
#include "ops.h"
paul@850 26
#include "progconsts.h"
paul@850 27
#include "progops.h"
paul@850 28
#include "progtypes.h"
paul@850 29
#include "main.h"
paul@850 30
paul@871 31
/* Conversion of trailing data to a double-precision floating point number. */
paul@850 32
paul@850 33
static double __TOFLOAT(__attr attr)
paul@850 34
{
paul@850 35
    return __get_trailing_data(attr, __builtins___float_float);
paul@850 36
}
paul@850 37
paul@850 38
/* Numeric formatting using snprintf.
paul@850 39
   NOTE: This might be moved elsewhere and used by other types. */
paul@850 40
paul@850 41
static __attr format_number(double n, int size)
paul@850 42
{
paul@850 43
    char *s = (char *) __ALLOCATE(size, sizeof(char));
paul@850 44
    int digits;
paul@850 45
paul@850 46
    /* Allocation should raise a memory error if it fails, so this loop should
paul@850 47
       terminate via the return statement or an allocation failure. */
paul@850 48
paul@850 49
    while (1)
paul@850 50
    {
paul@850 51
        digits = snprintf(s, size, "%f", n);
paul@850 52
paul@850 53
        if (digits < size)
paul@850 54
        {
paul@850 55
            s = (char *) __REALLOCATE(s, (digits + 1) * sizeof(char));
paul@850 56
            return __new_str(s, digits);
paul@850 57
        }
paul@850 58
paul@850 59
        size = digits + 1;
paul@850 60
        s = (char *) __REALLOCATE(s, size * sizeof(char));
paul@850 61
    }
paul@850 62
paul@850 63
    return __NULL;
paul@850 64
}
paul@850 65
paul@879 66
/* Floating point operations. Exceptions are raised in the signal handler. */
paul@850 67
paul@850 68
__attr __fn_native_float_float_add(__attr __self, __attr self, __attr other)
paul@850 69
{
paul@850 70
    /* self and other interpreted as float */
paul@850 71
    double i = __TOFLOAT(self);
paul@850 72
    double j = __TOFLOAT(other);
paul@879 73
    return __new_float(i + j);
paul@850 74
}
paul@850 75
paul@850 76
__attr __fn_native_float_float_sub(__attr __self, __attr self, __attr other)
paul@850 77
{
paul@850 78
    /* self and other interpreted as float */
paul@850 79
    double i = __TOFLOAT(self);
paul@850 80
    double j = __TOFLOAT(other);
paul@879 81
    return __new_float(i - j);
paul@850 82
}
paul@850 83
paul@850 84
__attr __fn_native_float_float_mul(__attr __self, __attr self, __attr other)
paul@850 85
{
paul@850 86
    /* self and other interpreted as float */
paul@850 87
    double i = __TOFLOAT(self);
paul@850 88
    double j = __TOFLOAT(other);
paul@879 89
    return __new_float(i * j);
paul@850 90
}
paul@850 91
paul@850 92
__attr __fn_native_float_float_div(__attr __self, __attr self, __attr other)
paul@850 93
{
paul@850 94
    /* self and other interpreted as float */
paul@850 95
    double i = __TOFLOAT(self);
paul@850 96
    double j = __TOFLOAT(other);
paul@879 97
    return __new_float(i / j);
paul@850 98
}
paul@850 99
paul@850 100
__attr __fn_native_float_float_mod(__attr __self, __attr self, __attr other)
paul@850 101
{
paul@850 102
    /* self and other interpreted as float */
paul@850 103
    double i = __TOFLOAT(self);
paul@850 104
    double j = __TOFLOAT(other);
paul@879 105
    return __new_float(fmod(i, j));
paul@850 106
}
paul@850 107
paul@850 108
__attr __fn_native_float_float_neg(__attr __self, __attr self)
paul@850 109
{
paul@850 110
    /* self interpreted as float */
paul@850 111
    double i = __TOFLOAT(self);
paul@879 112
    return __new_float(-i);
paul@850 113
}
paul@850 114
paul@850 115
__attr __fn_native_float_float_pow(__attr __self, __attr self, __attr other)
paul@850 116
{
paul@850 117
    /* self and other interpreted as float */
paul@850 118
    double i = __TOFLOAT(self);
paul@850 119
    double j = __TOFLOAT(other);
paul@850 120
    double result;
paul@850 121
paul@850 122
    errno = 0;
paul@850 123
    result = pow(i, j);
paul@850 124
paul@850 125
    /* Test for overflow. */
paul@850 126
paul@850 127
    if (errno == ERANGE)
paul@850 128
        __raise_overflow_error();
paul@850 129
paul@850 130
    /* Return the result. */
paul@850 131
    return __new_float(result);
paul@850 132
}
paul@850 133
paul@850 134
__attr __fn_native_float_float_le(__attr __self, __attr self, __attr other)
paul@850 135
{
paul@850 136
    /* self and other interpreted as float */
paul@850 137
    double i = __TOFLOAT(self);
paul@850 138
    double j = __TOFLOAT(other);
paul@850 139
paul@850 140
    /* Return a boolean result. */
paul@850 141
    return i <= j ? __builtins___boolean_True : __builtins___boolean_False;
paul@850 142
}
paul@850 143
paul@850 144
__attr __fn_native_float_float_lt(__attr __self, __attr self, __attr other)
paul@850 145
{
paul@850 146
    /* self and other interpreted as float */
paul@850 147
    double i = __TOFLOAT(self);
paul@850 148
    double j = __TOFLOAT(other);
paul@850 149
paul@850 150
    /* Return a boolean result. */
paul@850 151
    return i < j ? __builtins___boolean_True : __builtins___boolean_False;
paul@850 152
}
paul@850 153
paul@850 154
__attr __fn_native_float_float_ge(__attr __self, __attr self, __attr other)
paul@850 155
{
paul@850 156
    /* self and other interpreted as float */
paul@850 157
    double i = __TOFLOAT(self);
paul@850 158
    double j = __TOFLOAT(other);
paul@850 159
paul@850 160
    /* Return a boolean result. */
paul@850 161
    return i >= j ? __builtins___boolean_True : __builtins___boolean_False;
paul@850 162
}
paul@850 163
paul@850 164
__attr __fn_native_float_float_gt(__attr __self, __attr self, __attr other)
paul@850 165
{
paul@850 166
    /* self and other interpreted as float */
paul@850 167
    double i = __TOFLOAT(self);
paul@850 168
    double j = __TOFLOAT(other);
paul@850 169
paul@850 170
    /* Return a boolean result. */
paul@850 171
    return i > j ? __builtins___boolean_True : __builtins___boolean_False;
paul@850 172
}
paul@850 173
paul@850 174
__attr __fn_native_float_float_eq(__attr __self, __attr self, __attr other)
paul@850 175
{
paul@850 176
    /* self and other interpreted as float */
paul@850 177
    double i = __TOFLOAT(self);
paul@850 178
    double j = __TOFLOAT(other);
paul@850 179
paul@850 180
    /* Return a boolean result. */
paul@850 181
    return i == j ? __builtins___boolean_True : __builtins___boolean_False;
paul@850 182
}
paul@850 183
paul@850 184
__attr __fn_native_float_float_ne(__attr __self, __attr self, __attr other)
paul@850 185
{
paul@850 186
    /* self and other interpreted as float */
paul@850 187
    double i = __TOFLOAT(self);
paul@850 188
    double j = __TOFLOAT(other);
paul@850 189
paul@850 190
    /* Return a boolean result. */
paul@850 191
    return i != j ? __builtins___boolean_True : __builtins___boolean_False;
paul@850 192
}
paul@850 193
paul@850 194
__attr __fn_native_float_float_str(__attr __self, __attr self)
paul@850 195
{
paul@850 196
    /* self interpreted as float */
paul@850 197
    double i = __TOFLOAT(self);
paul@850 198
paul@850 199
    /* Return a new string. */
paul@850 200
    return format_number(i, 64);
paul@850 201
}
paul@850 202
paul@850 203
__attr __fn_native_float_float_int(__attr __self, __attr self)
paul@850 204
{
paul@850 205
    /* self interpreted as float */
paul@850 206
    double i = __TOFLOAT(self);
paul@850 207
paul@850 208
    /* NOTE: Test for conversion failure. */
paul@850 209
    return __new_int((int) i);
paul@850 210
}
paul@850 211
paul@850 212
/* Module initialisation. */
paul@850 213
paul@850 214
void __main_native_float()
paul@850 215
{
paul@850 216
}