newlib/ffi.ajla

   1 {*
   2  * Copyright (C) 2024, 2025 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 unit ffi;
  20
  21 uses io;
  22
  23 type ffi_structure;
  24
  25 option ffi_type [
  26         t_void;
  27         t_uint8;
  28         t_sint8;
  29         t_uint16;
  30         t_sint16;
  31         t_uint32;
  32         t_sint32;
  33         t_uint64;
  34         t_sint64;
  35         t_float;
  36         t_double;
  37         t_longdouble;
  38         t_pointer;
  39         t_uchar;
  40         t_schar;
  41         t_ushort;
  42         t_sshort;
  43         t_uint;
  44         t_sint;
  45         t_ulong;
  46         t_slong;
  47         t_usize;
  48         t_ssize;
  49         t_bool;
  50         t_structure : ffi_structure;
  51 ]
  52
  53 option ffi_error [
  54         e_none;
  55         e_errno;
  56         e_get_last_error;
  57         e_get_last_socket_error;
  58 ]
  59
  60 type ffi_function;
  61 type ffi_destructor;
  62
  63 fn ffi_unsafe_get_world : world;
  64
  65 fn ffi_get_size(ft : ffi_type) : int;
  66 fn ffi_get_alignment(ft : ffi_type) : int;
  67
  68 fn ffi_create_structure(elements : list(ffi_type)) : (ffi_structure, list(int));
  69 fn ffi_get_structure_offset(str : ffi_structure, element : int) : int;
  70
  71 fn ffi_poke(w : world, ptr : int, ft : ffi_type, val : int) : world;
  72 fn ffi_peek(w : world, ptr : int, ft : ffi_type) : (world, int);
  73
  74 fn ffi_poke_array(t : type, w : world, ptr : int, a : list(t)) : world;
  75 fn ffi_peek_array(w : world, ptr : int, l : int, ft : ffi_type, t : type) : (world, list(t));
  76
  77 fn ffi_poke_zstring(w : world, destr : ffi_destructor, str : bytes) : (world, int);
  78 fn ffi_peek_zstring(w : world, addr : int) : (world, bytes);
  79
  80 fn ffi_handle_to_number(w : world, desc : ffi_destructor, h : handle) : (world, int);
  81 fn ffi_number_to_handle(w : world, n : int, sckt : bool) : (world, handle);
  82
  83 fn ffi_create_function(filename : bytes, funcname : bytes, err_type : ffi_error, nvarargs : int, rtype : ffi_type, args : list(ffi_type)) : ffi_function;
  84 fn ffi_call_function(w : world, func : ffi_function, args : list(int)) : (world, int, int);
  85
  86 fn ffi_encode_float(f : real32) : int;
  87 fn ffi_encode_double(f : real64) : int;
  88 fn ffi_encode_longdouble(f : real80) : int;
  89 fn ffi_decode_float(i : int) : real32;
  90 fn ffi_decode_double(i : int) : real64;
  91 fn ffi_decode_longdouble(i : int) : real80;
  92
  93 fn ffi_destructor_new(w : world) : (world, ffi_destructor);
  94 fn ffi_destructor_destroy(w : world, fd : ffi_destructor) : world;
  95 fn ffi_destructor_allocate(w : world, fd : ffi_destructor, size align : int, zero : bool) : (world, int);
  96 fn ffi_destructor_free(w : world, fd : ffi_destructor, ptr : int) : world;
  97 fn ffi_destructor_call(w : world, fd : ffi_destructor, func : ffi_function, args : list(int)) : world;
  98
  99 implementation
 100
 101 type ffi_structure := internal_type;
 102 type ffi_function := internal_type;
 103
 104 fn ffi_unsafe_get_world : world
 105 [
 106         return unsafe_get_world;
 107 ]
 108
 109 fn ffi_get_size(ft : ffi_type) : int
 110 [
 111         var r : int;
 112         pcode IO IO_FFI_Get_Size_Alignment 1 1 1 =r ft 0;
 113         return r;
 114 ]
 115
 116 fn ffi_get_alignment(ft : ffi_type) : int
 117 [
 118         var r : int;
 119         pcode IO IO_FFI_Get_Size_Alignment 1 1 1 =r ft 1;
 120         return r;
 121 ]
 122
 123 fn ffi_create_structure(elements : list(ffi_type)) : (ffi_structure, list(int))
 124 [
 125         var r : ffi_structure;
 126         var offs : list(int);
 127         pcode IO IO_FFI_Create_Structure 2 1 0 =r =offs elements;
 128         return r, offs;
 129 ]
 130
 131 fn ffi_get_structure_offset(str : ffi_structure, element : int) : int
 132 [
 133         var r : int;
 134         pcode IO IO_FFI_Structure_Offset 1 2 0 =r str element;
 135         return r;
 136 ]
 137
 138 fn ffi_poke(w : world, ptr : int, ft : ffi_type, val : int) : world
 139 [
 140         var w2 : world;
 141         pcode IO IO_FFI_Poke 1 4 0 =w2 w ptr ft val;
 142         return w2;
 143 ]
 144
 145 fn ffi_peek(w : world, ptr : int, ft : ffi_type) : (world, int)
 146 [
 147         var r : int;
 148         var w2 : world;
 149         pcode IO IO_FFI_Peek 2 3 0 =w2 =r w ptr ft;
 150         return w2, r;
 151 ]
 152
 153 fn ffi_poke_array(t : type, w : world, ptr : int, a : list(t)) : world
 154 [
 155         var w2 : world;
 156         pcode IO IO_FFI_Poke_Array 1 3 0 =w2 w ptr a;
 157         return w2;
 158 ]
 159
 160 fn ffi_peek_array(w : world, ptr : int, l : int, ft : ffi_type, t : type) : (world, list(t))
 161 [
 162         var r : list(t);
 163         var w2 : world;
 164         pcode IO IO_FFI_Peek_Array 2 4 0 =w2 =r w ptr l ft;
 165         return w2, r;
 166 ]
 167
 168 fn ffi_poke_zstring(w : world, destr : ffi_destructor, str : bytes) : (world, int)
 169 [
 170         var mem_str : int;
 171         w, mem_str := ffi_destructor_allocate(w, destr, len(str) + 1, 1, false);
 172         w := ffi_poke_array(w, mem_str, str);
 173         w := ffi_poke(w, mem_str + len(str), ffi_type.t_uchar, 0);
 174         return w, mem_str;
 175 ]
 176
 177 fn ffi_peek_zstring(w : world, addr : int) : (world, bytes)
 178 [
 179         var result := empty(byte);
 180         while true do [
 181                 var c : int;
 182                 w, c := ffi_peek(w, addr, ffi_type.t_uchar);
 183                 if c = 0 then
 184                         break;
 185                 result +<= c;
 186                 addr += 1;
 187         ]
 188         return w, result;
 189 ]
 190
 191 fn ffi_handle_to_number(w : world, desc : ffi_destructor, h : handle) : (world, int)
 192 [
 193         var n : int;
 194         var w2 : world;
 195         pcode IO IO_FFI_Handle_To_Number 2 3 0 =w2 =n w desc h;
 196         return w2, n;
 197 ]
 198
 199 fn ffi_number_to_handle(w : world, n : int, sckt : bool) : (world, handle)
 200 [
 201         var h : handle;
 202         var w2 : world;
 203         pcode IO IO_FFI_Number_To_Handle 2 3 0 =w2 =h w n sckt;
 204         return w2, h;
 205 ]
 206
 207 fn ffi_create_function(filename : bytes, funcname : bytes, err_type : ffi_error, nvarargs : int, rtype : ffi_type, args : list(ffi_type)) : ffi_function
 208 [
 209         var r : ffi_function;
 210         pcode IO IO_FFI_Create_Function 1 6 0 =r filename funcname err_type nvarargs rtype args;
 211         return r;
 212 ]
 213
 214 fn ffi_call_function(w : world, func : ffi_function, args : list(int)) : (world, int, int)
 215 [
 216         var r e : int;
 217         var w2 : world;
 218         pcode IO IO_FFI_Call_Function 3 3 0 =w2 =r =e w func args;
 219         return w2, r, e;
 220 ]
 221
 222 fn ffi_encode_float(f : real32) : int
 223 [
 224         var r : int;
 225         pcode IO IO_FFI_Encode_Real 1 1 0 =r f;
 226         return r;
 227 ]
 228
 229 fn ffi_encode_double(f : real64) : int
 230 [
 231         var r : int;
 232         pcode IO IO_FFI_Encode_Real 1 1 0 =r f;
 233         return r;
 234 ]
 235
 236 fn ffi_encode_longdouble(f : real80) : int
 237 [
 238         var r : int;
 239         pcode IO IO_FFI_Encode_Real 1 1 0 =r f;
 240         return r;
 241 ]
 242
 243 fn ffi_decode_float(i : int) : real32
 244 [
 245         var r : real32;
 246         pcode IO IO_FFI_Decode_Real 1 1 0 =r i;
 247         return r;
 248 ]
 249
 250 fn ffi_decode_double(i : int) : real64
 251 [
 252         var r : real64;
 253         pcode IO IO_FFI_Decode_Real 1 1 0 =r i;
 254         return r;
 255 ]
 256
 257 fn ffi_decode_longdouble(i : int) : real80
 258 [
 259         var r : real80;
 260         pcode IO IO_FFI_Decode_Real 1 1 0 =r i;
 261         return r;
 262 ]
 263
 264 type ffi_destructor := internal_type;
 265
 266 fn ffi_destructor_new(w : world) : (world, ffi_destructor)
 267 [
 268         var r : ffi_destructor;
 269         var w2 : world;
 270         pcode IO IO_FFI_Destructor_New 2 1 0 =w2 =r w;
 271         return w2, r;
 272 ]
 273
 274 fn ffi_destructor_destroy(w : world, fd : ffi_destructor) : world
 275 [
 276         var w2 : world;
 277         pcode IO IO_Consume_Parameters 1 2 0 =w2 w fd;
 278         return w2;
 279 ]
 280
 281 fn ffi_destructor_allocate(w : world, fd : ffi_destructor, size align : int, zero : bool) : (world, int)
 282 [
 283         var r : int;
 284         var w2 : world;
 285         pcode IO IO_FFI_Destructor_Allocate 2 5 0 =w2 =r w fd size align zero;
 286         return w2, r;
 287 ]
 288
 289 fn ffi_destructor_free(w : world, fd : ffi_destructor, ptr : int) : world
 290 [
 291         var w2 : world;
 292         pcode IO IO_FFI_Destructor_Free 1 3 0 =w2 w fd ptr;
 293         return w2;
 294 ]
 295
 296 fn ffi_destructor_call(w : world, fd : ffi_destructor, func : ffi_function, args : list(int)) : world
 297 [
 298         var w2 : world;
 299         pcode IO IO_FFI_Destructor_Call 1 4 0 =w2 w fd func args;
 300         return w2;
 301 ]