version 1.7, 1997/12/14 01:15:19
|
version 1.11, 1998/10/07 18:29:38
|
Line 1327 a_addr = (Cell *)DOES_CODE(xt);
|
Line 1327 a_addr = (Cell *)DOES_CODE(xt);
|
code-address! c_addr xt -- gforth code_address_store |
code-address! c_addr xt -- gforth code_address_store |
""Creates a code field with code address c_addr at xt"" |
""Creates a code field with code address c_addr at xt"" |
MAKE_CF(xt, c_addr); |
MAKE_CF(xt, c_addr); |
CACHE_FLUSH(xt,PFA(0)); |
CACHE_FLUSH(xt,(size_t)PFA(0)); |
: |
: |
! ; |
! ; |
|
|
Line 1335 does-code! a_addr xt -- gforth does_cod
|
Line 1335 does-code! a_addr xt -- gforth does_cod
|
""creates a code field at xt for a defining-word-defined word; a_addr |
""creates a code field at xt for a defining-word-defined word; a_addr |
is the start of the Forth code after DOES>"" |
is the start of the Forth code after DOES>"" |
MAKE_DOES_CF(xt, a_addr); |
MAKE_DOES_CF(xt, a_addr); |
CACHE_FLUSH(xt,PFA(0)); |
CACHE_FLUSH(xt,(size_t)PFA(0)); |
: |
: |
dodoes: over ! cell+ ! ; |
dodoes: over ! cell+ ! ; |
|
|
Line 1343 does-handler! a_addr -- gforth does_hand
|
Line 1343 does-handler! a_addr -- gforth does_hand
|
""creates a DOES>-handler at address a_addr. a_addr usually points |
""creates a DOES>-handler at address a_addr. a_addr usually points |
just behind a DOES>."" |
just behind a DOES>."" |
MAKE_DOES_HANDLER(a_addr); |
MAKE_DOES_HANDLER(a_addr); |
CACHE_FLUSH(a_addr,DOES_HANDLER_SIZE); |
CACHE_FLUSH((caddr_t)a_addr,DOES_HANDLER_SIZE); |
: |
: |
drop ; |
drop ; |
|
|
Line 1980 f>l r -- gforth f_to_l
|
Line 1980 f>l r -- gforth f_to_l
|
lp -= sizeof(Float); |
lp -= sizeof(Float); |
*(Float *)lp = r; |
*(Float *)lp = r; |
|
|
|
fpick u -- r gforth |
|
r = fp[u+1]; /* +1, because update of fp happens before this fragment */ |
|
: |
|
floats fp@ + f@ ; |
|
|
\+[THEN] [THEN] \ has? glocals |
\+[THEN] [THEN] \ has? glocals |
|
|
\+has? OS [IF] |
\+has? OS [IF] |
Line 2004 define(argclist,
|
Line 2009 define(argclist,
|
\ icall(argnum) |
\ icall(argnum) |
define(icall, |
define(icall, |
`icall$1 argflist($1)u -- uret gforth |
`icall$1 argflist($1)u -- uret gforth |
uret = ((Cell(*)(argdlist($1)))u)(argclist($1)); |
uret = (SYSCALL(Cell(*)(argdlist($1)))u)(argclist($1)); |
|
|
') |
') |
define(fcall, |
define(fcall, |
`fcall$1 argflist($1)u -- rret gforth |
`fcall$1 argflist($1)u -- rret gforth |
rret = ((Float(*)(argdlist($1)))u)(argclist($1)); |
rret = (SYSCALL(Float(*)(argdlist($1)))u)(argclist($1)); |
|
|
') |
') |
|
|
|
|
open-lib c_addr1 u1 -- u2 gforth open_lib |
open-lib c_addr1 u1 -- u2 gforth open_lib |
#if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) |
#if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN) |
|
#ifndef RTLD_GLOBAL |
|
#define RTLD_GLOBAL 0 |
|
#endif |
u2=(UCell) dlopen(cstr(c_addr1, u1, 1), RTLD_GLOBAL | RTLD_LAZY); |
u2=(UCell) dlopen(cstr(c_addr1, u1, 1), RTLD_GLOBAL | RTLD_LAZY); |
#else |
#else |
# ifdef HAVE_LIBKERNEL32 |
# ifdef HAVE_LIBKERNEL32 |