Lichen

Annotated templates/native.c

347:17317598efd2
344:5f24a4b9d16a
343:e0879c83a439
2016-12-08 Paul Boddie file changeset files shortlog Added comments and copyright and licensing information.
paul@344 1 
/* Native functions.
paul@344 2 
 
 paul@344      3 
Copyright (C) 2016 Paul Boddie <paul@boddie.org.uk>
 
 paul@344      4 
 
 paul@344      5 
This program is free software; you can redistribute it and/or modify it under
 
 paul@344      6 
the terms of the GNU General Public License as published by the Free Software
 
 paul@344      7 
Foundation; either version 3 of the License, or (at your option) any later
 
 paul@344      8 
version.
 
 paul@344      9 
 
 paul@344     10 
This program is distributed in the hope that it will be useful, but WITHOUT
 
 paul@344     11 
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 
 paul@344     12 
FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
 
 paul@344     13 
details.
 
 paul@344     14 
 
 paul@344     15 
You should have received a copy of the GNU General Public License along with
 
 paul@344     16 
this program.  If not, see <http://www.gnu.org/licenses/>.
 
 paul@344     17 
*/
 
 paul@344     18 
 
 paul@293     19 
#include <stdlib.h> /* abs, exit */
 
 paul@173     20 
#include <unistd.h> /* read, write */
 
 paul@306     21 
#include <limits.h> /* INT_MAX, INT_MIN */
 
 paul@198     22 
#include <math.h>   /* ceil, log10, pow */
 
 paul@209     23 
#include <string.h> /* strcmp, strncpy, strlen */
 
 paul@328     24 
#include <stdio.h>  /* fdopen, snprintf */
 
 paul@306     25 
#include <errno.h>  /* errno */
 
 paul@161     26 
#include "types.h"
 
 paul@161     27 
#include "exceptions.h"
 
 paul@161     28 
#include "ops.h"
 
 paul@161     29 
#include "progconsts.h"
 
 paul@161     30 
#include "progops.h"
 
 paul@161     31 
#include "progtypes.h"
 
 paul@161     32 
#include "main.h"
 
 paul@161     33 
 
 paul@198     34 
/* Utility functions. */
 
 paul@198     35 
 
 paul@231     36 
static __attr __new_int(int i)
 
 paul@198     37 
{
 
 paul@198     38 
    /* Create a new integer and mutate the __data__ attribute. */
 
 paul@198     39 
    __attr attr = __new(&__InstanceTable___builtins___int_int, &__builtins___int_int, sizeof(__obj___builtins___int_int));
 
 paul@198     40 
    attr.value->attrs[__pos___data__].intvalue = i;
 
 paul@198     41 
    return attr;
 
 paul@198     42 
}
 
 paul@198     43 
 
 paul@231     44 
static __attr __new_str(char *s)
 
 paul@198     45 
{
 
 paul@198     46 
    /* Create a new string and mutate the __data__ attribute. */
 
 paul@198     47 
    __attr attr = __new(&__InstanceTable___builtins___str_string, &__builtins___str_string, sizeof(__obj___builtins___str_string));
 
 paul@198     48 
    attr.value->attrs[__pos___data__].strvalue = s;
 
 paul@198     49 
    return attr;
 
 paul@198     50 
}
 
 paul@198     51 
 
 paul@283     52 
static __attr __new_list(__fragment *f)
 
 paul@283     53 
{
 
 paul@283     54 
    /* Create a new list and mutate the __data__ attribute. */
 
 paul@283     55 
    __attr attr = __new(&__InstanceTable___builtins___list_list, &__builtins___list_list, sizeof(__obj___builtins___list_list));
 
 paul@283     56 
    attr.value->attrs[__pos___data__].seqvalue = f;
 
 paul@283     57 
    return attr;
 
 paul@283     58 
}
 
 paul@283     59 
 
 paul@283     60 
static __fragment *__fragment_append(__fragment *data, __attr * const value)
 
 paul@283     61 
{
 
 paul@283     62 
    __fragment *newdata = data;
 
 paul@283     63 
    unsigned int size = data->size, capacity = data->capacity;
 
 paul@283     64 
    unsigned int n;
 
 paul@283     65 
 
 paul@283     66 
    /* Re-allocate the fragment if the capacity has been reached. */
 
 paul@283     67 
    if (size >= capacity)
 
 paul@283     68 
    {
 
 paul@283     69 
        /* NOTE: Consider various restrictions on capacity increases. */
 
 paul@283     70 
        n = capacity ? capacity * 2 : 1;
 
 paul@283     71 
        newdata = (__fragment *) __REALLOCATE(data, __FRAGMENT_SIZE(n));
 
 paul@283     72 
        newdata->capacity = n;
 
 paul@283     73 
    }
 
 paul@283     74 
 
 paul@283     75 
    /* Insert the new element and increment the list size. */
 
 paul@283     76 
    newdata->attrs[size] = *value;
 
 paul@283     77 
    newdata->size = size + 1;
 
 paul@283     78 
 
 paul@283     79 
    return newdata;
 
 paul@283     80 
}
 
 paul@283     81 
 
 paul@344     82 
/* Environment support. */
 
 paul@167     83 
 
 paul@167     84 
__attr __fn_native__exit(__attr __args[])
 
 paul@167     85 
{
 
 paul@208     86 
    __attr * const status = &__args[1];
 
 paul@167     87 
 
 paul@208     88 
    exit(__load_via_object(status->value, __pos___data__).intvalue);
 
 paul@167     89 
    return __builtins___none_None;
 
 paul@167     90 
}
 
 paul@167     91 
 
 paul@182     92 
