Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB28.ZIP/LISTING.PAS

Pascal/Delphi Source File | 1984-11-11 | 20.7 KB | 726 lines

PROGRAM LISTING;

{$U+}
{$I FUNCTION.PAS}


TYPE
   STRING128 = STRING[128];
   STRING80 = STRING[80];
   STRING8 = STRING[8];
   STRING5 = STRING[5];
   STRING1 = STRING[1];
   VARPOINTER = ^VARRECORD;
   LINEPOINTER = ^LINERECORD;
   TYPEPOINTER = ^TYPERECORD;

   VARRECORD = RECORD
               VARNAME : STRING[80];
               VARTYPE : STRING[10];
                  {INTEGER}
                  {STRING}
                  {CHAR}
                  {REAL}
                  {BOOLEAN}
                  {CONST}
                  {LABEL}
                  {FUNCTION}
                  {PROCEDURE}
               PROCNAME : STRING[80];
               NEXTVAR : VARPOINTER;
               FIRSTLINE : LINEPOINTER;
               LASTLINE : LINEPOINTER;
               END;

   LINERECORD = RECORD
                LINENUM : INTEGER;
                NEXTLINE : LINEPOINTER;
                END;

   TYPERECORD = RECORD
                NEXTMARK : TYPEPOINTER;
                VARPT : VARPOINTER;
                END;


VAR
   FILVAR1, FILVAR2, FILVAR3 : TEXT;
   LISTPROG : STRING[140];
   PROGLINE, PROGLINE2 : STRING[128];
   TESTWORD, PROCNAME, VARTYPE : STRING[80];
   INFILE, OUTFILELIST, OUTFILEXREF, TMPFILE : STRING[14];
   SECTION : STRING[10];
   CHECKWORD : STRING[5];
   LINENUMST : STRING[4];
   MARK1, MARK2 : STRING[2];
   LEVEL, LINENUM, PAGE : INTEGER;
   XREF, DEFINITION, PROCSTART,
   TEMPRESULT1, TEMPRESULT2, NOT_DONE : BOOLEAN;
   XREFINP : CHAR;
   FIRSTVAR, LASTVAR, NEWVAR : VARPOINTER;
   NEWLINE : LINEPOINTER;
   FIRSTMARK, LASTMARK, NEWMARK : TYPEPOINTER;

CONST
   HEADER1 = 'LINE LEVEL  ';
   HEADER2 = '---- -- --  --------------------------------------------------';
   HEADER3 = 'VARIABLE NAME      TYPE        PROCEDURE          LINE NUMBERS';
   HEADER4 = '------------------ ----------- ------------------ ----------------------------------------';
   ALPHA   = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890_';


PROCEDURE INIT;
{  INITIATE VARIABLES  }

   BEGIN
   LINENUM := 0;
   LEVEL := 0;         { INDICATES THE LEVEL OF NESTING OF BEGIN-END BLOCKS  }
   PAGE := 1;
   DEFINITION := TRUE;
   PROCSTART := FALSE;
   PROCNAME := 'MAIN';
   SECTION := '';
   NEW(NEWVAR);
   NEWVAR^.VARNAME := 'A';
   NEWVAR^.VARTYPE := 'A';
   NEWVAR^.PROCNAME := 'A';
   NEWVAR^.FIRSTLINE := NIL;
   NEWVAR^.LASTLINE := NIL;
   NEWVAR^.NEXTVAR := NIL;
   FIRSTMARK := NIL;
   FIRSTVAR := NEWVAR;
   END;  { INIT }


