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