__attr __fn_native__get_argv(__attr __args[])
 
 paul@182     93 
{
 
 paul@208     94 
    __attr * const status = &__args[1];
 
 paul@182     95 
 
 paul@182     96 
    /* NOTE: To be written. */
 
 paul@182     97 
    return __builtins___none_None;
 
 paul@182     98 
}
 
 paul@182     99 
 
 paul@182    100 
__attr __fn_native__get_path(__attr __args[])
 
 paul@182    101 
{
 
 paul@208    102 
    __attr * const status = &__args[1];
 
 paul@182    103 
 
 paul@182    104 
    /* NOTE: To be written. */
 
 paul@182    105 
    return __builtins___none_None;
 
 paul@182    106 
}
 
 paul@182    107 
 
 paul@344    108 
/* Identity testing. */
 
 paul@344    109 
 
 paul@161    110 
__attr __fn_native__is(__attr __args[])
 
 paul@161    111 
{
 
 paul@208    112 
    __attr * const x = &__args[1];
 
 paul@208    113 
    __attr * const y = &__args[2];
 
 paul@161    114 
 
 paul@208    115 
    return x->value == y->value ? __builtins___boolean_True : __builtins___boolean_False;
 
 paul@161    116 
}
 
 paul@161    117 
 
 paul@161    118 
__attr __fn_native__is_not(__attr __args[])
 
 paul@161    119 
{
 
 paul@208    120 
    __attr * const x = &__args[1];
 
 paul@208    121 
    __attr * const y = &__args[2];
 
 paul@161    122 
 
 paul@208    123 
    return x->value != y->value ? __builtins___boolean_True : __builtins___boolean_False;
 
 paul@161    124 
}
 
 paul@161    125 
 
 paul@344    126 
/* Limit definition. */
 
 paul@344    127 
 
 paul@309    128 
__attr __fn_native__get_maxint(__attr __args[])
 
 paul@309    129 
{
 
 paul@309    130 
    __attr * const status = &__args[1];
 
 paul@309    131 
 
 paul@309    132 
    return __new_int(INT_MAX);
 
 paul@309    133 
}
 
 paul@309    134 
 
 paul@309    135 
__attr __fn_native__get_minint(__attr __args[])
 
 paul@309    136 
{
 
 paul@309    137 
    __attr * const status = &__args[1];
 
 paul@309    138 
 
 paul@309    139 
    return __new_int(INT_MIN);
 
 paul@309    140 
}
 
 paul@309    141 
 
 paul@344    142 
/* Integer operations. */
 
 paul@344    143 
 
 paul@161    144 
__attr __fn_native__int_add(__attr __args[])
 
 paul@161    145 
{
 
 paul@303    146 
    __attr * const _data = &__args[1];
 
 paul@208    147 
    __attr * const other = &__args[2];
 
 paul@303    148 
    /* _data and other interpreted as int */
 
 paul@303    149 
    int i = _data->intvalue;
 
 paul@303    150 
    int j = other->intvalue;
 
 paul@161    151 
 
 paul@306    152 
    /* Test for overflow. */
 
 paul@306    153 
    if (((i > 0) && (j > 0) && (i > INT_MAX - j)) ||
 
 paul@306    154 
        ((i < 0) && (j < 0) && (i < INT_MIN - j)))
 
 paul@306    155 
 
 paul@306    156 
        __raise_overflow_error();
 
 paul@306    157 
 
 paul@198    158 
    /* Return the new integer. */
 
 paul@198    159 
    return __new_int(i + j);
 
 paul@161    160 
}
 
 paul@161    161 
 
 paul@161    162 
__attr __fn_native__int_sub(__attr __args[])
 
 paul@161    163 
{
 
 paul@303    164 
    __attr * const _data = &__args[1];
 
 paul@208    165 
    __attr * const other = &__args[2];
 
 paul@303    166 
    /* _data and other interpreted as int */
 
 paul@303    167 
    int i = _data->intvalue;
 
 paul@303    168 
    int j = other->intvalue;
 
 paul@161    169 
 
 paul@306    170 
    /* Test for overflow. */
 
 paul@306    171 
    if (((i < 0) && (j > 0) && (i < INT_MIN + j)) ||
 
 paul@306    172 
        ((i > 0) && (j < 0) && (i > INT_MAX + j)))
 
 paul@306    173 
 
 paul@306    174 
        __raise_overflow_error();
 
 paul@306    175 
 
 paul@198    176 
    /* Return the new integer. */
 
 paul@198    177 
    return __new_int(i - j);
 
 paul@161    178 
}
 
 paul@161    179 
 
 paul@161    180 
__attr __fn_native__int_mul(__attr __args[])
 
 paul@161    181 
{
 
 paul@303    182 
    __attr * const _data = &__args[1];
 
 paul@208    183 
    __attr * const other = &__args[2];
 
 paul@303    184 
    /* _data and other interpreted as int */
 
 paul@303    185 
    int i = _data->intvalue;
 
 paul@303    186 
    int j = other->intvalue;
 
 paul@161    187 
 
 paul@306    188 
    /* Test for overflow. */
 
 paul@306    189 
    if (((i > 0) && (j > 0) && (i > INT_MAX / j)) ||
 
 paul@306    190 
        ((i < 0) && (j < 0) && (i > INT_MAX / j)) ||
 
 paul@306    191 
        ((i < 0) && (j > 0) && (i < INT_MIN / j)) ||
 
 paul@306    192 
        ((i > 0) && (j < 0) && (j < INT_MIN / i)))
 
 paul@306    193 
 
 paul@306    194 
        __raise_overflow_error();
 
 paul@306    195 
 
 paul@198    196 
    /* Return the new integer. */
 
 paul@198    197 
    return __new_int(i * j);
 
 paul@161    198 
}
 
 paul@161    199 
 
 paul@161    200 
