ipio_ffi.inc

   1 /*
   2  * Copyright (C) 2024 Mikulas Patocka
   3  *
   4  * This file is part of Ajla.
   5  *
   6  * Ajla is free software: you can redistribute it and/or modify it under the
   7  * terms of the GNU General Public License as published by the Free Software
   8  * Foundation, either version 3 of the License, or (at your option) any later
   9  * version.
  10  *
  11  * Ajla is distributed in the hope that it will be useful, but WITHOUT ANY
  12  * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
  13  * A PARTICULAR PURPOSE. See the GNU General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License along with
  16  * Ajla. If not, see <https://www.gnu.org/licenses/>.
  17  */
  18
  19 #define MAX_FFI_TYPE_SIZE       16
  20
  21 struct resource_ffi {
  22         struct dl_handle_t *dlh;
  23         void *sym;
  24         ajla_option_t err_type;
  25         ffi_type **args;
  26         uchar_efficient_t *ctx_args;
  27         unsigned n_args;
  28         ffi_type *ret_ffi_type;
  29         ajla_option_t ret_type;
  30         ffi_cif cif;
  31 };
  32
  33 struct resource_ffi_structure {
  34         ffi_type typ;
  35         unsigned n_elements;
  36         size_t *offsets;
  37 };
  38
  39 static void free_type(ffi_type *ft)
  40 {
  41         if (ft->type == FFI_TYPE_STRUCT) {
  42                 struct resource_ffi_structure *rfs = get_struct(ft, struct resource_ffi_structure, typ);
  43                 struct data *da = cast_ptr(struct data *, cast_ptr(char *, rfs) - data_resource_offset);
  44                 pointer_dereference(pointer_data(da));
  45         }
  46 }
  47
  48 static void resource_ffi_close(struct data *d)
  49 {
  50         unsigned i;
  51         struct resource_ffi *rf = da_resource(d);
  52         os_dlclose(rf->dlh);
  53         for (i = 0; i < rf->n_args; i++)
  54                 free_type(rf->args[i]);
  55         mem_free(rf->args);
  56         mem_free(rf->ctx_args);
  57         free_type(rf->ret_ffi_type);
  58 }
  59
  60 static void resource_ffi_structure_close(struct data *d)
  61 {
  62         unsigned i;
  63         struct resource_ffi_structure *rfs = da_resource(d);
  64         for (i = 0; i < rfs->n_elements; i++)
  65                 free_type(rfs->typ.elements[i]);
  66         mem_free(rfs->typ.elements);
  67         mem_free(rfs->offsets);
  68 }
  69
  70 #define T_VOID                  0
  71 #define T_UNSIGNED              1
  72 #define T_SIGNED                2
  73 #define T_REAL                  3
  74
  75 /* this must be in sync with option ffi_type */
  76 static const struct {
  77         ffi_type *ft;
  78         unsigned char size;
  79         unsigned char sign;
  80 } ajla_type_to_ffi_type_table[24] = {
  81         { &ffi_type_void,       0,                      T_VOID,         },
  82         { &ffi_type_uint8,      1,                      T_UNSIGNED,     },
  83         { &ffi_type_sint8,      1,                      T_SIGNED,       },
  84         { &ffi_type_uint16,     2,                      T_UNSIGNED,     },
  85         { &ffi_type_sint16,     2,                      T_SIGNED,       },
  86         { &ffi_type_uint32,     4,                      T_UNSIGNED,     },
  87         { &ffi_type_sint32,     4,                      T_SIGNED,       },
  88         { &ffi_type_uint64,     8,                      T_UNSIGNED,     },
  89         { &ffi_type_sint64,     8,                      T_SIGNED,       },
  90         { &ffi_type_float,      sizeof(float),          T_REAL,         },
  91         { &ffi_type_double,     sizeof(double),         T_REAL,         },
  92 #if REAL_MASK & 0x08
  93         { &ffi_type_longdouble, sizeof(real80_t),       T_REAL,         },
  94 #elif REAL_MASK & 0x10
  95         { &ffi_type_longdouble, sizeof(real128_t),      T_REAL,         },
  96 #else
  97         { &ffi_type_longdouble, sizeof(double),         T_REAL,         },
  98 #endif
  99         { &ffi_type_pointer,    sizeof(void *),         T_UNSIGNED,     },
 100         { &ffi_type_uchar,      1,                      T_UNSIGNED,     },
 101         { &ffi_type_schar,      1,                      T_SIGNED,       },
 102         { &ffi_type_ushort,     sizeof(unsigned short), T_UNSIGNED,     },
 103         { &ffi_type_sshort,     sizeof(short),          T_SIGNED,       },
 104         { &ffi_type_uint,       sizeof(unsigned),       T_UNSIGNED,     },
 105         { &ffi_type_sint,       sizeof(int),            T_SIGNED,       },
 106         { &ffi_type_ulong,      sizeof(unsigned long),  T_UNSIGNED,     },
 107         { &ffi_type_slong,      sizeof(long),           T_SIGNED,       },
 108         { sizeof(size_t) == 4 ? &ffi_type_uint32 : sizeof(size_t) == 8 ? &ffi_type_uint64 : NULL,       sizeof(size_t), T_UNSIGNED, },
 109         { sizeof(ssize_t) == 4 ? &ffi_type_sint32 : sizeof(ssize_t) == 8 ? &ffi_type_sint64 : NULL,     sizeof(ssize_t), T_SIGNED, },
 110         { sizeof(bool) == 1 ? &ffi_type_uint8 : sizeof(bool) == 4 ? &ffi_type_uint32 : NULL,            sizeof(bool),   T_UNSIGNED, },
 111 };
 112
 113 static const struct type *ajla_type_to_type(ajla_option_t a)
 114 {
 115         if (a >= 1 && a < 9) {
 116                 a -= 1;
 117                 return type_get_fixed(a >> 1, !(a & 1));
 118         }
 119         if (a == 9)
 120                 return type_get_real(1);
 121         if (a == 10)
 122                 return type_get_real(2);
 123         if (a == 11) {
 124 #if REAL_MASK & 0x18
 125                 return type_get_real(3);
 126 #else
 127                 return type_get_real(2);
 128 #endif
 129         }
 130         return NULL;
 131 }
 132
 133 static ffi_type *ajla_type_to_ffi_type(ajla_option_t a, struct data *struc, bool ref)
 134 {
 135         if (struc) {
 136                 struct resource_ffi_structure *str;
 137                 if (ref)
 138                         pointer_reference_owned(pointer_data(struc));
 139                 str = da_resource(struc);
 140                 return &str->typ;
 141         }
 142         if (unlikely(a >= n_array_elements(ajla_type_to_ffi_type_table)))
 143                 internal(file_line, "ajla_type_to_ffi_type: invalid ffi type %u", (unsigned)a);
 144         return ajla_type_to_ffi_type_table[a].ft;
 145 }
 146
 147 static void * attr_fastcall io_ffi_get_size_alignment_handler(struct io_ctx *ctx)
 148 {
 149         void *test;
 150         ajla_option_t a;
 151         struct data *struc;
 152         ffi_type *ft;
 153         size_t v;
 154
 155         test = io_deep_eval(ctx, "0", false);
 156         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 157                 goto ret_test;
 158
 159         io_get_option(ctx, get_input(ctx, 0), &a, &struc);
 160
 161         ft = ajla_type_to_ffi_type(a, struc, false);
 162         switch (get_param(ctx, 0)) {
 163                 case 0: v = ft->size;
 164                         break;
 165                 case 1: v = ft->alignment;
 166                         break;
 167                 default:internal(file_line, "io_ffi_get_size_alignment_handler: invalid parameter %u", (unsigned)get_param(ctx, 0));
 168         }
 169
 170         io_store_typed_number(ctx, get_output(ctx, 0), int_default_t, INT_DEFAULT_N, size_t, v);
 171         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 172                 goto ret_test;
 173
 174         test = POINTER_FOLLOW_THUNK_GO;
 175
 176 ret_test:
 177         return test;
 178
 179 }
 180
 181 static bool io_ffi_argument(struct io_ctx *ctx, ajla_option_t opt, struct data *struc)
 182 {
 183         if (unlikely(!array_add_mayfail(uchar_efficient_t, &ctx->args, &ctx->args_l, opt, NULL, &ctx->err)))
 184                 return false;
 185         if (unlikely(!array_add_mayfail(void *, &ctx->ptrs, &ctx->ptrs_l, struc, NULL, &ctx->err)))
 186                 return false;
 187         return true;
 188 }
 189
 190 static int_default_t io_get_argument_type_callback(unsigned char *flat, const struct type *type, int_default_t n_elements, pointer_t *ptr, void *ctx_)
 191 {
 192         struct io_ctx *ctx = cast_ptr(struct io_ctx *, ctx_);
 193         if (flat) {
 194                 int_default_t i;
 195                 for (i = n_elements; i; i--, flat += type->size) {
 196                         if (unlikely(!io_ffi_argument(ctx, *cast_ptr(ajla_flat_option_t *, flat), NULL)))
 197                                 return 0;
 198                 }
 199         } else {
 200                 struct data *opt = pointer_get_data(*ptr);
 201                 pointer_t ptr = da(opt,option)->pointer;
 202                 struct data *struc = pointer_is_empty(ptr) ? NULL : pointer_get_data(ptr);
 203                 if (unlikely(!io_ffi_argument(ctx, da(opt,option)->option, struc)))
 204                         return 0;
 205         }
 206         return n_elements;
 207 }
 208
 209 static void io_ffi_free_args(struct io_ctx *ctx, ffi_type **args)
 210 {
 211         unsigned i;
 212         if (args) {
 213                 for (i = 0; i < ctx->args_l; i++)
 214                         if (args[i])
 215                                 free_type(args[i]);
 216                 mem_free(args);
 217         }
 218 }
 219
 220 static ffi_type **io_ffi_load_arg_list(struct io_ctx *ctx, unsigned slot)
 221 {
 222         array_index_t idx;
 223         unsigned i;
 224         ffi_type **args;
 225
 226         if (unlikely(!array_init_mayfail(uchar_efficient_t, &ctx->args, &ctx->args_l, &ctx->err)))
 227                 return NULL;
 228
 229         if (unlikely(!array_init_mayfail(void *, &ctx->ptrs, &ctx->ptrs_l, &ctx->err)))
 230                 return NULL;
 231
 232         index_from_int(&idx, 0);
 233         if (!array_onstack_iterate(ctx->fp, get_input(ctx, slot), &idx, io_get_argument_type_callback, ctx)) {
 234                 index_free(&idx);
 235                 return NULL;
 236         }
 237         index_free(&idx);
 238         if (unlikely(ctx->args_l >= -1U)) {
 239                 ctx->err = error_ajla(EC_ASYNC, AJLA_ERROR_SIZE_OVERFLOW);
 240                 return NULL;
 241         }
 242
 243         args = mem_alloc_array_mayfail(mem_calloc_mayfail, ffi_type **, 0, 0, ctx->args_l + 1, sizeof(ffi_type *), &ctx->err);
 244         if (unlikely(!args))
 245                 return NULL;
 246         for (i = 0; i < ctx->args_l; i++) {
 247                 if (unlikely(!ctx->args[i])) {
 248                         ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
 249                         goto free_args_fail;
 250                 }
 251                 args[i] = ajla_type_to_ffi_type(ctx->args[i], ctx->ptrs[i], true);
 252                 if (unlikely(!args[i]))
 253                         goto free_args_fail;
 254         }
 255
 256         return args;
 257
 258 free_args_fail:
 259         io_ffi_free_args(ctx, args);
 260         return NULL;
 261 }
 262
 263 static void * attr_fastcall io_ffi_create_structure_handler(struct io_ctx *ctx)
 264 {
 265         void *test;
 266         struct data *d = NULL;
 267         struct data *a = NULL;
 268         struct resource_ffi_structure *rfs;
 269         ffi_type **args = NULL;
 270         size_t *offsets = NULL;
 271         ffi_cif cif;
 272         size_t pos;
 273         unsigned i;
 274
 275         ctx->args = NULL;
 276         ctx->ptrs = NULL;
 277
 278         test = io_deep_eval(ctx, "0", false);
 279         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 280                 goto ret_test;
 281
 282         args = io_ffi_load_arg_list(ctx, 0);
 283         if (unlikely(!args))
 284                 goto ret_err;
 285
 286         test = POINTER_FOLLOW_THUNK_GO;
 287
 288         offsets = mem_alloc_array_mayfail(mem_alloc_mayfail, size_t *, 0, 0, ctx->args_l, sizeof(size_t), &ctx->err);
 289         if (unlikely(!offsets))
 290                 goto ret_err;
 291
 292         d = data_alloc_resource_mayfail(sizeof(struct resource_ffi_structure), resource_ffi_structure_close, &ctx->err pass_file_line);
 293         if (unlikely(!d))
 294                 goto ret_err;
 295         rfs = da_resource(d);
 296
 297         rfs->n_elements = ctx->args_l;
 298         rfs->offsets = offsets;
 299         rfs->typ.size = 0;
 300         rfs->typ.alignment = 0;
 301         rfs->typ.type = FFI_TYPE_STRUCT;
 302         rfs->typ.elements = args;
 303         args = NULL;
 304
 305         if (unlikely(ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 0, &rfs->typ, NULL) != FFI_OK)) {
 306                 ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
 307                 goto ret_err;
 308         }
 309
 310         a = data_alloc_array_flat_mayfail(type_get_int(INT_DEFAULT_N), ctx->args_l, ctx->args_l, false, &ctx->err pass_file_line);
 311         if (unlikely(!a))
 312                 goto ret_err;
 313
 314         pos = 0;
 315         for (i = 0; i < ctx->args_l; i++) {
 316                 int_default_t p;
 317                 pos = round_up(pos, rfs->typ.elements[i]->alignment);
 318                 offsets[i] = pos;
 319                 p = pos;
 320                 if (unlikely(p < 0) || unlikely((uint_default_t)p != pos)) {
 321                         ctx->err = error_ajla(EC_ASYNC, AJLA_ERROR_SIZE_OVERFLOW);
 322                         goto ret_err;
 323                 }
 324                 cast_ptr(int_default_t *, da_array_flat(a))[i] = p;
 325                 pos += rfs->typ.elements[i]->size;
 326                 if (unlikely(pos < rfs->typ.elements[i]->size)) {
 327                         ctx->err = error_ajla(EC_ASYNC, AJLA_ERROR_SIZE_OVERFLOW);
 328                         goto ret_err;
 329                 }
 330         }
 331
 332         frame_set_pointer(ctx->fp, get_output(ctx, 0), pointer_data(d));
 333         d = NULL;
 334         frame_set_pointer(ctx->fp, get_output(ctx, 1), pointer_data(a));
 335         a = NULL;
 336         offsets = NULL;
 337
 338         test = POINTER_FOLLOW_THUNK_GO;
 339
 340 ret_test:
 341         if (a)
 342                 data_free_r1(a);
 343         if (d)
 344                 data_free_r1(d);
 345         if (offsets)
 346                 mem_free(offsets);
 347         io_ffi_free_args(ctx, args);
 348         if (ctx->ptrs)
 349                 mem_free(ctx->ptrs);
 350         if (ctx->args)
 351                 mem_free(ctx->args);
 352         return test;
 353
 354 ret_err:
 355         io_terminate_with_error(ctx, ctx->err, true, NULL);
 356         test = POINTER_FOLLOW_THUNK_EXCEPTION;
 357         goto ret_test;
 358 }
 359
 360 static void * attr_fastcall io_ffi_structure_offset_handler(struct io_ctx *ctx)
 361 {
 362         void *test;
 363         pointer_t ptr;
 364         struct resource_ffi_structure *s;
 365         unsigned n;
 366         size_t off;
 367
 368         test = io_deep_eval(ctx, "01", false);
 369         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 370                 goto ret_test;
 371
 372         ptr = *frame_pointer(ctx->fp, get_input(ctx, 0));
 373         ajla_assert_lo(!pointer_is_thunk(ptr), (file_line, "io_ffi_structure_offset_handler: pointer is thunk"));
 374         s = da_resource(pointer_get_data(ptr));
 375
 376         io_get_number(ctx, get_input(ctx, 1), int_default_t, unsigned, n);
 377         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 378                 goto ret_test;
 379
 380         if (unlikely(n >= s->n_elements)) {
 381                 ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
 382                 goto ret_err;
 383         }
 384         off = s->offsets[n];
 385         io_store_typed_number(ctx, get_output(ctx, 0), int_default_t, INT_DEFAULT_N, unsigned, off);
 386         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 387                 goto ret_test;
 388
 389         test = POINTER_FOLLOW_THUNK_GO;
 390
 391 ret_test:
 392         return test;
 393
 394 ret_err:
 395         io_terminate_with_error(ctx, ctx->err, true, NULL);
 396         test = POINTER_FOLLOW_THUNK_EXCEPTION;
 397         goto ret_test;
 398 }
 399
 400 static bool io_get_argument_from_flat(struct io_ctx *ctx, uchar_efficient_t t, int_default_t num);
 401 static bool io_get_argument_from_longint(struct io_ctx *ctx, uchar_efficient_t t, const mpint_t *m);
 402
 403 static void * attr_fastcall io_ffi_poke_handler(struct io_ctx *ctx)
 404 {
 405         void *test;
 406         frame_t slot;
 407         uintptr_t addr;
 408         ajla_option_t a;
 409         struct data *struc;
 410
 411         test = io_deep_eval(ctx, "0123", true);
 412         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 413                 goto ret_test;
 414
 415         io_get_number(ctx, get_input(ctx, 1), int_default_t, uintptr_t, addr);
 416         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 417                 goto ret_test;
 418
 419         io_get_option(ctx, get_input(ctx, 2), &a, &struc);
 420         if (unlikely(struc != NULL)) {
 421                 ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
 422                 goto ret_err;
 423         }
 424
 425         slot = get_input(ctx, 3);
 426
 427         ctx->ptrs = NULL;
 428         ctx->str = num_to_ptr(addr);
 429         if (likely(!frame_test_flag(ctx->fp, slot))) {
 430                 int_default_t in;
 431                 barrier_aliasing();
 432                 in = *frame_slot(ctx->fp, slot, int_default_t);
 433                 barrier_aliasing();
 434                 if (unlikely(!io_get_argument_from_flat(ctx, a, in)))
 435                         goto ret_err;
 436         } else {
 437                 struct data *d = pointer_get_data(*frame_pointer(ctx->fp, slot));
 438                 if (da_tag(d) == DATA_TAG_flat) {
 439                         if (unlikely(!io_get_argument_from_flat(ctx, a, *cast_ptr(int_default_t *, da_flat(d)))))
 440                                 goto ret_err;
 441                 } else {
 442                         if (unlikely(!io_get_argument_from_longint(ctx, a, &da(d,longint)->mp)))
 443                                 goto ret_err;
 444                 }
 445         }
 446
 447         test = POINTER_FOLLOW_THUNK_GO;
 448
 449 ret_test:
 450         return test;
 451
 452 ret_err:
 453         io_terminate_with_error(ctx, ctx->err, true, NULL);
 454         test = POINTER_FOLLOW_THUNK_EXCEPTION;
 455         goto ret_test;
 456 }
 457
 458 static void * attr_fastcall io_ffi_peek_handler(struct io_ctx *ctx)
 459 {
 460         void *test;
 461         frame_t slot;
 462         uintptr_t addr;
 463         void *ad;
 464         ajla_option_t a;
 465         struct data *struc;
 466         size_t sz;
 467
 468         union {
 469                 uint8_t u8;
 470                 uint16_t u16;
 471                 uint32_t u32;
 472                 uint64_t u64;
 473                 int8_t s8;
 474                 int16_t s16;
 475                 int32_t s32;
 476                 int64_t s64;
 477         } u;
 478
 479         test = io_deep_eval(ctx, "012", true);
 480         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 481                 goto ret_test;
 482
 483         io_get_number(ctx, get_input(ctx, 1), int_default_t, uintptr_t, addr);
 484         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 485                 goto ret_test;
 486         ad = num_to_ptr(addr);
 487
 488         io_get_option(ctx, get_input(ctx, 2), &a, &struc);
 489         if (unlikely(struc != NULL)) {
 490                 ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
 491                 goto ret_err;
 492         }
 493
 494         slot = get_output(ctx, 1);
 495
 496         sz = ajla_type_to_ffi_type_table[a].size;
 497         switch (ajla_type_to_ffi_type_table[a].sign) {
 498                 case T_VOID: {
 499                         ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
 500                         goto ret_err;
 501                 }
 502                 case T_REAL: {
 503                         struct data *dl = data_alloc_longint_mayfail(sz * 8, &ctx->err pass_file_line);
 504                         if (unlikely(!dl))
 505                                 goto ret_err;
 506                         mpz_import(&da(dl,longint)->mp, sz, -1, 1, 0, 0, ad);
 507                         frame_set_pointer(ctx->fp, slot, pointer_data(dl));
 508                         break;
 509                 }
 510                 case T_UNSIGNED: {
 511                         memcpy(&u, ad, sz);
 512                         switch (sz) {
 513                                 case 1: io_store_typed_number(ctx, slot, int_default_t, INT_DEFAULT_N, uint8_t, u.u8); if (unlikely(test != POINTER_FOLLOW_THUNK_GO)) goto ret_test; break;
 514                                 case 2: io_store_typed_number(ctx, slot, int_default_t, INT_DEFAULT_N, uint16_t, u.u16); if (unlikely(test != POINTER_FOLLOW_THUNK_GO)) goto ret_test; break;
 515                                 case 4: io_store_typed_number(ctx, slot, int_default_t, INT_DEFAULT_N, uint32_t, u.u32); if (unlikely(test != POINTER_FOLLOW_THUNK_GO)) goto ret_test; break;
 516                                 case 8: io_store_typed_number(ctx, slot, int_default_t, INT_DEFAULT_N, uint64_t, u.u64); if (unlikely(test != POINTER_FOLLOW_THUNK_GO)) goto ret_test; break;
 517                                 default:internal(file_line, "io_ffi_peek_handler: invalid size %"PRIuMAX"", (uintmax_t)sz);
 518                         }
 519                         break;
 520                 }
 521                 case T_SIGNED: {
 522                         memcpy(&u, ad, sz);
 523                         switch (sz) {
 524                                 case 1: io_store_typed_number(ctx, slot, int_default_t, INT_DEFAULT_N, int8_t, u.s8); if (unlikely(test != POINTER_FOLLOW_THUNK_GO)) goto ret_test; break;
 525                                 case 2: io_store_typed_number(ctx, slot, int_default_t, INT_DEFAULT_N, int16_t, u.s16); if (unlikely(test != POINTER_FOLLOW_THUNK_GO)) goto ret_test; break;
 526                                 case 4: io_store_typed_number(ctx, slot, int_default_t, INT_DEFAULT_N, int32_t, u.s32); if (unlikely(test != POINTER_FOLLOW_THUNK_GO)) goto ret_test; break;
 527                                 case 8: io_store_typed_number(ctx, slot, int_default_t, INT_DEFAULT_N, int64_t, u.s64); if (unlikely(test != POINTER_FOLLOW_THUNK_GO)) goto ret_test; break;
 528                                 default:internal(file_line, "io_ffi_peek_handler: invalid size %"PRIuMAX"", (uintmax_t)sz);
 529                         }
 530                         break;
 531                 }
 532                 default:
 533                         internal(file_line, "io_ffi_peek_handler: invalid type %u", (unsigned)a);
 534         }
 535
 536         test = POINTER_FOLLOW_THUNK_GO;
 537
 538 ret_test:
 539         return test;
 540
 541 ret_err:
 542         io_terminate_with_error(ctx, ctx->err, true, NULL);
 543         test = POINTER_FOLLOW_THUNK_EXCEPTION;
 544         goto ret_test;
 545
 546 }
 547
 548 static int_default_t io_ffi_poke_array_callback(unsigned char *flat, const struct type *type, int_default_t n_elements, pointer_t attr_unused *ptr, void *ctx_)
 549 {
 550         struct io_ctx *ctx = cast_ptr(struct io_ctx *, ctx_);
 551         if (flat) {
 552                 if (unlikely(!TYPE_TAG_IS_FIXED(type->tag)) &&
 553                     unlikely(!TYPE_TAG_IS_REAL(type->tag))) {
 554                         ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
 555                         return 0;
 556                 }
 557                 ctx->str = mempcpy(ctx->str, flat, (size_t)type->size * (size_t)n_elements);
 558                 return n_elements;
 559         } else {
 560                 ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
 561                 return 0;
 562         }
 563 }
 564
 565 static void * attr_fastcall io_ffi_poke_array_handler(struct io_ctx *ctx)
 566 {
 567         void *test;
 568         uintptr_t addr;
 569         frame_t slot;
 570         array_index_t idx;
 571         bool ret;
 572
 573         test = io_deep_eval(ctx, "012", true);
 574         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 575                 goto ret_test;
 576
 577         io_get_number(ctx, get_input(ctx, 1), int_default_t, uintptr_t, addr);
 578         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 579                 goto ret_test;
 580         ctx->str = num_to_ptr(addr);
 581
 582         slot = get_input(ctx, 2);
 583
 584         index_from_int(&idx, 0);
 585         ret = array_onstack_iterate(ctx->fp, slot, &idx, io_ffi_poke_array_callback, ctx);
 586         index_free(&idx);
 587
 588         if (unlikely(!ret))
 589                 goto ret_err;
 590
 591         test = POINTER_FOLLOW_THUNK_GO;
 592
 593 ret_test:
 594         return test;
 595
 596 ret_err:
 597         io_terminate_with_error(ctx, ctx->err, true, NULL);
 598         test = POINTER_FOLLOW_THUNK_EXCEPTION;
 599         goto ret_test;
 600 }
 601
 602 static void * attr_fastcall io_ffi_peek_array_handler(struct io_ctx *ctx)
 603 {
 604         void *test;
 605         uintptr_t addr;
 606         ajla_option_t a;
 607         struct data *struc;
 608         const struct type *type;
 609         int_default_t size;
 610         struct data *d;
 611
 612         test = io_deep_eval(ctx, "0123", true);
 613         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 614                 goto ret_test;
 615
 616         io_get_number(ctx, get_input(ctx, 1), int_default_t, uintptr_t, addr);
 617         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 618                 goto ret_test;
 619
 620         io_get_number(ctx, get_input(ctx, 2), int_default_t, int_default_t, size);
 621         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 622                 goto ret_test;
 623         if (unlikely(size < 0)) {
 624                 ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_NEGATIVE_INDEX);
 625                 goto ret_err;
 626         }
 627
 628         io_get_option(ctx, get_input(ctx, 3), &a, &struc);
 629         if (unlikely(struc != NULL) || unlikely(!(type = ajla_type_to_type(a)))) {
 630                 ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
 631                 goto ret_err;
 632         }
 633
 634         d = data_alloc_array_flat_mayfail(type, size, size, false, &ctx->err pass_file_line);
 635         if (unlikely(!d))
 636                 goto ret_err;
 637
 638         memcpy(da_array_flat(d), num_to_ptr(addr), (size_t)size * type->size);
 639
 640         frame_set_pointer(ctx->fp, get_output(ctx, 1), pointer_data(d));
 641
 642         test = POINTER_FOLLOW_THUNK_GO;
 643
 644 ret_test:
 645         return test;
 646
 647 ret_err:
 648         io_terminate_with_error(ctx, ctx->err, true, NULL);
 649         test = POINTER_FOLLOW_THUNK_EXCEPTION;
 650         goto ret_test;
 651 }
 652
 653 static void * attr_fastcall io_ffi_create_function_handler(struct io_ctx *ctx)
 654 {
 655         void *test;
 656         struct dl_handle_t *dlh = NULL;
 657         void *sym;
 658         struct data *d = NULL;
 659         struct resource_ffi *rf;
 660         char *open_msg = NULL;
 661         unsigned attr_unused nvargs;
 662         ajla_option_t err_type;
 663         ajla_option_t rtype;
 664         struct data *r_struc;
 665         ffi_type *ret = NULL;
 666         ffi_type **args = NULL;
 667
 668         ctx->args = NULL;
 669         ctx->ptrs = NULL;
 670         ctx->str = NULL;
 671         ctx->str2 = NULL;
 672
 673         test = io_deep_eval(ctx, "012345", false);
 674         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 675                 goto ret_test;
 676
 677         io_get_bytes(ctx, get_input(ctx, 0));
 678         io_get_bytes2(ctx, get_input(ctx, 1));
 679
 680         dlh = os_dlopen(*ctx->str ? ctx->str : NULL, &ctx->err, &open_msg);
 681         if (unlikely(!dlh))
 682                 goto ret_err;
 683         if (unlikely(!os_dlsym(dlh, ctx->str2, &sym))) {
 684                 ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_SYMBOL_NOT_FOUND);
 685                 goto ret_err;
 686         }
 687
 688         io_get_option(ctx, get_input(ctx, 2), &err_type, NULL);
 689
 690         io_get_positive_number(ctx, ctx->fp, get_input(ctx, 3), unsigned, nvargs);
 691         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 692                 goto ret_test;
 693
 694         io_get_option(ctx, get_input(ctx, 4), &rtype, &r_struc);
 695
 696         args = io_ffi_load_arg_list(ctx, 5);
 697         if (unlikely(!args))
 698                 goto ret_err;
 699
 700         ret = ajla_type_to_ffi_type(rtype, r_struc, true);
 701         if (unlikely(!ret))
 702                 goto ret_err;
 703
 704         d = data_alloc_resource_mayfail(sizeof(struct resource_ffi), resource_ffi_close, &ctx->err pass_file_line);
 705         if (unlikely(!d))
 706                 goto ret_err;
 707         rf = da_resource(d);
 708
 709 #ifdef HAVE_FFI_PREP_CIF_VAR
 710         if (!nvargs) {
 711 #endif
 712                 if (unlikely(ffi_prep_cif(&rf->cif, FFI_DEFAULT_ABI, ctx->args_l, ret, args) != FFI_OK)) {
 713                         ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
 714                         goto ret_err;
 715                 }
 716 #ifdef HAVE_FFI_PREP_CIF_VAR
 717         } else {
 718                 if (unlikely(ffi_prep_cif_var(&rf->cif, FFI_DEFAULT_ABI, ctx->args_l - nvargs, ctx->args_l, ret, args) != FFI_OK)) {
 719                         ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
 720                         goto ret_err;
 721                 }
 722         }
 723 #endif
 724
 725         rf->dlh = dlh;
 726         dlh = NULL;
 727         rf->sym = sym;
 728         rf->err_type = err_type;
 729         rf->ctx_args = ctx->args;
 730         rf->n_args = ctx->args_l;
 731         ctx->args = NULL;
 732         rf->args = args;
 733         args = NULL;
 734         rf->ret_ffi_type = ret;
 735         rf->ret_type = rtype;
 736         ret = NULL;
 737
 738         frame_set_pointer(ctx->fp, get_output(ctx, 0), pointer_data(d));
 739         d = NULL;
 740
 741         test = POINTER_FOLLOW_THUNK_GO;
 742
 743 ret_test:
 744         if (d)
 745                 data_free_r1(d);
 746         io_ffi_free_args(ctx, args);
 747         if (ret)
 748                 free_type(ret);
 749         if (dlh)
 750                 os_dlclose(dlh);
 751         if (ctx->str)
 752                 mem_free(ctx->str);
 753         if (ctx->str2)
 754                 mem_free(ctx->str2);
 755         if (ctx->ptrs)
 756                 mem_free(ctx->ptrs);
 757         if (ctx->args)
 758                 mem_free(ctx->args);
 759         return test;
 760
 761 ret_err:
 762         io_terminate_with_error(ctx, ctx->err, true, open_msg);
 763         test = POINTER_FOLLOW_THUNK_EXCEPTION;
 764         goto ret_test;
 765 }
 766
 767 static bool io_add_argument(struct io_ctx *ctx, void *ptr, size_t size)
 768 {
 769         void *xerr;
 770         void *cpy;
 771         if (!ctx->ptrs) {
 772                 memcpy_fast(ctx->str, ptr, size);
 773                 return true;
 774         }
 775         cpy = mem_alloc_mayfail(void *, size, &ctx->err);
 776         if (unlikely(!cpy))
 777                 return false;
 778         memcpy_fast(cpy, ptr, size);
 779         if (unlikely(!array_add_mayfail(void *, &ctx->ptrs, &ctx->ptrs_l, cpy, &xerr, &ctx->err))) {
 780                 ctx->ptrs = xerr;
 781                 return false;
 782         }
 783         return true;
 784 }
 785
 786 static bool io_get_argument_from_longint(struct io_ctx *ctx, uchar_efficient_t t, const mpint_t *m)
 787 {
 788         size_t size = ajla_type_to_ffi_type_table[t].size;
 789         unsigned idx;
 790         bool uns;
 791
 792         union {
 793                 ffi_arg rc;
 794                 ffi_sarg src;
 795                 unsigned char pool[MAX_FFI_TYPE_SIZE];
 796
 797                 /* force alignment */
 798                 long l;
 799                 int64_t i64;
 800                 uint64_t ui64;
 801 #ifdef HAVE_LONG_LONG
 802                 long long ll;
 803 #endif
 804                 double dbl;
 805 #ifdef HAVE_LONG_DOUBLE
 806                 long double ld;
 807 #endif
 808         } u;
 809
 810         if (ajla_type_to_ffi_type_table[t].sign == T_REAL) {
 811                 if (unlikely(mpz_sgn(m) < 0))
 812                         goto doesnt_fit;
 813                 if (mpz_sizeinbase(m, 2) > 8 * sizeof u.pool)
 814                         goto doesnt_fit;
 815                 memset(u.pool, 0, sizeof u.pool);
 816                 mpz_export(u.pool, NULL, -1, 1, 0, 0, m);
 817                 goto add;
 818         }
 819
 820         idx = log_2(size);
 821         uns = ajla_type_to_ffi_type_table[t].sign == T_UNSIGNED;
 822
 823         if (!uns) {
 824                 if (unlikely(!mpint_export(m, u.pool, idx, &ctx->err)))
 825                         return false;
 826         } else {
 827                 if (unlikely(!mpint_export_unsigned(m, u.pool, idx, &ctx->err)))
 828                         return false;
 829         }
 830
 831 add:
 832         return io_add_argument(ctx, u.pool, size);
 833
 834 doesnt_fit:
 835         ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_DOESNT_FIT);
 836         return false;
 837 }
 838
 839 static bool io_get_argument_from_flat(struct io_ctx *ctx, uchar_efficient_t t, int_default_t num)
 840 {
 841         size_t size = ajla_type_to_ffi_type_table[t].size;
 842         unsigned idx;
 843         bool uns;
 844
 845         if (ajla_type_to_ffi_type_table[t].sign == T_REAL) {
 846                 bool ret;
 847                 mpint_t m;
 848                 if (unlikely(!cat(mpint_init_from_,int_default_t)(&m, 0, &ctx->err)))
 849                         return false;
 850                 ret = io_get_argument_from_longint(ctx, t, &m);
 851                 mpint_free(&m);
 852                 return ret;
 853         }
 854
 855         idx = log_2(size);
 856         uns = ajla_type_to_ffi_type_table[t].sign == T_UNSIGNED;
 857
 858 #define f(n, stype, utype, sz, bits)                                    \
 859         case n: {                                                       \
 860                 union {                                                 \
 861                         stype s;                                        \
 862                         utype u;                                        \
 863                 } u;                                                    \
 864                 if (uns) {                                              \
 865                         if (unlikely(num < 0) || unlikely((uint_default_t)num > (utype)(-1 + zero)))\
 866                                 goto doesnt_fit;                        \
 867                         u.u = num;                                      \
 868                 } else {                                                \
 869                         if (unlikely(num < sign_bit(stype) + zero) || unlikely(num > signed_maximum(stype) + zero))\
 870                                 goto doesnt_fit;                        \
 871                         u.s = num;                                      \
 872                 }                                                       \
 873                 if (unlikely(!io_add_argument(ctx, &u, sizeof u)))      \
 874                         return false;                                   \
 875                 break;                                                  \
 876         }
 877         switch (idx) {
 878                 for_all_fixed(f)
 879                 default:
 880                         ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_NOT_SUPPORTED);
 881                         return false;
 882         }
 883 #undef f
 884         return true;
 885
 886 doesnt_fit:
 887         ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_DOESNT_FIT);
 888         return false;
 889 }
 890
 891 static int_default_t io_get_argument_callback(unsigned char *flat, const struct type attr_unused *type, int_default_t n_elements, pointer_t *ptr, void *ctx_)
 892 {
 893         struct io_ctx *ctx = cast_ptr(struct io_ctx *, ctx_);
 894         if (unlikely(flat != NULL)) {
 895                 int_default_t i;
 896                 for (i = n_elements; i; i--, flat += sizeof(int_default_t)) {
 897                         int_default_t num = *cast_ptr(int_default_t *, flat);
 898                         if (unlikely(!io_get_argument_from_flat(ctx, ctx->rf->ctx_args[ctx->ptrs_l], num)))
 899                                 return 0;
 900                 }
 901         } else {
 902                 struct data *d = pointer_get_data(*ptr);
 903                 if (unlikely(!io_get_argument_from_longint(ctx, ctx->rf->ctx_args[ctx->ptrs_l], &da(d,longint)->mp)))
 904                         return 0;
 905         }
 906         return n_elements;
 907 }
 908
 909 static void * attr_fastcall io_ffi_call_function_handler(struct io_ctx *ctx)
 910 {
 911         void *test;
 912         pointer_t ptr;
 913         struct data *d;
 914         struct resource_ffi *rf = NULL;         /* avoid warning */
 915         array_index_t idx;
 916         union {
 917                 ffi_arg rc;
 918                 ffi_sarg src;
 919                 unsigned char pool[MAX_FFI_TYPE_SIZE];
 920
 921                 /* force alignment */
 922                 long l;
 923                 int64_t i64;
 924                 uint64_t ui64;
 925 #ifdef HAVE_LONG_LONG
 926                 long long ll;
 927 #endif
 928                 double dbl;
 929 #ifdef HAVE_LONG_DOUBLE
 930                 long double ld;
 931 #endif
 932         } u;
 933         size_t i;
 934         uint32_t e = 0;         /* avoid warning */
 935         bool store = false;
 936
 937         ctx->ptrs = NULL;
 938         ctx->ptrs_l = 0;
 939
 940         test = io_deep_eval(ctx, "012", true);
 941         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 942                 goto ret_test;
 943
 944         ptr = *frame_pointer(ctx->fp, get_input(ctx, 1));
 945         ajla_assert_lo(!pointer_is_thunk(ptr), (file_line, "io_ffi_call_function_handler: pointer is thunk"));
 946         d = pointer_get_data(ptr);
 947         ctx->rf = rf = da_resource(d);
 948
 949         if (unlikely(!array_init_mayfail(void *, &ctx->ptrs, &ctx->ptrs_l, &ctx->err)))
 950                 goto ret_err;
 951
 952         index_from_int(&idx, 0);
 953         if (!array_onstack_iterate(ctx->fp, get_input(ctx, 2), &idx, io_get_argument_callback, ctx)) {
 954                 index_free(&idx);
 955                 goto ret_err;
 956         }
 957         index_free(&idx);
 958         if (unlikely(ctx->ptrs_l != rf->n_args)) {
 959                 ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
 960                 goto ret_err;
 961         }
 962
 963         ffi_call(&rf->cif, rf->sym, &u.rc, ctx->ptrs);
 964         store = true;
 965
 966         switch (rf->err_type) {
 967                 case 0: e = 0; break;
 968                 case 1: e = errno; break;
 969                 case 2: e = os_get_last_error(); break;
 970                 case 3: e = os_get_last_socket_error(); break;
 971                 default:
 972                         internal(file_line, "io_ffi_call_function_handler: invalid error specifier %u", (unsigned)rf->err_type);
 973         }
 974
 975         test = POINTER_FOLLOW_THUNK_GO;
 976
 977 ret_test:
 978         for (i = 0; i < ctx->ptrs_l; i++)
 979                 mem_free(ctx->ptrs[i]);
 980         if (ctx->ptrs)
 981                 mem_free(ctx->ptrs);
 982
 983         if (likely(store)) {
 984                 if (ajla_type_to_ffi_type_table[rf->ret_type].sign == T_VOID) {
 985                         io_store_typed_number(ctx, get_output(ctx, 1), int_default_t, INT_DEFAULT_N, int, 0);
 986                         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
 987                                 goto store_failed;
 988                 } else if (ajla_type_to_ffi_type_table[rf->ret_type].sign == T_REAL) {
 989                         struct data *dl = data_alloc_longint_mayfail(ajla_type_to_ffi_type_table[rf->ret_type].size * 8, &ctx->err pass_file_line);
 990                         if (unlikely(!dl)) {
 991                                 io_terminate_with_error(ctx, ctx->err, true, NULL);
 992                                 return POINTER_FOLLOW_THUNK_EXCEPTION;
 993                         }
 994                         mpz_import(&da(dl,longint)->mp, ajla_type_to_ffi_type_table[rf->ret_type].size, -1, 1, 0, 0, &u.pool);
 995                         frame_set_pointer(ctx->fp, get_output(ctx, 1), pointer_data(dl));
 996                 } else if (ajla_type_to_ffi_type_table[rf->ret_type].size > sizeof(u.rc)) {
 997                         if (ajla_type_to_ffi_type_table[rf->ret_type].sign != T_SIGNED) {
 998                                 io_store_typed_number(ctx, get_output(ctx, 1), int_default_t, INT_DEFAULT_N, uint64_t, u.ui64);
 999                                 if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1000                                         goto store_failed;
1001                         } else {
1002                                 io_store_typed_number(ctx, get_output(ctx, 1), int_default_t, INT_DEFAULT_N, int64_t, u.i64);
1003                                 if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1004                                         goto store_failed;
1005                         }
1006                 } else if (ajla_type_to_ffi_type_table[rf->ret_type].sign != T_SIGNED) {
1007                         io_store_typed_number(ctx, get_output(ctx, 1), int_default_t, INT_DEFAULT_N, ffi_arg, u.rc);
1008                         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1009                                 goto store_failed;
1010                 } else {
1011                         io_store_typed_number(ctx, get_output(ctx, 1), int_default_t, INT_DEFAULT_N, ffi_sarg, u.src);
1012                         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1013                                 goto store_failed;
1014                 }
1015                 io_store_typed_number(ctx, get_output(ctx, 2), int_default_t, INT_DEFAULT_N, uint32_t, e);
1016                 if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1017                         goto store_failed;
1018         }
1019
1020 store_failed:
1021         return test;
1022
1023 ret_err:
1024         io_terminate_with_error(ctx, ctx->err, true, NULL);
1025         test = POINTER_FOLLOW_THUNK_EXCEPTION;
1026         goto ret_test;
1027 }
1028
1029 struct destructor_call {
1030         struct data *d;
1031         void **args;
1032         size_t args_l;
1033 };
1034
1035 struct resource_ffi_destructor {
1036         void **ptrs;
1037         size_t ptrs_l;
1038         struct destructor_call *calls;
1039         size_t calls_l;
1040         pointer_t *handles;
1041         size_t handles_l;
1042 };
1043
1044 static void resource_ffi_destructor_close(struct data *d)
1045 {
1046         size_t i;
1047         struct resource_ffi_destructor *rfd = da_resource(d);
1048         i = rfd->calls_l;
1049         while (i) {
1050                 size_t j;
1051                 union {
1052                         ffi_arg rc;
1053                         ffi_sarg src;
1054                         unsigned char pool[MAX_FFI_TYPE_SIZE];
1055
1056                         /* force alignment */
1057                         long l;
1058                         int64_t i64;
1059                         uint64_t ui64;
1060 #ifdef HAVE_LONG_LONG
1061                         long long ll;
1062 #endif
1063                         double dbl;
1064 #ifdef HAVE_LONG_DOUBLE
1065                         long double ld;
1066 #endif
1067                 } u;
1068                 struct destructor_call *call = &rfd->calls[--i];
1069                 struct resource_ffi *rf = da_resource(call->d);
1070                 ffi_call(&rf->cif, rf->sym, &u, call->args);
1071                 pointer_dereference(pointer_data(call->d));
1072                 for (j = 0; j < call->args_l; j++)
1073                         mem_free(call->args[j]);
1074                 mem_free(call->args);
1075         }
1076         mem_free(rfd->calls);
1077         for (i = 0; i < rfd->handles_l; i++)
1078                 pointer_dereference(rfd->handles[i]);
1079         mem_free(rfd->handles);
1080         for (i = 0; i < rfd->ptrs_l; i++)
1081                 mem_free_aligned(rfd->ptrs[i]);
1082         mem_free(rfd->ptrs);
1083 }
1084
1085 static void * attr_fastcall io_ffi_destructor_new_handler(struct io_ctx *ctx)
1086 {
1087         void *test;
1088         struct data *d;
1089         struct resource_ffi_destructor *rfd;
1090
1091         test = io_deep_eval(ctx, "0", true);
1092         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1093                 goto ret_test;
1094
1095         d = data_alloc_resource_mayfail(sizeof(struct resource_ffi_destructor), resource_ffi_destructor_close, &ctx->err pass_file_line);
1096         if (unlikely(!d))
1097                 goto ret_err;
1098         rfd = da_resource(d);
1099
1100         if (unlikely(!array_init_mayfail(void *, &rfd->ptrs, &rfd->ptrs_l, &ctx->err))) {
1101                 data_free_r1(d);
1102                 goto ret_err;
1103         }
1104         if (unlikely(!array_init_mayfail(struct destructor_call, &rfd->calls, &rfd->calls_l, &ctx->err))) {
1105                 mem_free(rfd->ptrs);
1106                 data_free_r1(d);
1107                 goto ret_err;
1108         }
1109         if (unlikely(!array_init_mayfail(pointer_t, &rfd->handles, &rfd->handles_l, &ctx->err))) {
1110                 mem_free(rfd->calls);
1111                 mem_free(rfd->ptrs);
1112                 data_free_r1(d);
1113                 goto ret_err;
1114         }
1115
1116         frame_set_pointer(ctx->fp, get_output(ctx, 1), pointer_data(d));
1117
1118         test = POINTER_FOLLOW_THUNK_GO;
1119
1120 ret_test:
1121         return test;
1122
1123 ret_err:
1124         io_terminate_with_error(ctx, ctx->err, true, NULL);
1125         test = POINTER_FOLLOW_THUNK_EXCEPTION;
1126         goto ret_test;
1127 }
1128
1129 static void * attr_fastcall io_ffi_destructor_allocate_handler(struct io_ctx *ctx)
1130 {
1131         void *test;
1132         pointer_t ptr;
1133         struct resource_ffi_destructor *rfd = NULL;
1134         size_t size, align;
1135         ajla_option_t z;
1136         void *n;
1137         void *old;
1138
1139         test = io_deep_eval(ctx, "01234", true);
1140         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1141                 goto ret_test;
1142
1143         ptr = *frame_pointer(ctx->fp, get_input(ctx, 1));
1144         ajla_assert_lo(!pointer_is_thunk(ptr), (file_line, "io_ffi_destructor_allocate_handler: pointer is thunk"));
1145         rfd = da_resource(pointer_get_data(ptr));
1146
1147         io_get_number(ctx, get_input(ctx, 2), int_default_t, size_t, size);
1148         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1149                 goto ret_test;
1150
1151         io_get_number(ctx, get_input(ctx, 3), int_default_t, size_t, align);
1152         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1153                 goto ret_test;
1154
1155         io_get_option(ctx, get_input(ctx, 4), &z, NULL);
1156
1157         if (unlikely(!is_power_of_2(align))) {
1158                 ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
1159                 goto ret_err;
1160         }
1161
1162         if (!z)
1163                 n = mem_align_mayfail(void *, size, align, &ctx->err);
1164         else
1165                 n = mem_calign_mayfail(void *, size, align, &ctx->err);
1166         if (unlikely(!n))
1167                 goto ret_err;
1168
1169         address_lock(rfd, DEPTH_AUX);
1170         if (unlikely(!array_add_mayfail(void *, &rfd->ptrs, &rfd->ptrs_l, n, &old, &ctx->err))) {
1171                 rfd->ptrs = old;
1172                 address_unlock(rfd, DEPTH_AUX);
1173                 mem_free_aligned(n);
1174                 goto ret_err;
1175         }
1176         address_unlock(rfd, DEPTH_AUX);
1177
1178         io_store_typed_number(ctx, get_output(ctx, 1), int_default_t, INT_DEFAULT_N, uintptr_t, ptr_to_num(n));
1179         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1180                 goto ret_test;
1181
1182         test = POINTER_FOLLOW_THUNK_GO;
1183
1184 ret_test:
1185         return test;
1186
1187 ret_err:
1188         io_terminate_with_error(ctx, ctx->err, true, NULL);
1189         test = POINTER_FOLLOW_THUNK_EXCEPTION;
1190         goto ret_test;
1191 }
1192
1193 static void * attr_fastcall io_ffi_destructor_free_handler(struct io_ctx *ctx)
1194 {
1195         void *test;
1196         pointer_t ptr;
1197         struct resource_ffi_destructor *rfd = NULL;
1198         uintptr_t nn;
1199         void *n;
1200         size_t i;
1201
1202         test = io_deep_eval(ctx, "012", true);
1203         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1204                 goto ret_test;
1205
1206         ptr = *frame_pointer(ctx->fp, get_input(ctx, 1));
1207         ajla_assert_lo(!pointer_is_thunk(ptr), (file_line, "io_ffi_destructor_free_handler: pointer is thunk"));
1208         rfd = da_resource(pointer_get_data(ptr));
1209
1210         io_get_number(ctx, get_input(ctx, 2), int_default_t, uintptr_t, nn);
1211         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1212                 goto ret_test;
1213         n = num_to_ptr(nn);
1214
1215         address_lock(rfd, DEPTH_AUX);
1216         for (i = 0; i < rfd->ptrs_l; i++) {
1217                 if (rfd->ptrs[i] == n) {
1218                         memmove(&rfd->ptrs[i], &rfd->ptrs[i + 1], (rfd->ptrs_l - i - 1) * sizeof(void *));
1219                         rfd->ptrs_l--;
1220                         address_unlock(rfd, DEPTH_AUX);
1221                         mem_free_aligned(n);
1222                         test = POINTER_FOLLOW_THUNK_GO;
1223                         goto ret_test;
1224                 }
1225         }
1226         address_unlock(rfd, DEPTH_AUX);
1227
1228         ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
1229         goto ret_err;
1230
1231 ret_test:
1232         return test;
1233
1234 ret_err:
1235         io_terminate_with_error(ctx, ctx->err, true, NULL);
1236         test = POINTER_FOLLOW_THUNK_EXCEPTION;
1237         goto ret_test;
1238 }
1239
1240 static void * attr_fastcall io_ffi_destructor_call_handler(struct io_ctx *ctx)
1241 {
1242         void *test;
1243         pointer_t ptr;
1244         struct resource_ffi_destructor *rfd = NULL;
1245         array_index_t idx;
1246         size_t i;
1247         void *old;
1248         struct destructor_call call;
1249
1250         ctx->ptrs = NULL;
1251         ctx->ptrs_l = 0;
1252
1253         test = io_deep_eval(ctx, "0123", true);
1254         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1255                 goto ret_test;
1256
1257         ptr = *frame_pointer(ctx->fp, get_input(ctx, 1));
1258         ajla_assert_lo(!pointer_is_thunk(ptr), (file_line, "io_ffi_destructor_call_handler: pointer is thunk"));
1259         rfd = da_resource(pointer_get_data(ptr));
1260
1261         ptr = *frame_pointer(ctx->fp, get_input(ctx, 2));
1262         ajla_assert_lo(!pointer_is_thunk(ptr), (file_line, "io_ffi_destructor_call_handler: pointer is thunk"));
1263         call.d = pointer_get_data(ptr);
1264         ctx->rf = da_resource(call.d);
1265
1266         if (unlikely(!array_init_mayfail(void *, &ctx->ptrs, &ctx->ptrs_l, &ctx->err)))
1267                 goto ret_err;
1268
1269         index_from_int(&idx, 0);
1270         if (!array_onstack_iterate(ctx->fp, get_input(ctx, 3), &idx, io_get_argument_callback, ctx)) {
1271                 index_free(&idx);
1272                 goto ret_err;
1273         }
1274         index_free(&idx);
1275         if (unlikely(ctx->ptrs_l != ctx->rf->n_args)) {
1276                 ctx->err = error_ajla(EC_SYNC, AJLA_ERROR_INVALID_OPERATION);
1277                 goto ret_err;
1278         }
1279
1280         call.args = ctx->ptrs;
1281         call.args_l = ctx->ptrs_l;
1282
1283         address_lock(rfd, DEPTH_AUX);
1284         if (unlikely(!array_add_mayfail(struct destructor_call, &rfd->calls, &rfd->calls_l, call, &old, &ctx->err))) {
1285                 rfd->calls = old;
1286                 address_unlock(rfd, DEPTH_AUX);
1287                 goto ret_err;
1288         }
1289         address_unlock(rfd, DEPTH_AUX);
1290
1291         ctx->ptrs = NULL;
1292         ctx->ptrs_l = 0;
1293         pointer_reference_owned(pointer_data(call.d));
1294
1295         test = POINTER_FOLLOW_THUNK_GO;
1296
1297 ret_test:
1298         for (i = 0; i < ctx->ptrs_l; i++)
1299                 mem_free(ctx->ptrs[i]);
1300         if (ctx->ptrs)
1301                 mem_free(ctx->ptrs);
1302
1303         return test;
1304
1305 ret_err:
1306         io_terminate_with_error(ctx, ctx->err, true, NULL);
1307         test = POINTER_FOLLOW_THUNK_EXCEPTION;
1308         goto ret_test;
1309 }
1310
1311 static void * attr_fastcall io_ffi_handle_to_number_handler(struct io_ctx *ctx)
1312 {
1313         void *test;
1314         pointer_t ptr, hptr;
1315         struct resource_ffi_destructor *rfd;
1316         uintptr_t n;
1317         void *old;
1318
1319         test = io_deep_eval(ctx, "012", true);
1320         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1321                 goto ret_test;
1322
1323         ptr = *frame_pointer(ctx->fp, get_input(ctx, 1));
1324         ajla_assert_lo(!pointer_is_thunk(ptr), (file_line, "io_ffi_handle_to_number_handler: pointer is thunk"));
1325         rfd = da_resource(pointer_get_data(ptr));
1326
1327         hptr = *frame_pointer(ctx->fp, get_input(ctx, 2));
1328
1329         address_lock(rfd, DEPTH_AUX);
1330         if (unlikely(!array_add_mayfail(pointer_t, &rfd->handles, &rfd->handles_l, hptr, &old, &ctx->err))) {
1331                 rfd->handles = old;
1332                 address_unlock(rfd, DEPTH_AUX);
1333                 goto ret_err;
1334         }
1335         pointer_reference_owned(hptr);
1336         address_unlock(rfd, DEPTH_AUX);
1337
1338         io_get_handle(ctx, get_input(ctx, 2));
1339
1340         n = os_handle_to_number(ctx->handle->fd);
1341
1342         io_store_typed_number(ctx, get_output(ctx, 1), int_default_t, INT_DEFAULT_N, uintptr_t, n);
1343         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1344                 goto ret_test;
1345
1346         test = POINTER_FOLLOW_THUNK_GO;
1347
1348 ret_test:
1349         return test;
1350
1351 ret_err:
1352         io_terminate_with_error(ctx, ctx->err, true, NULL);
1353         test = POINTER_FOLLOW_THUNK_EXCEPTION;
1354         goto ret_test;
1355 }
1356
1357 static void * attr_fastcall io_ffi_number_to_handle_handler(struct io_ctx *ctx)
1358 {
1359         void *test;
1360         uintptr_t n = 0;        /* avoid warning */
1361         ajla_option_t sckt;
1362         handle_t hn;
1363         struct data *d = NULL;
1364         struct resource_handle *h;
1365
1366         test = io_deep_eval(ctx, "012", true);
1367         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1368                 goto ret_test;
1369
1370         io_get_number(ctx, get_input(ctx, 1), int_default_t, uintptr_t, n);
1371         if (unlikely(test != POINTER_FOLLOW_THUNK_GO))
1372                 goto ret_err;
1373
1374         io_get_option(ctx, get_input(ctx, 2), &sckt, NULL);
1375
1376         d = data_alloc_resource_mayfail(sizeof(struct resource_handle), handle_close, &ctx->err pass_file_line);
1377         if (unlikely(!d))
1378                 goto ret_err;
1379         h = da_resource(d);
1380
1381         hn = os_number_to_handle(n, !!sckt, &ctx->err);
1382         if (unlikely(!handle_is_valid(hn)))
1383                 goto ret_err;
1384
1385         h->fd = hn;
1386
1387         frame_set_pointer(ctx->fp, get_output(ctx, 1), pointer_data(d));
1388
1389         d = NULL;
1390         test = POINTER_FOLLOW_THUNK_GO;
1391
1392 ret_test:
1393         if (d)
1394                 data_free_r1(d);
1395         return test;
1396
1397 ret_err:
1398         io_terminate_with_error(ctx, ctx->err, true, NULL);
1399         test = POINTER_FOLLOW_THUNK_EXCEPTION;
1400         goto ret_test;
1401 }