ProfitPress Mega CDROM2 Shareware Freeware (MSDOS)(1992)(Eng)

home *** CD-ROM | disk | FTP | other *** search

/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_3.ZIP / ZIMMER.ZIP / CODEBUG.SEQ < prev next >

Wrap

Text File | 1990-03-07 | 25.7 KB | 697 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. { \ ************************************************************************** \ Load the disassembler, we need it in the debugger \ ************************************************************************** fload dis8086 ( dis8086 ) symbolic off \ ************************************************************************** \ variables to hold all needed registers \ ************************************************************************** variable debugip variable debugcs variable debugflags variable debugax variable debugbx 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-@ 2variable break_save break_save off \ ************************************************************************** \ Some handy debugging utilities \ ************************************************************************** 2 constant dbtop rows 6 - constant dbbot 0 value dboff 0 value dbto 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 ; ' no-name >name constant [no-name] : sp>col ( n1 -- ) #out @ - 0max spaces ; : dbeeol ( -- ) 58 sp>col ; : ?.cfa ( a1 -- ) >name dup [no-name] <> if dup .id then drop ; : debug_depth ( -- n1 ) sp-@ sp0 @ swap - 2/ ; : debug.s ( -- ) savecursor cursor-off 0 dbtop cols 1- dbtop 2+ box debug_depth 0< if ." \2 Data Stack INVALID !! " >attrib2 cols 2- sp>col >norm else debug_depth ?dup if dup ." [" 1 .r ." ]" 0 swap 8 min 1- do sp@ sp-@ swap - 2/ i + pick 7 u.r space -1 +loop else ." Stack Empty. " then cols 1- sp>col then restcursor ; : .dbheader ( -- ) cls 0 dbtop 2- at ." \3 Enter or Space \1 = single step instruction ." \2 ESC \1 = Quit debugging \2 F1 \1 = Help " cr ." \1 Use to select line to (G)o to. " ." \1 Press (R) to change registers. " ; : .dbfooter ( -- ) 0 dbbot 1+ at ." \1 Type \`\3STEPS\1\` to restart debugger. " >attrib1 cols sp>col >norm cr ; : .bytes ( a1 n1 -- ) 0max bounds ?do i c@ 0 <# # # #> type space loop ; \ ************************************************************************** \ Display current instruction followed by data stack \ ************************************************************************** dis8086 also 0 value ipprev 0 value ipprev2 : .inst ( -- ) \ display one instruction save> base hex ip-@ ?.cfa 11 sp>col cs-@ =seg ip-@ dup cp ! =: ipprev >rev ip-@ h.4 inst 44 sp>col ip-@ cp @ over - 5 min .bytes dbeeol >norm restore> base ; : .ninst ( n1 -- ) save> base hex cp @ ?.cfa 11 sp>col 1+ dboff = if cp @ =: dbto >attrib3 then cp @ dup>r h.4 inst 44 sp>col r> cp @ over - 5 min .bytes dbeeol >norm restore> base ; : .pinst ( -- ) ipprev 0= if dbeeol else save> base hex cs-@ =seg ipprev dup cp ! =: ipprev2 cp @ ?.cfa 11 sp>col cp @ dup>r h.4 inst 44 sp>col r> cp @ over - 5 min .bytes dbeeol >norm restore> base then ; previous \ ************************************************************************** \ Display the processor registers \ ************************************************************************** : .regs ( -- ) savecursor cursor-off 60 dbtop 3 + 79 dbtop 17 + box ." \3 Tom's Debugger " bcr bcr ." \1CS" cs-@ h.4 ." \1IP" ip-@ h.4 bcr ." \1DS" ds-@ h.4 ." \1SI" si-@ h.4 bcr ." \1ES" es-@ h.4 ." \1DI" di-@ h.4 bcr ." \1SS" ss-@ h.4 ." \1SP" sp-@ h.4 bcr ." \1BP" bp-@ h.4 bcr ." \1AX" ax-@ h.4 09 SPACES bcr ." \1BX" bx-@ h.4 ." \1FL" debugflags @ h.4 bcr ." \1CX" cx-@ h.4 09 SPACES bcr ." \1DX" 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: forthds 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 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 next end-code \ ************************************************************************** \ This is the break point "receiver". It saves the debugging registers \ and restores F-PC's registers then goes to "STEPS". \ ************************************************************************** defer do_steps 2variable int3save label int3 ( -- ) \ preserve all registers push ds push ax mov ax, cs: forthds mov ds, ax pop debugax pop debugds pop ax dec ax \ backup one byte to break point mov debugip ax pop debugcs pop ax and ax, # $FEFF \ clear TF flag bit mov debugflags ax mov debugbx bx mov debugcx cx mov debugdx dx mov bx, break_save mov ax, break_save 2+ mov 0 [bx], al \ restore break point mov break_save # 0 word \ clear break point variable 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 mov cx, cs mov ds, cx mov dx, cs: int3save \ restore interrupt three mov ds, cs: int3save 2+ mov ax, # $2503 int $21 mov ax, cs mov ds, ax mov ax, # ' do_steps \ goto "STEPS" jmp ax 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 pop bx push es mov ax, # $3500 or al, bl int $21 mov int1save bx mov int1save 2+ es \ save old vector pop es next end-code code save_int3 ( --- ) \ save the current contents of interrupt three push es mov ax, # $3503 int $21 mov int3save bx mov int3save 2+ es \ save old vector pop es next end-code code set_int# ( n1 --- ) \ set interrupt one to our interrupt handler pop bx push es mov ax, cs mov ds, ax mov dx, # int1 mov ax, # $2500 or al, bl int $21 pop es next end-code code set_int3 ( --- ) \ set interrupt three to our interrupt handler push es mov ax, cs mov ds, ax mov dx, # int3 mov ax, # $2503 int $21 pop es next end-code code rest_int# ( n1 --- ) \ restore the contents of interrupt one pop bx mov cx, cs mov ds, cx mov dx, cs: int1save mov ds, cs: int1save 2+ mov ax, # $2500 or al, bl int $21 mov ax, cs mov ds, ax next end-code code rest_int3 ( --- ) \ restore the contents of interrupt three mov cx, cs mov ds, cx mov dx, cs: int3save mov ds, cs: int3save 2+ mov ax, # $2503 int $21 mov ax, cs mov ds, ax next 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 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 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 code trace_done ( -- ) 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 \ *************************************************************************** \ initialize the Forth registers, so they will be valid when the break point \ occurs. \ *************************************************************************** : set_fregs ( -- ) \ give forth registers some defaults sp@ forthsp ! ?cs: forthss ! ?cs: forthds ! rp@ forthbp ! 0 forthdi ! 0 forthsi ! ['] quit >body @ xseg @ + forthes ! ; \ ************************************************************************** \ 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 ; : break_point ( -- ) \ break point to offset specified dbto c@ =: dbsave dboff if $CC dbto c! \ only break if not zero then 3 save_int# 3 set_int# one_break 3 rest_int# dbsave dbto c! \ restore program byte ip-@ 1- =ip \ backup program counter one byte off> dboff ; \ reset break point offset \ *************************************************************************** \ Break point control words, allow setting, removing, and displaying \ the current break point. \ *************************************************************************** : unbreak ( -- ) \ remove the break point break_save @ ?dup if break_save 2+ @ swap c! \ restore break point break_save off \ clear break_save rest_int3 \ restore vector then defers byefunc ; ' unbreak is byefunc \ make break point removal automatic : breakat ( | <name> -- ) \ install a break point unbreak \ restore previous if needed set_fregs \ give Forth registers a default save_int3 \ save interrupt three set_int3 \ set interrupt three ' dup break_save ! dup c@ break_save 2+ ! \ save break point $CC swap c! \ set break point off> ipprev cr ." Break point set" ; ' breakat alias xx \ xx is an alias for breakat : .break ( -- ) \ display the current break point break_save @ ?dup cr if ." Break point set in " >name .id else ." No break point set" then ; \ ************************************************************************** \ show the current registers, and a series of instructions as they will \ be executed. \ ************************************************************************** : show_debug ( -- ) savecursor cursor-off .regs debug.s 0 dbtop 3 + 59 dbbot box ." \1 Name Addr Instruction Data " bcr .pinst bcr .inst bcr dbbot dbtop 4 + - 3 - 0 do i .ninst bcr loop restcursor ; : set_register ( -- ) ipprev2 =: ipprev savecursor 0 dbbot 1+ 2dup at cols 1- sp>col at sp@ >r sp-@ sp! ." \1 {in the form $23 =AX } command: " query interpret sp@ =sp r> sp! 0 dbbot 1+ 2dup at cols 1- sp>col at 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 ." \S04\1 SPACE \0 = Do a single instruction" bcr ." \S04\1 ESC \0 = Done, terminate debugger" bcr ." \S04\1 D \0 = Done, continue execution from break point" bcr ." \S04\1 G \0 = Go till hilighted line" bcr ." \S04\1 R \0 = Set a Register" bcr bcr ." \1 Press ESC to continue, or SPACE for more help " key $1B <> if 0 5 59 19 box&fill bcr ." Using R, \`<number> =AX\` will set AX to <number>." bcr ." Registers that can be set are:" bcr ." =CS =DS =ES =SS =IP =SI =DI =SP =BP =AX =BX =CX =DX" bcr bcr ." TRACE gives registers CS, DS, SS, ES, IP, and AX" bcr ." default values. Use TRACE once, then use 'R' to set" bcr ." registers to your desired values." bcr bcr ." \S10\1 Press ANY key to continue " key drop then restscr restcursor ; \ ************************************************************************** \ 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 ( register set) 'R' of set_register false endof ( debug done ) 'D' of 0 20 at trace_done false endof ipprev2 =: ipprev ( all others ) drop beep false endcase ; : steps ( -- ) .dbheader 0 20 at rp@ =bp rp@ 80 - rp! \ move return stack out of the way sp@ =sp \ set debugger to Forth stack sp@ 20 - sp! begin show_debug key do_dbkey until sp0 @ sp-@ - 2/ 0> \ is stack empty? if sp-@ sp! \ if not, restore it else sp0 @ sp! \ else clear stack then debugbp @ rp! .dbfooter ; ' steps is do_steps \ link into break point handler \ ************************************************************************** \ setup for tracing a series of instructions, and call STEPS. \ ************************************************************************** : trace ( | <name> -- ) \ use as in: TRACE <word> <enter> \ sets up and displays first \ instruction with registers. ' dup =ip =ax ?cs: dup =cs dup =ds =ss ?es: =es off> dboff off> ipprev steps ; \ *************************************************************************** \ some test words for the debugger \ *************************************************************************** code tst ( -- ) mov ax, # 23 push ax next end-code cr .( try: TRACE TST <enter> ) : ++ + ; : test 2 3 ++ . ; .( try: BREAKAT ++ <enter> ) .( then: TEST <enter> ) cr \ ************************************************************************** \ A utility to allow dropping into the BXDEBUG program while testing this \ debugger \ ************************************************************************** \ code int3 ( -- ) \ a debugging tool \ int 3 \ next end-code }