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_5.ZIP / TCOM96.ZIP / TCOM / DEBUGGER / SRCINDEX.SEQ < prev next >

Wrap

Text File | 1991-04-22 | 34.8 KB | 964 lines

\\ SRCINDEX.SEQ Use an index of pointers to source for each target address Use an index of pointers to locations in list files. The index contains entries for each target address. Also use HYPER.NDX style index of symbols. Makes explicit reference to the following files. 80c196.FLS ( List of list-file handles ) 80c196.IND ( Target address index ) 80c196.NDX ( Like HYPER.NDX ) ( the name 80c196 really ought to be in a configuration file e.g. DB.CFG ) { anew flxwords decimal 0 value end-session 0 value nbrowse-addr \ set while browsing, to use for setting breakpoints etc. 0 value from, \ flag for compiled by , or c, 0 value firstcode \ flag for first byte of instruction 0 value othercode \ flag for other byte of instruction 0 value hilevel \ flag for hilevel call : ?serror ( f a c -- ) \ if f is true show the error string a c [ editor ] ?softerror ; } Here is the file stack support. { create abrowseplace 6 allot create thisplace 8 allot create fileplace 6 allot ' fileplace alias >filesfile \ What file we are in. A pointer into *.FLS : file-here fileplace 2+ ; \ Where we are in the file create neststack 10 6 * allot 0 value nestlevel \ here is a stack of buffers \ for nested browsing \ each contains a 2-byte files-file pointer and a 4-byte file offset : nestbuf ( -- a ) \ return the address of the current nest buffer nestlevel 0max 9 min 6 * neststack + ; : pushnest ( -- ) \ save present file and location on the nesting stack fileplace nestbuf 6 cmove nestlevel 1+ 9 min !> nestlevel ; : popnest ( -- ) \ restore previous file and location from the nesting stack nestlevel 1- 0max !> nestlevel nestbuf fileplace 6 cmove ; ( 10) 8 constant index-record-length } Here is the address-index file support The index file contains 10 bytes for each address in the target code, starting at location zero. Bytes 0,1 Points into the handles file to the handle for the file that contains the listing of the current address. Bytes 2,3,4,5 Points into the source file to the start of the line that compiled the code at the current address. Byte 6 Offset into line in source file. { } Index record format 0,1 flspoint @ \ pointer to source file handle in TARGET.FLS $F000 bits \ and flags for compilation type 2,3,4,5 (filepointer) 2@ \ line location in source file 6 (>IN) c@ \ location in source line ( < 255 ) 7 lbyte or \ target byte value \ 8,9 LOADLINE @ \ line number in source file { 10 constant #records \ index file buffer index-record-length #records * constant indbuflen 100 constant indblkrecords index-record-length indblkrecords * constant indblklen create indbuf indblklen allot : >record ( n -- a ) \ return the address of record n \ n = 0 is the last record in the buffer, and is the one \ for the "current" indexed location. \ n < 0 for prior records. 1- index-record-length * indbuflen + indbuf + ; : *file ( n -- p ) \ return the file pointer from record n \ This is a single-number that is an offset into the \ file containing source-file handles. >record @ dup $1000 and 0<> !> firstcode \ see if first byte of instruction dup $2000 and 0<> !> othercode \ see if other byte of instruction dup $4000 and 0<> !> hilevel \ see if hilevel call dup $8000 and 0<> !> from, \ see if from , $FFF and \ return source file pointer ; : soffset ( n -- d ) \ return the offset into the source file from record n \ This is a double-number >record 2+ 2@ ; : scol# ( n -- ln ) \ return the column offset from record n >record 6 + c@ ; : scode-byte ( n -- ln ) \ return the code byte from record n >record 7 + c@ ; : sline# ( n -- ln ) \ return the line number from record n >record 8 + @ ; : key-upc ( -- key ) \ get a keystroke and convert all \ lower-case letters into uppercase key dup 'a' 'z' between if upc then ; create flsbuf 50 allot \ files file buffer create flsbuf1 50 allot \ second files file buffer create lssbuf 200 allot \ .lss file buffer handle flshndl \ file handle for symbol writing handle indexhndl 0 value lfound 0 value max-addr \ highest address represented in the index file : ?indexopen ( -- f1 ) \ is symbol file open, if not open it \ return f1=true if symbol file is open flshndl >hndle @ 0< if " TARGET.FLS" flshndl ">handle flshndl read-only hopen dup " Could not open files file" ?serror 0= else true then indexhndl >hndle @ 0< if " TARGET.IND" indexhndl ">handle indexhndl read-only hopen dup " Could not open index file" ?serror indexhndl endfile \ compute max address in index index-record-length mu/mod drop nip 1+ !> max-addr 0= else true then and ; : ltype ( a c -- ) \ show a line and blank to the end ?dup if 2- 0max \ remove the cr lf cols min type \ show the line cols #out @ - spaces \ blank to the end else drop cols 0 do '░' femit loop \ grey beyound end of file then ; 0 value hicol \ the column at which the word highlight starts create browse-word 32 allot \ hold the highlighted word for browsing : hitype ( a c -- ) \ type the counted string with a word highlighted 2- 0max >attrib3 hicol over \ only highlight if hicol is within line < if hicol 0<> if over hicol type \ columns before hicol hicol /string then 2dup bl scan \ scan to next blank >attrib2 2swap 2 pick - 2dup type \ show one word in red 30 min dup browse-word c! \ and save it for browsing browse-word 1+ swap cmove >attrib3 then type \ rest of text 80 #out @ - spaces \ rest of line blank >norm ; 0 value priorlines 0 value #backups 0 value backup-len : backup-lines ( n -- ) \ Step back n lines in the source/list file 1 max 20 min \ Limit to 20 lines back dup !> #backups file-here 2@ \ Present offset into source file rot 132 * \ Guess distance to move back in file !> backup-len backup-len 0 d- \ New offset into source file 2dup 0. d< if \ Don't go back past the start of the file drop +!> backup-len 0. then \ Now offset to guessed place in file 2dup seqhandle movepointer 2dup filepointer 2! file-here 2! ibreset \ Now the next lineread will be way back in the file \ and backup-len contains the number of bytes from \ that lineread to our present position in the file. \ Now read lines until we get to our present position \ to find how many lines are in it ( priorlines ) off> priorlines begin incr> priorlines lineread count nip dup negate +!> backup-len 0= backup-len 0<= or until file-here 2@ 2dup seqhandle movepointer \ offset back to guessed place in file filepointer 2! ibreset \ Now priorlines is how many lineread's it takes to \ get to our present position. priorlines #backups - \ Now dump lines until we get where we want 0 ?do lineread c@ 0= ?leave loop filepointer 2@ file-here 2! ; : advance-lines ( n -- ) \ Step forward n lines in the source/list file 1 max 20 min \ Limit to 20 lines forwards \ Now dump lines until we get where we want 0 do lineread c@ 0= ?leave loop filepointer 2@ file-here 2! ; : show-this ( -- ) \ show the line at the current browse address 0 3 at >filesfile @ thisplace ! filepointer 2@ thisplace 2+ 2! lineread \ read source line for indexed address count hitype \ now display this line ; : show-next ( -- ) \ show lines after the current browse address browselines 4 - 0 ?do cr lineread count ltype \ show following lines loop ; : show-file ( -- ) \ show a screenful of the file in seqhandle 0 1 at lineread count ltype 0 2 at lineread count ltype show-this show-next ; : (open-list) ( -- f ) \ open the file list file ready for lineread \ Flag f is true if successful >filesfile @ 0 flshndl movepointer flsbuf 50 flshndl hread \ get source handle 0<> dup if flsbuf seqhandle $>handle seqhandle hopen \ open source file drop file-here 2@ seqhandle movepointer \ offset to place in file file-here 2@ filepointer 2! ibreset \ reset lineread buffer then ; : open-list ( --) (open-list) drop ; : get-file&show ( -- ) 0 scol# !> hicol \ get column of address's word 0 *file >filesfile ! \ pointer into TARGET.FLS from, firstcode or hilevel or 0= if exit then 0 soffset file-here 2! \ offset in file to required address (open-list) if \ open the file 2 backup-lines show-file \ display it seqhandle hclose drop on> lfound \ flag that it was displayed successfully then ; : read-index&show ( -- ) \ Read index into indbuf, such that the current \ location's index record is always in the same place \ This makes it easy to look at prior locations. browse-addr 10 u< if 0. indexhndl movepointer \ location in index file indbuf indbuflen erase 9 browse-addr - index-record-length * \ amount by which dup indbuf + swap \ to shift indbuflen swap - \ and shorten the read tuck indexhndl hread \ read index file else browse-addr 9 - index-record-length *d indexhndl movepointer \ location in index file indbuf indbuflen tuck indexhndl hread \ read index file then ( #requested #read ) = if get-file&show else 0 1 at ." \2 cannot read index file " then ; : (abrowse) ( -- ) \ browse source using the address in browse-addr off> lfound ?indexopen if read-index&show else true " \2 Index file not found " ?serror then ; ' (abrowse) is abrowse } ───────────────────────────────────────────────────────────────────────────── Scan index to find address of current line ───────────────────────────────────────────────────────────────────────────── { : checkhndl ( p -- f ) \ p = pointer to index buffer record @ $FFF and \ source file pointer 0 flshndl movepointer \ move pointer to read flsbuf1 50 flshndl hread \ get source handle 0<> thisplace @ \ current source file pointer 0 flshndl movepointer \ move pointer to read flsbuf 50 flshndl hread \ get source handle 0<> and if flsbuf count flsbuf1 count rot over = if compare 0= else 3drop false then else false then ; 0 value afound 0 value indcol 0 value indptr : record-match ( i -- f ) \ examine record i of the block index-record-length * indbuf + dup !> indptr dup 2+ 2@ \ compare file offset from index thisplace 2+ 2@ \ to current browsing file offset d= if \ if they match dup 6 + c@ \ see if offset in source line !> indcol \ hicol \ matches current offset in line ( patch ) hicol indcol = \ >= ( =) if checkhndl else drop 0 then \ check file handles else drop false then ; : scan-block ( n -- n' ) indblkrecords 0 do i record-match if i +!> browse-addr drop 0 on> afound leave then loop ; : scan-index ( -- ) 0. indexhndl movepointer \ beginning of index file begin indbuf indblklen indexhndl hread \ read a block of index file dup if scan-block then \ scan this block 0<> key? 0= and while \ continue until all read, or place found, or key pressed indblkrecords +!> browse-addr \ accumulate address search repeat ; : find-addr ( -- ) \ browse index to find the address if current file line off> lfound off> afound off> browse-addr ?indexopen if scan-index then ; : show-addr ( -- ) 30 0 at save> base hex hicol 2 .r ." Address " at? ." ...." at find-addr afound 0= if ." -------------" else browse-addr 4 u.r indptr @ 5 u.r indptr 2+ 2@ 8 ud.r indptr 6 + @ 5 u.r then restore> base ; } ───────────────────────────────────────────────────────────────────────────── ───────────────────────────────────────────────────────────────────────────── { : break-here ( -- ) \ set a breakpoint at current browse location \ and go into the debugger to receive it waiting-at-break if \ if the target is waiting in a breakpoint gofromtrap \ run from the breakpoint then nbrowse-addr \ this address set while browsing 0 setbreak \ dsteps ; : setbreakpoint ( -- ) \ to set breakpoints from browser savescr 10 10 60 20 box&fill ." \1 Press \3 Enter \1 to set breakpoint at " >attrib3 save> base hex nbrowse-addr 5 .r ." h " restore> base >norm bcr ." B = show serial port buffer" bcr ." M = monitor serial port" bcr key-upc case $0d of restscr break-here endof \ Enter 'M' of cls monitor restscr endof 'B' of cls .buf cr ." \2 Press a key " key drop restscr endof drop beep restscr endcase ; only forth also hidden also editor also forth definitions handle wordhndl handle hndlsave 32 constant hpblen create helpbuf hpblen allot create delims 2 c, bl c, ',' c, 32 allot 0 value wordfnd 0 value index.start 0 value index.found \ n1 = line to start searching from \ n2 = line number in file if found : #check-ndx ( n1 --- n2 f1 ) \ f1 = true if found index \ searched for word must be at HERE. =: index.start \ set the starting line here c@ 0= if 0 false exit then here helpbuf over c@ 2+ hpblen min cmove wordhndl save!> seqhandle \ " HYPER.NDX" ">$ $file 0= " TARGET.NDX" ">$ $file 0= if IBRESET 0.0 seek loadline off off> wordfnd index.start 1 max 0 \ skip to previous occurrance ?do lineread c@ 0= ?leave loop 0 20000 1 do outbuf c@ 0= ?leave outbuf 1+ c@ 249 ( ∙ ) = if \ outbuf count 3 - swap c! \ outbuf 1+ hndlsave $>handle outbuf 2+ @ >filesfile ! \ pointer into TARGET.FLS else bl outbuf count + 2- c! \ have at least 1 blank at end of line. helpbuf count outbuf 1+ swap 1+ caps-comp 0= if drop outbuf count bl scan 1 -1 d+ 2dup bl scan nip - dup here c! here 1+ swap cmove here %number 2drop loadline @ =: index.found on> wordfnd leave then then lineread c@ 0= ?leave loop wordhndl hclose drop wordfnd else 0 false then restore> seqhandle ; : #here-ed/br ( n1 --- f ) \ n1 is line to start on \ Word to browse is in a counted string at HERE \ Returns f=true if unable to find word #check-ndx ( this returns line# ) if 0.0 file-here 2! open-list \ open the file found by #check-ndx ( line# ) 3 - 0max 0 do lineread c@ 0= ?leave loop \ skip to the line-2 filepointer 2@ file-here 2! \ now the next lineread will be the first to show off> hicol show-file seqhandle hclose drop false else drop true then ; : br-unnest ( -- ) \ drop down one level of nested browsing nestlevel 0<> if popnest \ get prior place open-list show-file \ reshow file seqhandle hclose drop else beep then ; : unnest-all ( -- ) \ drop down to the bottom level of nested browsing off> nestlevel abrowseplace fileplace 6 cmove \ get original place open-list show-file \ reshow file seqhandle hclose drop ; create nbbuf 32 allot nbbuf off : nbrowse ( -- ) \ prompt for a word to browse savescr 8 8 59 10 box&fill ." \1 Word to browse: " >attrib1 on> autoclear #out @ 1+ #line @ nbbuf 30 lineeditor >norm restscr nbbuf c@ 0<> and if nbbuf count here c! here count cmove bl here count + c! pushnest \ save current browse place 0 #here-ed/br if true " \3 No LINKAGE for this word " ?serror br-unnest then then ; : browse-here ( -- ) \ browse for the word in browse-word browse-word c@ 0<> if browse-word count here c! here count cmove bl here count + c! pushnest \ save current browse place 0 #here-ed/br if true " \3 No LINKAGE for this word " ?serror br-unnest then then ; : nxtbrowse ( -- ) \ find next matching browse of word pushnest \ save current browse place helpbuf here over c@ 2+ cmove index.found 1+ #here-ed/br \ repeat previous search if true " \3 No MORE LINKS for this word " ?serror br-unnest then ; } : >delimiter ( --- ) \ move to next space in line linelen dup screenchar over min ?do linebuf 1+ i + c@ dup \ -- c1 c1 delims count rot scan nip \ look for delimiter swap 127 > or \ or > than 127 \ -- f1 if drop i leave then loop =: screenchar ; : <delimiter ( --- n1 ) \ n1 = offset from line strt to prev space 0 dup screenchar ?do linebuf 1+ i + c@ dup \ -- c1 c1 delims count rot scan nip \ look for delimiter swap 127 > or \ or > than 127 \ -- f1 if drop i leave then -1 +loop dup =: screenchar ; : get-word@cur ( --- ) save> screenchar \ save current cursor position <delimiter \ if space found, then bump forward 1 linebuf 1+ + c@ dup delims count rot scan nip \ did we find a delimiter? swap hyperchar = or \ or the hyper character? if incr> screenchar then screenchar \ cursor position >delimiter \ find next space screenchar \ get new cursor position ( old new ) swap =: screenchar \ restore cursor position ( new ) screenchar - 0 max >r \ length of word under cursor saved linebuf 1+ screenchar + \ source here 1+ r@ cmove \ move word to destination HERE r> here c! \ set words length byte here 1+ c@ hyperchar = \ remove a leading hyper char if here count >r dup 1+ swap r> 1- cmove -1 here c+! then here count + 2 bl fill \ append a couple of blanks restore> screenchar ; : word-ed/br ( false --- f1 ) get-word@cur 0 #here-ed/br ; { : word-right ( -- ) \ ^cur-right open-list 0 1 at lineread count ltype 0 2 at lineread count ltype \ show prior lines 0 3 at lineread count \ get current line 2dup hicol /string \ start at hicol column bl scan \ move to next blank bl skip \ skip over leading blanks drop 2 pick - !> hicol dup 2- hicol min !> hicol \ stop at end of line hitype \ now show this line show-next \ and the rest of the screen seqhandle hclose drop ; : cur-right ( -- ) \ cur-right open-list 1 +!> hicol show-file seqhandle hclose drop ; : curend ( -- ) open-list 0 1 at lineread count ltype 0 2 at lineread count ltype \ show prior lines 0 3 at lineread count \ get current line dup 2- 0max !> hicol hitype \ now show this line show-next \ and the rest of the screen seqhandle hclose drop ; : curhome ( -- ) open-list off> hicol show-file seqhandle hclose drop ; : word-left ( -- ) \ ^cur-left open-list 0 1 at lineread count ltype 0 2 at lineread count ltype \ show prior lines 0 3 at lineread count \ get current line dup hicol 0max min !> hicol \ keep hicol within line over hicol + \ start at current highlight point hicol 0 do 1- dup c@ bl <> ?leave \ back over blanks loop hicol 0 do dup 1- c@ bl = ?leave \ back over non-blanks 1- loop 2 pick - 0max !> hicol hitype \ now show this line show-next \ and the rest of the screen seqhandle hclose drop ; : cur-left ( -- ) \ cur-left open-list hicol 0> if -1 +!> hicol then show-file seqhandle hclose drop ; : LBbye ( -- ) \ get out of the debugger/browser environment on> end-session ; \ : toggledebug ( -- ) \ F2 key -- switch debugging window on/off \ on> showingdebug \ ; newmenu tfile$ menuline" Browse a word Alt-F9 " nbrowse menuline" ────────────────────────── " noop menuline" Dos Shell Ctrl-Enter " do-dos menuline" ────────────────────────── " noop menuline" Quit browsing Sh-F10 " LBbye endmenu : LBhelp savescr 0 2 59 21 box&fill bcr ." Browser commands:" bcr ." F9 browse highlighted word" bcr ." Alt-F9 enter a word to browse" bcr ." F10 previous browse place" bcr ." sh-F10 leave browse/debugger" bcr ." B set a breakpoint" bcr ." F enter a Forth command" bcr ." Cursor up/down" bcr ." move around in browse file" bcr ." Page up/down" bcr ." move around in browse file" bcr ." Home move to top of browse file" bcr ." End move to end of browse file" bcr ." + - move browse address" bcr showingdebug if bcr ." \1 Press ESC to continue, or SPACE for more help " key $1B <> if debug_help then else bcr ." \1 Press any key to continue" key drop then restscr ; newmenu thelp$ menuline" Browse Help F1 " LBhelp endmenu newmenubar LB-bar +," Menu " +," Help " endmenu create LB-list tfile$ , thelp$ , \ 0 value LBsave \ defsave : .top ( -- ) \ top line of screen 0 0 at ." \4 ESC=menu \1 TARGET browser " ; : LBmenu ( --- ) 0 0 at ." \4 Enter, or first letter \1 " \ LBsave =: mcol savemenu LB-bar =: menubar LB-list =: menulist ['] default-mline is mline ['] default-mcolumn is mcolumn ['] drop is doother menu restmenu \ mcol =: LBsave .top ; 0 value LB-inc \ direction of incrementing address : abrowse-find ( -- ) begin abrowse \ look up address and show listing lfound 0= if LB-inc +!> browse-addr at? 40 0 at browse-addr h. \ show progress in search at then lfound key? or until ; : addr+browse ( n -- ) \ move the address where we are browsing, a distance n afound 0= if drop exit then \ exit if we do not have a known address browse-addr swap \ save browse-addr for wrap-check dup 0< if -1 else 1 then !> LB-inc \ set direction for auto-incrementing +!> browse-addr dup 0< browse-addr 0< \ check for a wrap ( won't work above 32k! ) xor if LB-inc 0< if drop off> browse-addr \ If wrapped decreasing, zero addr else !> browse-addr \ If increasing, restore old addr then else drop then browse-addr max-addr \ if above end of index file u> if max-addr !> browse-addr \ reset to end, -1 !> LB-inc \ and reverse increments then abrowse-find ; : +browse ( n -- ) \ move where we are browsing, through the file, \ a distance n open-list dup 0> if advance-lines else negate backup-lines then show-file seqhandle hclose drop ; : topfile ( -- ) \ move to the top of the current file pushnest 0.0 file-here 2! open-list show-file seqhandle hclose drop ; : bottomfile ( -- ) \ move to the end of the current file pushnest open-list seqhandle endfile file-here 2! \ end of file 20 backup-lines \ back 20 lines show-file seqhandle hclose drop ; : .browse-state ( -- ) \ show nestlevel and stack 76 0 at depth ?dup 0<> if >attrib2 4 .r \ show stack else >norm 4 spaces then 73 0 at nestlevel dup 0= if >attrib3 else >attrib2 then \ show nest level 2 .r space >norm ; : BRkeys ( key -- ) \ execute key functions of browser case \ $0a of do-dos endof \ ^Enter $0d of browse-here endof \ Enter $09 of nxtbrowse endof \ tab $8f of endof \ sh-tab $08 of br-unnest endof \ bs $7f of endof \ ^bs 'B' of setbreakpoint endof 'F' of Forth-command endof '0' of unnest-all endof \ 0 key $d2 of unnest-all endof \ ins $d3 of endof \ del $bb of LBhelp endof \ F1 \ $bc of toggledebug endof \ F2 $c3 of browse-here endof \ F9 $c4 of br-unnest endof \ F10 $dd of LBbye endof \ sh-F10 $f0 of nbrowse endof \ Alt-F9 $cb of cur-left endof \ cur-left $cd of cur-right endof \ cur-right $f3 of word-left endof \ ^cur-left $f4 of word-right endof \ ^cur-right $2d of -1 addr+browse endof \ - $2b of 1 addr+browse endof \ + $c8 of -1 +browse endof \ cur-up $d0 of 1 +browse endof \ cur-down $84 of -1 +browse endof \ ^pgup $f6 of 1 +browse endof \ ^pgdn $c9 of 2 browselines - +browse endof \ pgup $d1 of browselines 2- +browse endof \ pgdn $f7 of topfile endof \ ^home $c7 of curhome endof \ home $cf of curend endof \ end $f5 of bottomfile endof \ ^end $1b of LBmenu endof \ esc drop beep \ all other keys endcase ; : LBkeys ( key -- ) showingdebug if case $0D of one-step show_debug endof \ enter $20 of one-step/skip show_debug endof \ space '-' of up_dbline endof \ bkpt up '+' of down_dbline endof \ bkpt down '0' of off> next-break show_debug endof \ 0 key $d2 of off> next-break show_debug endof \ ins 'R' of set_register endof \ register set BRkeys \ other keys may be for browsing endcase else BRkeys then ; : LB ( -- ) \ browse listings savecursor cursor-off savescr dark rows !> browselines .top 1 !> LB-inc off> end-session off> showingdebug off> nestlevel begin abrowse \ look up address and show listing lfound 0= if LB-inc addr+browse key? if .browse-state key-upc LBkeys then then lfound end-session or until lfound if fileplace abrowseplace 6 cmove \ remember this place begin .browse-state show-addr key-upc LBkeys end-session until \ browse listings else true " \2 Could not index address " ?serror then DB-endfunc restscr restcursor ; : acb ( n -- ) \ run browser starting with address n !> browse-addr LB ; 0 value reset-vector : cb ( -- ) \ top level word to run browser starting at reset entry point reset-vector acb ; }