| code-address! ( c_addr xt -- ) gforth code_address_store |
code-address! ( c_addr xt -- ) gforth code_address_store |
| ""Create a code field with code address @i{c-addr} at @i{xt}."" |
""Create a code field with code address @i{c-addr} at @i{xt}."" |
| MAKE_CF(xt, c_addr); |
MAKE_CF(xt, c_addr); |
| CACHE_FLUSH(xt,(size_t)PFA(0)); |
|
| : |
: |
| ! ; |
! ; |
| |
|
| ""Create a code field at @i{xt} for a child of a @code{DOES>}-word; |
""Create a code field at @i{xt} for a child of a @code{DOES>}-word; |
| @i{a-addr} is the start of the Forth code after @code{DOES>}."" |
@i{a-addr} is the start of the Forth code after @code{DOES>}."" |
| MAKE_DOES_CF(xt, a_addr); |
MAKE_DOES_CF(xt, a_addr); |
| CACHE_FLUSH(xt,(size_t)PFA(0)); |
|
| : |
: |
| dodoes: over ! cell+ ! ; |
dodoes: over ! cell+ ! ; |
| |
|
| ""Create a @code{DOES>}-handler at address @i{a-addr}. Normally, |
""Create a @code{DOES>}-handler at address @i{a-addr}. Normally, |
| @i{a-addr} points just behind a @code{DOES>}."" |
@i{a-addr} points just behind a @code{DOES>}."" |
| MAKE_DOES_HANDLER(a_addr); |
MAKE_DOES_HANDLER(a_addr); |
| CACHE_FLUSH((caddr_t)a_addr,DOES_HANDLER_SIZE); |
|
| : |
: |
| drop ; |
drop ; |
| |
|
| |
|
| call ( #a_callee -- R:a_retaddr ) new |
call ( #a_callee -- R:a_retaddr ) new |
| ""Call callee (a variant of docol with inline argument)."" |
""Call callee (a variant of docol with inline argument)."" |
| |
#ifdef DEBUG |
| |
{ |
| |
CFA_TO_NAME((((Cell *)a_callee)-2)); |
| |
fprintf(stderr,"%08lx: call %08lx %.*s\n",(Cell)ip,(Cell)a_callee, |
| |
len,name); |
| |
} |
| |
#endif |
| a_retaddr = (Cell *)IP; |
a_retaddr = (Cell *)IP; |
| SET_IP((Xt *)a_callee); |
SET_IP((Xt *)a_callee); |
| |
|
| compile-prim ( xt1 -- xt2 ) new compile_prim |
compile-prim ( xt1 -- xt2 ) new compile_prim |
| xt2 = (Xt)compile_prim((Label)xt1); |
xt2 = (Xt)compile_prim((Label)xt1); |
| |
|
| |
lit@ / lit_fetch = lit @ |
| |
|
| |
lit-perform ( #a_addr -- ) new lit_perform |
| |
ip=IP; |
| |
SUPER_END; |
| |
EXEC(*(Xt *)a_addr); |
| |
|
| |
lit+ / lit_plus = lit + |
| |
|
| |
does-exec ( #a_cfa -- R:nest a_pfa ) new does_exec |
| |
a_pfa = PFA(a_cfa); |
| |
nest = (Cell)ip; |
| |
IF_spTOS(spTOS = sp[0]); |
| |
#ifdef DEBUG |
| |
{ |
| |
CFA_TO_NAME(a_cfa); |
| |
fprintf(stderr,"%08lx: does %08lx %.*s\n", |
| |
(Cell)ip,(Cell)a_cfa,len,name); |
| |
} |
| |
#endif |
| |
SET_IP(DOES_CODE1(a_cfa)); |
| |
|
| include(peeprules.vmg) |
include(peeprules.vmg) |
| |
|
| \+ |
\+ |
