VolksForth/sources/cpm/TOOLS.FB.src

273 lines
17 KiB
Plaintext
Raw Normal View History

2020-06-20 16:59:14 +00:00
Screen 0 not modified
0 \\ Tools 11Nov86
1 Dieses File enthaelt die wichtigsten Werkzeuge zur Programm-
2 entwicklung: - den einfachen Decompiler
3 - der DUMP-Befehl
4 - den Tracer
5
6 Der einfache Decompiler wird benutzt, um neue Defining-Words
7 zu ueberpruefen. Der automatische Decompiler kann ja dafuer
8 nicht benutzt werden, da ihm diese Strukturen unbekannt sind.
9 (Benutzung: addr und dann, je nach Art: S N D L C oder B)
10
11 DUMP wird zum Ausgeben von Hexdumps benutzt. (from count DUMP)
12
13 Der Tracer erlaubt Einzelschrittausfuehrung von Worten.
14 Er ist unentbehrliches Hilfsmittel bei der Fehlersuche.
15 (Benutzung: DEBUG <name> und END-TRACE)
Screen 1 not modified
0 \ Loadscreen for simple decompiler and tracer 11Nov86
1
2 Onlyforth Vocabulary Tools Tools also definitions
3
4 01 05 +thru
5 06 +load \ Tracer
6
7 Onlyforth
8
9 : internal \ start headerless definitions
10 1 ?head ! ;
11
12 : external \ end headerless definitions
13 ?head off ;
14
15
Screen 2 not modified
0 \ Tools for decompiling 22feb86
1
2 | : ?: dup 4 u.r ." :" ;
3 | : @? dup @ 6 u.r ;
4 | : c? dup c@ 3 .r ;
5
6 : s ( adr - adr+ )
7 ?: space c? 3 spaces dup 1+ over c@ type dup c@ + 1+ even ;
8
9 : n ( adr - adr+2 ) ?: @? 2 spaces dup @ >name .name 2+ ;
10 : d ( adr n - adr+n)
11 2dup swap ?: swap 0 DO c? 1+ LOOP 2 spaces -rot type ;
12
13
14
15
Screen 3 not modified
0 \ Tools for decompiling 22feb86
1
2 : l ( adr - adr+2 ) ?: 5 spaces @? 2+ ;
3 : c ( adr - adr+1) 1 d ;
4 : b ( adr - adr+1) ?: @? dup @ over + 5 u.r 2+ ;
5
6
7
8 \\
9 : dump ( adr n -) bounds ?DO cr I 10 d drop stop? IF LEAVE
10 THEN 10 +LOOP ;
11
12
13
14
15
Screen 4 not modified
0 \ General Dump Utility - Output UH 07Jun86
1
2 | : .2 ( n -- ) 0 <# # # #> type space ;
3 | : .6 ( d -- ) <# # # # # # # #> type ;
4 | : d.2 ( addr len -- ) bounds ?DO I C@ .2 LOOP ;
5 | : emit. ( char -- )
6 $7F and dup bl $7E uwithin not IF drop Ascii . THEN emit ;
7 | : dln ( addr --- )
8 cr dup 6 u.r 2 spaces 8 2dup d.2 space
9 over + 8 d.2 space $10 bounds ?DO I C@ EMIT. LOOP ;
10 | : ?.n ( n1 n2 -- n1 )
11 2dup = IF ." \/" drop ELSE 2 .r THEN space ;
12 | : ?.a ( n1 n2 -- n1 )
13 2dup = IF ." V" drop ELSE 1 .r THEN ;
14
15
Screen 5 not modified
0 \ .head UH 03Jun86
1
2
3 | : .head ( addr len -- addr' len' )
4 swap dup -$10 and swap $0F and cr 8 spaces
5 8 0 DO I ?.n LOOP space $10 8 DO I ?.n LOOP
6 space $10 0 DO I ?.a LOOP rot + ;
7
8
9
10
11
12
13
14
15
Screen 6 not modified
0 \ Dump and Fill Memory Utility UH 25Aug86
1
2 Forth definitions
3
4 : dump ( addr len -- )
5 base push hex .head
6 bounds ?DO I dln stop? IF LEAVE THEN $10 +LOOP ;
7
8 Tools definitions
9
10 : du ( addr -- addr+$40 ) dup $40 dump $40 + ;
11
12 : dl ( line# -- ) c/l * scr @ block + c/l dump ;
13
14 Forth definitions
15
Screen 7 not modified
0 \ Trace Loadscreen 29Jun86
1
2 Onlyforth \needs Tools Vocabulary Tools
3 Tools also definitions
4
5 1 8 +thru
6
7 Onlyforth
8
9 \ clear
10
11 \ don't forget END-TRACE after using DEBUG
12
13
14
15
Screen 8 not modified
0 \ Variables do-trace UH 04Nov86
1
2 | Variable Wsave \ Variable for saving W
3 | Variable <ip \ start of trace trap range
4 | Variable ip> \ end of trace trap range
5 | Variable 'ip \ holds IP (preincrement!)
6 | Variable nest? \ True if NEST shall be performed
7 | Variable newnext \ Address of new Next for tracing
8 | Variable #spaces \ for indenting nested trace
9 | Variable tracing \ true if trace mode active
10
11
12
13
14
15
Screen 9 not modified
0 \ install Tracer UH 18Nov87
1
2 Tools definitions
3
4 | Code do-trace \ patch Next to new definition
5 $C3 A mvi ( jmp ) >next sta
6 newnext lhld >next 1+ shld Next
7 end-code
8
9
10
11
12
13
14
15
Screen 10 not modified
0 \ throw status on Return-Stack 29Jun86
1
2 | Create: npull
3 rp@ count 2dup + even rp! r> swap cmove ;
4
5 : npush ( addr len --) r> -rot over >r
6 rp@ over 1+ - even dup rp! place npull >r >r ;
7
8 | : oneline .status space query interpret -&82 allot
9 rdrop ( delete quit from tracenext ) ;
10
11
12
13
14
15
Screen 11 not modified
0 \ reenter tracer 04Nov86
1
2 | Code (step
3 true H lxi tracing shld IP rpop Wsave lhld H W mvx
4 Label fnext
5 xchg
6 M E mov H inx M D mov xchg pchl
7 end-code
8
9 | Create: nextstep (step ;
10
11 | : (debug ( addr --) \ start tracing at addr
12 dup <ip !
13 BEGIN 1+ dup @ ['] unnest = UNTIL 2+ ip> ! ;
14
15
Screen 12 not modified
0 \ check trace conditions 04Nov86
1
2 Label tracenext tracenext newnext !
3 IP ldax IP inx A L mov IP ldax IP inx A H mov
4 xchg tracing lhld H A mov L ora fnext jz
5 nest? 1+ lda A ana
6 0= ?[
7 <IP lhld H inx
8 IP A mov H cmp fnext jc
9 0= ?[ IP' A mov L cmp fnext jc ]?
10 IP> lhld
11 H A mov IP cmp fnext jc
12 0= ?[ L A mov IP' cmp fnext jc ]?
13 ][ A xra nest? 1+ sta ]? \ low byte still set
14 \ one trace condition satisfied
15 W H mvx Wsave shld false H lxi tracing shld
Screen 13 not modified
0 \ tracer display UH 25Jan88
1
2 ;c: nest? @
3 IF nest? off r> ip> push <ip push dup 2- (debug
4 #spaces push 1 #spaces +! >r THEN
5 r@ nextstep >r input push output push standardi/o
6 cr #spaces @ spaces
7 dup 'ip ! 2- dup 5 u.r @ dup 6 u.r 2 spaces
8 >name .name $1C col - 0 max spaces .s
9 state push blk push >in push ['] 'quit >body push
10 [ ' parser >body ] Literal push
11 span push #tib push tib #tib @ npush r0 push
12 rp@ r0 ! &82 allot ['] oneline Is 'quit quit ;
13
14
15
Screen 14 not modified
0 \ DEBUG with errorchecking 28Nov86
1
2 | : traceable ( cfa -- cfa' )
3 recursive dup @
4 ['] : @ case? ?exit
5 ['] key @ case? IF >body c@ Input @ + @ traceable exit THEN
6 ['] type @ case? IF >body c@ Output @ + @ traceable exit THEN
7 ['] r/w @ case? IF >body traceable exit THEN
8 dup 1+ @ [ ' Forth @ 1+ @ ] Literal = IF nip 1+ exit THEN
9 drop >name .name ." can't be DEBUGged" quit ;
10
11 also Forth definitions
12
13 : debug ( -- ) \ reads a word
14 ' traceable (debug Tools
15 nest? off #spaces off tracing on do-trace ;
Screen 15 not modified
0 \ misc. words for tracing 28Nov86
1 Tools definitions
2
3 : nest \ trace next high-level word executed
4 'ip @ 2- @ traceable drop nest? on ;
5
6 : unnest \ ends tracing of actual word
7 <ip on ip> off ; \ clears trap range
8
9 : endloop \ stop tracing loop
10 'ip @ <ip ! ; \ use when at end of loop
11
12 Forth definitions
13
14 : trace' ( -- ) \ reads a word
15 context push debug <ip perform end-trace ;