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 \ Trace Loadscreen                                ks cas 25sep16
 1   Onlyforth \needs Assembler   2 loadfrom asm.fb                
 2                                                                 
 3   Vocabulary Tools   Tools also definitions                     
 4                                                                 
 5   1 9 +thru   Onlyforth   .( Tools geladen) 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 <ip        | ip) Constant ip>                    
13                                                                 
14 | : (debug   ( addr -- )   dup <ip !                            
15      BEGIN  1+ dup @  ['] unnest = UNTIL  2+ ip> ! ;            
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> <ip !   -1 nest# +! ;            
 7                                                                 
 8 | : oneline   .status space                                     
 9      BEGIN  query  interpret  tib #tib @ + 1- c@ BL =           
10      WHILE  prompt &36 tab  REPEAT                              
11      -$20 allot   r0 @ rp!   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>  <ip @ >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      <ip on  ip> off ; unnest   \ clears trap range             
 9                                                                 
10   : endloop               \ stop tracing loop                   
11      'ip @ <ip ! ;        \ use when at end of loop             
12                                                                 
13   : debug     ' do_debug ;                                      
14                                                                 
15   : trace     ' dup >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                                                                 
 1                                                                 
 2                                                                 
 3                                                                 
 4                                                                 
 5                                                                 
 6                                                                 
 7                                                                 
 8                                                                 
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 
