| |
|
| VARIABLE Body |
VARIABLE Body |
| |
|
| : NestXT ( xt -- true | body false ) |
: nestXT-checkSpecial ( xt -- xt2 | cfa xt2 ) |
| \ special deal for create does> words |
dup >does-code IF |
| \ leaves body address on the stack |
\ if nest into a does> we must leave |
| dup >does-code IF dup >body swap THEN |
\ the body address on stack as does> does... |
| |
dup >body swap EXIT |
| |
THEN |
| |
dup ['] EXECUTE = IF |
| |
\ xt to EXECUTE is next stack item... |
| |
drop EXIT |
| |
THEN |
| |
dup ['] PERFORM = IF |
| |
\ xt to EXECUTE is addressed by next stack item |
| |
drop @ EXIT |
| |
THEN |
| |
BEGIN |
| |
dup >code-address dodefer: = |
| |
WHILE |
| |
\ load xt of DEFERed word |
| |
cr ." nesting defered..." |
| |
>body @ |
| |
REPEAT ; |
| |
|
| |
: nestXT ( xt -- true | body false ) |
| |
\G return true if we are not able to debug this, |
| |
\G body and false otherwise |
| |
nestXT-checkSpecial |
| |
\ scan code with xt-see |
| DebugMode c-pass ! C-Output off |
DebugMode c-pass ! C-Output off |
| xt-see C-Output on |
xt-see C-Output on |
| c-pass @ DebugMode = dup |
c-pass @ DebugMode = dup |
| IF ." Cannot debug" cr |
IF cr ." Cannot debug!!" |
| THEN ; |
THEN ; |
| |
|
| VARIABLE Nesting |
VARIABLE Nesting |
| : D-KEY ( -- flag ) |
: D-KEY ( -- flag ) |
| BEGIN |
BEGIN |
| Unnest @ IF 0 ELSE key THEN |
Unnest @ IF 0 ELSE key THEN |
| CASE [char] n OF dbg-ip @ @ NestXT EXIT ENDOF |
CASE [char] n OF dbg-ip @ @ nestXT EXIT ENDOF |
| [char] s OF Leave-D |
[char] s OF Leave-D |
| -128 THROW ENDOF |
-128 THROW ENDOF |
| [char] a OF Leave-D |
[char] a OF Leave-D |