__attr __fn_native__int_div(__attr __args[])
 
 paul@161    201 
{
 
 paul@303    202 
    __attr * const _data = &__args[1];
 
 paul@208    203 
    __attr * const other = &__args[2];
 
 paul@303    204 
    /* _data and other interpreted as int */
 
 paul@303    205 
    int i = _data->intvalue;
 
 paul@303    206 
    int j = other->intvalue;
 
 paul@161    207 
 
 paul@306    208 
    /* Test for division by zero or overflow. */
 
 paul@306    209 
    if (j == 0)
 
 paul@306    210 
        __raise_zero_division_error();
 
 paul@306    211 
    else if ((j == -1) && (i == INT_MIN))
 
 paul@306    212 
        __raise_overflow_error();
 
 paul@306    213 
 
 paul@198    214 
    /* Return the new integer. */
 
 paul@198    215 
    return __new_int(i / j);
 
 paul@161    216 
}
 
 paul@161    217 
 
 paul@161    218 
__attr __fn_native__int_mod(__attr __args[])
 
 paul@161    219 
{
 
 paul@303    220 
    __attr * const _data = &__args[1];
 
 paul@208    221 
    __attr * const other = &__args[2];
 
 paul@303    222 
    /* _data and other interpreted as int */
 
 paul@303    223 
    int i = _data->intvalue;
 
 paul@303    224 
    int j = other->intvalue;
 
 paul@161    225 
 
 paul@306    226 
    /* Test for division by zero or overflow. */
 
 paul@306    227 
    if (j == 0)
 
 paul@306    228 
        __raise_zero_division_error();
 
 paul@306    229 
    else if ((j == -1) && (i == INT_MIN))
 
 paul@306    230 
        __raise_overflow_error();
 
 paul@306    231 
 
 paul@198    232 
    /* Return the new integer. */
 
 paul@198    233 
    return __new_int(i % j);
 
 paul@161    234 
}
 
 paul@161    235 
 
 paul@207    236 
__attr __fn_native__int_neg(__attr __args[])
 
 paul@207    237 
{
 
 paul@303    238 
    __attr * const _data = &__args[1];
 
 paul@303    239 
    /* _data interpreted as int */
 
 paul@303    240 
    int i = _data->intvalue;
 
 paul@207    241 
 
 paul@306    242 
    /* Test for overflow. */
 
 paul@306    243 
    if (i == INT_MIN)
 
 paul@306    244 
        __raise_overflow_error();
 
 paul@306    245 
 
 paul@207    246 
    /* Return the new integer. */
 
 paul@207    247 
    return __new_int(-i);
 
 paul@207    248 
}
 
 paul@207    249 
 
 paul@161    250 
__attr __fn_native__int_pow(__attr __args[])
 
 paul@161    251 
{
 
 paul@303    252 
    __attr * const _data = &__args[1];
 
 paul@208    253 
    __attr * const other = &__args[2];
 
 paul@303    254 
    /* _data and other interpreted as int */
 
 paul@303    255 
    int i = _data->intvalue;
 
 paul@303    256 
    int j = other->intvalue;
 
 paul@306    257 
    int k;
 
 paul@306    258 
 
 paul@306    259 
    errno = 0;
 
 paul@306    260 
    k = (int) pow(i, j);
 
 paul@306    261 
 
 paul@306    262 
    /* Test for overflow. */
 
 paul@306    263 
 
 paul@306    264 
    if (errno == ERANGE)
 
 paul@306    265 
        __raise_overflow_error();
 
 paul@161    266 
 
 paul@198    267 
    /* Return the new integer. */
 
 paul@306    268 
    return __new_int(k);
 
 paul@161    269 
}
 
 paul@161    270 
 
 paul@161    271 
__attr __fn_native__int_and(__attr __args[])
 
 paul@161    272 
{
 
 paul@303    273 
    __attr * const _data = &__args[1];
 
 paul@208    274 
    __attr * const other = &__args[2];
 
 paul@303    275 
    /* _data and other interpreted as int */
 
 paul@303    276 
    int i = _data->intvalue;
 
 paul@303    277 
    int j = other->intvalue;
 
 paul@161    278 
 
 paul@198    279 
    /* Return the new integer. */
 
 paul@198    280 
    /* NOTE: No overflow test applied. */
 
 paul@198    281 
    return __new_int(i & j);
 
 paul@161    282 
}
 
 paul@161    283 
 
 paul@307    284 
__attr __fn_native__int_not(__attr __args[])
 
 paul@307    285 
{
 
 paul@307    286 
    __attr * const _data = &__args[1];
 
 paul@307    287 
    /* _data interpreted as int */
 
 paul@307    288 
    int i = _data->intvalue;
 
 paul@307    289 
 
 paul@307    290 
    /* Return the new integer. */
 
 paul@307    291 
    return __new_int(~i);
 
 paul@307    292 
}
 
 paul@307    293 
 
 paul@161    294 
__attr __fn_native__int_or(__attr __args[])
 
 paul@161    295 
{
 
 paul@303    296 
    __attr * const _data = &__args[1];
 
 paul@208    297 
    __attr * const other = &__args[2];
 
 paul@303    298 
    /* _data and other interpreted as int */
 
 paul@303    299 
    int i = _data->intvalue;
 
 paul@303    300 
    int j = other->intvalue;
 
 paul@161    301 
 
 paul@198    302 
    /* Return the new integer. */
 
 paul@198    303 
    /* NOTE: No overflow test applied. */
 
 paul@198    304 
    return __new_int(i | j);
 
 paul@161    305 
}
 
 paul@161    306 
 
 paul@161    307 
