--- gforth/debug.fs 2000/05/12 07:55:41 1.15 +++ gforth/debug.fs 2003/01/19 23:35:29 1.20 @@ -1,6 +1,6 @@ \ DEBUG.FS Debugger 12jun93jaw -\ Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. +\ Copyright (C) 1995-2003 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -16,7 +16,9 @@ \ You should have received a copy of the GNU General Public License \ 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 @@ -97,16 +99,38 @@ CREATE DT 0 , 0 , VARIABLE Body -: NestXT ( xt -- true | body false ) - \ special deal for create does> words - \ leaves body address on the stack - dup >does-code IF dup >body swap THEN - - DebugMode c-pass ! C-Output off - xt-see C-Output on - c-pass @ DebugMode = dup - IF ." Cannot debug" cr - THEN ; +: nestXT-checkSpecial ( xt -- xt2 | cfa xt2 ) + dup >does-code IF + \ if nest into a does> we must leave + \ 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 + xt-see C-Output on + c-pass @ DebugMode = dup + IF cr ." Cannot debug!!" + THEN ; VARIABLE Nesting @@ -115,7 +139,7 @@ VARIABLE Unnest : D-KEY ( -- flag ) BEGIN 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 -128 THROW ENDOF [char] a OF Leave-D