version 1.177, 2005/09/27 13:50:43
|
version 1.184, 2005/12/31 15:46:10
|
Line 1
|
Line 1
|
\ Gforth primitives |
\ Gforth primitives |
|
|
\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 2444 FP=fp;
|
Line 2444 FP=fp;
|
sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP); |
sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP); |
fp=FP; |
fp=FP; |
|
|
|
w@ ( a_addr -- u ) gforth wfetch |
|
u = *(UWyde*)(a_addr); |
|
|
|
sw@ ( a_addr -- u ) gforth swfetch |
|
u = *(Wyde*)(a_addr); |
|
|
|
w! ( u a_addr -- ) gforth wstore |
|
*(Wyde*)(a_addr) = u; |
|
|
|
l@ ( a_addr -- u ) gforth lfetch |
|
u = *(UTetrabyte*)(a_addr); |
|
|
|
sl@ ( a_addr -- u ) gforth slfetch |
|
u = *(Tetrabyte*)(a_addr); |
|
|
|
l! ( u a_addr -- ) gforth lstore |
|
*(Tetrabyte*)(a_addr) = u; |
|
|
\+FFCALL |
\+FFCALL |
|
|
av-start-void ( c_addr -- ) gforth av_start_void |
av-start-void ( c_addr -- ) gforth av_start_void |
Line 2639 ffi-prep-cif ( a_atypes n a_rtype a_cif
|
Line 2657 ffi-prep-cif ( a_atypes n a_rtype a_cif
|
w = ffi_prep_cif(a_cif, FFI_DEFAULT_ABI, n, a_rtype, a_atypes); |
w = ffi_prep_cif(a_cif, FFI_DEFAULT_ABI, n, a_rtype, a_atypes); |
|
|
ffi-call ( a_avalues a_rvalue a_ip a_cif -- ) gforth ffi_call |
ffi-call ( a_avalues a_rvalue a_ip a_cif -- ) gforth ffi_call |
|
SAVE_REGS |
ffi_call(a_cif, a_ip, a_rvalue, a_avalues); |
ffi_call(a_cif, a_ip, a_rvalue, a_avalues); |
|
REST_REGS |
|
|
ffi-prep-closure ( a_ip a_cif a_closure -- w ) gforth ffi_prep_closure |
ffi-prep-closure ( a_ip a_cif a_closure -- w ) gforth ffi_prep_closure |
w = ffi_prep_closure(a_closure, a_cif, ffi_callback, a_ip); |
w = ffi_prep_closure(a_closure, a_cif, ffi_callback, a_ip); |
Line 2649 ffi-2@ ( a_addr -- d ) gforth ffi_2fetch
|
Line 2669 ffi-2@ ( a_addr -- d ) gforth ffi_2fetch
|
DLO_IS(d, (Cell*)(*a_addr)); |
DLO_IS(d, (Cell*)(*a_addr)); |
DHI_IS(d, 0); |
DHI_IS(d, 0); |
#else |
#else |
d = *(DCell*)(*a_addr); |
d = *(DCell*)(a_addr); |
#endif |
#endif |
|
|
ffi-2! ( d a_addr -- ) gforth ffi_2store |
ffi-2! ( d a_addr -- ) gforth ffi_2store |
Line 2660 ffi-2! ( d a_addr -- ) gforth ffi_2store
|
Line 2680 ffi-2! ( d a_addr -- ) gforth ffi_2store
|
#endif |
#endif |
|
|
ffi-arg-int ( -- w ) gforth ffi_arg_int |
ffi-arg-int ( -- w ) gforth ffi_arg_int |
w = *(Cell*)(*clist++); |
w = *(int *)(*clist++); |
|
|
ffi-arg-longlong ( -- d ) gforth ffi_arg_longlong |
ffi-arg-longlong ( -- d ) gforth ffi_arg_longlong |
#ifdef BUGGY_LONG_LONG |
#ifdef BUGGY_LONG_LONG |
Line 2679 r = *(float*)(*clist++);
|
Line 2699 r = *(float*)(*clist++);
|
ffi-arg-double ( -- r ) gforth ffi_arg_double |
ffi-arg-double ( -- r ) gforth ffi_arg_double |
r = *(double*)(*clist++); |
r = *(double*)(*clist++); |
|
|
ffi-ret-int ( -- w ) gforth ffi_ret_int |
ffi-ret-void ( -- ) gforth ffi_ret_void |
|
return 0; |
|
|
|
ffi-ret-int ( w -- ) gforth ffi_ret_int |
*(int*)(ritem) = w; |
*(int*)(ritem) = w; |
|
return 0; |
|
|
ffi-ret-longlong ( -- d ) gforth ffi_ret_longlong |
ffi-ret-longlong ( d -- ) gforth ffi_ret_longlong |
#ifdef BUGGY_LONG_LONG |
#ifdef BUGGY_LONG_LONG |
*(Cell*)(ritem) = DLO(d); |
*(Cell*)(ritem) = DLO(d); |
#else |
#else |
*(DCell*)(ritem) = d; |
*(DCell*)(ritem) = d; |
#endif |
#endif |
|
return 0; |
|
|
ffi-ret-ptr ( -- c_addr ) gforth ffi_ret_ptr |
ffi-ret-ptr ( c_addr -- ) gforth ffi_ret_ptr |
*(char **)(ritem) = c_addr; |
*(char **)(ritem) = c_addr; |
|
return 0; |
|
|
ffi-ret-float ( -- r ) gforth ffi_ret_float |
ffi-ret-float ( r -- ) gforth ffi_ret_float |
*(float*)(ritem) = r; |
*(float*)(ritem) = r; |
|
return 0; |
|
|
ffi-ret-double ( -- r ) gforth ffi_ret_double |
ffi-ret-double ( r -- ) gforth ffi_ret_double |
*(double*)(ritem) = r; |
*(double*)(ritem) = r; |
|
return 0; |
|
|
\+ |
\+ |
|
|