mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-07-09 14:29:01 +00:00
273 lines
17 KiB
Plaintext
273 lines
17 KiB
Plaintext
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 ;
|