PROCEDURE ENTER_OPTIONS;
{  ENTER FILE NAMES AND OPTIONS AT BEGINNING OF PROGRAM  }

   BEGIN
   CLRSCR;
   WRITE('ENTER NAME OF FILE TO LIST -');
   GOTOXY(42,1);
   READLN(INFILE);
   IF POS('.',INFILE) = 0 THEN INFILE := INFILE + '.PAS';
   OUTFILELIST := INFILE;
   IF POS('.',INFILE) <> 0 THEN DELETE(OUTFILELIST,POS('.',INFILE),4);
   OUTFILEXREF := OUTFILELIST + '.REF';
   OUTFILELIST := OUTFILELIST + '.LST';
   IF INFILE = OUTFILELIST THEN
      BEGIN
      DELETE(OUTFILELIST,LENGTH(OUTFILELIST),1);
      OUTFILELIST := OUTFILELIST + '2';
      END;

   IF INFILE = OUTFILEXREF THEN
      BEGIN
      DELETE(OUTFILEXREF,LENGTH(OUTFILEXREF),1);
      OUTFILEXREF := OUTFILEXREF + '2';
      END;

   TMPFILE := OUTFILELIST;
   WRITELN;
   WRITELN('ENTER NAME OF OUTPUT FILE  -');
   GOTOXY(5,4);
   WRITELN(TAB(5), '- RETURN = ', OUTFILELIST);
   WRITELN(TAB(5), '- PRN    = PRINTER');
   WRITELN(TAB(5), '- NUL    = NO FILE');
   GOTOXY(42,3);

   READLN(OUTFILELIST);
   IF OUTFILELIST = '' THEN OUTFILELIST:=TMPFILE;
   IF INFILE = OUTFILELIST THEN
      BEGIN
      DELETE(OUTFILELIST,LENGTH(OUTFILELIST),1);
      OUTFILELIST := OUTFILELIST + '2';
      END;
   IF INFILE = OUTFILELIST THEN
      BEGIN
      DELETE(OUTFILELIST,LENGTH(OUTFILELIST),1);
      OUTFILELIST := OUTFILELIST + '3';
      END;


      REPEAT
      GOTOXY(1,8);
      WRITE('DO YOU WANT A CROSS REFERENCE?  (Y OR N) ');
      READ(TRM, XREFINP);
      UNTIL XREFINP IN ['Y', 'y', 'N', 'n'];

   IF XREFINP IN ['N', 'n'] THEN XREF := FALSE ELSE XREF := TRUE;

   IF XREF THEN
      BEGIN
      TMPFILE := OUTFILEXREF;
      WRITELN;
      WRITELN;
      WRITELN('ENTER NAME OF OUTPUT FILE  -');
      GOTOXY(5,11);
      WRITELN(TAB(5), '- RETURN = ', OUTFILEXREF);
      WRITELN(TAB(5), '- PRN    = PRINTER');
      WRITELN(TAB(5), '- NUL    = NO FILE');
      GOTOXY(42,10);

      READLN(OUTFILEXREF);
      IF OUTFILEXREF = '' THEN OUTFILEXREF := TMPFILE;
      IF INFILE = OUTFILEXREF THEN
         BEGIN
         DELETE(OUTFILEXREF,LENGTH(OUTFILEXREF),1);
         OUTFILEXREF := OUTFILEXREF + '2';
         END;
      IF INFILE = OUTFILEXREF THEN
         BEGIN
         DELETE(OUTFILEXREF,LENGTH(OUTFILEXREF),1);
         OUTFILEXREF := OUTFILEXREF + '3';
         END;

      END;

   CLRSCR;
   WRITELN('READING FROM      - ',INFILE);
   WRITELN('LISTING TO        - ', OUTFILELIST);
   IF XREF THEN WRITELN('CROSS REFERENCE   - ',OUTFILEXREF);
   WRITELN;
   END;  { ENTER_OPTIONS }


