\ Loadscreen for Decompiler    20oct87re 
\ nach F83 by Henry Laxen / Mike Perry   
                                         
\needs Tools  Vocabulary Tools           
                                         
.( Decompiler loading...)                
                                         
Onlyforth                                
Tools also definitions                   
                                         
\needs dis     ' drop | Alias dis        
          \ Disassemble if possible      
                                         
&1 &9 +thru                              
                                         
\\                                       
                                         
clear                                    
                                         
                                         
                                         
                                         
                                         
                                         
                                        
\ case defining words        20aug85mawe 
                                         
| : case:  ( n -)                        
 Create , 0 ]                            
 Does> 2+ swap 2* + perform ;            
                                         
| : associative:                         
 Create ,   ( n -)                       
 Does>      ( n - index)                 
 dup @ -rot dup @ 0                      
   DO 2+ 2dup @ =                        
     IF 2drop drop I 0 0 LEAVE THEN      
   LOOP 2drop ;                          
                                         
                                         
Defer (see                               
| Variable maxbranch                     
| Variable thenbranch                    
                                         
                                         
                                         
                                         
                                         
                                         
                                        
\ decompile each type of word 29nov85re  
                                         
| : .word   ( IP - IP')                  
 dup @ >name .name 2+ ;                  
                                         
| : .lit    ( IP - IP')                  
 .word dup @ . 2+ ;                      
                                         
| : .clit   ( IP - IP')                  
 .word dup c@ . 1+ ;                     
                                         
| : .string ( IP - IP')                  
 cr .word count 2dup type ascii " emit   
 space + ;                               
                                         
| : .do  ( IP - IP')   ." DO " 4 + ;     
                                         
| : .loop  ( IP - IP')   ." LOOP " 4 + ; 
                                         
| : .exit    ( IP - IP' f)               
 dup maxbranch @ u< IF  .word exit  THEN 
 dup @ [ Forth ] ['] unnest =            
 IF  ." ; "  ELSE  .word ." ; -2 allot " 
 THEN  0= ;                              
                                        
\ branch, ?branch             29nov85re  
                                         
| : .to                                  
 ." back to " .word drop ;               
                                         
| : .branch ( IP - IP')                  
 2+ dup @ 2dup +  swap 0<                
 IF   cr ." REPEAT to " .exit            
   0<> swap 2+  and  exit                
 THEN cr ." ELSE " dup thenbranch !      
 dup maxbranch @ u>                      
 IF  maxbranch !  ELSE  drop  THEN 2+ ;  
                                         
| : .?branch  ( IP - IP')                
 2+ dup @ 2dup +                         
 swap 0<                                 
 IF cr ." UNTIL " .to 2+ exit THEN       
 cr dup 4 - @ [ ' branch ] literal =     
 over 2-  @ 0< and                       
 IF   ." WHILE "                         
 ELSE ." IF "  dup thenbranch !          
 THEN  dup maxbranch @ u>                
    IF maxbranch ! ELSE drop THEN  2+ ;  
                                         
                                        
\ decompile does> ;code ;      20oct87re 
                                         
| : does?    ( IP - IP' f)               
 dup 3 + swap                            
 dup c@ $4C  =  swap      \ jmp-opcode   
 1+ @  ['] Forth @ 1+ @ = \ (dodoes>     
 and ;                                   
                                         
| : .(;code  ( IP - IP' f)               
  2+ does?                               
   IF cr ." Does> "                      
   ELSE  ." ;Code " 3 - dis 0 THEN ;     
                                         
| : .compile  ( IP -- IP' )              
  .word .word ;                          
                                         
                                         
                                         
                                         
                                         
                                         
                                         
                                         
                                         
                                        
\ classify each word           20oct87re 
                                         
&18 associative: execution-class         
Forth                                    
' lit ,     ' clit ,     ' ?branch ,     
' branch ,  ' (DO ,      ' (." ,         
' (abort" , ' Does> 4 + @ , \ (;code     
' exit ,    ' abort ,    ' quit ,        
' 'quit ,   ' (quit ,    ' unnest ,      
' (" ,      ' (?DO ,     ' (LOOP ,       
' compile ,                              
                                         
&19 case: .execution-class               
.lit        .clit        .?branch        
.branch     .do          .string         
.string     .(;code                      
.exit       .exit        .exit           
.exit       .exit        .exit           
.string     .do          .loop           
.compile    .word    ;                   
                                         
                                         
                                         
                                         
                                        
\ decompile a :-definition   20aug85mawe 
                                         
: .pfa  ( cfa -)                         
 >body                                   
 BEGIN ?cr dup                           
   dup thenbranch @ =                    
   IF ." THEN " ?cr THEN                 
   @ execution-class .execution-class    
   dup 0= stop? or UNTIL                 
 drop ;                                  
                                         
: .immediate  ( cfa -)                   
 >name c@ dup                            
 ?cr $40 and IF ." Immediate " THEN      
 ?cr $80 and IF ." restrict" THEN ;      
                                         
: .constant   ( cfa -)                   
 dup >body @ . ." Constant "             
 >name .name ;                           
                                         
: .variable   ( cfa -)                   
 dup >body . ." Variable "               
 dup >name .name                         
 cr ." Value = "  >body @ . ;            
                                        
\ display category of word     20oct87re 
                                         
: .:      ( cfa -)                       
 ." : " dup >name .name cr .pfa ;        
                                         
: .does>  ( cfa -)                       
 cr ." Does> " 2- .pfa ;                 
                                         
: .user-variable  ( cfa -)               
 dup >body c@ . ." User-Variable "       
 dup >name .name                         
 cr ." Value = "  execute @ . ;          
                                         
: .defer  ( cfa -)                       
 ." deferred " dup >name .name           
 ." Is " >body @ (see ;                  
                                         
: .other  ( cfa -)                       
 dup >name .name                         
 dup @ over >body =                      
  IF ." is Code" @ dis exit THEN         
 dup @ does? IF .does> drop exit THEN    
 drop ." maybe Code" @ dis ;             
                                         
                                        
\ Classify a word              22jul85we 
                                         
5 associative: definition-class          
' quit @ ,        ' 0 @ ,                
' scr @ ,         ' base @ ,             
' 'cold @ ,                              
                                         
6 case: .definition-class                
.:                .constant              
.variable         .user-variable         
.defer            .other  ;              
                                         
                                         
                                         
                                         
                                         
                                         
                                         
                                         
                                         
                                         
                                         
                                         
                                         
                                        
\ Top level of Decompiler    20aug85mawe 
                                         
: ((see    ( cfa -)                      
 maxbranch off  thenbranch off           
 cr dup dup @                            
 definition-class .definition-class      
 .immediate ;                            
                                         
' ((see Is (see                          
                                         
Forth definitions                        
                                         
: see   ' (see ;                         
                                         
                                         
                                         
