home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / crossref / xrefbas6.pas < prev   
Pascal/Delphi Source File  |  1986-06-07  |  17KB  |  662 lines
  1. PROGRAM Xrefbas6;
  2.  
  3.  {  Cross-reference a BASIC program saved in ASCII }
  4.  {  Original BASIC-80 version by Advanced Informatics, 1980 }
  5.  {  MODIFIED FOR IBM PC BY STEVE NOSSEN V1.10 1/13/82  }
  6.  {  MODIFIED BY Buzz Hamilton V1.2 12/2/82       }
  7.  {  TRANSLATED to Turbo Pascal by David W. Carroll, V2.0, 6/7/86 }
  8.  {  Copyright 1986 by David W. Carroll. }
  9.  {  Released for NON-COMMERCIAL use only, all other rights reserved. }
  10.  
  11.  {  This and over 1500 other Turbo Pascal programs are available }
  12.  {  on the High Sierra RBBS-PC 24 hours a day at 209/296-3534    }
  13.  
  14.  {RESERVED WORDS}
  15.  
  16.   CONST
  17.     Linewidth = 79;
  18.     Spc = ' ';
  19.     Maxreswords = 157;
  20.     Reswords: ARRAY [1..Maxreswords] OF STRING [8] =
  21.     ('ABS', 'AND', 'APPEND', 'ASC', 'AS', 'ATN', 'AUTO', 'BEEP',
  22.     'BLOAD', 'BSAVE', 'CALL', 'CDBL', 'CHAIN', 'CHR$', 'CINT', 'CIRCLE',
  23.     'CLEAR', 'CLOSE', 'CLS', 'COLOR ', 'COMMON', 'COM', 'CONT', 'COS', 'CSNC',
  24.     'CSRLIN', 'CVD', 'CVI', 'CVS', 'DATA', 'DATE$', 'DEFDBL', 'DEFINT',
  25.     'DEFSNG', 'DEFSTR', 'DEFUSR', 'DEF', 'DELETE', 'DIM', 'DRAW', 'EDIT',
  26.     'ELSE', 'END', 'EOF', 'EQV', 'ERASE', 'ERL', 'ERROR', 'ERR', 'EXP',
  27.     'FIELD', 'FILES', 'FIX', 'FOR', 'FRE', 'GET', 'GOSUB', 'GOTO', 'HEX$',
  28.     'IF', 'IMP', 'INKEY$', 'INPUT$', 'INPUT', 'INP', 'INSTR', 'INT', 'KEY',
  29.     'KILL', 'LEFT$', 'LEN', 'LET', 'LINE', 'LIST', 'LLIST', 'LOAD', 'LOCATE',
  30.     'LOC', 'LOF', 'LOG', 'LPOS', 'LPRINT', 'LSET', 'MERGE', 'MID$', 'MKD$',
  31.     'MKI$', 'MKS$', 'MOD', 'MOTOR', 'NAME', 'NEW', 'NEXT', 'NOT', 'OCT$',
  32.     'OFF', 'ON', 'OPEN', 'OPTION', 'OR', 'OUT', 'PAINT', 'PEEK', 'PEN', 'PLAY',
  33.     'POINT', 'POKE', 'POS', 'PRESET', 'PRINT', 'PSET', 'PUT', 'RANDOMIZE',
  34.     'READ', 'REM', 'RENUM', 'RESET', 'RESTORE', 'RESUME', 'RETURN', 'RIGHT$',
  35.     'RND', 'RSET', 'RUN', 'SAVE', 'SCREEN', 'SGN', 'SIN', 'SOUND', 'SPACE$',
  36.     'SPC(', 'SQR', 'STEP', 'STICK', 'STOP', 'STR$', 'STRIG', 'STRING$', 'SWAP',
  37.     'SYSTEM', 'TAB(', 'TAN', 'THEN', 'TIME$', 'TO', 'TROFF', 'TRON', 'USING',
  38.     'USR', 'VAL', 'VARPTR', 'WAIT', 'WEND', 'WHILE', 'WIDTH', 'WRITE', 'XOR');
  39.  
  40.   TYPE
  41.     Longstr = STRING [132];
  42.     Datstr = STRING [25];
  43.  
  44.   VAR
  45.     Infile, Outfile: Text;
  46.     Infname, Outfname: Datstr;
  47.     Nocnt, Q, Err, V, P, C, Value, M, I, J: Integer;
  48.     Ls: Longstr;
  49.     Ers, Rword, Vsx: Longstr;
  50.     Ch1: STRING [1];
  51.     Ch: Char;
  52.     Ok: Boolean;
  53.     Lineno, Lc, Bc: Real;
  54.     Il, Rz, Lp, Brnch, Lg, Lz, X, Y, Pz, Vc, Rc: Integer;
  55.  
  56.     Pt: ARRAY [0..25] OF Integer;
  57.     Vnxt: ARRAY [0..490] OF Integer;
  58.     Vs: ARRAY [0..490] OF STRING [15];
  59.     Frst, Last: ARRAY [0..400] OF Integer;
  60.     Rfl, Nxt: ARRAY [0..2000] OF Integer;
  61.  
  62.  
  63.   PROCEDURE Uppercase(VAR Str: Datstr);
  64.  
  65.     VAR
  66.       Indx, Len: Integer;
  67.  
  68.     BEGIN
  69.       Len := Length(Str);
  70.       FOR Indx := 1 TO Len DO
  71.         Str[Indx] := Upcase(Str[Indx])
  72.     END;
  73.  
  74.  
  75.   FUNCTION Instr(Start: Integer;
  76.                  A, B: Longstr): Integer;
  77.  
  78.     VAR
  79.       Loc: Integer;
  80.     BEGIN
  81.       Loc := Pos(B, Copy(A, Start, Length(A)));
  82.       IF Loc > 0 THEN
  83.         Loc := Loc + (Start - 1);
  84.       Instr := Loc;
  85.     END;
  86.  
  87.  
  88.   PROCEDURE Newpage;
  89.     BEGIN
  90.       IF (Pz > 0) OR (M > 1) THEN
  91.         Writeln(Outfile, Chr(12));
  92.       Pz := Pz + 1;
  93.       Writeln(Outfile, Infname, Spc: 55, 'PAGE # ', Pz);
  94.       Writeln(Outfile);
  95.       Writeln(Outfile);
  96.       Lz := 3;
  97.     END;
  98.  
  99.  
  100.   PROCEDURE PrintHeader;
  101.  
  102.     VAR
  103.       I: Integer;
  104.     BEGIN
  105.       Newpage;
  106.       Writeln(Outfile, 'SYMBOL', Spc: 16, 'REFERENCE LINE');
  107.       FOR I := 1 TO 40 DO
  108.         Write(Outfile, '-');
  109.       Writeln(Outfile);
  110.       Writeln(Outfile);
  111.       Lz := Lz + 1;
  112.     END;
  113.  
  114.   { Print Program Listing to Outfile }
  115.  
  116.  
  117.   PROCEDURE PrintListing;
  118.     BEGIN
  119.       X := 1;
  120.       IF (Lz > 60) THEN
  121.         Newpage;
  122.       WHILE X <= Length(Ls) DO
  123.         BEGIN
  124.           Writeln(Outfile, Copy(Ls, X, Linewidth));
  125.           Lz := Lz + 1;
  126.           X := X + Linewidth;
  127.         END;
  128.     END;
  129.  
  130.   { END VARIABLE }
  131.  
  132.  
  133.   PROCEDURE EndVar;
  134.  
  135.     LABEL
  136.       1260, 1280, 1300, 1310;
  137.  
  138.     VAR
  139.       Temp: STRING [15];
  140.     BEGIN
  141.       IF Vsx = '' THEN
  142.         Exit;
  143.       IF Vsx >= 'A' THEN
  144.         BEGIN
  145.           Vsx := Vsx + Ers;
  146.           C := Ord(Vsx[1]) + 1;
  147.         END
  148.       ELSE IF Vsx >= '' THEN
  149.         BEGIN
  150.           WHILE Length(Vsx) < 5 DO
  151.             Vsx := ' ' + Vsx;
  152.           Val(Copy(Vsx, 1, 2), C, Err);
  153.         END
  154.       ELSE
  155.         GOTO 1310;
  156.       Il := - 1;
  157.       I := C;
  158.     1260:
  159.       IF Vsx > Vs[I] THEN
  160.         BEGIN
  161.           Il := I;
  162.           I := Vnxt[I];
  163.           IF I > 0 THEN
  164.             GOTO 1260
  165.           ELSE
  166.             GOTO 1280;
  167.         END;
  168.       IF Vsx = Vs[I] THEN
  169.         BEGIN
  170.           J := Last[I - 91];
  171.           IF Rfl[J] = Lineno THEN
  172.             GOTO 1310
  173.           ELSE
  174.             BEGIN
  175.               Rc := Rc + 1;
  176.               Nxt[J] := Rc;
  177.               GOTO 1300;
  178.             END;
  179.         END;
  180.     1280:
  181.       Vc := Vc + 1;
  182.       IF Il >= 0 THEN
  183.         Vnxt[Il] := Vc;
  184.       Vs[Vc] := Vsx;
  185.       Vnxt[Vc] := I;
  186.       Rc := Rc + 1;
  187.       Frst[Vc - 91] := Rc;
  188.       I := Vc;
  189.     1300:
  190.       Rfl[Rc] := Trunc(Lineno);
  191.       Nxt[Rc] := - 1;
  192.       Last[I - 91] := Rc;
  193.     1310:
  194.       Vsx := '';
  195.     END;
  196.  
  197.   { LIST VARIABLES }
  198.  
  199.  
  200.   PROCEDURE ListXrf;
  201.  
  202.     LABEL
  203.       1480;
  204.  
  205.     VAR
  206.       Q, Vlen: Integer;
  207.  
  208.     BEGIN
  209.       IF M <> 2 THEN
  210.         BEGIN
  211.           Pz := 0;
  212.           Lz := 60;
  213.           FOR J := 0 TO 91 DO
  214.             BEGIN
  215.               V := J;
  216.               V := Vnxt[V];
  217.               WHILE V >= 0 DO
  218.                 BEGIN
  219.                   IF Lz > 56 THEN
  220.                     PrintHeader;
  221.                   Rz := 0;
  222.                   I := Frst[V - 91];
  223.                   Writeln(Outfile);
  224.                   Write(Outfile, Vs[V]);
  225.                   Vlen := Length(Vs[V]);
  226.                 1480:
  227.                   IF Rz = 0 THEN
  228.                     Write(Outfile, Spc: (21 - Vlen));
  229.                   Lineno := Rfl[I];
  230.                   IF Lineno < 0 THEN
  231.                     Lineno := Lineno + 65536.0;
  232.                   Write(Outfile, Lineno: 5: 0, '  ');
  233.                   Rz := Rz + 1;
  234.                   IF Rz > 6 THEN
  235.                     BEGIN
  236.                       Rz := 0;
  237.                       Writeln(Outfile);
  238.                       Vlen := 0;
  239.                       Lz := Lz + 1;
  240.                       IF Lz > 56 THEN
  241.                         PrintHeader;
  242.                     END;
  243.                   I := Nxt[I];
  244.                   IF I > 0 THEN
  245.                     GOTO 1480;
  246.                   IF Rz > 0 THEN
  247.                     BEGIN
  248.                       Writeln(Outfile);
  249.                       Lz := Lz + 1;
  250.                     END;
  251.                   V := Vnxt[V];
  252.                 END;
  253.             END;
  254.  
  255.           FOR Q := 1 TO 79 DO
  256.             Write(Outfile, '=');
  257.           Writeln(Outfile);
  258.           Write(Outfile, 'LINES: ', Lc: 5: 0, '    BYTES: ', Bc: 6: 0);
  259.           Writeln(Outfile, '     SYMBOLS: ', Vc - 91, '    REFERENCES: ',
  260.                   Rc + 1);
  261.           Writeln;
  262.           Writeln;
  263.           Write('LINES: ', Lc: 5: 0, '    BYTES: ', Bc: 6: 0);
  264.           Writeln('     SYMBOLS: ', Vc - 91, '    REFERENCES: ', Rc + 1);
  265.  
  266.           Writeln;
  267.           Writeln('- XREF DONE - ');
  268.         END
  269.       ELSE
  270.         BEGIN
  271.           Writeln;
  272.           Writeln('- LISTING DONE - ');
  273.           Writeln(Outfile);
  274.           Writeln(Outfile, '    - End Of File -');
  275.         END;
  276.  
  277.       Writeln(Outfile);
  278.       Close(Outfile);
  279.       Lz := Lz + 2;
  280.     END;
  281.  
  282.  
  283.   FUNCTION Openfiles: Boolean;
  284.  
  285.     CONST
  286.       Bell = 07;
  287.  
  288.     VAR
  289.       Ch: Char;
  290.       Goodfile, Quit: Boolean;
  291.  
  292.     BEGIN
  293.       REPEAT
  294.         Quit := False;
  295.         Write('Enter input file: ');
  296.         Readln(Infname);
  297.         Uppercase(Infname);
  298.         Assign(Infile, Infname);
  299.         {$I-}
  300.         Reset(Infile) {$I+} ;
  301.         Goodfile := (Ioresult = 0);
  302.         IF NOT Goodfile THEN
  303.           BEGIN
  304.             Write(Chr(Bell));
  305.             Writeln('FILE ', Infname, ' NOT FOUND');
  306.             Write('Quit? (Y/N) ');
  307.             REPEAT
  308.               Read(Kbd, Ch);
  309.               Ch := Upcase(Ch);
  310.             UNTIL Ch IN ['Y', 'N'];
  311.             Writeln(Ch);
  312.             Quit := Ch = 'Y';
  313.           END;
  314.       UNTIL Goodfile OR Quit;
  315.       IF NOT Quit THEN
  316.         BEGIN
  317.           REPEAT
  318.             Quit := False;
  319.             Write('Enter output file: ');
  320.             Readln(Outfname);
  321.             Uppercase(Outfname);
  322.             Assign(Outfile, Outfname);
  323.             {$I-}
  324.             Reset(Outfile) {$I+} ;
  325.             Goodfile := (Ioresult <> 0);
  326.             IF NOT Goodfile THEN
  327.               BEGIN
  328.                 Write(Chr(Bell));
  329.                 Write('FILE ', Outfname, ' EXISTS, OVERWRITE? (y/n) ');
  330.                 REPEAT
  331.                   Read(Kbd, Ch);
  332.                   Ch := Upcase(Ch);
  333.                 UNTIL Ch IN ['Y', 'N'];
  334.                 Writeln(Ch);
  335.                 Goodfile := Ch = 'Y';
  336.                 IF NOT Goodfile THEN
  337.                   BEGIN
  338.                     Write('Quit? (Y/N) ');
  339.                     REPEAT
  340.                       Read(Kbd, Ch);
  341.                       Ch := Upcase(Ch);
  342.                     UNTIL Ch IN ['Y', 'N'];
  343.                     Writeln(Ch);
  344.                     Quit := Ch = 'Y';
  345.                   END;
  346.               END;
  347.           UNTIL Goodfile OR Quit;
  348.           IF NOT Quit THEN
  349.             Rewrite(Outfile);
  350.         END;
  351.       Openfiles := NOT Quit;
  352.     END; {open_files}
  353.  
  354.   PROCEDURE Getfiles;
  355.    BEGIN
  356.     CASE Paramcount OF
  357.       0:
  358.         IF NOT Openfiles THEN
  359.           Halt;
  360.       1:
  361.         BEGIN
  362.           Infname := Paramstr(1);
  363.           Uppercase(Infname);
  364.           IF Pos('.', Infname) = 0 THEN
  365.             BEGIN
  366.               Outfname := Infname + '.XRF';
  367.               Infname := Infname + '.ASC';
  368.             END
  369.           ELSE
  370.             Outfname := Copy(Infname, 1, Pos('.', Infname) - 1) + '.XRF';
  371.           Assign(Infile, Infname);
  372.           {$I-}
  373.           Reset(Infile);
  374.           {$I+}
  375.           Ok := Ioresult = 0;
  376.           IF NOT Ok THEN
  377.             BEGIN
  378.               Writeln('File ', Infname, ' not found.');
  379.               IF NOT Openfiles THEN
  380.                 Halt;
  381.             END
  382.           ELSE
  383.             BEGIN
  384.               Assign(Outfile, Outfname);
  385.               Rewrite(Outfile);
  386.             END;
  387.         END;
  388.       2:
  389.         BEGIN
  390.           Infname := Paramstr(1);
  391.           Uppercase(Infname);
  392.           IF Pos('.', Infname) = 0 THEN
  393.             Infname := Infname + '.ASC';
  394.           Outfname := Paramstr(2);
  395.           Uppercase(Outfname);
  396.           IF Pos('.', Outfname) = 0 THEN
  397.             Outfname := Outfname + '.XRF';
  398.           Assign(Infile, Infname);
  399.           {$I-}
  400.           Reset(Infile);
  401.           {$I+}
  402.           Ok := Ioresult = 0;
  403.           IF NOT Ok THEN
  404.             BEGIN
  405.               Writeln('File ', Infname, ' not found.');
  406.               IF NOT Openfiles THEN
  407.                 Halt;
  408.             END
  409.           ELSE
  410.             BEGIN
  411.               Assign(Outfile, Outfname);
  412.               Rewrite(Outfile);
  413.             END;
  414.         END;
  415.       ELSE
  416.         Writeln('Parameter error - ');
  417.         Writeln('Use:  XREFBAS INFILE[.ASC] [OUTFILE.XRF] ');
  418.         Writeln('Halting...');
  419.         Halt;
  420.       END;
  421.    END;
  422.  
  423.   PROCEDURE Process;
  424.  
  425.     LABEL
  426.       880, 960, 1100, 1110, 1370;
  427.     BEGIN
  428.  
  429.       {INITIALIZE FOR CROSS REFERENCE}
  430.  
  431.       Lc := 0;
  432.       Bc := 0;
  433.       Pz := 0;
  434.       P := 1;
  435.       C := 0;
  436.       Vsx := '';
  437.       Ch1 := '';
  438.       Vc := 91;
  439.       Nocnt := 0;
  440.       Rc := - 1;
  441.       FOR I := 0 TO 91 DO
  442.         Vnxt[I] := - 1;
  443.       IF M > 1 THEN
  444.         Newpage;
  445.  
  446.       { INPUT LINE AND EXTRACT LINE NUMBER }
  447.  
  448.     880:
  449.       IF Eof(Infile) THEN
  450.         BEGIN
  451.           Close(Infile);
  452.           ListXrf;
  453.           Halt;
  454.         END;
  455.       Readln(Infile, Ls);
  456.       IF M > 1 THEN
  457.         BEGIN
  458.           PrintListing;
  459.           IF M = 2 THEN
  460.             GOTO 880;
  461.         END;
  462.       Lg := Length(Ls);
  463.       Brnch := 0;
  464.  
  465.       Ers := '';
  466.       Nocnt := Nocnt + 1;
  467.       Lc := Lc + 1;
  468.       Bc := Bc + Lg;
  469.       Lp := Pos(' ', Ls);
  470.       Val(Copy(Ls, 1, Lp) + '.0', Lineno, Err);
  471.       Write(Lineno: 5: 0, '  ');
  472.       IF Lineno > 32767 THEN
  473.         Lineno := Lineno - 65536.0;
  474.       IF Nocnt > 9 THEN
  475.         BEGIN
  476.           Nocnt := 0;
  477.           Writeln;
  478.         END;
  479.  
  480.       { PARSE REST OF LINE }
  481.  
  482.     960:
  483.       Lp := Lp + 1;
  484.       IF Lp > Lg THEN
  485.         BEGIN
  486.           EndVar;
  487.           GOTO 880;
  488.         END;
  489.       Ch1 := Copy(Ls, Lp, 1);
  490.       IF (Ch1 >= 'A') AND (Ch1 <= 'Z') THEN
  491.         GOTO 1100
  492.       ELSE IF ((Ch1 >= '0') AND (Ch1 <= '9')) OR (Ch1 = '.') THEN
  493.         GOTO 1370;
  494.       IF Ch1 = ' ' THEN
  495.         BEGIN
  496.           EndVar;
  497.           GOTO 960;
  498.         END
  499.       ELSE IF Ch1 <> ',' THEN
  500.         Brnch := 0;
  501.       IF Ch1 = Chr(34) THEN
  502.         BEGIN
  503.           EndVar;
  504.           Lp := Instr(Lp + 1, Ls, Ch1);
  505.           IF Lp > 0 THEN
  506.             GOTO 960
  507.           ELSE
  508.             GOTO 880;
  509.         END;
  510.       IF Ch1 = '''' THEN
  511.         BEGIN
  512.           EndVar;
  513.           GOTO 880;
  514.         END;
  515.       IF Ch1 = '&' THEN
  516.         BEGIN
  517.           EndVar;
  518.           Vsx := Ch1;
  519.           GOTO 880;
  520.         END;
  521.       Ch := Ch1;
  522.       IF (Ch IN ['$', '!', '%', '#']) THEN
  523.         BEGIN
  524.           IF Vsx <> '' THEN
  525.             Vsx := Vsx + Ch1;
  526.           GOTO 960;
  527.         END;
  528.       IF Ch1 = '(' THEN
  529.         BEGIN
  530.           IF Vsx <> '' THEN
  531.             Vsx := Vsx + Ch1;
  532.         END;
  533.       EndVar;
  534.  
  535.       IF Ch1 <> ',' THEN
  536.         Ers := '';
  537.       GOTO 960;
  538.  
  539.       {TEST FOR COMMAND}
  540.  
  541.     1100:
  542.       IF Vsx > '' THEN
  543.         BEGIN
  544.           Vsx := Vsx + Ch1;
  545.           GOTO 960;
  546.         END
  547.       ELSE
  548.         BEGIN
  549.           C := Ord(Ch1);
  550.           P := Pt[C - Ord('A')];
  551.           Brnch := 0;
  552.         END;
  553.     1110:
  554.       IF C < Ord(Reswords[P][1]) THEN
  555.         BEGIN
  556.           Vsx := Vsx + Ch1;
  557.           GOTO 960;
  558.         END;
  559.       IF Instr(Lp, Ls, Reswords[P]) <> Lp THEN
  560.         BEGIN
  561.           P := P + 1;
  562.           GOTO 1110;
  563.         END;
  564.       EndVar;
  565.       Rword := Reswords[P];
  566.       IF Rword = 'DATA' THEN
  567.         BEGIN
  568.           Lp := Instr(Lp, Ls, ':');
  569.           IF Lp > 0 THEN
  570.             GOTO 960
  571.           ELSE
  572.             GOTO 880;
  573.         END;
  574.       IF Rword = 'REM' THEN
  575.         GOTO 880;
  576.       IF (Rword = 'GOTO') OR (Rword = 'GOSUB') OR (Rword = 'THEN') THEN
  577.         Brnch := 1;
  578.       IF (Rword = 'ELSE') OR (Rword = 'RESUME') THEN
  579.         Brnch := 1;
  580.       IF Rword = 'ERASE' THEN
  581.         Ers := '('
  582.       ELSE
  583.         Ers := '';
  584.       Lp := Lp + Length(Rword) - 1;
  585.       GOTO 960;
  586.     1370:
  587.       IF (Vsx = '') AND (Brnch = 0) THEN
  588.         GOTO 960;
  589.       Vsx := Vsx + Ch1;
  590.       GOTO 960;
  591.  
  592.     END;  { PROCESS }
  593.  
  594.   BEGIN   { MAIN }
  595.     Clrscr;
  596.     Writeln('BASIC CROSS-REFERENCE ');
  597.     Writeln('COPYRIGHT (C) 1986 BY David W. Carroll');
  598.     Writeln('V2.0 6/7/86');
  599.  
  600.     { Initialize arrays }
  601.  
  602.     FOR I := 0 TO 25 DO
  603.       Pt[I] := 0;
  604.  
  605.     FOR I := 0 TO 490 DO
  606.       Vnxt[I] := 0;
  607.  
  608.     FOR I := 0 TO 400 DO
  609.       BEGIN
  610.         Frst[I] := 0;
  611.         Last[I] := 0;
  612.       END;
  613.  
  614.     FOR I := 0 TO 2000 DO
  615.       BEGIN
  616.         Rfl[I] := 0;
  617.         Nxt[I] := 0;
  618.       END;
  619.  
  620.     FOR I := 0 TO 490 DO
  621.       Vs[I] := '';
  622.  
  623.     FOR I := 1 TO Maxreswords DO
  624.       BEGIN
  625.         Value := Ord(Reswords[I][1]) - Ord('A');
  626.         IF Pt[Value] = 0 THEN
  627.           Pt[Value] := I;
  628.       END;
  629.  
  630.     FOR I := 0 TO 25 DO
  631.       IF Pt[I] = 0 THEN
  632.         Pt[I] := Maxreswords;
  633.  
  634.     { GET FILE NAMES }
  635.     Getfiles;
  636.  
  637.     Writeln;
  638.     Writeln;
  639.     Writeln('Input file:  ', Infname);
  640.     Writeln('Output file: ', Outfname);
  641.     Writeln;
  642.     Writeln;
  643.     Writeln('         MENU');
  644.     Writeln('========================');
  645.     Writeln('  1.  Crossref Program');
  646.     Writeln('  2.  List Program');
  647.     Writeln('  3.  Do Both');
  648.     Writeln('  4.  Quit');
  649.     Writeln;
  650.     REPEAT
  651.       Write('  Enter choice: ');
  652.       Readln(M);
  653.     UNTIL M IN [1..4];
  654.     IF M = 4 THEN
  655.       Halt;
  656.     Clrscr;
  657.     Writeln('Processing program ', Infname, ' ... ');
  658.     Writeln;
  659.     Process;
  660.  
  661.   END.
  662.