Published using Google Docs
( DECOMPILER.fth )
Updated automatically every 5 minutes

TACHYON

[~

( *** DECOMPILER *** )

( WEB LINK )

pub DECOMPILER.fth                ." Tachyon Forth decompiler V1.0 130312.1620 " ;

{ CHANGELOG:

130312        

Added two pass decompilation to reveal BEGIN structures

Calculate end of code to stop listing automatically (in addition to other methods)        

}

BYTE indent,dmode

pri INDENT                 indent C@ 1 MAX SPACES ;

pri +INDENT                3 indent C+! ;

pri -INDENT                indent C@ IF -3 indent C+! THEN ;

pri .ADDR                CR DUP .WORD ." : " ;

TABLE ifs        #16 ALLOT                \ create a stack for forward branch matching

\ Push a forward branch onto the IF stack and increase the indent

pri +IF ( addr -- )

        ifs DUP 2+ #14 <CMOVE

         ifs W!

         +INDENT

         ;

\ drop a forward branch from the IF stack and decrease the indent

pri -IF

         ifs DUP 2+ SWAP #14 CMOVE

         -INDENT

         .ADDR INDENT ." THEN "

         ;

TABLE begins        #16 ALLOT

pri +BEGIN ( addr -- : place the addr into a blank long - assumes there is one blank )

         begins 16 ADO I W@ 0= IF I W! LEAVE THEN 2 +LOOP

        ;

pri BEGIN? ( addr -- flg : search the begins table for a match )        

        begins 16 ADO I W@ OVER = IF DROP FALSE LEAVE THEN 2 +LOOP NOT

        ;

\ Fetch a Forth literal which is byte aligned and big endian - assume it's a long

pri LIT@ ( addr -- long )

        C@++ 8 SHL SWAP C@++ ROT + 8 SHL SWAP C@++ ROT + 8 SHL SWAP C@ +

         ;  

\ resolve the code at the current address and increment the code pointer accordingly

pri (SEE) ( addr -- addr+ )

         DUP >PFA ' (.") = IF "." EMIT """ EMIT SPACE 2+ DUP .STR """ EMIT DUP STRLEN + 1+ EXIT THEN

        DUP C@ ' (XCALL) DUP 3 - SWAP WITHIN

           IF DUP >PFA PFA>NFA .STR 2+ EXIT THEN

        DUP C@ ' DUP = IF ." DUP" 1+ EXIT THEN

         DUP C@ ' (PUSH4) = IF 1+ DUP LIT@ ." $" .LONG 4 + EXIT THEN

         DUP C@ ' (PUSH3) = IF 1+ DUP LIT@ 8 SHR $FFFFFF AND ." $" .LONG 3 + EXIT THEN

         DUP C@ ' (PUSH2) = IF 1+ DUP LIT@ 16 SHR DUP PFA>NFA ?DUP

             IF ." ' " .STR DROP ELSE ." $" .WORD THEN

            2+ EXIT THEN

         DUP C@ ' (PUSH1) = IF 1+ DUP C@ ." $" .BYTE 1+ EXIT THEN

          DUP C@ ' (REG) = IF 1+ DUP C@ ." R" .BYTE 1+ EXIT THEN

           DUP C@ ' (IF) = IF  1+ DUP C@ ." IF " OVER + 1+ +IF 1+ EXIT THEN

           DUP C@ ' (ELSE) = IF 1+ DUP C@ ." ELSE " OVER + 1+ ifs W! 1+ EXIT THEN

        DUP C@ ' DO = IF +INDENT THEN

        DUP C@ ' LOOP = IF -INDENT THEN

        DUP C@ ' +LOOP = IF -INDENT THEN

        DUP C@ ' FOR = IF +INDENT THEN

        DUP C@ ' NEXT = IF -INDENT THEN

        DUP C@ ' (UNTIL) = IF ." UNTIL " 1+ DUP DUP C@ - 1+ +BEGIN 1+ EXIT THEN

        DUP C@ ' (AGAIN) = IF ." AGAIN " 1+ DUP DUP C@ - 1+ +BEGIN 1+ EXIT THEN

         DUP C@ PFA>NFA 1- C@++ ADO I C@ EMIT LOOP 1+                \ otherwise print the name of the bytecode instruction

        ;

WORD cend

pri END? ( addr -- addr flg )

        DUP C@ 3 = ifs W@ 0= AND

         OVER cend W@ = OR

         ESC? OR

        ;

pri DECOMPILE

         DUP 0 REG W!                                                                \ keep track of code size

        indent C~ ifs 16 ERASE                                                \ reset defaults

          BEGIN

            BEGIN DUP ifs W@ = WHILE -IF REPEAT                        \ handle multiple THENs

           DUP BEGIN? IF .ADDR INDENT ." BEGIN" +INDENT THEN

          DUP C@ ' (UNTIL) = IF -INDENT THEN

          .ADDR INDENT (SEE)

           END?

          UNTIL

          DUP C@ 3 = IF .ADDR INDENT ." EXIT" THEN

        0 REG W@ - CR ." =" .DEC ."  bytes "

         ;

IFNDEF NULLOUT

pri (NULLOUT)                DROP ;

pub NULLOUT                ' (NULLOUT) uemit W! ;

}

