\ tracer: loadscreen          clv12oct87 
                                         
Onlyforth                                
                                         
\needs Code -$2B +load \ Trans Assembler 
                                         
\needs Tools   Vocabulary Tools          
                                         
Tools also definitions                   
                                         
   1 6  +thru  \ Tracer                  
   7 8  +thru  \ Tools for decompiling   
                                         
Onlyforth                                
                                         
\\                                       
                                         
Dieser wundervolle Tracer wurde          
von Bernd Pennemann und Co fuer          
den Atari entwickelt. Ich liess mir      
aufschwatzen, ihn an C64/C16 anzupassen  
und muss sagen, es ging erstaunlich      
einfach. /clv                            
                                         
                                        
\ tracer: wcmp variables      clv04aug87 
                                         
Assembler also definitions               
                                         
: wcmp ( adr1 adr2--) \ Assembler-Macro  
 over lda dup cmp swap  \ compares word  
 1+   lda 1+  sbc ;                      
                                         
                                         
Only Forth also Tools also definitions   
                                         
| Variable (W                            
| Variable <ip      | Variable ip>       
| Variable nest?    | Variable trap?     
| Variable last'    | Variable #spaces   
                                         
                                         
                                         
                                         
                                         
                                         
                                         
                                         
                                         
                                        
\ tracer:cpush oneline        clv12oct87 
                                         
| Create cpull    0  ]                   
 rp@ count 2dup + rp! r> swap cmove ;    
                                         
: cpush  ( addr len -)                   
 r> -rot   over  >r                      
 rp@ over 1+ - dup rp!  place            
 cpull >r  >r ;                          
                                         
| : oneline  &82 allot keyboard display  
 .status  space  query  interpret        
 -&82 allot  rdrop                       
 ( delete quit from tnext )  ;           
                                         
: range ( adr--) \ ermittelt <ip ip>     
 ip> off  dup <ip !                      
 BEGIN 1+ dup @                          
   [ Forth ] ['] unnest = UNTIL          
 3+ ip> ! ;                              
                                         
                                         
                                         
                                         
                                        
\ tracer:step tnext           clv04aug87 
                                         
| Code step                              
 $ff # lda trap? sta trap? 1+ sta        
           RP X) lda  IP sta             
 RP )Y lda  IP 1+ sta  RP 2inc           
 (W lda  W sta   (W 1+ lda   W 1+ sta    
Label W1-  W 1- jmp  end-code            
                                         
| Create: nextstep step ;                
                                         
Label  tnext IP 2inc                     
 trap? lda  W1- beq                      
 nest? lda 0=  \ low(!)Byte test         
 ?[ IP <ip wcmp W1- bcc                  
    IP ip> wcmp W1- bcs                  
 ][ nest? stx  \ low(!)Byte clear        
 ]?                                      
  trap? dup stx 1+ stx \ disable tracer  
  W lda  (W sta    W 1+ lda   (W 1+ sta  
                                         
                                         
                                         
                                         
                                        
\ tracer:..tnext              clv12oct87 
                                         
 ;c: nest? @                             
 IF nest? off r> ip> push <ip push       
    dup 2- range                         
    #spaces push 1 #spaces +! >r THEN    
 r@  nextstep >r                         
 input push    output push               
 2- dup last' !                          
 cr #spaces @ spaces                     
 dup 4 u.r @ dup 5 u.r space             
 >name .name  $10 col - 0 max spaces .s  
 state push  blk push  >in push          
 [ ' 'quit      >body ] Literal  push    
 [ ' >interpret >body ] Literal  push    
 #tib push  tib #tib @ cpush  r0 push    
 rp@ r0 !                                
 ['] oneline Is 'quit  quit ;            
                                         
                                         
                                         
                                         
                                         
                                         
                                        
\ tracer:do-trace traceable   clv12oct87 
                                         
| Code do-trace \ installs TNEXT         
 tnext 0 $100 m/mod                      
     # lda  Next $c + sta                
     # lda  Next $b + sta                
 $4C # lda  Next $a + sta  Next jmp      
end-code                                 
                                         
| : traceable ( cfa--<IP ) recursive     
 dup @                                   
 ['] :    @ case? IF >body     exit THEN 
 ['] 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 
 @  [ ' Forth @ @ ] Literal =            
                  IF @ 3 + exit THEN     
 \ fuer def.Worte mit does>              
 >name .name ." can't be DEBUGged"       
 quit ;                                  
                                         
                                        
\ tracer:Benutzer/innen-Worte clv12oct87 
                                         
: nest   \ trace into current word       
 last' @ @ traceable drop nest? on ;     
                                         
: unnest \ proceeds at calling word      
 <ip on ip> off ; \ clears trap range    
                                         
: endloop last' @ 4 + <ip ! ;            
\ no trace of next word to skip LOOP..   
                                         
' end-trace Alias unbug \ cont. execut.  
                                         
: (debug  ( cfa-- )                      
 traceable range                         
 nest? off trap? on #spaces off          
 Tools do-trace ;                        
                                         
Forth definitions                        
                                         
: debug  ' (debug ; \ word follows       
                                         
: trace'            \ word follows       
 ' dup (debug execute end-trace ;        
