home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / DETOKENZ.ZIP / DETOKENZ.PAS
Encoding:
Pascal/Delphi Source File  |  1986-01-30  |  13.1 KB  |  480 lines
  1. program de_tokenize;
  2.  
  3. {
  4.   11/15/1985
  5.  
  6.   Version 1.0    by John Michael T.
  7.                     Detroit, Michigan
  8.  
  9.   detokenize IBM basica tokenized programs into ascii
  10.  
  11.   this is a preliminary version that works most of the time.
  12.   i'm still having problems with conversion of double and
  13.   single precision numbers.
  14.  
  15.   i have put this out as a demo of how to detokenize and also
  16.   just in case someone out there can help out with the double/
  17.   single precision conversions.
  18.  
  19. }
  20.  
  21. type
  22.  st255 = string[255];
  23.  st2 = string[2];
  24.  
  25. var
  26.     fvar1,fvar2 : text[$F00];
  27.     ch_r,a,b,c,header,mystery_a,mystery_b : char;
  28.     a_val,b_val,c_val : integer;
  29.     line_no : integer;
  30.     line : st255;
  31.     end_flag : boolean;
  32.  
  33. FUNCTION POWER(X,N : INTEGER) : INTEGER;
  34. BEGIN
  35.    IF N = 1
  36.       THEN POWER := X
  37.       ELSE POWER := X*POWER(X,N-1)
  38. END;
  39.  
  40. FUNCTION SPACES(NUM : INTEGER) : ST255;
  41.   VAR
  42.     SP1 : INTEGER;
  43.     SPACE : ST255;
  44.   BEGIN
  45.     SPACE := '';
  46.     FOR SP1 := 1 TO NUM DO
  47.         SPACE := SPACE + ' ';
  48.     SPACES := SPACE;
  49.   END;
  50.  
  51. function fns ( a1 : integer) : st255;
  52. var
  53.  a1s : st255;
  54. begin
  55.  str(a1,a1s);
  56.  fns := a1s;
  57. end;
  58.  
  59. function fnsr ( a1 : real) : st255;
  60. var
  61.  a1s : st255;
  62. begin
  63.  str(a1,a1s);
  64.  fnsr := a1s;
  65. end;
  66.  
  67. function cvi (a1,a2 : char) : integer;
  68. begin
  69.  cvi := ord(a1) + (ord(a2)*256);
  70. end;
  71.  
  72. function hex(num : integer) : st2;
  73. var
  74.  hex_str : string[16];
  75.  h1,h2 : integer;
  76. begin
  77.  hex_str := '0123456789ABCDEF';
  78.  h1 := num div 16;
  79.  h2 := num mod 16;
  80.  if h1 <> 0
  81.   then
  82.      hex := hex_str[h1+1] + hex_str[h2+1]
  83.    else
  84.      hex := hex_str[h2+1];
  85. end;
  86.  
  87. procedure accept_cvi;
  88. var
  89.  a_val,b_val,c_val : integer;
  90.  a1,b1,a3 : char;
  91. begin
  92.  read(fvar1,a1);
  93.  read(fvar1,b1);
  94.  a_val := ord(a1);
  95.  b_val := ord(b1);
  96.  c_val := a_val + (b_val*256);
  97.  line := line + fns(c_val);
  98. end;
  99.  
  100. procedure accept_hex;
  101. var
  102.  a_val,b_val : integer;
  103.  a1,b1 : char;
  104. begin
  105.  read(fvar1,a1);
  106.  read(fvar1,b1);
  107.  a_val := ord(a1);
  108.  b_val := ord(b1);
  109.  line := line + '&H' + hex(b_val) + hex(a_val);
  110. end;
  111.  
  112. procedure accept_cvs;
  113. var
  114.  a1,a2,a3,a4,a5 : char;
  115.  base,bnum,a,b,c,d,laser,ph : integer;
  116.  resol,cvs : real;
  117. begin
  118.  read(fvar1,a1);
  119.  read(fvar1,a2);
  120.  read(fvar1,a3);
  121.  read(fvar1,a4);
  122.  a := ord(a1);
  123.  b := ord(a2);
  124.  c := ord(a3);
  125.  d := ord(a4);
  126.  if (c=128) and (d=129)
  127.     then cvs := -1
  128.     else
  129.       begin
  130.         base := d-129;
  131.         bnum := power(2,base);
  132.         resol := bnum/128;
  133.         laser := trunc(c*resol);
  134.         ph := trunc(b/(128/resol));
  135.         cvs := bnum+laser+ph
  136.       end;
  137.   line := line + fnsr(cvs);
  138. end;
  139.  
  140. procedure accept_cvd;
  141. var
  142.  a1,a2,a3,a4,a5 : integer;
  143.  base,bnum,a,b,c,d,laser,ph : integer;
  144.  resol,cvs : real;
  145. begin
  146.  read(fvar1,a1);
  147.  read(fvar1,a2);
  148.  read(fvar1,a3);
  149.  read(fvar1,a4);
  150.  a := ord(a1);
  151.  b := ord(a2);
  152.  c := ord(a3);
  153.  d := ord(a4);
  154.  if (c=128) and (d=129)
  155.     then cvs := -1
  156.     else
  157.       begin
  158.         base := d-129;
  159.         bnum := power(2,base);
  160.         resol := bnum/128;
  161.         laser := trunc(c*resol);
  162.         ph := trunc(b/(128/resol));
  163.         cvs := bnum+laser+ph
  164.       end;
  165.   line := line + fnsr(cvs);
  166. end;
  167.  
  168. procedure get_line_no;
  169. var
  170.  lsb,msb : char;
  171. begin
  172.  read(fvar1,lsb);
  173.  read(fvar1,msb);
  174.  line_no := cvi(lsb,msb);
  175.  line := fns(line_no) + ' ';
  176. end;
  177.  
  178. procedure form_line;
  179. begin
  180.   a_val := 1;
  181.   end_flag := false;
  182.   repeat
  183.    read(fvar1,a);
  184.    a_val := ord(a);
  185.    case a_val of
  186.      255 : begin
  187.              read(fvar1,b);
  188.              b_val := ord(b);
  189.              case b_val of
  190.                165 : line := line + 'LOF';
  191.                164 : line := line + 'LOC';
  192.                163 : line := line + 'EOF';
  193.                162 : line := line + 'STRIG';
  194.                161 : line := line + 'STICK';
  195.                160 : line := line + 'PEN';  {???}
  196.                159 : line := line + 'FIX';
  197.                158 : line := line + 'CDBL';
  198.                157 : line := line + 'CSNG';
  199.                156 : line := line + 'CINT';
  200.                155 : line := line + 'LPOS';
  201.                154 : line := line + 'HEX$';
  202.                153 : line := line + 'OCT$';
  203.                152 : line := line + 'SPACE$';
  204.                151 : line := line + 'PEEK';
  205.                150 : line := line + 'CHR$';
  206.                149 : line := line + 'ASC';
  207.                148 : line := line + 'VAL';
  208.                147 : line := line + 'STR$';
  209.                146 : line := line + 'LEN';
  210.                145 : line := line + 'POS';
  211.                144 : line := line + 'INP';
  212.                143 : line := line + 'FRE';
  213.                142 : line := line + 'ATN';
  214.                141 : line := line + 'TAN';
  215.                140 : line := line + 'COS';
  216.                139 : line := line + 'EXP';
  217.                138 : line := line + 'LOG';
  218.                137 : line := line + 'SIN';
  219.                136 : line := line + 'RND';
  220.                135 : line := line + 'SQR';
  221.                134 : line := line + 'ABS';
  222.                133 : line := line + 'INT';
  223.                132 : line := line + 'SGN';
  224.                131 : line := line + 'MID$';
  225.                130 : line := line + 'RIGHT$';
  226.                129 : line := line + 'LEFT$';
  227.              end; {case 255 & b_val of}
  228.            end; {case a_val of 255}
  229.  
  230.      254 : begin
  231.              read(fvar1,b);
  232.              b_val := ord(b);
  233.              case b_val of
  234.                158 : line := line + 'PMAP';
  235.                157 : line := line + 'WINDOW';
  236.                156 : line := line + 'VIEW';
  237.                155 : line := line + 'ENVIRON';
  238.                154 : line := line + 'SHELL';                                   
  239.                153 : line := line + 'RMDIR';                                   
  240.                152 : line := line + 'MKDIR';                                   
  241.                151 : line := line + 'CHDIR';
  242.                150 : line := line + 'IOCTL';
  243.                149 : line := line + 'ERDEV';
  244.                148 : line := line + 'TIMER';                                   
  245.                147 : line := line + 'PLAY';
  246.                146 : line := line + 'DRAW';
  247.                145 : line := line + 'CIRCLE';
  248.                144 : line := line + 'COM';
  249.                143 : line := line + 'PAINT';
  250.                142 : line := line + 'TIME$';                                   
  251.                141 : line := line + 'DATE$';
  252.                140 : line := line + 'CHAIN';
  253.                139 : line := line + 'COMMON';
  254.                138 : line := line + 'RESET';
  255.                137 : line := line + 'GET';
  256.                136 : line := line + 'PUT';
  257.                135 : line := line + 'KILL';
  258.                134 : line := line + 'RSET';
  259.                133 : line := line + 'LSET';
  260.                132 : line := line + 'NAME';
  261.                131 : line := line + 'SYSTEM';
  262.                130 : line := line + 'FIELD';
  263.                129 : line := line + 'FILES';
  264.              end; {case 254 & b_val of}
  265.            end; {case a_val of 254}
  266.  
  267.      253 : begin
  268.              read(fvar1,b);
  269.              b_val := ord(b);
  270.              case b_val of
  271.                129 : line := line + 'CVI';
  272.                130 : line := line + 'CVS';
  273.                131 : line := line + 'CVD';
  274.                132 : line := line + 'MKI$';
  275.                133 : line := line + 'MKS$';
  276.                134 : line := line + 'MKD$';
  277.              end; {case 253 & b_val of}
  278.            end; {case a_val of 253}
  279.  
  280.      250 : line := line + 'RESTORE';
  281.  
  282.      244 : line := line + '\';
  283.      243 : line := line + 'MOD';
  284.      242 : line := line + 'IMP';
  285.      241 : line := line + 'EQV';
  286.      240 : line := line + 'XOR';
  287.      239 : line := line + 'OR';
  288.      238 : line := line + 'AND';
  289.      237 : line := line + '^';
  290.      236 : line := line + '/';
  291.      235 : line := line + '*';
  292.      234 : line := line + '-';
  293.      233 : line := line + '+';
  294.      232 : line := line + '<';
  295.      231 : line := line + '=';
  296.      230 : line := line + '>';
  297.  
  298.      222 : line := line + 'INKEY$';
  299.      221 : line := line + 'OFF';
  300.      220 : line := line + 'POINT';
  301.      219 : line := line + 'CSRLIN';
  302.      218 : line := line + 'VARPTR';
  303.  
  304.      216 : line := line + 'INSTR';
  305.      215 : line := line + 'USING';
  306.      214 : line := line + 'STRING$';
  307.      213 : line := line + 'ERR';
  308.      212 : line := line + 'ERL';
  309.      211 : line := line + 'NOT';
  310.      210 : line := line + 'SPC(';
  311.      209 : line := line + 'FN';
  312.      208 : line := line + 'USR';
  313.      207 : line := line + 'STEP';
  314.      206 : line := line + 'TAB(';
  315.      205 : line := line + 'THEN';
  316.      204 : line := line + 'TO';
  317.  
  318.      202 : line := line + 'LOCATE';
  319.      201 : line := line + 'KEY';
  320.      200 : line := line + 'SCREEN';
  321.      199 : line := line + 'PRESET';
  322.      198 : line := line + 'PSET';
  323.      197 : line := line + 'BEEP';
  324.      196 : line := line + 'SOUND';
  325.      195 : line := line + 'BLOAD';
  326.      194 : line := line + 'BSAVE';
  327.      193 : line := line + 'MOTOR';
  328.      192 : line := line + 'CLS';
  329.      191 : line := line + 'COLOR';
  330.      190 : line := line + 'SAVE';
  331.      189 : line := line + 'MERGE';
  332.      188 : line := line + 'LOAD';
  333.      187 : line := line + 'CLOSE';
  334.      186 : line := line + 'OPEN';
  335.      185 : line := line + 'RANDOMIZE';
  336.      184 : line := line + 'OPTION';
  337.      183 : line := line + 'WRITE';
  338.  
  339.      179 : line := line + 'CALL';
  340.      178 : line := line + 'WEND';
  341.  
  342.    {  177 : line := line + 'WHILE'; }
  343.      177 : begin
  344.              read(fvar1,b);
  345.              b_val := ord(b);
  346.              if b_val = 233
  347.               then
  348.                 line := line + 'WHILE'
  349.              else
  350.               line := line + '*** UNKNOWN for 177 ***';
  351.            end; {case 177 of}
  352.  
  353.      176 : line := line + 'LINE';
  354.      175 : line := line + 'DEFDBL';
  355.      174 : line := line + 'DEFSNG';
  356.      173 : line := line + 'DEFINT';
  357.      172 : line := line + 'DEFSTR';
  358.      171 : line := line + 'RESUME';
  359.      170 : line := line + 'AUTO';
  360.      169 : line := line + 'DELETE';
  361.      168 : line := line + 'RESUME';
  362.      167 : line := line + 'ERROR';
  363.      166 : line := line + 'EDIT';
  364.      165 : line := line + 'ERASE';
  365.      164 : line := line + 'SWAP';
  366.      163 : line := line + 'TROFF';
  367.      162 : line := line + 'TRON';
  368.  
  369.      160 : line := line + 'WIDTH';
  370.  
  371.      158 : line := line + 'LLIST';
  372.      157 : line := line + 'LPRINT';
  373.      156 : line := line + 'OUT';
  374.  
  375.      153 : line := line + 'CONT';
  376.      152 : line := line + 'POKE';
  377.  
  378.      151 : begin
  379.              read(fvar1,b);
  380.              b_val := ord(b);
  381.              case b_val of
  382.                { 209 : line := line + 'DEF FN'; }
  383.                208 : line := line + 'DEF USR';
  384.                 32 : line := line + 'DEF ';
  385.              end; {case b_val of}
  386.             end; {case a_val 151 of}
  387.  
  388.      150 : line := line + 'WAIT';
  389.      149 : line := line + 'ON';
  390.      148 : line := line + 'NEW';
  391.      147 : line := line + 'LIST';
  392.      146 : line := line + 'CLEAR';
  393.      145 : line := line + 'PRINT';
  394.      144 : line := line + 'STOP';
  395.      143 : line := line + 'REM';
  396.      142 : line := line + 'RETURN';
  397.      141 : line := line + 'GOSUB';
  398.  
  399.      139 : line := line + 'IF';
  400.      138 : line := line + 'RUN';
  401.      137 : line := line + 'GOTO';
  402.      136 : line := line + 'LET';
  403.      135 : line := line + 'READ';
  404.      134 : line := line + 'DIM';
  405.      133 : line := line + 'INPUT';
  406.      132 : line := line + 'DATA';
  407.      131 : line := line + 'NEXT';
  408.      130 : line := line + 'FOR';
  409.      129 : line := line + 'END';
  410.  
  411.       58 : begin
  412.              read(fvar1,b);
  413.              b_val := ord(b);
  414.              case b_val of
  415.                   0 : begin
  416.                         line := line + ':';
  417.                         end_flag := true;
  418.                       end;
  419.                 161 : line := line + 'ELSE';
  420.                 143 : begin
  421.                         read(fvar1,c);
  422.                         c_val := ord(c);
  423.                         if c_val = 217
  424.                           then
  425.                             line := line + chr(39)
  426.                           else
  427.                            line := line + chr(58) + chr(b_val) + chr(c_val);
  428.                       end; {case b_val 143 of}
  429.              else
  430.                line := line + chr(58) + chr(b_val);
  431.             end; {case b_val of}
  432.            end; {case a_val 58 of}
  433.  
  434.      30 : accept_cvd;
  435.      29 : accept_cvs;
  436.      28 : accept_cvi;
  437.      26 : end_flag := true;
  438.  17..25 : line := line + fns(a_val-17);
  439.  
  440.      15 : begin
  441.             read(fvar1,b);
  442.             b_val := ord(b);
  443.             line := line + fns(b_val);
  444.           end;
  445.  
  446.      14 : accept_cvi;
  447.  
  448.      12 : accept_hex;
  449.  
  450.  
  451.   else
  452.     if (a_val <> 0) and (not end_flag)
  453.      then
  454.       line := line + chr(a_val);
  455.    end; {case a_val of}
  456.    until (a_val = 0) or end_flag;
  457. end;
  458.  
  459.  
  460. { -------- MAIN --------- }
  461.  
  462. begin
  463.     assign(fvar1,'test2.bas');    {source tokenized}
  464.     assign(fvar2,'test2.asc');    {dest ascii}
  465.     reset(fvar1);
  466.     rewrite(fvar2);
  467.     read(fvar1,header);
  468.     line_no := 1;
  469.     while line_no <> 0 do
  470.       begin
  471.         read(fvar1,mystery_a);
  472.         read(fvar1,mystery_b);
  473.         get_line_no;
  474.         form_line;
  475.         writeln(fvar2,line);
  476.       end;
  477.     close(fvar1);
  478.     close(fvar2);
  479. end.
  480.