home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
forth
/
compiler
/
fpc
/
source
/
tdebug.seq
< prev
next >
Wrap
Text File
|
1990-04-24
|
19KB
|
516 lines
\\ CODEBUG.SEQ A CODE debugger for F-PC by Tom Zimmer
This file contains a simple debugger for F-PC to allow debugging
CODE routines. Don't expect TOO MUCH from this debugger, it is still
in quite primitive form. It is useful though.
The debugger can be invoked directly by:
TRACE <forth_name> <enter>
Each subsequent enter key press causes the debugger to step one
instruction through <forth_name>. Limited operations are supported while
in the debugger, read the screen while debugging and press F1 for some help.
To set a break point that will invoke the debugger when a particular
word is executed, use:
BREAKAT <forth_name> <enter>
The first time this word is executed, the code debugger will be started.
If your break point is not ever executed, you should execute UNBREAK
before leaving F-PC to remove the break point from memory.
***************************************************************************
To make a debugger for CODE, we needed to make an interrupt handler for
INT 1, and then enable the single step status flag bit TF.
{
\ **************************************************************************
\ variables to hold all needed registers
\ **************************************************************************
variable debugip
variable debugcs
variable debugflags
variable debugax
variable debugbx variable forthbx
variable debugcx
variable debugdx
variable debugbp variable forthbp
variable debugsi variable forthsi
variable debugdi variable forthdi
variable debuges variable forthes
variable debugss variable forthss
variable debugsp variable forthsp
variable debugds variable forthds
\ **************************************************************************
\ words to allow setting the debugging registers
\ **************************************************************************
:: reg! ( a1 | <name> -- ) \ defining word to make register
\ assignment words
create , does> @ ! ;
debugcs reg! =cs
debugip reg! =ip
debugss reg! =ss
debugsp reg! =sp
debugds reg! =ds
debuges reg! =es
debugax reg! =ax
debugbx reg! =bx
debugcx reg! =cx
debugdx reg! =dx
debugsi reg! =si
debugdi reg! =di
debugbp reg! =bp
debugflags reg! =fl
:: reg@ ( a1 | <name> -- ) \ defining word to make register
\ fetch words
create , does> @ @ ;
debugcs reg@ cs-@
debugip reg@ ip-@
debugss reg@ ss-@
debugsp reg@ sp-@
debugds reg@ ds-@
debuges reg@ es-@
debugax reg@ ax-@
debugbx reg@ bx-@
debugcx reg@ cx-@
debugdx reg@ dx-@
debugsi reg@ si-@
debugdi reg@ di-@
debugbp reg@ bp-@
\ **************************************************************************
\ Some handy debugging utilities
\ **************************************************************************
2 constant dbtop
rows 6 - constant dbbot
0 value dboff
0 value dbto
0 value dobreak
0 value dbsave
0 value keysave
0 value spsave
: h.4 ( n1 -- ) \ display n1 in four digit hex
$10 save!> base
0 <# # # # # #> space type space
restore> base ;
: sp>col ( n1 -- )
#out @ - 0max spaces ;
: dbeeol ( -- )
58 sp>col ;
: ?.cfa ( a1 -- )
?symbol if type then ;
: debug_depth ( -- n1 )
si-@ sp0 @ swap - 2/ 1- ;
: %debug.s ( .. n1 -- )
dup ." [" 1 .r ." ]" 0 swap 8 min 1-
do sp@ si-@ swap - 2/ i + pick
7 u.r space
-1 +loop ;
: debug.s ( -- )
savecursor cursor-off
0 dbtop cols 1- dbtop 2+ box
debug_depth 0<
if ." Data Stack INVALID !! "
cols 2- sp>col >norm
else debug_depth ?dup
if %debug.s
else ." Stack Empty. "
then cols 1- sp>col
then restcursor ;
: .dbheader ( -- )
0 dbtop 2- at
." Enter or Space = single step instruction
." ESC = Quit debugging F1 = Help "
cr
." Use to select line to (G)o to. "
." Press (R) to change registers. " ;
: .dbfooter ( -- )
0 dbbot 1+ at
." Debugger terminated, type `STEPS` to restart. "
cols sp>col >norm cr ;
\ **************************************************************************
\ Display current instruction followed by data stack
\ **************************************************************************
0 value ipprev
0 value ipprev2
: .instruction ( -- ) \ display one instruction
save> base hex
ip-@ ?.cfa 8 sp>col ." >> "
cs-@ =seg
ip-@ dup cp ! =: ipprev
inst dbeeol
restore> base ;
: .ninst ( n1 -- )
save> base hex
cp @ ?.cfa 8 sp>col
1+ dboff =
if cp @ =: dbto
." ** "
else ." "
then
inst dbeeol
restore> base ;
: .pinst ( -- )
ipprev 0=
if dbeeol exit
then
save> base hex
cs-@ =seg
ipprev dup cp ! =: ipprev2
cp @ ?.cfa 12 sp>col
inst dbeeol
restore> base ;
\ **************************************************************************
\ Display the processor registers
\ **************************************************************************
: .regs ( -- )
key? ?exit
savecursor cursor-off
60 dbtop 3 + 79 dbtop 17 + box
." Tom's Debugger " bcr 17 spaces bcr
." CS" cs-@ h.4 ." IP" ip-@ h.4 bcr
." DS" ds-@ h.4 ." SI" si-@ h.4 bcr
." ES" es-@ h.4 ." DI" di-@ h.4 bcr
." SS" ss-@ h.4 ." SP" sp-@ h.4 bcr
." BP" bp-@ h.4 bcr
." AX" ax-@ h.4 09 SPACES bcr
." BX" bx-@ h.4 ." FL" debugflags @ h.4
bcr
." CX" cx-@ h.4 09 SPACES bcr
." DX" dx-@ h.4 09 SPACES bcr
." ----ODITsz-a-p-c" bcr
2 save!> base
space
debugflags @ 0 <# 16 0 do # loop #> type
restore> base
restcursor ;
\ **************************************************************************
\ This is the single step "receiver". It saves the debugging registers
\ and restores F-PC's registers then goes back to Forth.
\ **************************************************************************
label int1 ( -- ) \ preserve all registers
push ds
push ax
mov ax, cs: $00FE \ we hide DS value here at startup
mov ds, ax
pop debugax
pop debugds
pop debugip
pop debugcs
pop ax
and ax, # $FEFF \ clear TF flag bit
mov debugflags ax
mov debugbx bx mov bx, forthbx
mov debugcx cx
mov debugdx dx
mov debugbp bp mov bp, forthbp
mov debugsi si mov si, forthsi
mov debugdi di mov di, forthdi
mov debuges es mov es, forthes
mov debugss ss mov ss, forthss
mov debugsp sp mov sp, forthsp
ret end-code
\ **************************************************************************
\ Routines to save, set & restore the number one & three interrupt vectors.
\ **************************************************************************
2variable int1save \ a place to save the interrupt one vector
code save_int# ( n1 --- ) \ save the current contents of interrupt one
push es
mov ax, # $3500
or al, bl
int $21
mov int1save bx
mov int1save 2+ es \ save old vector
pop es
ret end-code
code set_int# ( n1 --- ) \ set interrupt one to our interrupt handler
push es
push ds
mov ax, cs
mov ds, ax
mov dx, # int1
mov ax, # $2500
or al, bl
int $21
pop ds
pop es
ret end-code
code rest_int# ( n1 --- ) \ restore the contents of interrupt one
push ds
mov dx, int1save
mov ds, int1save 2+
mov ax, # $2500
or al, bl
int $21
pop ds
ret end-code
\ **************************************************************************
\ initiate one single instruction step. Swaps registers, sets up the
\ hardware stack with processor status, code segment, and instruction
\ pointer then does an IRET to return to do a single step. The TF flag
\ is set in the status register to make the processor immediately perform
\ an INT1 after a single instruction has been executed. Execution then
\ returns to INT1 above, and consequently back to Forth.
\ **************************************************************************
code one_step ( -- ) \ single step through one instruction as
\ already setup in the debugging recisters
mov forthsp sp
mov forthss ss
mov forthbp bp
mov forthbx bx
mov forthsi si
mov forthdi di
mov forthds ds
mov forthes es
cmp debugsp # 0 \ give a default if needed.
0= if mov debugsp sp
mov debugss ss
mov debugds ds
mov debugcs cs
pushf
pop ax
and ax, # $FEFF \ clear TF flag bit
mov debugflags ax
then
mov bx, debugbx
mov cx, debugcx
mov dx, debugdx
mov bp, debugbp
mov si, debugsi
mov di, debugdi
mov ss, debugss
mov es, debuges
mov sp, debugsp
mov ax, debugflags
or ax, # $100 \ set TF bit in flags
push ax
push debugcs
push debugip
mov ax, debugax
mov ds, debugds
iret end-code
code one_break ( -- ) \ go till the breakpoint we just installed
mov forthsp sp
mov forthss ss
mov forthbp bp
mov forthbx bx
mov forthsi si
mov forthdi di
mov forthds ds
mov forthes es
mov bx, debugbx
mov cx, debugcx
mov dx, debugdx
mov bp, debugbp
mov si, debugsi
mov di, debugdi
mov ss, debugss
mov es, debuges
mov sp, debugsp
mov ax, debugflags
and ax, # $FEFF \ CLEAR TF bit in flags
push ax
push debugcs
push debugip
mov ax, debugax
mov ds, debugds
iret end-code
\ **************************************************************************
\ Set the single step interrupt, perform a single instruction step, and
\ then restore the single step interrupt.
\ **************************************************************************
: single_step ( -- ) \ perform one instruction step, and
\ display registers with next
\ instruction to be traced.
1 save_int# \ save existing interrupt vector
1 set_int# \ set to out interrupt routine
one_step \ do a single step trace of one inst
1 rest_int# \ restore the interrupt vector
;
: unbreak ( -- ) \ remove the break point
dbto
if 3 rest_int#
dbsave ?cs: dbto c!L \ restore program byte
then ;
: break_point ( -- ) \ break point to offset specified
dbto 0=
if one_break exit \ just continue execution
then
?cs: dbto c@L =: dbsave
dboff
if $CC ?cs: dbto c!L \ only break if not zero
then
3 save_int#
3 set_int#
one_break
3 rest_int#
dbsave ?cs: dbto c!L \ restore program byte
ip-@ 1- =ip \ backup IP one byte
off> dbto
off> dboff ; \ reset break point offset
\ **************************************************************************
\ show the current registers, and a series of instructions as they will
\ be executed.
\ **************************************************************************
0 value tbline
: show_debug_init ( -- )
savecursor cursor-off
.dbheader
0 dbtop 3 + 59 dbbot box
." Name Addr Instruction Data "
bline =: tbline
restcursor
0 20 at ;
: show_debug ( -- )
savecursor cursor-off
.regs
debug.s
tbline =: bline
bcr .pinst bcr .instruction bcr
dbbot dbtop 4 + - 3 - 0
do i .ninst bcr
key? ?leave
loop restcursor ;
: up_dbline ( -- )
ipprev2 =: ipprev
( up arrow ) dboff 1- 0max =: dboff ;
: down_dbline ( -- )
ipprev2 =: ipprev
( down arrow ) incr> dboff ;
\ **************************************************************************
\ Additional MINI help for the debugger.
\ **************************************************************************
: show_help ( -- )
ipprev2 =: ipprev
savecursor cursor-off savescr
0 5 59 19 box&fill
bcr ." Debugger commands:"
bcr
bcr ." SPACE = Do a single instruction step."
bcr ." ESC = Done, terminate the debugger."
bcr ." G = Go-till '**' line, or just continue program"
bcr ." execution if no Go-till line marked."
bcr
bcr ." Press ANY key to continue debugging "
key drop
restscr restcursor show_debug_init ;
\ **************************************************************************
\ the main trace loop, walks through instructions until the ESC key is
\ pressed.
\ **************************************************************************
: do_dbkey ( c1 -- f1 )
case
( terminate ) $1B of true endof
( enter ) $0D of single_step false endof
( space ) $20 of single_step false endof
( up arrow ) $C8 of up_dbline false endof
( down arrow ) $D0 of down_dbline false endof
( help ) $BB of show_help false endof
upc \ remaining tests are case insensitive
( Go ) 'G' of break_point false endof
ipprev2 =: ipprev
( all others ) drop beep false
endcase ;
: steps ( -- )
rp@ =sp
rp@ 80 - rp! \ move return stack out of the way
=bx \ top of stack to debug BX
sp@ =si \ set debugger to Forth stack
sp@ 20 - sp!
dobreak 0=
if show_debug_init
then
begin dobreak 0=
if show_debug
key do_dbkey
else dobreak =: dbto
off> dobreak
break_point
show_debug_init
false
then
until .dbfooter abort ;
\ **************************************************************************
\ setup for tracing a series of instructions, and call STEPS.
\ **************************************************************************
: %trace ( a1 -- )
?dup 0= ?exit
?ds: ?cs: $00FE !L \ a place to get the DS value later
dup =ip =ax
?cs: dup =cs =es
?ds: dup =ds =ss
off> ipprev
steps ;
: $trace ( a1 -- ) \ use as in: TRACE <word> <enter>
\ sets up and displays first
\ instruction with registers.
off> dboff
%trace ;
0 value interp
: $breakat ( a1 -- )
=: dobreak
1 =: dboff
interp %trace ; \ set the breakpoint and interpret
\ the rest of the line.
}
