\ Load Screen for Decompiler 5 /15/88 1 11 +THRU CR .( Decompiler Loaded ) \S A Forth decompiler is a utility program that translates executable forth code back into source code. Normally this is impossible, since traditional compilers produce more object code than source, but in Forth it is quite easy. The decompileris almost one to one, failing only to correctly decompile the various Forth control stuctures and special compiling words. It was written with modifiability in mind, so if you add your own special compiling words, it will be easy to change the decompiler to include them. This code is highly implementation dependant, and will NOT work on other Forth systems. To invoke the decompiler, use the word SEE <name> where <name> is the name of a Forth word. \ Positional case defining word 5 /15/88( Subscripts start FROM 0 ) : OUT ( # apf -- ) ( report out of range error ) CR ." Subscript out of range on " DUP BODY> >NAME .ID ." Max is " ? ." tried " . QUIT ; : MAP ( # apf -- a ) ( convert subscript # to address a ) 2DUP @ U< IF 2+ SWAP 2* + ELSE OUT THEN ; : CASE: ( n -- ) ( define positional case defining word ) CONSTANT !CSP HIDE COMPILER DOES> ( #subscript -- ) ( executes #'th word ) MAP PERFORM ; \ ASSOCIATIVE: Table Lookup Def. Wo 5 /15/88 : ASSOCIATIVE: CONSTANT DOES> ( N -- INDEX ) DUP @ ( N PFA CNT ) -ROT DUP @ 0 ( CNT N PFA CNT 0 ) DO 2+ 2DUP @ = ( CNT N PFA' BOOL ) IF 2DROP DROP I 0 0 LEAVE THEN ( CLEAR STACK AND RETURN INDEX THAT MATCHED ) LOOP 2DROP ; \ Decompile each type of word 5 /15/88DEFER (SEE) HIDDEN DEFINITIONS : .WORD ( IP -- IP' ) DUP @ >NAME .ID 2+ ; : .INLINE ( IP -- IP' ) ( .WORD ) 2+ DUP @ . 2+ ; : .BRANCH ( IP -- IP' ) .WORD DUP @ OVER - . 2+ ; : .QUOTE ( IP -- IP' ) .WORD .WORD ; : .STRING ( IP -- IP' ) .WORD COUNT 2DUP TYPE SPACE + EVEN ; \ Decompile each type of word 5 /16/88: .(;CODE) ( IP -- IP' ) .WORD DOES? IF ." DOES> " ELSE DROP FALSE THEN ; : .UNNEST ( IP -- IP' ) ." ; " DROP 0 ; : .FINISH ( IP -- IP' ) .WORD DROP 0 ; : .ASCII ( IP -- IP' ) ." ASCII " 2+ DUP @ EMIT SPACE 2+ ; : .['] ( IP -- IP' ) ." ['] " 2+ .WORD ; \ Classify each word in a definition 5 /16/8816 ASSOCIATIVE: EXECUTION-CLASS ( 0 ) ' (LIT) , ( 1 ) ' ?BRANCH , ( 2 ) ' BRANCH , ( 3 ) ' (LOOP) , ( 4 ) ' (+LOOP) , ( 5 ) ' (DO) , ( 6 ) ' COMPILE , ( 7 ) ' (.") , ( 8 ) ' (ABORT") , ( 9 ) ' (;CODE) , ( 10 ) ' UNNEST , ( 11 ) ' (") , ( 12 ) ' (?DO) , ( 13 ) ' (;USES) , ( 14 ) ' (ASCII) , ( 15 ) ' (') , \ Classify each word in a definition 5 /16/8817 CASE: .EXECUTION-CLASS ( 0 ) .INLINE ( 1 ) .BRANCH ( 2 ) .BRANCH ( 3 ) .BRANCH ( 4 ) .BRANCH ( 6 ) .BRANCH ( 6 ) .QUOTE ( 7 ) .STRING ( 8 ) .STRING ( 9 ) .(;CODE) ( 10 ) .UNNEST ( 11 ) .STRING ( 12 ) .BRANCH ( 13 ) .FINISH ( 14 ) .ASCII ( 15 ) .['] ( 15 ) .WORD ; \ Decompile a : definition 5 /15/88: .PFA ( CFA -- ) >BODY BEGIN ?CR DUP @ EXECUTION-CLASS .EXECUTION-CLASS DUP 0= KEY? OR UNTIL DROP ; : .IMMEDIATE ( CFA -- ) >NAME HEAD-SEG LC@ 64 AND IF ." IMMEDIATE" THEN ; : REL>ABS ( cfa -- addr of called routine ) 1+ DUP @ 2+ + ; \ Display category of word 5 /15/88: .CONSTANT ( CFA -- ) DUP >BODY ? ." CONSTANT " >NAME .ID ; : .VARIABLE ( CFA -- ) DUP >BODY . ." VARIABLE " DUP >NAME .ID ." Value = " >BODY ? ; : .: (S CFA -- ) ." : " DUP >NAME .ID 2 SPACES .PFA ; : .DOES> ( CFA -- ) ." DOES> " BODY> .PFA ; : .USER-VARIABLE ( CFA -- ) DUP >BODY ? ." USER VARIABLE " DUP >NAME .ID ." Value = " >IS ? ; \ Display category of word 5 /15/88: .DEFER ( CFA -- ) ." DEFERRED " DUP >NAME .ID ." IS " >IS @ (SEE) ; : .USER-DEFER ( cfa -- ) ." USER DEFERRED " DUP >NAME .ID ." IS " >IS @ (SEE) ; : .OTHER ( CFA -- ) DUP >NAME .ID DUP C@ 232 = NOT ( cfa does not contain jsr in code words ) IF DROP ." is Code" EXIT THEN DUP @ DOES? IF .DOES> DROP EXIT THEN 2DROP ." is Unknown" ; \ Classify a word based on its CFA 5 /15/886 ASSOCIATIVE: DEFINITION-CLASS ( 0 ) ' (QUIT) REL>ABS , ( 1 ) ' 1 REL>ABS , ( 2 ) ' SCR REL>ABS , ( 3 ) ' BASE REL>ABS , ( 4 ) ' KEY REL>ABS , ( 5 ) ' TYPE REL>ABS , 7 CASE: .DEFINITION-CLASS ( 0 ) .: ( 1 ) .CONSTANT ( 2 ) .VARIABLE ( 3 ) .USER-VARIABLE ( 4 ) .DEFER ( 5 ) .USER-DEFER ( 6 ) .OTHER ; \ Top level of the Decompiler SEE 5 /15/88: ((SEE)) ( Cfa -- ) CR DUP DUP REL>ABS DEFINITION-CLASS .DEFINITION-CLASS .IMMEDIATE ; ' ((SEE)) IS (SEE) FORTH DEFINITIONS : SEE ( -- ) ' (SEE) ;
