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 ;              