__attr __fn_native__int_xor(__attr __args[])
 
 paul@161    308 
{
 
 paul@303    309 
    __attr * const _data = &__args[1];
 
 paul@208    310 
    __attr * const other = &__args[2];
 
 paul@303    311 
    /* _data and other interpreted as int */
 
 paul@303    312 
    int i = _data->intvalue;
 
 paul@303    313 
    int j = other->intvalue;
 
 paul@161    314 
 
 paul@198    315 
    /* Return the new integer. */
 
 paul@198    316 
    /* NOTE: No overflow test applied. */
 
 paul@198    317 
    return __new_int(i ^ j);
 
 paul@161    318 
}
 
 paul@161    319 
 
 paul@161    320 
__attr __fn_native__int_lt(__attr __args[])
 
 paul@161    321 
{
 
 paul@303    322 
    __attr * const _data = &__args[1];
 
 paul@208    323 
    __attr * const other = &__args[2];
 
 paul@303    324 
    /* _data and other interpreted as int */
 
 paul@303    325 
    int i = _data->intvalue;
 
 paul@303    326 
    int j = other->intvalue;
 
 paul@161    327 
 
 paul@198    328 
    /* Return a boolean result. */
 
 paul@198    329 
    return i < j ? __builtins___boolean_True : __builtins___boolean_False;
 
 paul@161    330 
}
 
 paul@161    331 
 
 paul@161    332 
__attr __fn_native__int_gt(__attr __args[])
 
 paul@161    333 
{
 
 paul@303    334 
    __attr * const _data = &__args[1];
 
 paul@208    335 
    __attr * const other = &__args[2];
 
 paul@303    336 
    /* _data and other interpreted as int */
 
 paul@303    337 
    int i = _data->intvalue;
 
 paul@303    338 
    int j = other->intvalue;
 
 paul@161    339 
 
 paul@198    340 
    /* Return a boolean result. */
 
 paul@198    341 
    return i > j ? __builtins___boolean_True : __builtins___boolean_False;
 
 paul@161    342 
}
 
 paul@161    343 
 
 paul@161    344 
__attr __fn_native__int_eq(__attr __args[])
 
 paul@161    345 
{
 
 paul@303    346 
    __attr * const _data = &__args[1];
 
 paul@208    347 
    __attr * const other = &__args[2];
 
 paul@303    348 
    /* _data and other interpreted as int */
 
 paul@303    349 
    int i = _data->intvalue;
 
 paul@303    350 
    int j = other->intvalue;
 
 paul@161    351 
 
 paul@198    352 
    /* Return a boolean result. */
 
 paul@198    353 
    return i == j ? __builtins___boolean_True : __builtins___boolean_False;
 
 paul@198    354 
}
 
 paul@198    355 
 
 paul@198    356 
__attr __fn_native__int_ne(__attr __args[])
 
 paul@198    357 
{
 
 paul@303    358 
    __attr * const _data = &__args[1];
 
 paul@208    359 
    __attr * const other = &__args[2];
 
 paul@303    360 
    /* _data and other interpreted as int */
 
 paul@303    361 
    int i = _data->intvalue;
 
 paul@303    362 
    int j = other->intvalue;
 
 paul@198    363 
 
 paul@198    364 
    /* Return a boolean result. */
 
 paul@198    365 
    return i != j ? __builtins___boolean_True : __builtins___boolean_False;
 
 paul@198    366 
}
 
 paul@198    367 
 
 paul@198    368 
__attr __fn_native__int_str(__attr __args[])
 
 paul@198    369 
{
 
 paul@303    370 
    __attr * const _data = &__args[1];
 
 paul@303    371 
    /* _data interpreted as int */
 
 paul@303    372 
    int i = _data->intvalue;
 
 paul@309    373 
    /* Employ a buffer big enough to fit the largest integer plus an extra
 
 paul@309    374 
       character, a minus sign, and the null terminator. */
 
 paul@309    375 
    unsigned int n = (int) log10(INT_MAX) + 3;
 
 paul@260    376 
    char *s = (char *) __ALLOCATE(n, sizeof(char));
 
 paul@198    377 
 
 paul@198    378 
    snprintf(s, n, "%d", i);
 
 paul@198    379 
 
 paul@198    380 
    /* Return a new string. */
 
 paul@198    381 
    return __new_str(s);
 
 paul@161    382 
}
 
 paul@161    383 
 
 paul@344    384 
/* String operations. */
 
 paul@344    385 
 
 paul@161    386 
__attr __fn_native__str_add(__attr __args[])
 
 paul@161    387 
{
 
 paul@303    388 
    __attr * const _data = &__args[1];
 
 paul@208    389 
    __attr * const other = &__args[2];
 
 paul@303    390 
    /* _data, other interpreted as string */
 
 paul@303    391 
    char *s = _data->strvalue;
 
 paul@303    392 
    char *o = other->strvalue;
 
 paul@198    393 
    int n = strlen(s) + strlen(o) + 1;
 
 paul@260    394 
    char *r = (char *) __ALLOCATE(n, sizeof(char));
 
 paul@161    395 
 
 paul@198    396 
    strncpy(r, s, n);
 
 paul@292    397 
    strncpy(r + strlen(s), o, n - strlen(s)); /* should null terminate */
 
 paul@198    398 
 
 paul@198    399 
    /* Return a new string. */
 
 paul@198    400 
    return __new_str(r);
 
 paul@161    401 
}
 
 paul@161    402 
 
 paul@161    403 
__attr __fn_native__str_lt(__attr __args[])
 
 paul@161    404 
{
 
 paul@303    405 
    __attr * const _data = &__args[1];
 
 paul@208    406 
    __attr * const other = &__args[2];
 
 paul@303    407 
    /* _data, other interpreted as string */
 
 paul@303    408 
    char *s = _data->strvalue;
 
 paul@303    409 
    char *o = other->strvalue;
 
 paul@161    410 
 
 paul@198    411 
    /* NOTE: Using simple byte-level string operations. */
 
 paul@198    412 
    return strcmp(s, o) < 0 ? __builtins___boolean_True : __builtins___boolean_False;
 
 paul@161    413 
}
 
 paul@161    414 
 
 paul@161    415 
