version 1.49, 2003/01/26 20:56:37
|
version 1.54, 2004/06/19 15:32:31
|
Line 1
|
Line 1
|
\ SEE.FS highend SEE for ANSforth 16may93jaw |
\ SEE.FS highend SEE for ANSforth 16may93jaw |
|
|
\ Copyright (C) 1995,2000 Free Software Foundation, Inc. |
\ Copyright (C) 1995,2000,2003 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 28
|
Line 28
|
require look.fs |
require look.fs |
require termsize.fs |
require termsize.fs |
require wordinfo.fs |
require wordinfo.fs |
[IFUNDEF] .name |
|
: id. ( nt -- ) \ gforth |
|
\G Print the name of the word represented by @var{nt}. |
|
\ this name comes from fig-Forth |
|
name>string type space ; |
|
|
|
' id. alias .id ( nt -- ) |
|
\G F83 name for @code{id.}. |
|
|
|
' id. alias .name ( nt -- ) |
|
\G Gforth <=0.5.0 name for @code{id.}. |
|
|
|
[THEN] |
|
|
|
decimal |
decimal |
|
|
Line 467 VARIABLE C-Pass
|
Line 454 VARIABLE C-Pass
|
THEN |
THEN |
THEN |
THEN |
Debug? |
Debug? |
IF dup @ + |
IF @ \ !!! cross-interacts with debugger !!! |
ELSE cell+ |
ELSE cell+ |
THEN ; |
THEN ; |
|
|
: DebugBranch |
: DebugBranch |
Debug? |
Debug? |
IF dup @ over + swap THEN ; \ return 2 different addresses |
IF dup @ swap THEN ; \ return 2 different addresses |
|
|
: c-?branch |
: c-?branch |
Scan? |
Scan? |
Line 507 VARIABLE C-Pass
|
Line 494 VARIABLE C-Pass
|
Display? IF nl S" FOR" .struc level+ THEN ; |
Display? IF nl S" FOR" .struc level+ THEN ; |
|
|
: c-loop |
: c-loop |
Display? IF level- nl .name-without bl cemit nl THEN |
Display? IF level- nl .name-without nl bl cemit THEN |
DebugBranch cell+ |
DebugBranch cell+ |
Scan? |
Scan? |
IF dup BranchAddr? |
IF dup BranchAddr? |
Line 526 VARIABLE C-Pass
|
Line 513 VARIABLE C-Pass
|
THEN |
THEN |
DebugBranch cell+ ; |
DebugBranch cell+ ; |
|
|
: c-exit dup 1 cells - |
: c-exit ( addr1 -- addr2 ) |
CheckEnd |
dup 1 cells - |
IF Display? IF nlflag off S" ;" Com# .string THEN |
CheckEnd |
C-Stop on |
IF |
ELSE Display? IF S" EXIT " .struc THEN |
Display? IF nlflag off S" ;" Com# .string THEN |
THEN |
C-Stop on |
Debug? IF drop THEN ; |
ELSE |
|
Display? IF S" EXIT " .struc THEN |
|
THEN |
|
Debug? IF drop THEN ; \ !!! cross-interacts with debugger !!! |
|
|
: c-abort" |
: c-abort" |
count 2dup + aligned -rot |
count 2dup + aligned -rot |
Line 734 Defer discode ( addr u -- ) \ gforth
|
Line 724 Defer discode ( addr u -- ) \ gforth
|
>name ?dup-if |
>name ?dup-if |
." IS " .name cr |
." IS " .name cr |
else |
else |
." lastxt >body !" |
." latestxt >body !" |
then ; |
then ; |
: see-threaded ( addr -- ) |
: see-threaded ( addr -- ) |
C-Pass @ DebugMode = IF |
C-Pass @ DebugMode = IF |
Line 786 Defer discode ( addr u -- ) \ gforth
|
Line 776 Defer discode ( addr u -- ) \ gforth
|
ENDCASE ; |
ENDCASE ; |
|
|
: (xt-see-xt) ( xt -- ) |
: (xt-see-xt) ( xt -- ) |
xt-see cr ." lastxt" ; |
xt-see cr ." latestxt" ; |
' (xt-see-xt) is xt-see-xt |
' (xt-see-xt) is xt-see-xt |
|
|
: (.immediate) ( xt -- ) |
: (.immediate) ( xt -- ) |
Line 807 Defer discode ( addr u -- ) \ gforth
|
Line 797 Defer discode ( addr u -- ) \ gforth
|
else \ interpret/compile word |
else \ interpret/compile word |
r@ xt-see-xt cr |
r@ xt-see-xt cr |
swap xt-see-xt cr |
swap xt-see-xt cr |
." interpret/compile " over .name (.immediate) |
." interpret/compile: " over .name drop |
then |
then |
then |
then |
rdrop drop ; |
rdrop drop ; |