dsforth/f/deco.f

   1 ( ;; orig: )
   2 ( ;; 24189 - LIT )
   3 ( ;; 24249 - 0BRANCH )
   4 ( ;; 24225 - BRANCH )
   5 ( ;; 24270 - [LOOP] )
   6 ( ;; 24328 - [+LOOP] )
   7 ( ;; )
   8 ( ;; CFAs: )
   9 ( ;;   25350 - FORTH )
  10 ( ;;   25416 - CONSTANT )
  11 ( ;;   25442 - VARIABLE )
  12 ( ;;   25416 - CONSTANT )
  13 ( ;;   32512 - CONSTANT2 )
  14 ( ;;   32547 - 2VARIABLE )
  15
  16
  17 (  0: tracing labels )
  18 (  1: emiting code )
  19 ( -1: stop, no more code allowed )
  20 ( -2: stop, but more code allowed )
  21 0 VARIABLE DC-MODE
  22 0 VARIABLE DC-LABEL-START
  23 0 VARIABLE DC-MAX-LABEL
  24 0 VARIABLE DC-MAX-PC
  25
  26 : (DC-ADD-LABEL)  ( pc -- )
  27   ( ." NEW LABEL: L" DUP U. CR )
  28   DUP DC-MAX-LABEL @ UMAX DC-MAX-LABEL !
  29   DP @
  30   BEGIN
  31     2-
  32     DUP DC-LABEL-START @ 1- U>
  33   WHILE
  34     2DUP @ = IF 2DROP EXIT ENDIF
  35   REPEAT
  36   DROP
  37   ( ." STORED NEW LABEL: L" DUP U. CR )
  38   ,  ( remember label )
  39 ;
  40
  41 : (DC-HAS-LABEL?)  ( pc -- flag )
  42   DP @
  43   BEGIN
  44     2-
  45     DUP DC-LABEL-START @ 1- U>
  46   WHILE
  47     2DUP @ = IF 2DROP -1 EXIT ENDIF
  48   REPEAT
  49   2DROP 0
  50 ;
  51
  52
  53 : (DC-CODE) ( pc -- pc )
  54   -1 DC-MODE !
  55 ;
  56
  57
  58 : (DC-ENDW) ( pc -- pc )
  59   -2 DC-MODE !
  60   2+
  61 ;
  62
  63
  64 : (DC-LIT) ( pc -- pc )
  65   DC-MODE @ IF
  66     DUP @ .
  67   ENDIF
  68   2+
  69 ;
  70
  71
  72 : (DC-BRN) ( pc -- pc )
  73   DUP @ OVER +
  74   DC-MODE @ IF
  75     76 EMIT U.
  76   ELSE
  77     (DC-ADD-LABEL)
  78   ENDIF
  79   2+
  80 ;
  81
  82 : (DC-STR) ( pc -- pc )
  83   DC-MODE @ IF
  84     126 EMIT DUP COUNT TYPE 126 EMIT
  85   ENDIF
  86   COUNT +
  87 ;
  88
  89
  90 ' LIT CFA VARIABLE (DC-SPECW)
  91   ' (DC-LIT) CFA ,
  92   ' BRANCH  CFA , ' (DC-BRN) CFA ,
  93   ' 0BRANCH CFA , ' (DC-BRN) CFA ,
  94   ' TBRANCH CFA , ' (DC-BRN) CFA ,
  95   ' (LOOP)  CFA , ' (DC-BRN) CFA ,
  96   ' (+LOOP) CFA , ' (DC-BRN) CFA ,
  97   ' (.")    CFA , ' (DC-STR) CFA ,
  98   ' (")     CFA , ' (DC-STR) CFA ,
  99   ' (;CODE) CFA , ' (DC-CODE) CFA ,
 100   ' ;S      CFA , ' (DC-ENDW) CFA ,
 101    0 ,
 102
 103
 104 : (DC-WAFIND) ( a arr -- word )
 105   SWAP >R  ( arr | a )
 106   BEGIN
 107     DUP @ DUP  ( arr cfa cfa | a )
 108   WHILE ( arr cfa | a )
 109     R@ = IF RDROP 2+ @ EXIT ENDIF
 110     4+
 111   REPEAT
 112   RDROP 2DROP
 113   ' NOOP CFA
 114 ;
 115
 116
 117 : (DC-TRACE-LABELS) ( pc -- )
 118   ( setup variables )
 119   0 DC-MODE !
 120   DP @ DC-LABEL-START !
 121   DC-MAX-LABEL 0!
 122   DUP DC-MAX-PC !
 123   BEGIN
 124     DUP @  ( pc cfa )
 125     SWAP 2+ SWAP  ( pc cfa / advance pc )
 126     (DC-SPECW) (DC-WAFIND) EXECUTE  ( pc )
 127     ( ." DC-MODE=" DC-MODE @ . CR )
 128     DC-MODE @ IF
 129       DUP DC-MAX-PC !
 130       DC-MODE @ -1 = IF DROP EXIT ENDIF
 131       ( check if we have a label after this )
 132       DUP DC-MAX-LABEL @ U> IF DROP EXIT ENDIF
 133     ENDIF
 134   AGAIN
 135 ;
 136
 137
 138 : (DC-DUMP-LABELS) ( -- )
 139   DP @ DC-LABEL-START @ - 2U/ ." LABELS: " . CR
 140   DP @ U. CR
 141   DC-LABEL-START @ U. CR
 142   DP @
 143   BEGIN
 144     2-
 145     DUP DC-LABEL-START @ 1- U>
 146   WHILE
 147     DUP @ SPACE SPACE 76 EMIT U. CR
 148   REPEAT
 149   DROP
 150 ;
 151
 152
 153 : (DC-CR) ( lcount pc -- newlcount pc )
 154   CR
 155   SWAP
 156   1+
 157   DUP 19 = IF
 158     ." <press ENTER...>"
 159     BEGIN
 160       KEY 13 !=
 161     WHILE REPEAT
 162     13 EMIT 40 SPACES 13 EMIT
 163     DROP 0
 164   ENDIF
 165   SWAP
 166 ;
 167
 168
 169 : DC ( -- ; word )
 170   [COMPILE] '
 171   DUP FORTH-WORD? IFNOT ." ERROR: not a FORTH word!" CR 0 ERROR ENDIF
 172
 173   \ DUP U. CR
 174   DUP (DC-TRACE-LABELS)
 175   \ DUP U. CR
 176
 177   \ (DC-DUMP-LABELS)
 178   ( ." PC START: " DUP U. CR )
 179   ( ." PC END  : " DC-MAX-PC @ U. CR )
 180
 181   ( DROP EXIT )
 182
 183   ( ." press 'Q' to quit" CR )
 184   CR ." DECOMPILED: " DUP NFA ID. CR
 185   0 SWAP
 186   ( lcount pc )
 187   1 DC-MODE !
 188   BEGIN
 189     ( DUP U. SPACE SPACE )  ( pc )
 190     ( show label )
 191     DUP (DC-HAS-LABEL?) IF
 192       76 EMIT DUP U. 8 EMIT 58 EMIT (DC-CR)
 193     ENDIF
 194     ( show word name )
 195     DUP @  ( pc cfa )
 196     SWAP 2+ SWAP  ( pc cfa / advance pc )
 197     DUP 2+ NFA SPACE SPACE ID.  ( pc cfa )
 198     ( process special word )
 199     (DC-SPECW) (DC-WAFIND) EXECUTE  ( pc )
 200     ( debug ) ( DUP SPACE SPACE U. )
 201     (DC-CR)
 202     ( KEY 81 - )
 203     DUP DC-MAX-PC @ U<
 204   WHILE REPEAT
 205   2DROP
 206   ( unallot labels )
 207   DC-LABEL-START @ DP !
 208 ;
 209
 210 \ : TEST ( -- ) 3 0 DO I . CR LOOP ;
 211 ( DC TEST )