__attr __fn_native__str_gt(__attr __args[])
 
 paul@161    416 
{
 
 paul@303    417 
    __attr * const _data = &__args[1];
 
 paul@208    418 
    __attr * const other = &__args[2];
 
 paul@303    419 
    /* _data, other interpreted as string */
 
 paul@303    420 
    char *s = _data->strvalue;
 
 paul@303    421 
    char *o = other->strvalue;
 
 paul@161    422 
 
 paul@198    423 
    /* NOTE: Using simple byte-level string operations. */
 
 paul@198    424 
    return strcmp(s, o) > 0 ? __builtins___boolean_True : __builtins___boolean_False;
 
 paul@161    425 
}
 
 paul@161    426 
 
 paul@161    427 
__attr __fn_native__str_eq(__attr __args[])
 
 paul@161    428 
{
 
 paul@303    429 
    __attr * const _data = &__args[1];
 
 paul@208    430 
    __attr * const other = &__args[2];
 
 paul@303    431 
    /* _data, other interpreted as string */
 
 paul@303    432 
    char *s = _data->strvalue;
 
 paul@303    433 
    char *o = other->strvalue;
 
 paul@161    434 
 
 paul@198    435 
    /* NOTE: Using simple byte-level string operations. */
 
 paul@198    436 
    return strcmp(s, o) == 0 ? __builtins___boolean_True : __builtins___boolean_False;
 
 paul@161    437 
}
 
 paul@161    438 
 
 paul@161    439 
__attr __fn_native__str_len(__attr __args[])
 
 paul@161    440 
{
 
 paul@303    441 
    __attr * const _data = &__args[1];
 
 paul@303    442 
    /* _data interpreted as string */
 
 paul@303    443 
    char *s = _data->strvalue;
 
 paul@161    444 
 
 paul@198    445 
    /* Return the new integer. */
 
 paul@198    446 
    return __new_int(strlen(s));
 
 paul@161    447 
}
 
 paul@161    448 
 
 paul@161    449 
__attr __fn_native__str_nonempty(__attr __args[])
 
 paul@161    450 
{
 
 paul@303    451 
    __attr * const _data = &__args[1];
 
 paul@303    452 
    /* _data interpreted as string */
 
 paul@303    453 
    char *s = _data->strvalue;
 
 paul@161    454 
 
 paul@198    455 
    return strlen(s) ? __builtins___boolean_True : __builtins___boolean_False;
 
 paul@161    456 
}
 
 paul@161    457 
 
 paul@296    458 
__attr __fn_native__str_ord(__attr __args[])
 
 paul@296    459 
{
 
 paul@303    460 
    __attr * const _data = &__args[1];
 
 paul@303    461 
    /* _data interpreted as string */
 
 paul@303    462 
    char *s = _data->strvalue;
 
 paul@296    463 
 
 paul@296    464 
    return __new_int((unsigned int) s[0]);
 
 paul@296    465 
}
 
 paul@296    466 
 
 paul@292    467 
__attr __fn_native__str_substr(__attr __args[])
 
 paul@292    468 
{
 
 paul@303    469 
    __attr * const _data = &__args[1];
 
 paul@292    470 
    __attr * const start = &__args[2];
 
 paul@292    471 
    __attr * const size = &__args[3];
 
 paul@303    472 
    /* _data interpreted as string */
 
 paul@303    473 
    char *s = _data->strvalue, *sub;
 
 paul@292    474 
    /* start.__data__ interpreted as int */
 
 paul@292    475 
    int i = __load_via_object(start->value, __pos___data__).intvalue;
 
 paul@292    476 
    /* size.__data__ interpreted as int */
 
 paul@292    477 
    int l = __load_via_object(size->value, __pos___data__).intvalue;
 
 paul@292    478 
 
 paul@292    479 
    /* Reserve space for a new string. */
 
 paul@292    480 
    sub = (char *) __ALLOCATE(l + 1, sizeof(char));
 
 paul@292    481 
    strncpy(sub, s + i, l); /* does not null terminate but final byte should be zero */
 
 paul@292    482 
    return __new_str(sub);
 
 paul@292    483 
}
 
 paul@292    484 
 
 paul@344    485 
/* List operations. */
 
 paul@344    486 
 
 paul@161    487 
__attr __fn_native__list_init(__attr __args[])
 
 paul@161    488 
{
 
 paul@208    489 
    __attr * const size = &__args[1];
 
 paul@208    490 
    /* size.__data__ interpreted as int */
 
 paul@208    491 
    unsigned int n = __load_via_object(size->value, __pos___data__).intvalue;
 
 paul@283    492 
    __attr attr = {0, .seqvalue=__new_fragment(n)};
 
 paul@206    493 
 
 paul@283    494 
    /* Return the __data__ attribute. */
 
 paul@161    495 
    return attr;
 
 paul@206    496 
}
 
 paul@206    497 
 
 paul@227    498 
__attr __fn_native__list_setsize(__attr __args[])
 
 paul@227    499 
{
 
 paul@303    500 
    __attr * const _data = &__args[1];
 
 paul@227    501 
    __attr * const size = &__args[2];
 
 paul@303    502 
    /* _data interpreted as list */
 
 paul@303    503 
    __fragment *data = _data->seqvalue;
 
 paul@227    504 
    /* size.__data__ interpreted as int */
 
 paul@227    505 
    unsigned int n = __load_via_object(size->value, __pos___data__).intvalue;
 
 paul@227    506 
 
 paul@227    507 
    data->size = n;
 
 paul@227    508 
    return __builtins___none_None;
 
 paul@227    509 
}
 
 paul@227    510 
 
 paul@206    511 
