version 1.37, 2001/04/08 13:48:12
|
version 1.42, 2002/12/04 10:42:59
|
Line 271 VARIABLE C-Pass
|
Line 271 VARIABLE C-Pass
|
THEN ; |
THEN ; |
|
|
: c-call |
: c-call |
Display? IF dup @ body> .word bl cemit THEN cell+ ; |
Display? IF ." call " dup @ body> .word bl cemit THEN cell+ ; |
|
|
: .name-without ( addr -- addr ) |
: .name-without ( addr -- addr ) |
\ prints a name without () e.g. (+LOOP) or (s") |
\ prints a name without () e.g. (+LOOP) or (s") |
Line 445 VARIABLE C-Pass
|
Line 445 VARIABLE C-Pass
|
CREATE C-Table |
CREATE C-Table |
' lit A, ' c-lit A, |
' lit A, ' c-lit A, |
[IFDEF] call ' call A, ' c-call A, [THEN] |
[IFDEF] call ' call A, ' c-call A, [THEN] |
' (s") A, ' c-c" A, |
[IFDEF] (s") ' (s") A, ' c-c" A, [THEN] |
' (.") A, ' c-c" A, |
[IFDEF] (.") ' (.") A, ' c-c" A, [THEN] |
' "lit A, ' c-c" A, |
[IFDEF] "lit ' "lit A, ' c-c" A, [THEN] |
[IFDEF] (c") ' (c") A, ' c-c" A, [THEN] |
[IFDEF] (c") ' (c") A, ' c-c" A, [THEN] |
' (do) A, ' c-do A, |
' (do) A, ' c-do A, |
[IFDEF] (+do) ' (+do) A, ' c-do A, [THEN] |
[IFDEF] (+do) ' (+do) A, ' c-do A, [THEN] |
Line 464 CREATE C-Table
|
Line 464 CREATE C-Table
|
[IFDEF] (-loop) ' (-loop) A, ' c-loop A, [THEN] |
[IFDEF] (-loop) ' (-loop) A, ' c-loop A, [THEN] |
' (next) A, ' c-loop A, |
' (next) A, ' c-loop A, |
' ;s A, ' c-exit A, |
' ;s A, ' c-exit A, |
' (abort") A, ' c-abort" A, |
[IFDEF] (abort") ' (abort") A, ' c-abort" A, [THEN] |
\ only defined if compiler is loaded |
\ only defined if compiler is loaded |
[IFDEF] (compile) ' (compile) A, ' c-(compile) A, [THEN] |
[IFDEF] (compile) ' (compile) A, ' c-(compile) A, [THEN] |
[IFDEF] (does>) ' (does>) A, ' c-does> A, [THEN] |
[IFDEF] (does>) ' (does>) A, ' c-does> A, [THEN] |
Line 483 c-extender !
|
Line 483 c-extender !
|
( end!) 2drop false EXIT THEN |
( end!) 2drop false EXIT THEN |
THEN |
THEN |
\ jump over to extender, if any 26jan97jaw |
\ jump over to extender, if any 26jan97jaw |
2 pick <> |
xt>threaded 2 pick <> |
WHILE 2 cells + |
WHILE 2 cells + |
REPEAT |
REPEAT |
nip cell+ perform |
nip cell+ perform |
Line 584 Defer discode ( addr u -- ) \ gforth
|
Line 584 Defer discode ( addr u -- ) \ gforth
|
|
|
: seecode ( xt -- ) |
: seecode ( xt -- ) |
dup s" Code" .defname |
dup s" Code" .defname |
threading-method |
>code-address |
if |
|
>code-address |
|
then |
|
dup in-dictionary? \ user-defined code word? |
dup in-dictionary? \ user-defined code word? |
if |
if |
dup next-head |
dup next-head |
Line 679 Defer discode ( addr u -- ) \ gforth
|
Line 676 Defer discode ( addr u -- ) \ gforth
|
if \ normal or immediate word |
if \ normal or immediate word |
swap xt-see (.immediate) |
swap xt-see (.immediate) |
else |
else |
r@ ['] compile-only-error = |
r@ ['] ticking-compile-only-error = |
if \ compile-only word |
if \ compile-only word |
swap xt-see (.immediate) ." compile-only" |
swap xt-see (.immediate) ." compile-only" |
else \ interpret/compile word |
else \ interpret/compile word |