version 1.179, 2005/11/27 22:47:18
|
version 1.187, 2006/01/29 18:34:33
|
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 873 division by 2 (note that @code{/} not ne
|
Line 873 division by 2 (note that @code{/} not ne
|
n2 = n1>>1; |
n2 = n1>>1; |
: |
: |
dup MINI and IF 1 ELSE 0 THEN |
dup MINI and IF 1 ELSE 0 THEN |
[ bits/byte cell * 1- ] literal |
[ bits/char cell * 1- ] literal |
0 DO 2* swap dup 2* >r MINI and |
0 DO 2* swap dup 2* >r MINI and |
IF 1 ELSE 0 THEN or r> swap |
IF 1 ELSE 0 THEN or r> swap |
LOOP nip ; |
LOOP nip ; |
Line 1229 useraddr ( #u -- a_addr ) new
|
Line 1229 useraddr ( #u -- a_addr ) new
|
a_addr = (Cell *)(up+u); |
a_addr = (Cell *)(up+u); |
|
|
up! ( a_addr -- ) gforth up_store |
up! ( a_addr -- ) gforth up_store |
UP=up=(char *)a_addr; |
gforth_UP=up=(char *)a_addr; |
: |
: |
up ! ; |
up ! ; |
Variable UP |
Variable UP |
Line 1788 access the stack itself. The stack point
|
Line 1788 access the stack itself. The stack point
|
variables @code{SP} and @code{FP}."" |
variables @code{SP} and @code{FP}."" |
/* This is a first attempt at support for calls to C. This may change in |
/* This is a first attempt at support for calls to C. This may change in |
the future */ |
the future */ |
FP=fp; |
gforth_FP=fp; |
SP=sp; |
gforth_SP=sp; |
((void (*)())w)(); |
((void (*)())w)(); |
sp=SP; |
sp=gforth_SP; |
fp=FP; |
fp=gforth_FP; |
|
|
\+ |
\+ |
\+file |
\+file |
Line 2440 u3 = 0;
|
Line 2440 u3 = 0;
|
#endif |
#endif |
|
|
wcall ( ... u -- ... ) gforth |
wcall ( ... u -- ... ) gforth |
FP=fp; |
gforth_FP=fp; |
sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &FP); |
sp=(Cell*)(SYSCALL(Cell*(*)(Cell *, void *))u)(sp, &gforth_FP); |
fp=FP; |
fp=gforth_FP; |
|
|
|
uw@ ( c_addr -- u ) gforth u_w_fetch |
|
""@i{u} is the zero-extended 16-bit value stored at @i{c_addr}."" |
|
u = *(UWyde*)(c_addr); |
|
|
|
sw@ ( c_addr -- n ) gforth s_w_fetch |
|
""@i{n} is the sign-extended 16-bit value stored at @i{c_addr}."" |
|
n = *(Wyde*)(c_addr); |
|
|
|
w! ( w c_addr -- ) gforth w_store |
|
""Store the bottom 16 bits of @i{w} at @i{c_addr}."" |
|
*(Wyde*)(c_addr) = w; |
|
|
|
ul@ ( c_addr -- u ) gforth u_l_fetch |
|
""@i{u} is the zero-extended 32-bit value stored at @i{c_addr}."" |
|
u = *(UTetrabyte*)(c_addr); |
|
|
|
sl@ ( c_addr -- n ) gforth s_l_fetch |
|
""@i{n} is the sign-extended 32-bit value stored at @i{c_addr}."" |
|
n = *(Tetrabyte*)(c_addr); |
|
|
|
l! ( w c_addr -- ) gforth l_store |
|
""Store the bottom 32 bits of @i{w} at @i{c_addr}."" |
|
*(Tetrabyte*)(c_addr) = w; |
|
|
\+FFCALL |
\+FFCALL |
|
|
Line 2547 REST_REGS
|
Line 2571 REST_REGS
|
c_addr = prv; |
c_addr = prv; |
|
|
alloc-callback ( a_ip -- c_addr ) gforth alloc_callback |
alloc-callback ( a_ip -- c_addr ) gforth alloc_callback |
c_addr = (char *)alloc_callback(engine_callback, (Xt *)a_ip); |
c_addr = (char *)alloc_callback(gforth_callback, (Xt *)a_ip); |
|
|
va-start-void ( -- ) gforth va_start_void |
va-start-void ( -- ) gforth va_start_void |
va_start_void(clist); |
va_start_void(clist); |
Line 2639 ffi-prep-cif ( a_atypes n a_rtype a_cif
|
Line 2663 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, gforth_callback, a_ip); |
|
|
ffi-i@ ( a_addr -- n ) gforth ffi_ifetch |
|
n = *(int*)(a_addr); |
|
|
|
ffi-i! ( n a_addr -- ) gforth ffi_istore |
|
*(int*)(a_addr) = n; |
|
|
|
ffi-2@ ( a_addr -- d ) gforth ffi_2fetch |
ffi-2@ ( a_addr -- d ) gforth ffi_2fetch |
#ifdef BUGGY_LONG_LONG |
#ifdef BUGGY_LONG_LONG |