__attr __fn_native__list_append(__attr __args[])
 
 paul@206    512 
{
 
 paul@208    513 
    __attr * const self = &__args[1];
 
 paul@208    514 
    __attr * const value = &__args[2];
 
 paul@206    515 
    /* self.__data__ interpreted as list */
 
 paul@280    516 
    __fragment *data = __load_via_object(self->value, __pos___data__).seqvalue;
 
 paul@283    517 
    __fragment *newdata = __fragment_append(data, value);
 
 paul@215    518 
 
 paul@215    519 
    /* Replace the __data__ attribute if appropriate. */
 
 paul@215    520 
    if (newdata != data)
 
 paul@280    521 
        __store_via_object(self->value, __pos___data__, ((__attr) {0, .seqvalue=newdata}));
 
 paul@206    522 
    return __builtins___none_None;
 
 paul@206    523 
}
 
 paul@206    524 
 
 paul@206    525 
__attr __fn_native__list_concat(__attr __args[])
 
 paul@206    526 
{
 
 paul@208    527 
    __attr * const self = &__args[1];
 
 paul@215    528 
    __attr * const other = &__args[2];
 
 paul@303    529 
    /* self.__data__, other interpreted as list */
 
 paul@280    530 
    __fragment *data = __load_via_object(self->value, __pos___data__).seqvalue;
 
 paul@303    531 
    __fragment *other_data = other->seqvalue;
 
 paul@215    532 
    __fragment *newdata = data;
 
 paul@206    533 
    unsigned int size = data->size, capacity = data->capacity;
 
 paul@206    534 
    unsigned int other_size = other_data->size;
 
 paul@206    535 
    unsigned int i, j, n;
 
 paul@206    536 
 
 paul@206    537 
    /* Re-allocate the fragment if the capacity has been reached. */
 
 paul@206    538 
    if (size + other_size >= capacity)
 
 paul@206    539 
    {
 
 paul@206    540 
        n = size + other_size;
 
 paul@260    541 
        newdata = (__fragment *) __REALLOCATE(data, __FRAGMENT_SIZE(n));
 
 paul@215    542 
        newdata->capacity = n;
 
 paul@206    543 
    }
 
 paul@206    544 
 
 paul@206    545 
    /* Copy the elements from the other list and increment the list size. */
 
 paul@206    546 
    for (i = size, j = 0; j < other_size; i++, j++)
 
 paul@215    547 
        newdata->attrs[i] = other_data->attrs[j];
 
 paul@215    548 
    newdata->size = n;
 
 paul@215    549 
 
 paul@215    550 
    /* Replace the __data__ attribute if appropriate. */
 
 paul@215    551 
    if (newdata != data)
 
 paul@280    552 
        __store_via_object(self->value, __pos___data__, ((__attr) {0, .seqvalue=newdata}));
 
 paul@206    553 
    return __builtins___none_None;
 
 paul@161    554 
}
 
 paul@161    555 
 
 paul@161    556 
__attr __fn_native__list_len(__attr __args[])
 
 paul@161    557 
{
 
 paul@303    558 
    __attr * const _data = &__args[1];
 
 paul@303    559 
    /* _data interpreted as fragment */
 
 paul@303    560 
    unsigned int size = _data->seqvalue->size;
 
 paul@161    561 
 
 paul@182    562 
    /* Return the new integer. */
 
 paul@198    563 
    return __new_int(size);
 
 paul@161    564 
}
 
 paul@161    565 
 
 paul@161    566 
__attr __fn_native__list_nonempty(__attr __args[])
 
 paul@161    567 
{
 
 paul@303    568 
    __attr * const _data = &__args[1];
 
 paul@161    569 
 
 paul@303    570 
    return _data->seqvalue->size ? __builtins___boolean_True : __builtins___boolean_False;
 
 paul@161    571 
}
 
 paul@161    572 
 
 paul@161    573 
__attr __fn_native__list_element(__attr __args[])
 
 paul@161    574 
{
 
 paul@303    575 
    __attr * const _data = &__args[1];
 
 paul@208    576 
    __attr * const index = &__args[2];
 
 paul@303    577 
    /* _data interpreted as fragment */
 
 paul@303    578 
    __attr *elements = _data->seqvalue->attrs;
 
 paul@198    579 
    /* index.__data__ interpreted as int */
 
 paul@208    580 
    int i = __load_via_object(index->value, __pos___data__).intvalue;
 
 paul@161    581 
 
 paul@198    582 
    return elements[i];
 
 paul@161    583 
}
 
 paul@161    584 
 
 paul@227    585 
__attr __fn_native__list_setelement(__attr __args[])
 
 paul@161    586 
{
 
 paul@303    587 
    __attr * const _data = &__args[1];
 
 paul@227    588 
    __attr * const index = &__args[2];
 
 paul@227    589 
    __attr * const value = &__args[3];
 
 paul@303    590 
    /* _data interpreted as fragment */
 
 paul@303    591 
    __attr *elements = _data->seqvalue->attrs;
 
 paul@227    592 
    /* index.__data__ interpreted as int */
 
 paul@227    593 
    int i = __load_via_object(index->value, __pos___data__).intvalue;
 
 paul@161    594 
 
 paul@227    595 
    /* Set the element. */
 
 paul@227    596 
    elements[i] = *value;
 
 paul@161    597 
    return __builtins___none_None;
 
 paul@161    598 
}
 
 paul@161    599 
 
 paul@344    600 
/* Buffer operations. */
 
 paul@344    601 
 
 paul@206    602 
