VolksForth decompiler

\ Loadscreen for Decompiler    
\ nach F83 by Henry Laxen / Mike Perry   

Vocabulary Tools

CR .( Decompiler loading...) CR
ONLYFORTH                
Tools also definitions
 
' drop | Alias dis 
        
clear
| : 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

| : .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

| : .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 ;

| : 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

&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

: .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

: .:      ( 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

5 associative: definition-class
' quit @ ,        ' 0 @ ,
' scr @ ,         ' base @ ,
' 'cold @ ,

6 case: .definition-class
.:                .constant
.variable         .user-variable
.defer            .other ;

\ Top level of Decompiler

: ((see    ( cfa -)
 maxbranch off  thenbranch off
 cr dup dup @
 definition-class .definition-class
 .immediate ;

' ((see Is (see

Forth definitions

: see   ' (see ;