version 1.16, 2000/09/23 15:05:59
|
version 1.21, 2003/01/20 17:07:37
|
Line 16
|
Line 16
|
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program; if not, write to the Free Software |
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
|
require see.fs |
|
|
decimal |
decimal |
|
|
Line 97 CREATE DT 0 , 0 ,
|
Line 99 CREATE DT 0 , 0 ,
|
|
|
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 |
DebugMode c-pass ! C-Output off |
THEN |
xt-see C-Output on |
dup ['] EXECUTE = IF |
c-pass @ DebugMode = dup |
\ xt to EXECUTE is next stack item... |
IF ." Cannot debug" cr |
drop EXIT |
THEN ; |
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 |
|
xt-see C-Output on |
|
c-pass @ DebugMode = dup |
|
IF cr ." Cannot debug!!" |
|
THEN ; |
|
|
VARIABLE Nesting |
VARIABLE Nesting |
|
|
Line 115 VARIABLE Unnest
|
Line 139 VARIABLE Unnest
|
: 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 |