__attr __fn_native__buffer_str(__attr __args[])
 
 paul@206    603 
{
 
 paul@303    604 
    __attr * const _data = &__args[1];
 
 paul@303    605 
    /* _data interpreted as buffer */
 
 paul@303    606 
    __fragment *data = _data->seqvalue;
 
 paul@209    607 
    unsigned int size = 0, i, j, n;
 
 paul@209    608 
    char *s, *o;
 
 paul@206    609 
 
 paul@206    610 
    /* Calculate the size of the string. */
 
 paul@206    611 
    for (i = 0; i < data->size; i++)
 
 paul@253    612 
        size += strlen(__load_via_object(data->attrs[i].value, __pos___data__).strvalue);
 
 paul@206    613 
 
 paul@206    614 
    /* Reserve space for a new string. */
 
 paul@260    615 
    s = (char *) __ALLOCATE(size + 1, sizeof(char));
 
 paul@206    616 
 
 paul@206    617 
    /* Build a single string from the buffer contents. */
 
 paul@209    618 
    for (i = 0, j = 0; i < data->size; i++)
 
 paul@209    619 
    {
 
 paul@209    620 
        o = __load_via_object(data->attrs[i].value, __pos___data__).strvalue;
 
 paul@209    621 
        n = strlen(o);
 
 paul@292    622 
        strncpy(s + j, o, n); /* does not null terminate but final byte should be zero */
 
 paul@209    623 
        j += n;
 
 paul@209    624 
    }
 
 paul@206    625 
 
 paul@206    626 
    /* Return a new string. */
 
 paul@206    627 
    return __new_str(s);
 
 paul@206    628 
}
 
 paul@206    629 
 
 paul@344    630 
/* Method binding. */
 
 paul@344    631 
 
 paul@230    632 
__attr __fn_native__get_using(__attr __args[])
 
 paul@230    633 
{
 
 paul@230    634 
    __attr * const callable = &__args[1];
 
 paul@230    635 
    __attr * const instance = &__args[2];
 
 paul@230    636 
 
 paul@230    637 
    return __replace_context(instance->value, *callable);
 
 paul@230    638 
}
 
 paul@230    639 
 
 paul@344    640 
/* Introspection. */
 
 paul@344    641 
 
 paul@228    642 
__attr __fn_native__object_getattr(__attr __args[])
 
 paul@228    643 
{
 
 paul@228    644 
    __attr * const obj = &__args[1];
 
 paul@228    645 
    __attr * const name = &__args[2];
 
 paul@228    646 
    __attr * const _default = &__args[3];
 
 paul@228    647 
 
 paul@228    648 
    /* NOTE: To be written. */
 
 paul@228    649 
    return __builtins___none_None;
 
 paul@228    650 
}
 
 paul@228    651 
 
 paul@231    652 
static int __issubclass(__ref obj, __attr cls)
 
 paul@231    653 
{
 
 paul@231    654 
    return (__HASATTR(obj, __TYPEPOS(cls.value), __TYPECODE(cls.value)));
 
 paul@231    655 
}
 
 paul@231    656 
 
 paul@161    657 
__attr __fn_native__isinstance(__attr __args[])
 
 paul@161    658 
{
 
 paul@208    659 
    __attr * const obj = &__args[1];
 
 paul@208    660 
    __attr * const cls = &__args[2];
 
 paul@161    661 
 
 paul@231    662 
    /* cls must be a class. */
 
 paul@231    663 
    if (__is_instance(obj->value) && __issubclass(__get_class(obj->value), *cls))
 
 paul@231    664 
        return __builtins___boolean_True;
 
 paul@231    665 
    else
 
 paul@231    666 
        return __builtins___boolean_False;
 
 paul@231    667 
}
 
 paul@231    668 
 
 paul@231    669 
__attr __fn_native__issubclass(__attr __args[])
 
 paul@231    670 
{
 
 paul@231    671 
    __attr * const obj = &__args[1];
 
 paul@231    672 
    __attr * const cls = &__args[2];
 
 paul@231    673 
 
 paul@231    674 
    /* obj and cls must be classes. */
 
 paul@231    675 
    if (__issubclass(obj->value, *cls))
 
 paul@198    676 
        return __builtins___boolean_True;
 
 paul@161    677 
    else
 
 paul@198    678 
        return __builtins___boolean_False;
 
 paul@161    679 
}
 
 paul@161    680 
 
 paul@328    681 
/* Input/output. */
 
 paul@328    682 
 
 paul@328    683 
__attr __fn_native__fdopen(__attr __args[])
 
 paul@328    684 
{
 
 paul@328    685 
    __attr * const fd = &__args[1];
 
 paul@328    686 
    __attr * const mode = &__args[2];
 
 paul@328    687 
    /* fd.__data__ interpreted as int */
 
 paul@328    688 
    int i = __load_via_object(fd->value, __pos___data__).intvalue;
 
 paul@328    689 
    /* str.__data__ interpreted as string */
 
 paul@328    690 
    char *s = __load_via_object(mode->value, __pos___data__).strvalue;
 
 paul@328    691 
    FILE *f;
 
 paul@328    692 
    __attr attr;
 
 paul@328    693 
 
 paul@328    694 
    errno = 0;
 
 paul@328    695 
    f = fdopen(i, s);
 
 paul@328    696 
 
 paul@328    697 
    /* Produce an exception if the operation failed. */
 
 paul@328    698 
 
 paul@328    699 
    if (f == NULL)
 
 paul@331    700 
        __raise_io_error(__new_int(errno));
 
 paul@333    701 
 
 paul@333    702 
    /* Return the __data__ attribute. */
 
 paul@333    703 
 
 paul@328    704 
    else
 
 paul@328    705 
    {
 
 paul@328    706 
        attr.context = 0;
 
 paul@328    707 
        attr.datavalue = (void *) f;
 
 paul@328    708 
        return attr;
 
 paul@328    709 
    }
 
 paul@328    710 
}
 
 paul@328    711 
 
 paul@336    712 
