home *** CD-ROM | disk | FTP | other *** search
Text File | 1992-11-27 | 6.5 KB | 103 lines | [04] ASCII Text (0x0000) |
- \ Forth decompiler
- \ -- does not decompile control structures...
-
- VOCABULARY DECOMPILER DECOMPILER DEFINITIONS HEX
- : 2NDARY? ( pfa -- ? ) CFA @ ' ; CFA @ = ;
- : NEST1 ( wa -- nfa ) @ >BODY NFA ;
- : IMMED? ( wa -- ? ) C@ 40 AND ;
- : NEXT ( pfa -- lfa ) LFA @ ( 2+ PFA ) ;
- : TEST ( n1 n2 -- ? n1 ) OVER = SWAP ;
- : END? ( wa -- ? ) @ >BODY ' (;CODE) TEST ' ;S TEST DROP OR ;
- : .ADR 0 <# # # # # #> TYPE ;
-
- DEC
-
- \ Forth decompiler
-
- : LIKE COMPILE LIT FIND @ , ; IMMEDIATE
- : NOT2NDARY ( pfa -- ) DUP CFA @ CASE
- LIKE 0 OF @ . ." CONSTANT " ENDOF
- LIKE FENCE OF C@ U. ." USER " ENDOF
- LIKE PREV OF DROP ." VARIABLE " ENDOF
- LIKE R/W OF C@ U. ." US@X " ENDOF
- LIKE FORTH OF ." VOCABULARY " ENDOF
- OVER CFA @ OF DROP ." CODE " ENDOF
- ENDCASE ;
- : .BRANCH DUP @ DUP .ADR OVER 2+ SWAP - DUP ABS SPACE DEC
- 0 <# ASCII ) HOLD #S ROT 0< IF ASCII + HOLD ELSE
- ASCII - HOLD THEN ASCII ( HOLD #> TYPE
- CR 12 SPACES HEX 2+ ;
-
- \ Forth decompiler
-
- VARIABLE LOUT LOUT !0
- : ?NEW-PAGE ( --- ? ) LOUT @ 58 = IF
- PAGE LOGO. CR CR LOUT !0 THEN ;
- : NEW-LINE [ 'CR @ , ] 1 LOUT +! ?NEW-PAGE ;
-
- : EOL? ( margin -- ) 80 SWAP - OUT C@ < IF
- CR 12 SPACES
- THEN ;
- : 2BYTE DUP @ .ADR SPACE 2+ ;
-
- \ Forth decompiler
-
- : INC ( pfa -- pfa+ ) DUP 2+ SWAP @ >BODY CASE
- ' COMPILE OF DUP @ >BODY NFA ID. 2+ ENDOF
- ' CLIT OF DUP C@ DEC U. HEX 1+ ENDOF
- ' (.") OF DUP COUNT DUP BURY DUP EOL? TYPE +
- 1+ ASCII " EMIT SPACE ENDOF
- ' LIT OF 2BYTE ENDOF
- ' BRANCH OF .BRANCH ENDOF
- ' 0BRANCH OF .BRANCH ENDOF
- ' (LOOP) OF 2+ ENDOF
- ' (+LOOP) OF 2+ ENDOF
- ENDCASE ;
-
- \ Forth decompiler
-
- : IS-WORD COMPILE LIT FIND >BODY NFA , ; IMMEDIATE
- : SMART-ID. ( nfa --- ) DUP CASE
- IS-WORD (.") OF DROP ASCII . EMIT
- ASCII " EMIT SPACE ENDOF
- IS-WORD LIT OF DROP ENDOF
- IS-WORD CLIT OF DROP ENDOF
- IS-WORD (LOOP) OF DROP ." LOOP " ENDOF
- IS-WORD (+LOOP) OF DROP ." +LOOP " ENDOF
- IS-WORD (DO) OF DROP ." DO " ENDOF
- IS-WORD ;S OF DROP ." ; " ENDOF
- DEFAULT OF ID. ENDOF
- ENDCASE ;
-
- \ Forth decompiler
-
- : (DCMP) ( pfa -- ) BEGIN
- DUP NEST1 DUP IMMED? IF
- 15 EOL? ." [COMPILE] "
- THEN 15 EOL? SMART-ID. DUP END? NOT
- WHILE
- INC
- REPEAT DROP ;
-
- \ Forth decompiler
-
- : (DECOMPILE) ( pfa -- pfa.next.word ) CR HEX
- DUP .ADR SPACE DUP CFA @ .ADR SPACE DUP 2NDARY? IF
- ." : " DUP NFA ID. SPACE DUP (DCMP)
- DUP NFA IMMED? IF
- ." IMMEDIATE "
- THEN
- ELSE
- DUP NOT2NDARY DUP NFA ID.
- THEN NEXT CR DEC ;
-
- : DECOMPILE FIND ?DUP 0= 0 ?ERROR >BODY (DECOMPILE) DROP ;
-
- \ Forth decompiler
-
- : DCMPALL LATEST 2+ PFA LOUT !0 (DECOMPILE) BEGIN
- DUP 0= NOT ?TERMINAL 0= AND
- WHILE
- 2+ PFA (DECOMPILE)
- REPEAT ;
-