home *** CD-ROM | disk | FTP | other *** search
/ Set of Apple II Hard Drive Images / hard.hdv / HARD / FORTH / DECOMPILE.WRD < prev    next >
Encoding:
Text File  |  1992-11-27  |  6.5 KB  |  103 lines  |  [04] ASCII Text (0x0000)

  1. \ Forth decompiler                                              
  2. \   -- does not decompile control structures...                 
  3.                                                                 
  4. VOCABULARY DECOMPILER     DECOMPILER DEFINITIONS   HEX          
  5. : 2NDARY?  ( pfa -- ? )  CFA @ ' ; CFA @ = ;                    
  6. : NEST1 ( wa -- nfa )  @ >BODY NFA ;                            
  7. : IMMED?  ( wa -- ? )  C@ 40 AND ;                              
  8. : NEXT  ( pfa -- lfa )  LFA @ ( 2+ PFA ) ;                      
  9. : TEST ( n1 n2 -- ? n1 )  OVER = SWAP ;                         
  10. : END?  ( wa -- ? )  @ >BODY ' (;CODE) TEST ' ;S TEST DROP OR ; 
  11. : .ADR 0 <# # # # # #> TYPE ;                                   
  12.                                                                 
  13. DEC                                                             
  14.                                                                 
  15. \    Forth decompiler                                           
  16.                                                                 
  17. : LIKE COMPILE LIT  FIND @ , ;  IMMEDIATE                       
  18. : NOT2NDARY  ( pfa -- )  DUP CFA @ CASE                         
  19.    LIKE 0      OF  @ . ." CONSTANT "   ENDOF                    
  20.    LIKE FENCE  OF  C@ U. ." USER "     ENDOF                    
  21.    LIKE PREV   OF  DROP ." VARIABLE "  ENDOF                    
  22.    LIKE R/W    OF  C@ U. ." US@X "     ENDOF                    
  23.    LIKE FORTH  OF  ." VOCABULARY "     ENDOF                    
  24.    OVER CFA @  OF  DROP ." CODE "      ENDOF                    
  25.    ENDCASE ;                                                    
  26. : .BRANCH  DUP @ DUP .ADR  OVER 2+ SWAP  -  DUP ABS  SPACE DEC  
  27.      0 <#  ASCII ) HOLD #S  ROT 0<  IF   ASCII + HOLD   ELSE    
  28.      ASCII - HOLD   THEN  ASCII ( HOLD  #> TYPE                 
  29.      CR 12 SPACES  HEX  2+ ;                                    
  30.                                                                 
  31. \    Forth decompiler                                           
  32.                                                                 
  33. VARIABLE LOUT     LOUT !0                                       
  34. : ?NEW-PAGE   ( --- ? )  LOUT @ 58 = IF                         
  35.         PAGE  LOGO. CR CR  LOUT !0  THEN ;                      
  36. : NEW-LINE  [ 'CR @ , ]  1 LOUT +!  ?NEW-PAGE ;                 
  37.                                                                 
  38. : EOL?  ( margin -- )  80 SWAP - OUT C@ < IF                    
  39.         CR 12 SPACES                                            
  40.      THEN ;                                                     
  41. : 2BYTE  DUP @ .ADR SPACE 2+ ;                                  
  42.                                                                 
  43. \    Forth decompiler                                           
  44.                                                                 
  45. : INC ( pfa -- pfa+ )  DUP 2+ SWAP @ >BODY CASE                 
  46.       ' COMPILE OF DUP @ >BODY NFA ID. 2+ ENDOF                 
  47.          ' CLIT OF DUP C@  DEC U.  HEX 1+ ENDOF                 
  48.          ' (.") OF DUP COUNT DUP BURY DUP EOL? TYPE +           
  49.                    1+ ASCII " EMIT SPACE ENDOF                  
  50.           ' LIT OF 2BYTE ENDOF                                  
  51.        ' BRANCH OF .BRANCH ENDOF                                
  52.       ' 0BRANCH OF .BRANCH ENDOF                                
  53.        ' (LOOP) OF 2+ ENDOF                                     
  54.       ' (+LOOP) OF 2+ ENDOF                                     
  55.     ENDCASE ;                                                   
  56.                                                                 
  57. \    Forth decompiler                                           
  58.                                                                 
  59. : IS-WORD  COMPILE LIT   FIND >BODY NFA , ;   IMMEDIATE         
  60. : SMART-ID.   ( nfa --- )  DUP CASE                             
  61.      IS-WORD (.")    OF  DROP  ASCII . EMIT                     
  62.                          ASCII " EMIT SPACE ENDOF               
  63.      IS-WORD LIT     OF  DROP  ENDOF                            
  64.      IS-WORD CLIT    OF  DROP  ENDOF                            
  65.      IS-WORD (LOOP)  OF  DROP ." LOOP " ENDOF                   
  66.      IS-WORD (+LOOP) OF  DROP ." +LOOP " ENDOF                  
  67.      IS-WORD (DO)    OF  DROP ." DO "  ENDOF                    
  68.      IS-WORD ;S      OF  DROP ." ; " ENDOF                      
  69.      DEFAULT         OF  ID. ENDOF                              
  70.    ENDCASE ;                                                    
  71.                                                                 
  72. \    Forth decompiler                                           
  73.                                                                 
  74. : (DCMP)  ( pfa  -- )  BEGIN                                    
  75.          DUP NEST1 DUP IMMED? IF                                
  76.              15 EOL? ." [COMPILE] "                             
  77.          THEN 15 EOL? SMART-ID. DUP END? NOT                    
  78.       WHILE                                                     
  79.          INC                                                    
  80.       REPEAT DROP ;                                             
  81.                                                                 
  82. \    Forth decompiler                                           
  83.                                                                 
  84. : (DECOMPILE)  ( pfa -- pfa.next.word )  CR HEX                 
  85.      DUP .ADR SPACE  DUP CFA @ .ADR SPACE DUP 2NDARY?  IF       
  86.          ." : " DUP NFA ID.  SPACE DUP (DCMP)                   
  87.          DUP NFA IMMED? IF                                      
  88.             ." IMMEDIATE "                                      
  89.          THEN                                                   
  90.      ELSE                                                       
  91.          DUP NOT2NDARY DUP NFA ID.                              
  92.      THEN NEXT CR DEC ;                                         
  93.                                                                 
  94. : DECOMPILE    FIND ?DUP 0= 0 ?ERROR >BODY  (DECOMPILE) DROP ;  
  95.                                                                 
  96. \    Forth decompiler                                           
  97.                                                                 
  98. : DCMPALL   LATEST 2+ PFA  LOUT !0  (DECOMPILE) BEGIN           
  99.         DUP 0= NOT  ?TERMINAL 0= AND                            
  100.      WHILE                                                      
  101.         2+ PFA (DECOMPILE)                                      
  102.      REPEAT ;                                                   
  103.