| ""Store the bottom 32 bits of @i{w} at @i{c_addr}."" |
""Store the bottom 32 bits of @i{w} at @i{c_addr}."" |
| *(Tetrabyte*)(c_addr) = w; |
*(Tetrabyte*)(c_addr) = w; |
| |
|
| \+FFCALL |
|
| |
|
| av-start-void ( c_addr -- ) gforth av_start_void |
|
| av_start_void(alist, c_addr); |
|
| |
|
| av-start-int ( c_addr -- ) gforth av_start_int |
|
| av_start_int(alist, c_addr, &irv); |
|
| |
|
| av-start-float ( c_addr -- ) gforth av_start_float |
|
| av_start_float(alist, c_addr, &frv); |
|
| |
|
| av-start-double ( c_addr -- ) gforth av_start_double |
|
| av_start_double(alist, c_addr, &drv); |
|
| |
|
| av-start-longlong ( c_addr -- ) gforth av_start_longlong |
|
| av_start_longlong(alist, c_addr, &llrv); |
|
| |
|
| av-start-ptr ( c_addr -- ) gforth av_start_ptr |
|
| av_start_ptr(alist, c_addr, void*, &prv); |
|
| |
|
| av-int ( w -- ) gforth av_int |
|
| av_int(alist, w); |
|
| |
|
| av-float ( r -- ) gforth av_float |
|
| av_float(alist, r); |
|
| |
|
| av-double ( r -- ) gforth av_double |
|
| av_double(alist, r); |
|
| |
|
| av-longlong ( d -- ) gforth av_longlong |
|
| #ifdef BUGGY_LL_SIZE |
|
| av_longlong(alist, DLO(d)); |
|
| #else |
|
| av_longlong(alist, d); |
|
| #endif |
|
| |
|
| av-ptr ( c_addr -- ) gforth av_ptr |
|
| av_ptr(alist, void*, c_addr); |
|
| |
|
| av-int-r ( R:w -- ) gforth av_int_r |
|
| av_int(alist, w); |
|
| |
|
| av-float-r ( -- ) gforth av_float_r |
|
| float r = *(Float*)lp; |
|
| lp += sizeof(Float); |
|
| av_float(alist, r); |
|
| |
|
| av-double-r ( -- ) gforth av_double_r |
|
| double r = *(Float*)lp; |
|
| lp += sizeof(Float); |
|
| av_double(alist, r); |
|
| |
|
| av-longlong-r ( R:d -- ) gforth av_longlong_r |
|
| #ifdef BUGGY_LL_SIZE |
|
| av_longlong(alist, DLO(d)); |
|
| #else |
|
| av_longlong(alist, d); |
|
| #endif |
|
| |
|
| av-ptr-r ( R:c_addr -- ) gforth av_ptr_r |
|
| av_ptr(alist, void*, c_addr); |
|
| |
|
| av-call-void ( ... -- ... ) gforth av_call_void |
|
| SAVE_REGS |
|
| av_call(alist); |
|
| REST_REGS |
|
| |
|
| av-call-int ( ... -- ... w ) gforth av_call_int |
|
| SAVE_REGS |
|
| av_call(alist); |
|
| REST_REGS |
|
| w = irv; |
|
| |
|
| av-call-float ( ... -- ... r ) gforth av_call_float |
|
| SAVE_REGS |
|
| av_call(alist); |
|
| REST_REGS |
|
| r = frv; |
|
| |
|
| av-call-double ( ... -- ... r ) gforth av_call_double |
|
| SAVE_REGS |
|
| av_call(alist); |
|
| REST_REGS |
|
| r = drv; |
|
| |
|
| av-call-longlong ( ... -- ... d ) gforth av_call_longlong |
|
| SAVE_REGS |
|
| av_call(alist); |
|
| REST_REGS |
|
| #ifdef BUGGY_LONG_LONG |
|
| DLO_IS(d, llrv); |
|
| DHI_IS(d, 0); |
|
| #else |
|
| d = llrv; |
|
| #endif |
|
| |
|
| av-call-ptr ( ... -- ... c_addr ) gforth av_call_ptr |
|
| SAVE_REGS |
|
| av_call(alist); |
|
| REST_REGS |
|
| c_addr = prv; |
|
| |
|
| alloc-callback ( a_ip -- c_addr ) gforth alloc_callback |
|
| c_addr = (char *)alloc_callback(gforth_callback, (Xt *)a_ip); |
|
| |
|
| va-start-void ( -- ) gforth va_start_void |
|
| va_start_void(gforth_clist); |
|
| |
|
| va-start-int ( -- ) gforth va_start_int |
|
| va_start_int(gforth_clist); |
|
| |
|
| va-start-longlong ( -- ) gforth va_start_longlong |
|
| va_start_longlong(gforth_clist); |
|
| |
|
| va-start-ptr ( -- ) gforth va_start_ptr |
|
| va_start_ptr(gforth_clist, (char *)); |
|
| |
|
| va-start-float ( -- ) gforth va_start_float |
|
| va_start_float(gforth_clist); |
|
| |
|
| va-start-double ( -- ) gforth va_start_double |
|
| va_start_double(gforth_clist); |
|
| |
|
| va-arg-int ( -- w ) gforth va_arg_int |
|
| w = va_arg_int(gforth_clist); |
|
| |
|
| va-arg-longlong ( -- d ) gforth va_arg_longlong |
|
| #ifdef BUGGY_LONG_LONG |
|
| DLO_IS(d, va_arg_longlong(gforth_clist)); |
|
| DHI_IS(d, 0); |
|
| #else |
|
| d = va_arg_longlong(gforth_clist); |
|
| #endif |
|
| |
|
| va-arg-ptr ( -- c_addr ) gforth va_arg_ptr |
|
| c_addr = (char *)va_arg_ptr(gforth_clist,char*); |
|
| |
|
| va-arg-float ( -- r ) gforth va_arg_float |
|
| r = va_arg_float(gforth_clist); |
|
| |
|
| va-arg-double ( -- r ) gforth va_arg_double |
|
| r = va_arg_double(gforth_clist); |
|
| |
|
| va-return-void ( -- ) gforth va_return_void |
|
| va_return_void(gforth_clist); |
|
| return 0; |
|
| |
|
| va-return-int ( w -- ) gforth va_return_int |
|
| va_return_int(gforth_clist, w); |
|
| return 0; |
|
| |
|
| va-return-ptr ( c_addr -- ) gforth va_return_ptr |
|
| va_return_ptr(gforth_clist, void *, c_addr); |
|
| return 0; |
|
| |
|
| va-return-longlong ( d -- ) gforth va_return_longlong |
|
| #ifdef BUGGY_LONG_LONG |
|
| va_return_longlong(gforth_clist, d.lo); |
|
| #else |
|
| va_return_longlong(gforth_clist, d); |
|
| #endif |
|
| return 0; |
|
| |
|
| va-return-float ( r -- ) gforth va_return_float |
|
| va_return_float(gforth_clist, r); |
|
| return 0; |
|
| |
|
| va-return-double ( r -- ) gforth va_return_double |
|
| va_return_double(gforth_clist, r); |
|
| return 0; |
|
| |
|
| \+ |
|
| |
|
| \+LIBFFI |
|
| |
|
| ffi-type ( n -- a_type ) gforth ffi_type |
|
| static void* ffi_types[] = |
|
| { &ffi_type_void, |
|
| &ffi_type_uint8, &ffi_type_sint8, |
|
| &ffi_type_uint16, &ffi_type_sint16, |
|
| &ffi_type_uint32, &ffi_type_sint32, |
|
| &ffi_type_uint64, &ffi_type_sint64, |
|
| &ffi_type_float, &ffi_type_double, &ffi_type_longdouble, |
|
| &ffi_type_pointer }; |
|
| a_type = ffi_types[n]; |
|
| |
|
| ffi-size ( n1 -- n2 ) gforth ffi_size |
|
| static int ffi_sizes[] = |
|
| { sizeof(ffi_cif), sizeof(ffi_closure) }; |
|
| n2 = ffi_sizes[n1]; |
|
| |
|
| ffi-prep-cif ( a_atypes n a_rtype a_cif -- w ) gforth ffi_prep_cif |
|
| w = ffi_prep_cif((ffi_cif *)a_cif, FFI_DEFAULT_ABI, n, |
|
| (ffi_type *)a_rtype, (ffi_type **)a_atypes); |
|
| |
|
| ffi-call ( a_avalues a_rvalue a_ip a_cif -- ) gforth ffi_call |
|
| SAVE_REGS |
|
| ffi_call((ffi_cif *)a_cif, (void(*)())a_ip, (void *)a_rvalue, (void **)a_avalues); |
|
| REST_REGS |
|
| |
|
| ffi-prep-closure ( a_ip a_cif a_closure -- w ) gforth ffi_prep_closure |
|
| w = ffi_prep_closure((ffi_closure *)a_closure, (ffi_cif *)a_cif, gforth_callback, (void *)a_ip); |
|
| |
|
| ffi-2@ ( a_addr -- d ) gforth ffi_2fetch |
|
| #ifdef BUGGY_LONG_LONG |
|
| DLO_IS(d, *(Cell*)(*a_addr)); |
|
| DHI_IS(d, 0); |
|
| #else |
|
| d = *(DCell*)(a_addr); |
|
| #endif |
|
| |
|
| ffi-2! ( d a_addr -- ) gforth ffi_2store |
|
| #ifdef BUGGY_LONG_LONG |
|
| *(Cell*)(a_addr) = DLO(d); |
|
| #else |
|
| *(DCell*)(a_addr) = d; |
|
| #endif |
|
| |
|
| ffi-arg-int ( -- w ) gforth ffi_arg_int |
|
| w = *(int *)(*gforth_clist++); |
|
| |
|
| ffi-arg-long ( -- w ) gforth ffi_arg_long |
|
| w = *(long *)(*gforth_clist++); |
|
| |
|
| ffi-arg-longlong ( -- d ) gforth ffi_arg_longlong |
|
| #ifdef BUGGY_LONG_LONG |
|
| DLO_IS(d, *(Cell*)(*gforth_clist++)); |
|
| DHI_IS(d, -(*(Cell*)(*gforth_clist++)<0)); |
|
| #else |
|
| d = *(DCell*)(*gforth_clist++); |
|
| #endif |
|
| |
|
| ffi-arg-dlong ( -- d ) gforth ffi_arg_dlong |
|
| #ifdef BUGGY_LONG_LONG |
|
| DLO_IS(d, *(Cell*)(*gforth_clist++)); |
|
| DHI_IS(d, -(*(Cell*)(*gforth_clist++)<0)); |
|
| #else |
|
| d = *(Cell*)(*gforth_clist++); |
|
| #endif |
|
| |
|
| ffi-arg-ptr ( -- c_addr ) gforth ffi_arg_ptr |
|
| c_addr = *(Char **)(*gforth_clist++); |
|
| |
|
| ffi-arg-float ( -- r ) gforth ffi_arg_float |
|
| r = *(float*)(*gforth_clist++); |
|
| |
|
| ffi-arg-double ( -- r ) gforth ffi_arg_double |
|
| r = *(double*)(*gforth_clist++); |
|
| |
|
| ffi-ret-void ( -- ) gforth ffi_ret_void |
|
| return 0; |
|
| |
|
| ffi-ret-int ( w -- ) gforth ffi_ret_int |
|
| *(int*)(gforth_ritem) = w; |
|
| return 0; |
|
| |
|
| ffi-ret-longlong ( d -- ) gforth ffi_ret_longlong |
|
| #ifdef BUGGY_LONG_LONG |
|
| *(Cell*)(gforth_ritem) = DLO(d); |
|
| #else |
|
| *(DCell*)(gforth_ritem) = d; |
|
| #endif |
|
| return 0; |
|
| |
|
| ffi-ret-dlong ( d -- ) gforth ffi_ret_dlong |
|
| #ifdef BUGGY_LONG_LONG |
|
| *(Cell*)(gforth_ritem) = DLO(d); |
|
| #else |
|
| *(Cell*)(gforth_ritem) = d; |
|
| #endif |
|
| return 0; |
|
| |
|
| ffi-ret-long ( n -- ) gforth ffi_ret_long |
|
| *(Cell*)(gforth_ritem) = n; |
|
| return 0; |
|
| |
|
| ffi-ret-ptr ( c_addr -- ) gforth ffi_ret_ptr |
|
| *(Char **)(gforth_ritem) = c_addr; |
|
| return 0; |
|
| |
|
| ffi-ret-float ( r -- ) gforth ffi_ret_float |
|
| *(float*)(gforth_ritem) = r; |
|
| return 0; |
|
| |
|
| ffi-ret-double ( r -- ) gforth ffi_ret_double |
|
| *(double*)(gforth_ritem) = r; |
|
| return 0; |
|
| |
|
| \+ |
|
| |
|
| \+OLDCALL |
|
| |
|
| define(`uploop', |
|
| `pushdef(`$1', `$2')_uploop(`$1', `$2', `$3', `$4', `$5')`'popdef(`$1')') |
|
| define(`_uploop', |
|
| `ifelse($1, `$3', `$5', |
|
| `$4`'define(`$1', incr($1))_uploop(`$1', `$2', `$3', `$4', `$5')')') |
|
| |
|
| \ argflist(argnum): Forth argument list |
|
| define(argflist, |
|
| `ifelse($1, 0, `', |
|
| `uploop(`_i', 1, $1, ``u''`_i ', ``u''`_i')')') |
|
| \ argdlist(argnum): declare C's arguments |
|
| define(argdlist, |
|
| `ifelse($1, 0, `', |
|
| `uploop(`_i', 1, $1, `Cell, ', `Cell')')') |
|
| \ argclist(argnum): pass C's arguments |
|
| define(argclist, |
|
| `ifelse($1, 0, `', |
|
| `uploop(`_i', 1, $1, ``u''`_i, ', ``u''`_i')')') |
|
| \ icall(argnum) |
|
| define(icall, |
|
| `icall$1 ( argflist($1) u -- uret ) gforth |
|
| uret = (SYSCALL(Cell(*)(argdlist($1)))u)(argclist($1)); |
|
| |
|
| ') |
|
| define(fcall, |
|
| `fcall$1 ( argflist($1) u -- rret ) gforth |
|
| rret = (SYSCALL(Float(*)(argdlist($1)))u)(argclist($1)); |
|
| |
|
| ') |
|
| |
|
| \ close ' to keep fontify happy |
|
| |
|
| uploop(i, 0, 7, `icall(i)') |
|
| icall(20) |
|
| uploop(i, 0, 7, `fcall(i)') |
|
| fcall(20) |
|
| |
|
| \+ |
|
| |
|
| lib-error ( -- c_addr u ) gforth lib_error |
lib-error ( -- c_addr u ) gforth lib_error |
| c_addr = lt_dlerror(); |
c_addr = lt_dlerror(); |
| u = (c_addr == NULL) ? 0 : strlen(c_addr); |
u = (c_addr == NULL) ? 0 : strlen(c_addr); |