pri !SEE

         begins 16 ERASE

        [COMPILE] NFA'

        [COMPILE] GRAB

        \ CR ." : " DUP 1+ .STR SPACE

         DUP 2- >PFA cend W!

        SPACE

        NFA>CFA DUP 1- C@ DUP .ATRS                                                \ List the attributes for this word

        7 AND 0= IF ." *** CODE *** " DROP EXIT THEN

        >PFA

        ;

\ Simple one pass decompiler

pub SEE ( <name> -- )

        !SEE ?DUP IF DECOMPILE THEN

        ;

IMMEDIATE

\ This is a two pass decompiler so there is a delay until then it lists the code complete with BEGIN structures

pub SEEALL ( <name> -- )

        !SEE ?DUP IF NULLOUT DUP DECOMPILE CON DECOMPILE THEN

        ;

IMMEDIATE

\ Testing some source code decompilation as well - attempts to present in source code format

pri -IF2

         ifs DUP 2+ SWAP #14 CMOVE

         -INDENT

         CR INDENT ." THEN "

        ;

 

]~        \ disable preprocessor

pri DECOMPILE2 ( pfa -- )

         DUP 0 REG W!                                                        \ keep track of code size

        ifs 16 ERASE                                                \ reset defaults

        BEGIN

          BEGIN DUP ifs W@ = WHILE -IF2 REPEAT                        \ handle multiple THENs

           DUP BEGIN? IF CR  INDENT ." BEGIN " +INDENT  THEN

           DUP C@ ' (UNTIL) = IF -INDENT THEN

          DUP C@ ' (IF) = OVER C@ ' DO = OR OVER C@ ' LOOP = OR OVER C@ ' (UNTIL) = OR

          OVER C@ ' FOR = OR OVER C@ ' NEXT = OR OVER C@ ' (ELSE) = OR

           OVER >PFA ' (.") = OR

             IF CR INDENT THEN

          (SEE) SPACE

          END?

        UNTIL

          DUP C@ 3 = IF CR INDENT ." ;" THEN

        ;

[~

pri !SEE2

         begins 16 ERASE

        [COMPILE] NFA'

        [COMPILE] GRAB

        CR ." : " DUP 1+ .STR CR

         3 indent C! INDENT

         DUP 2- >PFA cend W!

        NFA>CFA

         DUP 1- C@ 2 REG C!

        >PFA

        ;

pub DECOMP ( <name> -- )

        !SEE2 ?DUP IF DUP NULLOUT DECOMPILE2 SWAP CON 3 indent C! DECOMPILE2 THEN

        2 REG C@ BL AND IF ."  IMMEDIATE " THEN

        0 REG W@ - CR $28 EMIT ."  =" .DEC ."  bytes )"

         ;

IMMEDIATE

]~

END