version 1.117, 2003/01/08 10:25:34
|
version 1.119, 2003/01/10 16:57:25
|
Line 1404 while(a_addr != NULL)
|
Line 1404 while(a_addr != NULL)
|
rdrop r> |
rdrop r> |
REPEAT nip nip ; |
REPEAT nip nip ; |
|
|
(hashkey) ( c_addr u1 -- u2 ) gforth paren_hashkey |
|
u2=0; |
|
while(u1--) |
|
u2+=(Cell)toupper(*c_addr++); |
|
: |
|
0 -rot bounds ?DO I c@ toupper + LOOP ; |
|
|
|
(hashkey1) ( c_addr u ubits -- ukey ) gforth paren_hashkey1 |
(hashkey1) ( c_addr u ubits -- ukey ) gforth paren_hashkey1 |
""ukey is the hash key for the string c_addr u fitting in ubits bits"" |
""ukey is the hash key for the string c_addr u fitting in ubits bits"" |
/* this hash function rotates the key at every step by rot bits within |
/* this hash function rotates the key at every step by rot bits within |
Line 1475 f_addr = (Float *)((((Cell)c_addr)+(size
|
Line 1468 f_addr = (Float *)((((Cell)c_addr)+(size
|
|
|
\ threading stuff is currently only interesting if we have a compiler |
\ threading stuff is currently only interesting if we have a compiler |
\fhas? standardthreading has? compiler and [IF] |
\fhas? standardthreading has? compiler and [IF] |
code-address! ( c_addr xt -- ) gforth code_address_store |
|
""Create a code field with code address @i{c-addr} at @i{xt}."" |
|
MAKE_CF(xt, c_addr); |
|
: |
|
! ; |
|
|
|
does-code! ( a_addr xt -- ) gforth does_code_store |
|
""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>}."" |
|
MAKE_DOES_CF(xt, a_addr); |
|
: |
|
dodoes: over ! cell+ ! ; |
|
|
|
does-handler! ( a_addr -- ) gforth does_handler_store |
does-handler! ( a_addr -- ) gforth does_handler_store |
""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>}."" |
Line 1495 MAKE_DOES_HANDLER(a_addr);
|
Line 1475 MAKE_DOES_HANDLER(a_addr);
|
: |
: |
drop ; |
drop ; |
|
|
/does-handler ( -- n ) gforth slash_does_handler |
|
""The size of a @code{DOES>}-handler (includes possible padding)."" |
|
/* !! a constant or environmental query might be better */ |
|
n = DOES_HANDLER_SIZE; |
|
: |
|
2 cells ; |
|
|
|
threading-method ( -- n ) gforth threading_method |
threading-method ( -- n ) gforth threading_method |
""0 if the engine is direct threaded. Note that this may change during |
""0 if the engine is direct threaded. Note that this may change during |
the lifetime of an image."" |
the lifetime of an image."" |
Line 2432 xt = peephole_opt(xt1, xt2, wpeeptable);
|
Line 2405 xt = peephole_opt(xt1, xt2, wpeeptable);
|
compile-prim ( xt1 -- xt2 ) obsolete compile_prim |
compile-prim ( xt1 -- xt2 ) obsolete compile_prim |
xt2 = (Xt)compile_prim((Label)xt1); |
xt2 = (Xt)compile_prim((Label)xt1); |
|
|
\ set-next-code and call2 do not appear in images and can be |
|
\ renumbered arbitrarily |
|
|
|
set-next-code ( #w -- ) gforth set_next_code |
|
#ifdef NO_IP |
|
next_code = (Label)w; |
|
#endif |
|
|
|
call2 ( #a_callee #a_ret_addr -- R:a_ret_addr ) gforth |
|
/* call with explicit return address */ |
|
#ifdef NO_IP |
|
INST_TAIL; |
|
JUMP(a_callee); |
|
#else |
|
assert(0); |
|
#endif |
|
|
|
compile-prim1 ( a_prim -- ) gforth compile_prim1 |
compile-prim1 ( a_prim -- ) gforth compile_prim1 |
""compile prim (incl. immargs) at @var{a_prim}"" |
""compile prim (incl. immargs) at @var{a_prim}"" |
compile_prim1(a_prim); |
compile_prim1(a_prim); |
Line 2466 decompile-prim ( a_code -- a_prim ) gfor
|
Line 2422 decompile-prim ( a_code -- a_prim ) gfor
|
compile_prim1ed to a_code"" |
compile_prim1ed to a_code"" |
a_prim = (Label)decompile_code((Label)a_code); |
a_prim = (Label)decompile_code((Label)a_code); |
|
|
|
\ set-next-code and call2 do not appear in images and can be |
|
\ renumbered arbitrarily |
|
|
|
set-next-code ( #w -- ) gforth set_next_code |
|
#ifdef NO_IP |
|
next_code = (Label)w; |
|
#endif |
|
|
|
call2 ( #a_callee #a_ret_addr -- R:a_ret_addr ) gforth |
|
/* call with explicit return address */ |
|
#ifdef NO_IP |
|
INST_TAIL; |
|
JUMP(a_callee); |
|
#else |
|
assert(0); |
|
#endif |
|
|
\+ |
\+ |
|
|
include(peeprules.vmg) |
include(peeprules.vmg) |