Screen 0 not modified 0 \ ks 22 dez 87 1 2 Some simple tools for debugging. 3 A state-of-the-art, interactive single step tracer 4 and a couple of tools for decompiling and dumping 5 6 7 8 9 10 11 12 13 14 15 Screen 1 not modified 0 \ Programming-Tools word set cas 19july2020 1 Onlyforth \needs Assembler 2 loadfrom asm.fb 2 3 Vocabulary Tools Tools also definitions 4 5 1 11 +thru Onlyforth .( Tools loaded ) cr 6 7 8 9 10 11 12 13 14 15 Screen 2 not modified 0 \ trace - next ks 11 jun 87 1 2 | Variable nest? nest? off 3 4 Label tracenext 0 # nest? #) byte cmp 0= 5 ?[ $5555 # I cmp here 2- >label (ip >= 6 ?[ [[ swap lods A W xchg W ) jmp ]? 7 $5555 # I cmp here 2- >label ip) CS ?] 8 ][ 0 # nest? #) byte mov 9 ]? $5555 # W mov here 2- >label >tracing W ) jmp 10 end-code 11 12 | (ip Constant 13 14 | : (debug ( addr -- ) dup ! ; Screen 3 not modified 0 \ install Tracer ks 11 jun 87 1 2 Label (do-trace next-link # W mov D push 3 $E9 # A- mov tracenext 1+ # C mov 4 [[ W ) W mov W W or 0= not 5 ?[[ A- -4 W D) mov C D mov W D sub 6 D -3 W D) mov ]]? D pop ret end-code 7 8 Code do-trace (do-trace # call Next end-code 9 10 ' end-trace Alias end-trace 11 12 | Code (step (do-trace # call 13 R ) I mov R inc R inc lods A W xchg W ) jmp 14 15 | Create: nextstep (step ; Screen 4 not modified 0 \ tracer display ks 20 sep 88 1 2 | Variable nest# nest# off 3 4 | Variable 'ip 'ip off 5 6 | Create: -nest r> ip> ! r> r0 ! r> dup #tib ! 12 rp@ over tib swap cmove rp@ + rp! 13 r> Is parser r> adr 'quit ! r> >in ! 14 r> blk ! r> state ! r> output ! r> input ! ; 15 Screen 5 not modified 0 \ tracer display ks 16 sep 88 1 2 | : tracing end-trace nest? @ 3 IF r> r ip> @ >r -nest >r >r 4 1 nest# +! r@ 2- (debug nest? off THEN r@ 'ip ! 5 nextstep >r input @ >r output @ >r state @ >r 6 blk @ >r >in @ >r adr 'quit @ >r adr parser @ >r 7 tib #tib @ rp@ over - under rp! cmove #tib @ >r 8 r0 @ >r rp@ r0 ! standardi/o 9 cr nest# @ spaces 'ip @ dup 5 u.r @ dup 5 u.r 10 2 spaces >name .name &30 nest# @ + tab .s 11 $20 allot ['] oneline Is 'quit quit ; 12 ' tracing >tracing ! 13 14 15 Screen 6 not modified 0 \ test traceability ks 07 dez 87 1 2 | : traceable ( cfa -- cfa' ) recursive dup @ 3 [ ' : @ ] Literal case? ?exit 4 [ ' key @ ] Literal case? IF >body c@ Input @ + 5 @ traceable exit THEN 6 [ ' type @ ] Literal case? IF >body c@ Output @ + 7 @ traceable exit THEN 8 [ ' r/w @ ] Literal case? IF >body @ traceable exit THEN 9 c@ $E9 = IF @ 1+ exit THEN \ Does> word 10 >name .name ." can't be DEBUGged" quit ; 11 12 13 14 15 Screen 7 not modified 0 \ user words for tracing ks 16 sep 88 1 | : do_debug ( addr -- ) 2 traceable (debug nest? off nest# off do-trace ; 3 4 : nest \ trace next high-level word executed 5 'ip @ @ traceable drop nest? on ; 6 7 : unnest \ ends tracing of actual word 8 off ; unnest \ clears trap range 9 10 : endloop \ stop tracing loop 11 'ip @ r do_debug r> execute end-trace unnest ; Screen 8 not modified 0 \ tools for decompiling, interactive use ks 04 jul 87 1 2 | : ?: ( addr -- addr ) dup 5 u.r ." :" ; 3 | : @? ( addr -- addr ) dup @ 6 u.r ; 4 | : c? ( addr -- addr ) dup c@ 3 .r ; 5 | : end $28 tab ; 6 7 : s ( addr1 -- addr2 ) 8 ?: 3 spaces c? 2 spaces count 2dup type + even end ; 9 : n ( addr1 -- addr2 ) 10 ?: @? 2 spaces dup @ >name .name 2+ end ; 11 : d ( addr1 n -- addr2 ) 2dup swap ?: 3 spaces 12 swap 0 DO c? 1+ LOOP 2 spaces -rot type end ; 13 : l ( addr1 -- addr2 ) ?: 6 spaces @? 2+ end ; 14 : c ( addr1 -- addr2 ) 1 d end ; 15 : b ( addr1 -- addr2 ) ?: @? dup @ over + 6 u.r 2+ end ; Screen 9 not modified 0 \ often times ks 29 jun 87 1 Onlyforth 2 3 : often stop? ?exit >in off ; 4 5 | Variable #times #times off 6 7 : times ( n -- ) ?dup 8 IF #times @ 2+ u< stop? or 9 IF #times off exit THEN 1 #times +! 10 ELSE stop? ?exit 11 THEN >in off ; 12 13 14 15 Screen 10 not modified 0 \ dump ks 04 jul 87 1 2 : dump ( addr n -- ) base push hex 3 bounds ?DO cr I $10 [ Tools ] d [ Forth ] drop 4 stop? IF LEAVE THEN $10 +LOOP ; 5 6 | : ld ( seg:addr -- ) 7 over 4 u.r ." :" dup 0 <# # # # # #> type 8 3 spaces ds@ pad $10 lmove pad $10 bounds 9 DO I c@ 3 u.r LOOP 2 spaces pad $10 type ; 10 11 : ldump ( seg:addr quan -- ) base push hex 12 0 DO cr 2dup ld $10 + stop? IF LEAVE THEN 13 $10 +LOOP 2drop ; 14 15 Screen 11 not modified 0 \ N>R NR> cr 1 2 : N>R ( i * n +n -- ) ( R: -- j * x +n ) 3 \ Transfer N items and count to the return stack. 4 DUP BEGIN DUP WHILE 5 ROT R> SWAP >R >R 6 1- 7 REPEAT DROP R> SWAP >R >R ; 8 9 : NR> ( -- i * x +n ) ( R: j * x +n -- ) 10 \ Pull N items and count off the return stack. 11 R> R> SWAP >R DUP 12 BEGIN DUP WHILE 13 R> R> SWAP >R -ROT 14 1- 15 REPEAT DROP ; Screen 12 not modified 0 \ ? 1 : ? ( a-addr -- ) 2 \ Display the value stored at a-addr. 3 @ . ; 4 5 6 7 8 9 10 11 12 13 14 15