home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / USCX / TURBO-06.ZIP / XLIST.PAS < prev    next >
Pascal/Delphi Source File  |  1985-02-23  |  17KB  |  638 lines
  1. Program XLIST(input,output);
  2.  
  3. {This program produces a cross-reference listing for a
  4. Pascal program. Occurences only are listed. No distinction is
  5. made between definitions and references. It will also give a
  6. graphical representation of the block structure of the program.
  7.  
  8. Note: This program, originally written by N. Wirth,
  9. uses the 'quadratic quotient' hash method. It was
  10. adapted for UCSD Pascal (1.4 - the public domain version)
  11. by Shawn Fanning (in 1978) and subsequently adapted for
  12. Pascal/MT+ by Mike Lehman (in 1981). This version was then
  13. modified be Warren A. Smith to try to get back to iso stan-
  14. dard pascal and to add the additional feature of mapping
  15. out the compound statements. It was adapted for Turbo Pascal
  16. by Ron Finger in July 1984. This is a public domain program.}
  17.  
  18. {$I-}
  19. {$V-}
  20. Const
  21.       P  = 749;        {SIZE of HASHTABLE}
  22.       NK =  45;        {NO. of KEYWORDS}
  23.       PAGESIZE = 57;   {LINES PER PAGE}
  24.       ALFALEN  =  8;   {SIZE of IDENTIFIERS}
  25.       REFSPERLINE = 17;
  26.       REFSPERITEM =  5;
  27.       NESTMAX = 10 ;
  28. Type
  29.      ALFA = Packed Array[1..ALFALEN] of Char;
  30.      INDEX = 0..P;
  31.      ITEMPTR = ^ITEM;
  32.      WORD = Record
  33.                KEY: ALFA;
  34.                FIRST, LAST: ITEMPTR;
  35.                FOL: INDEX
  36.             End ;
  37.      NUMREFS = 1..REFSPERITEM;
  38.      REFTYPE = (COUNT, PTR);
  39.      ITEM = Record
  40.                REF   : ARRAY[NUMREFS] of Integer;
  41.                CASE REFTYPE of
  42.                   COUNT: (REFNUM: NUMREFS);
  43.                   PTR: (NEXT: ITEMPTR)
  44.             End ;
  45.      BUFFER = Packed Array[0..131] of Char;
  46. Var
  47.     TOP: INDEX;  {TOP of CHAIN LINKING ALL ENTRIES IN T}
  48.     I,LINECOUNT,BUFCURSOR: Integer; {CURRENT LINE NUMBER}
  49.     FF,CH: Char;          {CURRENT CHAR SCANNED }
  50.     BUF : BUFFER;
  51.     T: ARRAY [INDEX] of WORD;   {HASH TABLE}
  52.     KEY: ARRAY [1..NK] of ALFA; {RESERVED KEYWORD TABLE }
  53.     ERROR,                      { ERROR FLAG }
  54.     LISTING: Boolean;           { LISTING OPTION }
  55.     INFILE,LST: Text;
  56.     LSTFILENAME : String[14];
  57.     INPUT_LINE : String[120];
  58.     LAST_KEY,PAGE_NUM,NESTLVL:Integer;
  59.     ABORT,LITERAL,ACOMMENT,BCOMMENT,EOL,NESTUP,NESTDN,NODOT:Boolean;
  60.     BAR : Char ;
  61.     FILENAME,FILETITLE:String[14];
  62.     DATE:String[20];
  63.     LDATE,LTITLE:Byte;
  64.  
  65. FUNCTION TAB (NUM : Integer) : Char ;
  66.   Var
  67.       I : Integer ;
  68.   Begin
  69.   For I := 1 to NUM do
  70.     Write (LST, ' ') ;
  71.   TAB := CHR(0)
  72.   End ; { TAB }
  73.  
  74. Procedure TITLELINE;
  75. Begin
  76.   If PAGE_NUM > 1 then
  77.     Writeln(LST,^L);
  78.   Writeln(LST);
  79.   Writeln(LST);
  80.   Write(LST,'File: ',FILETITLE);
  81.   Write(LST,TAB(15),'Cross-Reference & Block Listing',TAB(15));
  82.   If LDATE>5 then
  83.     Write(LST,'Date: ',DATE);
  84.   Write(LST,TAB(50-(LDATE+LTITLE)));
  85.   Writeln (LST,'Page ', PAGE_NUM:1);
  86.   Writeln (LST) ;
  87.   PAGE_NUM := PAGE_NUM + 1
  88. End ; {TITLELINE}
  89.  
  90. Procedure LPWRITELN;
  91. Var
  92.   I : Integer;
  93. Begin
  94.   BUF[BUFCURSOR]:=CHR(13);
  95.   BUFCURSOR:=BUFCURSOR+1;
  96.   For I := 0 to BUFCURSOR-1 do
  97.     Write(LST,BUF[I]);
  98.   Writeln(LST);
  99.   BUFCURSOR:=0;
  100.   LINECOUNT:=LINECOUNT+1;
  101.   If (LINECOUNT MOD PAGESIZE) = 0 then
  102.     TITLELINE;
  103. End;
  104.  
  105. Procedure INITIALIZE;
  106. Var
  107.   I : Integer;
  108. Begin { INITIALIZE }
  109.    FF:=CHR(12);
  110.    ERROR := FALSE;
  111.    For I := 0 to P do
  112.       T[I].KEY := '        ';
  113.    KEY[ 1] := 'AND     ';
  114.    KEY[ 2] := 'ARRAY   ';
  115.    KEY[ 3] := 'BEGIN   ';
  116.    KEY[ 4] := 'BOOLEAN ';
  117.    KEY[ 5] := 'CASE    ';
  118.    KEY[ 6] := 'CHAR    ';
  119.    KEY[ 7] := 'CONST   ';
  120.    KEY[ 8] := 'DIV     ';
  121.    KEY[ 9] := 'DOWNTO  ';
  122.    KEY[10] := 'DO      ';
  123.    KEY[11] := 'ELSE    ';
  124.    KEY[12] := 'END     ';
  125.    KEY[13] := 'EXIT    ';
  126.    KEY[14] := 'FILE    ';
  127.    KEY[15] := 'FOR     ';
  128.    KEY[16] := 'FUNCTION';
  129.    KEY[17] := 'GOTO    ';
  130.    KEY[18] := 'IF      ';
  131.    KEY[19] := 'IN      ';
  132.    KEY[20] := 'INPUT   ';
  133.    KEY[21] := 'INTEGER ';
  134.    KEY[22] := 'MOD     ';
  135.    KEY[23] := 'NIL     ';
  136.    KEY[24] := 'NOT     ';
  137.    KEY[25] := 'OF      ';
  138.    KEY[26] := 'OR      ';
  139.    KEY[27] := 'OUTPUT  ';
  140.    KEY[28] := 'PACKED  ';
  141.    KEY[29] := 'PROCEDUR';
  142.    KEY[30] := 'PROGRAM ';
  143.    KEY[31] := 'REAL    ';
  144.    KEY[32] := 'RECORD  ';
  145.    KEY[33] := 'REPEAT  ';
  146.    KEY[34] := 'SET     ';
  147.    KEY[35] := 'STRING  ';
  148.    KEY[36] := 'TEXT    ';
  149.    KEY[37] := 'THEN    ';
  150.    KEY[38] := 'TO      ';
  151.    KEY[39] := 'TYPE    ';
  152.    KEY[40] := 'UNTIL   ';
  153.    KEY[41] := 'VAR     ';
  154.    KEY[42] := 'WHILE   ';
  155.    KEY[43] := 'WITH    ';
  156.    KEY[44] := 'WRITE   ';
  157.    KEY[45] := 'WRITELN ';
  158.  
  159.    LINECOUNT:= 1;
  160.    TOP := P;
  161.    PAGE_NUM := 1 ;
  162.    LITERAL := FALSE ;
  163.    ACOMMENT := FALSE ;
  164.    BCOMMENT := FALSE ;
  165.    NESTLVL := 0 ;
  166.    LAST_KEY := 0 ;
  167.    BAR := '|' ;
  168.    CH  := ' '
  169. End; { INITIALIZE }
  170.  
  171. Procedure OPENFILES;
  172. Var
  173.     I,NUMBLOCKS,OPENERRNUM: Integer;
  174.     OPENOK: Boolean;
  175.     LISTOPTION: Char;
  176. Begin { OPEN }
  177.    Writeln;
  178.    ABORT := FALSE ;
  179.    Repeat
  180.       NODOT := TRUE;
  181.       Write('Filename: ( CR to quit): ');
  182.       READLN( FILENAME );
  183.         ABORT := Length(FILENAME) <= 0;
  184.         If NOT ABORT then
  185.           Begin
  186.             For I := 1 to LENGTH(FILENAME) do
  187.               Begin
  188.                 FILENAME[I] := UPcase(FILENAME[I]) ;
  189.                 If FILENAME[I] = '.' then
  190.                   NODOT := False
  191.               End;
  192.             If NODOT then
  193.               FILENAME := FILENAME + '.PAS';
  194.             ASSIGN(INFILE,FILENAME);
  195.             RESET(INFILE);
  196.             OPENERRNUM := IORESULT;
  197.             OPENOK := ( OPENERRNUM = 0);
  198.             If NOT OPENOK then
  199.               Writeln(FILENAME,' not found')
  200.             Else
  201.               FILETITLE := FILENAME;
  202.               If POS(':',FILETITLE) = 2 then
  203.                 DELETE(FILETITLE,1,2);
  204.               LTITLE := LENGTH(FILETITLE);
  205.         End;
  206.    Until OPENOK OR ABORT;
  207.  
  208.    If NOT ABORT then
  209.      Begin
  210.        Write('Destination file or device (CR for LST:): ');
  211.        READLN(LSTFILENAME);
  212.        If LENGTH (LSTFILENAME) <= 0 then
  213.          LSTFILENAME := 'LST:' ;
  214.        For I := 1 to LENGTH(LSTFILENAME) do
  215.          LSTFILENAME[I] := UPcase(LSTFILENAME[I]) ;
  216.        ASSIGN(LST,LSTFILENAME);
  217.        Rewrite(LST);
  218.   End;
  219.    If NOT ABORT then
  220.      Begin
  221.        Repeat
  222.          Write('Do you want a listing (Y/N)? ');
  223.          READLN( LISTOPTION );
  224.          LISTOPTION := UPcase(LISTOPTION);
  225.        Until LISTOPTION IN ['Y','N'];
  226.          LISTING := LISTOPTION = 'Y';
  227.          If LDATE=5 then
  228.            Begin
  229.              Write('Date: ');
  230.              READLN(DATE);
  231.              LDATE:=LENGTH(DATE)+5
  232.            End;
  233.      End
  234. End; {open}
  235.  
  236. Procedure PUTALFA(S:ALFA);
  237. Begin
  238.   MOVE(S[1],BUF[BUFCURSOR],8);
  239.   BUFCURSOR:=BUFCURSOR+8;
  240. End;
  241.  
  242. Procedure PUTNUMBER(NUM: Integer);
  243. Var I,IPOT:Integer;
  244.     A: ALFA;
  245.     CH: Char;
  246.     ZAP:Boolean;
  247.     
  248. Begin
  249.   ZAP:=TRUE;
  250.   IPOT:=10000;
  251.   A[1]:=' ';
  252.   For I:= 2 to 6 do
  253.     Begin
  254.       CH:=CHR(NUM DIV IPOT + ORD('0'));
  255.       If I <> 6 then
  256.         If ZAP then
  257.            If CH = '0' then
  258.              CH:=' '
  259.            Else ZAP:=FALSE;
  260.       A[I]:=CH;
  261.       NUM:=NUM MOD IPOT;
  262.       IPOT:=IPOT DIV 10;
  263.     End;
  264.   A[7]:=' ';
  265.   MOVE(A,BUF[BUFCURSOR],7);
  266.   BUFCURSOR:=BUFCURSOR+7;
  267. End;
  268.  
  269. Procedure SEARCH( ID: ALFA );               {MODULO P HASH SEARCH}
  270. {GLOBAL: T, TOP}
  271. Var
  272.     I,J,H,D  : Integer;
  273.     X         : ITEMPTR;
  274.     F         : Boolean;
  275.  
  276. Begin
  277.    J:=0;
  278.    For I:= 1 to ALFALEN do
  279.      J:= J*10+ORD(ID[I]);
  280.    H  := ABS(J) MOD P;
  281.    F  := FALSE;
  282.    D  := 1;
  283.    Repeat
  284.       If T[H].KEY = ID
  285.          then
  286.             Begin {FOUND}
  287.                F := TRUE;
  288.                If T[H].LAST^.REFNUM = REFSPERITEM
  289.                   then
  290.                      Begin
  291.                          NEW(X);
  292.                          X^.REFNUM := 1;
  293.                          X^.REF[1] := LINECOUNT;
  294.                          T[H].LAST^.NEXT:= X;
  295.                          T[H].LAST        := X;
  296.                      End
  297.                  Else
  298.                     WITH T[H].LAST^ do
  299.                        Begin
  300.                           REFNUM      := REFNUM + 1;
  301.                           REF[REFNUM] := LINECOUNT
  302.                        End
  303.             End
  304.          Else
  305.             If T[H].KEY = '        '
  306.                then
  307.                   Begin {NEW ENTRY}
  308.                      F := TRUE;
  309.                      NEW(X);
  310.                      X^.REFNUM := 1;
  311.                      X^.REF[1] := LINECOUNT;
  312.                      T[H].KEY := ID;
  313.                      T[H].FIRST := X;
  314.                      T[H].LAST := X;
  315.                      T[H].FOL := TOP;
  316.                      TOP := H
  317.                   End
  318.                Else
  319.                   Begin {COLLISION}
  320.                      H := H+D;
  321.                      D := D+2;
  322.                      If H >= P
  323.                         then
  324.                            H := H - P;
  325.                      If D = P
  326.                         then
  327.                            Begin
  328.                               Writeln(OUTPUT,'TBLE OVFLW');
  329.                               ERROR := TRUE
  330.                            End ;
  331.                   End
  332.    Until F OR ERROR
  333. End {SEARCH} ;
  334.  
  335.  
  336.  
  337. Procedure PRINTWORD(W: WORD);
  338. Var
  339.     L,NEXTREF: Integer;
  340.     X: ITEMPTR;
  341.     THISREF: NUMREFS;
  342. Begin
  343.    PUTALFA(W.KEY);
  344.    X := W.FIRST;
  345.    L := 0;
  346.    Repeat
  347.       If L = REFSPERLINE
  348.          then
  349.             Begin
  350.                L := 0;
  351.                LPWRITELN;
  352.                PUTALFA('        ');
  353.             End ;
  354.       L := L+1;
  355.       THISREF := (L-1) MOD REFSPERITEM + 1;
  356.       NEXTREF := X^.REF[ THISREF ];
  357.       If THISREF = X^.REFNUM
  358.          then
  359.             X := NIL
  360.          Else
  361.             If THISREF = REFSPERITEM
  362.                then
  363.                   X := X^.NEXT;
  364.       PUTNUMBER(NEXTREF);
  365.    Until X = NIL;
  366.   LPWRITELN;
  367. End {PRINTWORD} ;
  368.  
  369. Procedure PRINTTABLE;
  370. Var
  371.     I,J,M: INDEX;
  372. Begin
  373.    I := TOP;
  374.    While I <> P do
  375.       Begin {FIND MINIMAL WORD}
  376.          M := I;
  377.          J := T[I].FOL;
  378.          While J <> P do
  379.             Begin
  380.                If T[J].KEY < T[M].KEY
  381.                   then
  382.                      M := J;
  383.                J := T[J].FOL
  384.             End ;
  385.          PRINTWORD(T[M]);
  386.          If M <> I then 
  387.            Begin
  388.              T[M].KEY:=T[I].KEY;
  389.              T[M].FIRST:=T[I].FIRST;
  390.              T[M].LAST:=T[I].LAST;
  391.            End;
  392.          I := T[I].FOL
  393.       End
  394. End {PRINTTABLE} ;
  395.  
  396. Procedure OUTPUT_LINE (BUF : BUFFER) ;
  397.   Var
  398.     I : Integer ;
  399.   Procedure FILL_LINE (Var LINE : BUFFER) ;
  400.     Var
  401.       I : Integer ;
  402.     Begin { FILL_LINE }
  403.     I := 1 ;
  404.     While (LINE[I] = ' ') do
  405.       Begin
  406.       LINE[I] := '-' ;
  407.       I := I + 1
  408.       End
  409.     End ; { FILL_LINE }
  410.  
  411.   Procedure PRTNEST (Var LINE : BUFFER) ;
  412.  
  413.     Var COL : Integer ;
  414.  
  415.     Begin { PRTNEST }
  416.     For COL := 1 to NESTLVL - 1 do
  417.       Write (LST, BAR, '  ') ;
  418.     If NESTLVL > 0 then
  419.       If NESTUP OR NESTDN then
  420.         Begin
  421.         If NESTDN then
  422.           Begin
  423.           Write (LST, BAR, '  ') ;
  424.           Write (LST, 'E--') ;
  425.           For COL := NESTLVL+2 to NESTMAX do
  426.             Write (LST, '---')
  427.           End
  428.         Else
  429.           Begin
  430.           Write (LST, 'B--') ;
  431.           For COL := NESTLVL+1 to NESTMAX do
  432.             Write (LST, '---')
  433.           End ;
  434.         FILL_LINE (LINE)
  435.         End
  436.       Else
  437.         Begin
  438.         Write (LST, BAR, '  ') ;
  439.         For COL := NESTLVL+1 to NESTMAX do
  440.           Write (LST, '   ')
  441.         End
  442.     Else
  443.       If NESTDN then
  444.         Begin
  445.         Write (LST, 'E--') ;
  446.         For COL := 2 to NESTMAX do
  447.           Write (LST, '---') ;
  448.         FILL_LINE (LINE)
  449.         End
  450.       Else
  451.         For COL := 1 to NESTMAX do
  452.           Write (LST, '   ')
  453.     End ; { PRTNEST }
  454.         
  455.   Begin { OUTPUT_LINE }
  456.   If ((LINECOUNT MOD PAGESIZE) = 0) OR (PAGE_NUM = 1) then
  457.     Begin
  458.       If LISTING then
  459.         TITLELINE;
  460.     If (LSTFILENAME <> 'CON:') AND ((LINECOUNT MOD PAGESIZE) = 0) then
  461.       Writeln (OUTPUT, '< ', LINECOUNT:4, ',', MEMAVAIL:5, ' >')
  462.     End ;
  463.   Write (LST, LINECOUNT:4, '  ') ;
  464.   PRTNEST (BUF) ;
  465.   For I := 1 to BUFCURSOR do
  466.     Write (LST, BUF[I]) ;
  467.   Writeln (LST) ;
  468.   If LSTFILENAME <> 'CON:' then
  469.     Write (OUTPUT, '.')
  470.   End ; { OUTPUT_LINE }
  471.  
  472. Procedure GETNEXTCHAR;
  473. Var I : Integer;
  474.  
  475. Begin { GETNEXTCHAR }
  476. If BUFCURSOR >= LENGTH (INPUT_LINE) then
  477.   Begin
  478.   EOL := TRUE ;
  479.   CH := ' ' ;
  480.   ERROR := EOF(INFILE)
  481.   End
  482. Else
  483.   Begin
  484.   BUFCURSOR := BUFCURSOR + 1 ;
  485.   CH := INPUT_LINE [BUFCURSOR] ;
  486.   BUF [BUFCURSOR] := CH ;
  487.   CH := UPcase(CH)
  488.   End
  489. End; { GETNEXTCHAR }
  490.  
  491. Procedure GETIDENTIFIER;
  492. Var
  493.     J,K,I: Integer;
  494.     ID: ALFA;
  495.  
  496. Begin { GETIDENTIFIER }
  497.    I := 0;
  498.    ID := '        ';
  499.    Repeat
  500.       If I < ALFALEN
  501.          then
  502.             Begin
  503.                I := I+1;
  504.                ID[I] := CH
  505.             End;
  506.       GETNEXTCHAR
  507.    Until ( NOT(((CH>='A') AND (CH<='Z')) OR (CH='_')
  508.                 OR ((CH>='0') AND (CH<='9')))) OR (ERROR);
  509.    I := 1;
  510.    J := NK;
  511.    Repeat
  512.       K := (I+J) DIV 2;      {BINARY SEARCH}
  513.       If KEY[K] <= ID
  514.          then
  515.             I := K+1;
  516.  
  517.       If KEY[K] >= ID
  518.          then
  519.             J := K-1;
  520.  
  521.    Until I > J;
  522.    If KEY[K] <> ID then
  523.      SEARCH(ID)
  524.    Else
  525.      Begin
  526.        If (K=3) OR ((K=5) AND (LAST_KEY<>32)) OR     { Begin or CASE }
  527.           (K=32) OR (K=33) then                      { Record or Repeat }
  528.          Begin
  529.            LAST_KEY := K ;
  530.            If NESTLVL = NESTMAX then
  531.              Write (LST, '----Too many levels')
  532.            Else
  533.              Begin
  534.                NESTLVL := NESTLVL + 1 ;
  535.                NESTUP := TRUE
  536.              End
  537.          End ;
  538.        If (K=12) OR (K=40) then          { End or Until }
  539.          If NESTLVL = 0 then
  540.            Write (LST, '----Nesting error  ')
  541.          Else
  542.            Begin
  543.              NESTLVL := NESTLVL - 1 ;
  544.              NESTDN := TRUE
  545.            End
  546.      End
  547.  
  548. End; { GETIDENTIFIER }
  549.  
  550. Begin { CROSSREF }
  551.    LDATE:=5;
  552.    Repeat
  553.    INITIALIZE;
  554.    OPENFILES;
  555.    While NOT EOF(INFILE) AND (NOT ABORT) do
  556.       Begin
  557.       BUFCURSOR:= 0;
  558.       NESTUP := FALSE ;
  559.       NESTDN := FALSE ;
  560.       READLN (INFILE, INPUT_LINE) ;
  561.       If LENGTH (INPUT_LINE) > 0 then
  562.         Begin
  563.         EOL := FALSE ;
  564.         BUFCURSOR := BUFCURSOR + 1 ;
  565.         CH := INPUT_LINE [BUFCURSOR] ;
  566.         BUF [BUFCURSOR] := CH ;
  567.         CH := UPcase (CH)
  568.         End
  569.       Else
  570.         Begin
  571.         EOL := TRUE ;
  572.         CH := ' '
  573.         End ;
  574.       While NOT EOL do
  575.         Begin
  576.         If ((CH >= 'A') AND (CH <= 'Z')) AND (NOT LITERAL) AND
  577.            (NOT ACOMMENT) AND (NOT BCOMMENT) then
  578.           GETIDENTIFIER
  579.         Else
  580.           If (CH = '''') OR LITERAL then
  581.             Begin
  582.               Repeat
  583.                 GETNEXTCHAR;
  584.               Until (CH = '''') OR (ERROR) OR EOL;
  585.               LITERAL := EOL ;
  586.               GETNEXTCHAR
  587.             End
  588.           Else
  589.             If (CH = '{') OR ACOMMENT then
  590.               Begin
  591.                 While (CH <> '}') AND (NOT ERROR) AND (NOT EOL) do
  592.                   GETNEXTCHAR ;
  593.                 ACOMMENT := EOL ;
  594.                 GETNEXTCHAR
  595.               End
  596.             Else
  597.               If (CH = '(') OR BCOMMENT then
  598.                 Begin
  599.                   If NOT BCOMMENT then
  600.                     GETNEXTCHAR;
  601.                   If (CH = '*') OR BCOMMENT then
  602.                     Begin
  603.                       If NOT BCOMMENT then
  604.                         GETNEXTCHAR;
  605.                       Repeat
  606.                         While (CH <> '*') AND (NOT ERROR) AND (NOT EOL) do
  607.                           GETNEXTCHAR ;
  608.                         BCOMMENT := EOL ;
  609.                         If NOT EOL then
  610.                           GETNEXTCHAR
  611.                       Until (CH = ')') OR ERROR OR EOL ;
  612.                       If NOT EOL then
  613.                         GETNEXTCHAR
  614.                     End
  615.                 End
  616.               Else
  617.                 GETNEXTCHAR;
  618.  
  619.         End; { While }
  620.       EOL := FALSE ;
  621.       If LISTING then
  622.         OUTPUT_LINE (BUF) ;
  623.       LINECOUNT := LINECOUNT + 1
  624.       End ;
  625.    If NOT ABORT then
  626.      Begin
  627.      TITLELINE;
  628.      LINECOUNT := 0;
  629.      BUFCURSOR := 0;
  630.      PRINTTABLE;
  631.      Writeln(LST,^L);
  632.      CLOSE(LST);
  633.      If IOresult <> 0 then
  634.        Writeln('Error closing output file')
  635.      End;
  636.   Until LENGTH(FILENAME) <= 0
  637. End.
  638.