__attr __fn_native__fread(__attr __args[])
 
 paul@336    713 
{
 
 paul@336    714 
    __attr * const fp = &__args[1];
 
 paul@336    715 
    __attr * const size = &__args[2];
 
 paul@336    716 
    /* fp interpreted as FILE reference */
 
 paul@336    717 
    FILE *f = (FILE *) fp->datavalue;
 
 paul@336    718 
    /* size.__data__ interpreted as int */
 
 paul@336    719 
    int to_read = __load_via_object(size->value, __pos___data__).intvalue;
 
 paul@336    720 
    char buf[to_read];
 
 paul@336    721 
    size_t have_read;
 
 paul@336    722 
    int error;
 
 paul@336    723 
    char *s;
 
 paul@336    724 
 
 paul@336    725 
    have_read = fread(buf, sizeof(char), to_read, f);
 
 paul@336    726 
 
 paul@336    727 
    if (have_read != to_read)
 
 paul@336    728 
    {
 
 paul@343    729 
        if (feof(f) && (have_read == 0))
 
 paul@336    730 
            __raise_eof_error();
 
 paul@336    731 
        else if (error = ferror(f))
 
 paul@336    732 
            __raise_io_error(__new_int(error));
 
 paul@336    733 
    }
 
 paul@336    734 
 
 paul@336    735 
    /* Reserve space for a new string. */
 
 paul@336    736 
 
 paul@336    737 
    s = __ALLOCATE(have_read + 1, sizeof(char));
 
 paul@336    738 
    strncpy(s, (char *) buf, have_read); /* does not null terminate but final byte should be zero */
 
 paul@336    739 
    return __new_str(s);
 
 paul@336    740 
}
 
 paul@336    741 
 
 paul@336    742 
__attr __fn_native__fwrite(__attr __args[])
 
 paul@336    743 
{
 
 paul@336    744 
    __attr * const fp = &__args[1];
 
 paul@336    745 
    __attr * const str = &__args[2];
 
 paul@336    746 
    /* fp interpreted as FILE reference */
 
 paul@336    747 
    FILE *f = (FILE *) fp->datavalue;
 
 paul@336    748 
    /* str.__data__ interpreted as string */
 
 paul@336    749 
    char *s = __load_via_object(str->value, __pos___data__).strvalue;
 
 paul@336    750 
    size_t to_write = strlen(s);
 
 paul@336    751 
    size_t have_written = fwrite(s, sizeof(char), to_write, f);
 
 paul@336    752 
    int error;
 
 paul@336    753 
 
 paul@336    754 
    if (have_written != to_write)
 
 paul@336    755 
    {
 
 paul@336    756 
        if (feof(f))
 
 paul@336    757 
            __raise_eof_error();
 
 paul@336    758 
        else if (error = ferror(f))
 
 paul@336    759 
            __raise_io_error(__new_int(error));
 
 paul@336    760 
    }
 
 paul@336    761 
 
 paul@336    762 
    return __builtins___none_None;
 
 paul@336    763 
}
 
 paul@336    764 
 
 paul@173    765 
__attr __fn_native__read(__attr __args[])
 
 paul@173    766 
{
 
 paul@208    767 
    __attr * const fd = &__args[1];
 
 paul@208    768 
    __attr * const n = &__args[2];
 
 paul@328    769 
    /* fd.__data__ interpreted as int */
 
 paul@328    770 
    int i = __load_via_object(fd->value, __pos___data__).intvalue;
 
 paul@328    771 
    /* n.__data__ interpreted as int */
 
 paul@328    772 
    int to_read = __load_via_object(n->value, __pos___data__).intvalue;
 
 paul@335    773 
    char buf[to_read];
 
 paul@328    774 
    ssize_t have_read;
 
 paul@331    775 
    char *s;
 
 paul@173    776 
 
 paul@328    777 
    errno = 0;
 
 paul@335    778 
    have_read = read(i, buf, to_read * sizeof(char));
 
 paul@328    779 
 
 paul@328    780 
    if (have_read == -1)
 
 paul@331    781 
        __raise_io_error(__new_int(errno));
 
 paul@328    782 
    else
 
 paul@328    783 
    {
 
 paul@331    784 
        /* Reserve space for a new string. */
 
 paul@336    785 
 
 paul@331    786 
        s = __ALLOCATE(have_read + 1, 1);
 
 paul@331    787 
        strncpy(s, (char *) buf, have_read); /* does not null terminate but final byte should be zero */
 
 paul@331    788 
        return __new_str(s);
 
 paul@328    789 
    }
 
 paul@173    790 
}
 
 paul@173    791 
 
 paul@173    792 
__attr __fn_native__write(__attr __args[])
 
 paul@173    793 
{
 
 paul@208    794 
    __attr * const fd = &__args[1];
 
 paul@208    795 
    __attr * const str = &__args[2];
 
 paul@198    796 
    /* fd.__data__ interpreted as int */
 
 paul@208    797 
    int i = __load_via_object(fd->value, __pos___data__).intvalue;
 
 paul@198    798 
    /* str.__data__ interpreted as string */
 
 paul@208    799 
    char *s = __load_via_object(str->value, __pos___data__).strvalue;
 
 paul@173    800 
 
 paul@198    801 
    write(i, s, sizeof(char) * strlen(s));
 
 paul@173    802 
    return __builtins___none_None;
 
 paul@173    803 
}
 
 paul@173    804 
 
 paul@173    805 
/* Module initialisation. */
 
 paul@173    806 
 
 paul@161    807 
void __main_native()
 
 paul@161    808 
{
 
 paul@161    809 
}