FUNCTION CHECKREM(PROGLINE : STRING128; CHECKWORD : STRING80): BOOLEAN;
{  CHECK A LINE TO SEE IF IT IS A REMARK.  IF 'CHECKWORD' IS IN A REMARK,
   OR CONTAINED IN QUOTES THEN CHECKREM IS TRUE.  }

   VAR
      CHECKWORDPOS : INTEGER;
      SURCHAR : CHAR;
      CHECKREMTEMP : BOOLEAN;

   LABEL
      RETURN;

   BEGIN
      CHECKREMTEMP := FALSE;
      CHECKWORDPOS := POS(CHECKWORD,PROGLINE);

      IF LENGTH(CHECKWORD) = LENGTH(PROGLINE) THEN GOTO RETURN;

      IF ( (CHECKWORDPOS <> 1) AND
         (CHECKWORDPOS + LENGTH(CHECKWORD)-1 <> LENGTH(PROGLINE)) ) THEN
            BEGIN
            SURCHAR := COPY(PROGLINE, LENGTH(CHECKWORD)+CHECKWORDPOS,1);
            IF POS(SURCHAR,ALPHA) <> 0 THEN
               BEGIN
               CHECKREMTEMP := TRUE;
               GOTO RETURN;
               END;

            SURCHAR := COPY(PROGLINE, CHECKWORDPOS-1, 1);
            IF POS(SURCHAR,ALPHA) <> 0 THEN
               BEGIN
               CHECKREMTEMP := TRUE;
               GOTO RETURN;
               END;
            END;

      IF CHECKWORDPOS = 1 THEN
         BEGIN
         SURCHAR := COPY(PROGLINE, CHECKWORDPOS + LENGTH(CHECKWORD),1);
         IF POS(SURCHAR,ALPHA) <> 0 THEN
            BEGIN
            CHECKREMTEMP := TRUE;
            GOTO RETURN;
            END;
         END;

      IF CHECKWORDPOS + LENGTH(CHECKWORD) - 1 = LENGTH(PROGLINE) THEN
         BEGIN
         SURCHAR := COPY(PROGLINE, CHECKWORDPOS-1,1);
         IF POS(SURCHAR,ALPHA) <> 0 THEN
            BEGIN
            CHECKREMTEMP := TRUE;
            GOTO RETURN;
            END;
         END;

      IF ( (POS('(*',PROGLINE)<>0) AND (POS('*)',PROGLINE)<>0)  ) THEN
         BEGIN
         IF ( CHECKWORDPOS > POS('(*',PROGLINE) ) AND
            ( CHECKWORDPOS < POS('*)',PROGLINE) ) THEN
               CHECKREMTEMP := TRUE
               ELSE CHECKREMTEMP := FALSE;
         GOTO RETURN;
         END;

      IF ( (POS('{',PROGLINE)<>0) AND (POS('}',PROGLINE)<>0) ) THEN
         BEGIN
         IF ( CHECKWORDPOS > POS('{',PROGLINE) ) AND
            ( CHECKWORDPOS < POS('}',PROGLINE) ) THEN
               CHECKREMTEMP := TRUE
               ELSE CHECKREMTEMP := FALSE;
         GOTO RETURN;
         END;

      WHILE ((POS('''',PROGLINE) <> 0) AND (CHECKWORDPOS > POS('''',PROGLINE))) DO
         BEGIN
         DELETE(PROGLINE,1,POS('''',PROGLINE));
         CHECKWORDPOS := POS(CHECKWORD,PROGLINE);
         IF ((POS('''',PROGLINE)<>0) AND (CHECKWORDPOS < POS('''',PROGLINE))) THEN
            BEGIN
            CHECKREMTEMP := TRUE;
            CHECKWORDPOS := 0;      { THIS JUST TERMINATES THE LOOP }
            END;

         DELETE(PROGLINE,1,POS('''',PROGLINE));
         CHECKWORDPOS := POS(CHECKWORD,PROGLINE);
         END;

      RETURN:
      DELETE(PROGLINE,1,POS(CHECKWORD,PROGLINE) + LENGTH(CHECKWORD) -1);
      IF POS(CHECKWORD, PROGLINE) <> 0 THEN
         CHECKREM := CHECKREMTEMP AND CHECKREM(PROGLINE, CHECKWORD)
         ELSE CHECKREM := CHECKREMTEMP;
   END;  { CHECKREM }


PROCEDURE INSERTVAR;
{  INSERT A NEW VARIABLE INTO THE VARIABLE LIST.  CALLED FROM ADDVAR  }

   BEGIN
   NEWVAR^.FIRSTLINE := NIL;
   NEW(LASTVAR);
   LASTVAR^.NEXTVAR := FIRSTVAR;
   NOT_DONE := TRUE;
   WHILE (NOT_DONE) AND (LASTVAR^.NEXTVAR^.NEXTVAR <> NIL) DO
      BEGIN
      LASTVAR := LASTVAR^.NEXTVAR;
      TEMPRESULT1 := LASTVAR^.NEXTVAR^.PROCNAME < NEWVAR^.PROCNAME;
      TEMPRESULT2 := (LASTVAR^.NEXTVAR^.PROCNAME = NEWVAR^.PROCNAME) AND
                     (LASTVAR^.NEXTVAR^.VARNAME < NEWVAR^.VARNAME);
      NOT_DONE := TEMPRESULT1 OR TEMPRESULT2;
      END;

   IF NOT_DONE THEN
      LASTVAR := LASTVAR^.NEXTVAR;
   NEWVAR^.NEXTVAR := LASTVAR^.NEXTVAR;
   LASTVAR^.NEXTVAR := NEWVAR;
   END;  { INSERTVAR }


FUNCTION GETTYPE(VARTYPE : STRING80) : STRING8;
{  DETERMINE THE VARIABLE TYPE OF A VARIABLE  }

   BEGIN
   IF VARTYPE = 'INTEGER' THEN GETTYPE := 'INTEGER'
      ELSE IF VARTYPE = 'STRING' THEN GETTYPE := 'STRING'
         ELSE IF VARTYPE = 'BOOLEAN' THEN GETTYPE := 'BOOLEAN'
            ELSE IF VARTYPE = 'REAL' THEN GETTYPE := 'REAL'
               ELSE IF VARTYPE = 'CHAR' THEN GETTYPE := 'CHAR'
                  ELSE IF VARTYPE = 'SET' THEN GETTYPE := 'SET'
                     ELSE GETTYPE := 'TYPE';
   END;  { GETTYPE }


FUNCTION GETWORD : STRING80;
{  FIND THE NEXT WORD IN A STRING  }

   BEGIN
   TESTWORD := '';
   WHILE (POS( PROGLINE[1], ALPHA ) = 0) AND (LENGTH(PROGLINE) <> 0) DO
      DELETE(PROGLINE,1,1);
   IF LENGTH(PROGLINE) <> 0 THEN
      BEGIN
      WHILE (POS( PROGLINE[1],ALPHA ) <> 0) AND (LENGTH(PROGLINE) > 0) DO
         BEGIN
         TESTWORD := TESTWORD + PROGLINE[1];
         DELETE(PROGLINE,1,1);
         END;

      GETWORD := TESTWORD;
      END

      ELSE GETWORD := '';
   END;  { GETWORD }


PROCEDURE ADDVAR;
{  ADD A VARIABLE TO THE CROSS REFERENCE LIST  }

   BEGIN
   TESTWORD := GETWORD;
   IF POS(TESTWORD[1], ALPHA) <> 0 THEN
      BEGIN
      PROGLINE := TESTWORD + PROGLINE;
      IF (TESTWORD = 'VAR') OR (TESTWORD = 'CONST') OR
         (TESTWORD = 'LABEL') OR (TESTWORD = 'PROCEDURE') OR
         (TESTWORD = 'FUNCTION') OR (TESTWORD = 'TYPE') THEN
            SECTION := GETWORD;

      {  DETERMINE THE VARIABLE TYPE AND PROCESS VARIABLE  }
      CASE SECTION[1] OF

         'P': IF SECTION = 'PROCEDURE' THEN
                  BEGIN
                  PROCNAME := GETWORD;
                  NEW(NEWVAR);
                  NEWVAR^.VARNAME := PROCNAME;
                  NEWVAR^.VARTYPE := 'PROCEDURE';
                  NEWVAR^.PROCNAME := 'MAIN';
                  INSERTVAR;
                  SECTION := ' ';
                  END;

         'F': IF SECTION = 'FUNCTION' THEN
                  BEGIN
                  PROCNAME := GETWORD;
                  NEW(NEWVAR);
                  NEWVAR^.VARNAME := PROCNAME;
                  NEWVAR^.VARTYPE := 'FUNCTION';
                  NEWVAR^.PROCNAME := 'MAIN';
                  INSERTVAR;
                  SECTION := ' ';
                  END;

         'V':
            IF SECTION = 'VAR' THEN
            BEGIN
            WHILE LENGTH(PROGLINE) <> 0 DO
               BEGIN
               WHILE PROGLINE[1] = ' ' DO DELETE(PROGLINE,1,1);
               IF PROGLINE[1] <> ':' THEN
                  BEGIN
                  NEW(NEWVAR);
                  NEWVAR^.VARNAME := GETWORD;
                  NEWVAR^.VARTYPE := '';
                  NEWVAR^.PROCNAME := PROCNAME;
                  INSERTVAR;
                  NEW(NEWMARK);
                  IF FIRSTMARK = NIL THEN
                     FIRSTMARK := NEWMARK

                     ELSE LASTMARK^.NEXTMARK := NEWMARK;
                  NEWMARK^.VARPT := NEWVAR;
                  LASTMARK := NEWMARK;
                  WHILE (POS(PROGLINE[1], ALPHA) = 0) AND (LENGTH(PROGLINE) <> 0)
                     AND (PROGLINE[1]<>':')
                        DO DELETE(PROGLINE,1,1);
                  END   { IF-THEN CLAUSE }

                  ELSE
                  BEGIN
                  DELETE(PROGLINE,1,1);
                  VARTYPE := GETWORD;
                  VARTYPE := GETTYPE(VARTYPE);
                  NEWMARK := FIRSTMARK;
                  WHILE NEWMARK <> NIL DO
                     BEGIN
                     NEWMARK^.VARPT^.VARTYPE := VARTYPE;
                     NEWMARK := NEWMARK^.NEXTMARK;
                     END;

                  FIRSTMARK := NIL;
                  PROGLINE := '';

                  END;  { ELSE CLAUSE }
               END;  { WHILE LOOP }
            END;  { VAR DECLARATION HEAD }

         'T': BEGIN END;

         'C':
            IF SECTION = 'CONST' THEN
            BEGIN
            WHILE (PROGLINE[1] = ' ') AND (LENGTH(PROGLINE) <> 0) DO DELETE(PROGLINE,1,1);
            IF LENGTH(PROGLINE) <> 0 THEN
               BEGIN
               NEW(NEWVAR);
               NEWVAR^.VARNAME := GETWORD;
               NEWVAR^.VARTYPE := 'CONST';
               NEWVAR^.PROCNAME := PROCNAME;
               INSERTVAR;
               WHILE POS(';',PROGLINE) = 0 DO READLN(FILVAR1,PROGLINE);
               END;
            END;

         'L':
            IF SECTION = 'LABEL' THEN
            BEGIN
            WHILE (PROGLINE[1] = ' ') AND (LENGTH(PROGLINE) <> 0) DO
               DELETE(PROGLINE,1,1);
            WHILE LENGTH(PROGLINE) <> 0 DO
               BEGIN
               TESTWORD := GETWORD;
               NEW(NEWVAR);
               NEWVAR^.VARNAME := TESTWORD;
               NEWVAR^.VARTYPE := 'LABEL';
               NEWVAR^.PROCNAME := PROCNAME;
               INSERTVAR;
               WHILE (POS(PROGLINE[1], ALPHA) = 0) AND (LENGTH(PROGLINE) <> 0) DO
                  DELETE(PROGLINE,1,1);
               END;
            END;
         END;  { CASE STATEMENT }
      END;  { LENGTH(TESTWORD) > 0 }
   END;  { ADDVAR }


PROCEDURE ADDLINE;
{  IF A VARIABLE IS FOUND IN A LINE, THEN ADD THAT LINE NUMBER TO THE
   CROSS REFERENCE LIST  }

   BEGIN
   NEWVAR := FIRSTVAR;
   WHILE NEWVAR <> NIL DO
      BEGIN
      IF ( (PROCNAME = NEWVAR^.PROCNAME) OR (NEWVAR^.PROCNAME = 'MAIN') ) AND
         (POS(NEWVAR^.VARNAME,PROGLINE) <> 0) THEN
            IF CHECKREM(PROGLINE,NEWVAR^.VARNAME) = FALSE THEN
               BEGIN
               NEW(NEWLINE);
               IF NEWVAR^.FIRSTLINE = NIL THEN
                  NEWVAR^.FIRSTLINE := NEWLINE

                  ELSE NEWVAR^.LASTLINE^.NEXTLINE := NEWLINE;
               NEWLINE^.LINENUM := LINENUM;
               NEWLINE^.NEXTLINE := NIL;
               NEWVAR^.LASTLINE := NEWLINE;
               END;  { ADD A LINE NUMBER SECTION }

      NEWVAR := NEWVAR^.NEXTVAR;
      END;  { CHECK ALL VARIABLES DEFINED SO FAR }
   END;  { ADDLINE }


PROCEDURE INCLEV(WORD : STRING8);
{  INCREASE THE NESTING LEVEL FOR 'BEGIN', 'CASE', AND 'RECORD' STATEMENTS  }

   BEGIN
   IF POS(WORD,PROGLINE) <> 0 THEN
      IF NOT CHECKREM(PROGLINE,WORD) THEN
      BEGIN
      LEVEL := LEVEL + 1;
      STR(LEVEL,MARK1);
      END;
   END;  { INCLEV }


{*****  BEGIN MAIN PROGRAM  *****}


BEGIN

{  ENTER PROGRAM OPTIONS  }

   ENTER_OPTIONS;

{  OPEN FILES  }

   ASSIGN(FILVAR1,INFILE);
   RESET(FILVAR1);
   IF ( (COPY(OUTFILELIST,1,3) <> 'NUL') AND (COPY(OUTFILELIST,1,3) <> 'PRN') ) THEN
      BEGIN
      ASSIGN(FILVAR2,OUTFILELIST);
      REWRITE(FILVAR2);
      END;

   IF XREF AND (OUTFILELIST <> OUTFILEXREF) AND
      ( (COPY(OUTFILEXREF,1,2) <> 'NUL') AND (COPY(OUTFILEXREF,1,2) <> 'PRN') ) THEN
      BEGIN
      ASSIGN(FILVAR3,OUTFILEXREF);
      REWRITE(FILVAR3);
      END;

   INIT;


{ INITIALIZE PRINTER }

   IF (COPY(OUTFILELIST,1,3) = 'PRN') THEN
      BEGIN
      WRITELN(LST,CHR(15));
      WRITELN;
      WRITELN(LST, HEADER1, INFILE, '  -  PAGE 1');
      WRITELN(LST, HEADER2);
      END;

   IF (COPY(OUTFILEXREF,1,3) = 'PRN') THEN
      WRITE(LST,CHR(15));

{ INPUT LINES AND CHECK FOR BEGIN AND END OF SEGMENTS }

   WHILE NOT EOF(FILVAR1) DO
      BEGIN
      READLN(FILVAR1,PROGLINE);
      LINENUM := LINENUM+1;
      MARK1 := '--';
      MARK2 := '--';

{ INCREMENT LEVEL FOR 'BEGIN', 'CASE', OR 'RECORD' }

   INCLEV('BEGIN');
   INCLEV('begin');
   INCLEV('CASE');
   INCLEV('case');
   INCLEV(' RECORD');
   INCLEV(' record');


{ DECREMENT LEVEL FOR 'END' }

   IF ( (POS('END',PROGLINE) <> 0) OR (POS('end',PROGLINE) <> 0) ) THEN
      BEGIN
      IF NOT CHECKREM(PROGLINE, 'END') THEN
         BEGIN
         STR(LEVEL,MARK2);
         LEVEL := LEVEL-1;
         END;
      END;


{ CONSTRUCT PRINT LINE }

   LISTPROG := '              ';
   STR(LINENUM,LINENUMST);
   INSERT(LINENUMST,LISTPROG,1);
   INSERT(MARK1,LISTPROG,6);
   INSERT(MARK2,LISTPROG,9);
   INSERT(PROGLINE,LISTPROG,13);


{ PRINT PROGRAM LINE }

   IF ( (COPY(OUTFILELIST,1,3) <> 'PRN') AND (COPY(OUTFILELIST,1,3) <> 'NUL')) THEN
      BEGIN
      WRITELN(FILVAR2,LISTPROG);
      END;

   WRITELN(LISTPROG);
   IF (COPY(OUTFILELIST,1,3) = 'PRN') THEN
      BEGIN
      WRITELN(LST,LISTPROG);
      IF (LINENUM MOD 58) = 0 THEN
         BEGIN
         PAGE := PAGE + 1;
         WRITELN(LST, CHR(12));
         WRITELN;
         WRITELN(LST, HEADER1, INFILE, '  -  PAGE ', PAGE);
         WRITELN(LST, HEADER2);
         END;
      END;


{ CONSTRUCT CROSS REFERENCE LIST }

   IF LEVEL = 0 THEN
      DEFINITION := TRUE

      ELSE BEGIN
      DEFINITION := FALSE;
      SECTION := ' ';
      END;

   PROGLINE2 := PROGLINE;
   IF XREF AND DEFINITION THEN ADDVAR;
   IF (PROCNAME<>'MAIN') AND (LEVEL = 0) AND PROCSTART THEN
      BEGIN
      PROCSTART := FALSE;
      PROCNAME := 'MAIN';
      END;

   IF LEVEL > 0 THEN PROCSTART := TRUE;
   IF PROCSTART AND (LEVEL = 0) THEN PROCSTART := FALSE;
   PROGLINE := PROGLINE2;
   IF XREF THEN ADDLINE;

   END;  { DONE SEARCHING EACH LINE }


{ CLOSE FILES }

   CLOSE(FILVAR1);
   IF OUTFILELIST <> OUTFILEXREF THEN
      BEGIN
      IF (COPY(OUTFILELIST,1,3) <> 'NUL') AND
         (COPY(OUTFILELIST,1,3) <> 'PRN') THEN CLOSE(FILVAR2);
      ASSIGN(FILVAR3,OUTFILEXREF);
      REWRITE(FILVAR3);
      END;

   IF (COPY(OUTFILELIST,1,3) = 'PRN') THEN WRITELN(LST, CHR(12));


{ WRITE CROSS REFERENCE LISTING }

   IF XREF THEN
      BEGIN
      NEWVAR := FIRSTVAR^.NEXTVAR;
      WRITELN;
      WRITELN;
      TEXTCOLOR(9);
      WRITELN(HEADER3);
      TEXTCOLOR(7);
      IF (COPY(OUTFILEXREF,1,3)<>'PRN') AND (COPY(OUTFILEXREF,1,3)<>'NUL') THEN
         IF OUTFILELIST = OUTFILEXREF THEN
            WRITELN(FILVAR2,HEADER3)

            ELSE WRITELN(FILVAR3,HEADER3);

      IF COPY(OUTFILEXREF,1,3) = 'PRN' THEN
         BEGIN
         LINENUM := 3;
         WRITELN(LST, HEADER3);
         WRITELN(LST, HEADER4);
         END;

      WHILE NEWVAR <> NIL DO
         BEGIN
         LISTPROG := NEWVAR^.VARNAME + '                    ';
         INSERT(NEWVAR^.VARTYPE,LISTPROG,20);
         LISTPROG := LISTPROG + '            ';
         INSERT(NEWVAR^.PROCNAME,LISTPROG,32);
         NEWLINE := NEWVAR^.FIRSTLINE;
         DELETE(LISTPROG,50,31);
         WHILE LENGTH(LISTPROG) < 50 DO LISTPROG:=LISTPROG + ' ';
         WHILE NEWLINE <> NIL DO
            BEGIN
            IF (LENGTH(LISTPROG) > 125) AND (COPY(OUTFILEXREF,1,3) = 'PRN') THEN
               BEGIN
               WRITELN(LST,LISTPROG);
               LISTPROG := '                                                  ';
               LINENUM := LINENUM + 1;
               END;

            STR(NEWLINE^.LINENUM, LINENUMST);
            LISTPROG := LISTPROG + LINENUMST + ' ';
            NEWLINE := NEWLINE^.NEXTLINE;
            END;

         WRITELN(LISTPROG);
         IF COPY(OUTFILEXREF,1,3) = 'PRN' THEN
            BEGIN
            WRITELN(LST,LISTPROG);
            LINENUM := LINENUM+1;
            IF LINENUM > 58 THEN
               BEGIN
               LINENUM := 3;
               WRITELN(LST,CHR(12));
               WRITELN(LST,HEADER3);
               WRITELN(LST,HEADER4);
               END;
            END;

         IF (COPY(OUTFILEXREF,1,3)<>'PRN') AND (COPY(OUTFILEXREF,1,3)<>'NUL') THEN
            IF OUTFILELIST = OUTFILEXREF THEN
               WRITELN(FILVAR2,LISTPROG)

               ELSE WRITELN(FILVAR3,LISTPROG);

         IF (COPY(OUTFILEXREF,1,3) = 'PRN') AND
            (NEWVAR^.PROCNAME <> NEWVAR^.NEXTVAR^.PROCNAME) THEN
               WRITELN(LST,' ');
         NEWVAR:=NEWVAR^.NEXTVAR;
         END;
      END;

   IF OUTFILELIST = OUTFILEXREF THEN CLOSE(FILVAR2) ELSE CLOSE(FILVAR3);
   IF (COPY(OUTFILELIST,1,3) = 'PRN') OR
      (COPY(OUTFILEXREF,1,3) = 'PRN') THEN
         WRITE(LST,CHR(18));
END.