6502/VolksForth
1
0
Fork 0
mirror of https://github.com/forth-ev/VolksForth.git synced 2024-11-19 17:31:23 +00:00
Code Issues Projects Releases Wiki Activity
12972a5590
VolksForth/sources/msdos/see.fb.src
Carsten Strotmann 857eedeafd Initial sync from fossil repo
2017-04-24 00:25:49 +02:00

2075 lines
133 KiB
Plaintext
Raw Blame History

Screen 0 not modified
0 \ Extended-Decompiler for VolksForth cas 10nov05
1
2 This file contains the volksFORTH decompiler. The decompiler
3 will convert FORTH code back to Sourcecode.
4 Conditional words like IF THEN ELSE, BEGIN WHILE REPEAT UNTIL
5 and DO LOOP +LOOP are identified and converted.
6
7 The Decompiler cannot re-create comments, so please use
8 comments in screens and view.
9
10
11 Because: There is always one more bug!
12 And to correct bug, nothing beats good commented sourcecode.
13
14
15 Usage: SEE <name>
Screen 1 not modified
0 \ Extended-Decompiler for VolksForth LOAD-SCREEN ks 22 dez 87
1 Onlyforth Tools also definitions
2
3 | : internal 1 ?head ! ;
4 | : external ?head off ;
5
6 1 &18 +thru
7
8 \\
9 Produces compilable Forth source from normal compiled Forth.
10
11 These source blocks are based on the works of
12
13 Henry Laxen, Mike Perry and Wil Baden
14
15 volksFORTH version: U. Hoffmann
Screen 2 not modified
0 \ detecting does> ks 22 dez 87
1
2 internal
3
4 ' Forth @ 1+ dup @ + 2+ Constant (dodoes>
5
6 : does? ( IP - f )
7 dup c@ $E9 ( jmp ) =
8 swap 1+ dup @ + 2+ (dodoes> = and ;
9
10
11
12
13
14
15
Screen 3 not modified
0 \ indentation. 04Jul86
1 Variable #spaces #spaces off
2
3 : +in ( -- ) 3 #spaces +! ;
4
5 : -in ( -- ) -3 #spaces +! ;
6
7 : ind-cr ( -- ) ( col #spaces @ = ?exit ) cr #spaces @ spaces ;
8
9 : ?ind-cr ( -- ) col c/l u> IF ind-cr THEN ;
10
11
12
13
14
15
Screen 4 not modified
0 \ case defining words 01Jul86
1
2 : Case: ( -- )
3 Create: Does> swap 2* + perform ;
4
5 : Associative: ( n -- )
6 Constant Does> ( n - index )
7 dup @ -rot dup @ 0
8 DO 2+ 2dup @ =
9 IF 2drop drop I 0 0 LEAVE THEN LOOP 2drop ;
10
11
12
13
14
15
Screen 5 not modified
0 \ branching 04Jul86
1
2 Variable #branches Variable #branch
3
4 : branch-type ( n -- a ) 6 * pad + ;
5 : branch-from ( n -- a ) branch-type 2+ ;
6 : branch-to ( n -- a ) branch-type 4+ ;
7
8 : branched ( adr type -- ) \ Make entry in branch-table.
9 #branches @ branch-type ! dup #branches @ branch-from !
10 2+ dup @ + #branches @ branch-to ! 1 #branches +! ;
11
12 \\ branch-table: { type0|from0|to0 | type1|from1|to1 ... }
13
14
15
Screen 6 not modified
0 \ branching 01Jul86
1
2 : branch-back ( adr type -- )
3 \ : make entry in branch-table & reclassify branch-type.)
4 over swap branched
5 2+ dup dup @ + swap 2+ ( loop-start,-end.)
6 0 #branches @ 1-
7 ?DO
8 over I branch-from @ u> IF LEAVE THEN
9 dup I branch-to @ = IF ['] while I branch-type ! THEN
10 -1 +LOOP 2drop ;
11
12
13
14
15
Screen 7 not modified
0 \ branching 01Jul86
1 : forward? ( ip -- f ) 2+ @ 0> ;
2
3 : ?branch+ ( ip -- ip' ) dup 4+ swap dup forward?
4 IF ['] if branched exit THEN ['] until branch-back ;
5
6 : branch+ ( ip -- ip' ) dup 4+ swap dup forward?
7 IF ['] else branched exit THEN ['] repeat branch-back ;
8
9 : (loop)+ ( ip -- ip' )
10 dup dup @ ( loop,+loop ) branch-back -1 #branches +! 4+ ;
11
12 : string+ ( ip -- ip' ) 2+ count + even ;
13
14 : (;code+ ( ip -- ip' ) 2+ dup does? not IF 0= exit THEN 3+ ;
15
Screen 8 not modified
0 \ classify each word 25Aug86
1 Forth
2
3 &15 Associative: execution-class
4 ] clit lit ?branch branch
5 (do (." (abort" (;code
6 (" (?do (loop
7 (+loop unnest (is compile [
8
9 Case: execution-class+
10 3+ 4+ ?branch+ branch+
11 2+ string+ string+ (;code+
12 string+ 2+ 4+
13 4+ 0= 4+ 4+ 2+ ;
14
15 Tools
Screen 9 not modified
0 \ first pass ks 22 dez 87
1
2 : pass1 ( cfa -- ) #branches off >body
3 BEGIN dup @ execution-class execution-class+
4 dup 0= stop? or
5 UNTIL drop ;
6
7 : thru.branchtable ( -- limit start ) #branches @ 0 ;
8
9
10
11
12
13
14
15
Screen 10 not modified
0 \ identify branch destinations. ks 22 dez 87
1 : ?.then ( ip -- ) thru.branchtable
2 ?DO I branch-to @ over =
3 IF I branch-from @ over u<
4 IF I branch-type @ dup ['] else = swap ['] if = or
5 IF -in ." THEN " ind-cr LEAVE THEN THEN THEN
6 LOOP ;
7
8 : ?.begin ( ip -- ) thru.branchtable
9 ?DO I branch-to @ over =
10 IF I branch-from @ over u< not
11 IF I branch-type @ dup
12 ['] repeat = swap ['] until = or
13 IF ind-cr ." BEGIN " +in LEAVE THEN THEN THEN
14 LOOP ;
15 ( put "BEGIN" and "THEN" where used.)
Screen 11 not modified
0 \ decompile each type of word 01Jul86
1
2 : .word ( ip -- ip' ) dup @ >name .name 2+ ;
3
4 : .(word ( ip -- ip' ) dup @ >name
5 ?dup 0= IF ." ??? " ELSE
6 count $1f and swap 1+ swap 1- type space THEN 2+ ;
7 : .inline ( val16b -- )
8 dup >name ?dup IF ." ['] " .name drop exit THEN . ;
9
10 : .lit ( ip -- ip' ) 2+ dup @ .inline 2+ ?.then ;
11 : .clit ( ip -- ip' ) 2+ dup c@ . 1+ ?.then ;
12 : .string ( ip -- ip' )
13 .(word count 2dup type Ascii " emit space + even ?.then ;
14
15 : .unnest ( ip -- 0 ) ." ; " 0= ;
Screen 12 not modified
0 \ decompile each type of word 01Jul86
1
2 : .default ( ip -- ip' ) dup @ >name ?dup IF
3 c@ $40 and IF ." [COMPILE] " THEN THEN .word ?.then ;
4
5 : .['] ( ip -- ip' ) .(word dup @ 2- >name .name 2+ ?.then ;
6
7 : .compile ( ip -- ip' ) .word .word ?.then ;
8
9
10
11
12
13
14
15
Screen 13 not modified
0 \ decompiling conditionals 04Jul86
1
2 : .if ( ip nfa -- ip' ) ind-cr .name +in 4+ ?.then ;
3 : .repeat ( ip nfa -- ip' ) -in .name ind-cr 4+ ?.then ;
4 : .else ( ip nfa -- ip' ) -in ind-cr .name +in 4+ ;
5 : .do ( ip nfa -- ip' ) ind-cr .(word +in 2+ ?.then ;
6 : .loop ( ip nfa -- ip' ) -in .(word ind-cr 2+ ?.then ;
7
8 5 Associative: branch-class
9 ' if , ' while , ' else , ' repeat , ' until ,
10 Case: .branch-class
11 .if .else .else .repeat .repeat ;
12
13 : .branch ( ip -- ip' )
14 #branch @ branch-type @ 1 #branch +!
15 dup >name swap branch-class .branch-class ;
Screen 14 not modified
0 \ decompile Does> ;code 04Jul86
1
2 : .(;code ( IP - IP' f)
3 2+ dup does?
4 IF ind-cr ." DOES> " 3+ ELSE ." ;CODE " 0= THEN ;
5
6
7
8
9
10
11
12
13
14
15
Screen 15 not modified
0 \ classify word's output 01Jul86
1
2 Case: .execution-class
3 .clit .lit .branch .branch
4 .do .string .string .(;code
5 .string .do .loop
6 .loop .unnest .['] .compile
7 .default ;
8
9
10
11
12
13
14
15
Screen 16 not modified
0 \ decompile colon-definitions 04Jul86
1
2 : pass2 ( cfa -- ) #branch off >body
3 BEGIN ?.begin ?ind-cr dup @ execution-class .execution-class
4 dup 0= stop? or
5 UNTIL drop ;
6
7 : .pfa ( cfa -- ) #spaces off +in dup pass1 pass2 ;
8
9 : .immediate ( cfa - ) >name c@ dup
10 ?ind-cr 40 and IF ." IMMEDIATE " THEN
11 ?ind-cr 80 and IF ." RESTRICT" THEN ;
12
13 : .: ( cfa - ) ." : " dup >name .name 3 spaces .pfa ;
14
15
Screen 17 not modified
0 \ display category of word 01Jul86
1 external Defer (see internal
2
3 : .does> ( cfa - ) ." DOES> " @ 1+ .pfa ;
4
5 : .user-variable ( cfa - ) ." USER " dup >name dup .name
6 3 spaces swap execute @ u. .name ." ! " ;
7
8 : .defer ( cfa - )
9 ." deferred " dup >name .name ." Is " >body @ (see ;
10
11 : .other ( cfa - ) dup >name .name
12 dup @ over >body = IF drop ." is Code " exit THEN
13 dup @ does? IF .does> exit THEN
14 drop ." is unknown " ;
15
Screen 18 not modified
0 \ decompiling variables and constants ks 22 dez 87
1
2 : .constant ( cfa - )
3 dup >body @ u. ." CONSTANT " >name .name ;
4
5 : .variable ( cfa - ) ." VARIABLE "
6 dup >name dup .name 3 spaces swap >body @ u. .name ." ! " ;
7
8 5 Associative: definition-class
9 ' quit @ , ' 0 @ , ' scr @ , ' base @ ,
10 ' 'cold @ ,
11
12 Case: .definition-class
13 .: .constant .variable .user-variable
14 .defer .other ;
15
Screen 19 not modified
0 \ Top level of Decompiler ks 20dez87
1
2 external
3
4 : ((see ( cfa -)
5 #spaces off cr
6 dup dup @
7 definition-class .definition-class .immediate ;
8
9 ' ((see Is (see
10
11 Forth definitions
12 : see ' (see ;
13
14
15
Screen 20 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 21 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 22 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 23 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 24 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 25 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 26 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 27 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 28 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 29 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 30 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 31 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 32 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 33 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 34 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 35 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 36 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 37 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 38 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 39 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 40 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 41 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 42 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 43 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 44 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 45 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 46 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 47 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 48 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 49 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 50 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 51 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 52 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 53 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 54 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 55 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 56 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 57 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 58 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 59 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 60 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 61 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 62 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 63 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 64 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 65 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 66 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 67 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 68 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 69 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 70 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 71 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 72 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 73 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 74 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 75 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 76 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 77 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 78 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 79 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 80 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 81 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 82 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 83 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 84 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 85 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 86 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 87 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 88 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 89 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 90 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 91 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 92 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 93 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 94 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 95 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 96 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 97 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 98 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 99 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 100 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 101 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 102 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 103 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 104 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 105 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 106 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 107 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 108 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 109 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 110 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 111 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 112 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 113 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 114 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 115 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 116 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 117 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 118 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 119 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 120 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 121 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Reference in New Issue View Git Blame Copy Permalink