Program XLIST62(input,output);

{$U+}
{$I-}
{$V-}
Const

      P  = 749;        {SIZE of HASHTABLE}
      NK =  79;        {NO. of KEYWORDS}
      PAGESIZE = 65;   { LINES PER PAGE}
      ALFALEN  =  16;   {  SIZE of IDENTIFIERS}
      REFSPERLINE = 8;
      REFSPERITEM =  8;
      NESTMAX = 22;

Type

     Str80 = string[80];
     FNAME = STRING[14];
     ALFA = Packed Array[1..ALFALEN] of Char;
     INDEX = 0..P;
     ITEMPTR = ^ITEM;
     WORD = Record
               KEY: ALFA;
               FIRST, LAST: ITEMPTR;
               FOL: INDEX
            End ;
     NUMREFS = 1..REFSPERITEM;
     REFTYPE = (COUNT, PTR);
     ITEM = Record
               REF   : ARRAY[NUMREFS] of Integer;
               CASE REFTYPE of
                  COUNT: (REFNUM: NUMREFS);
                  PTR: (NEXT: ITEMPTR)
            End ;
     BUFFER = STRING[131]{Packed Array[0..131] of Char};


Var
    TOP: INDEX;  {TOP of CHAIN LINKING ALL ENTRIES IN T}
    I,LINECOUNT,BUFCURSOR: Integer; {CURRENT LINE NUMBER}
    FF,CH, LANGUAGE: Char;          {CURRENT CHAR SCANNED }
    WORKSTRING,BUF : BUFFER;
    T : ARRAY [INDEX] of WORD;   {HASH TABLE}
    KEY: ARRAY [1..NK] of ALFA; {RESERVED KEYWORD TABLE}
    ERROR,                      { ERROR FLAG }
    BLOCK,LISTING: Boolean;     { LISTING/BLOCK OPTION }
    INFILE,LST: Text;
    LSTFILENAME : String[14];
    INPUT_LINE : BUFFER{ String[131]};
    LAST_KEY,PAGE_NUM,NESTLVL:Integer;
    ABORT,LITERAL,ACOMMENT,BCOMMENT,EOL,NESTUP,NESTDN,
    NODOT,nextime,nex2time,nex3time:Boolean;
    BAR : Char ;
    FILENAME,FILETITLE:FNAME {String[14]};
    DATE:String[20];
    LDATE,LTITLE:Byte;
    search1,search2, search3, search4: string[5];
    Ignore: Boolean;


PROCEDURE PROCESSLINE; FORWARD;

procedure WHITESPACE;  {rsr * added 1/13/87 to eliminate whitespace}
      BEGIN
      WHILE LENGTH(INPUT_LINE) > 0 DO
      BEGIN
      IF INPUT_LINE[1] IN[^I,' '] THEN DELETE(INPUT_LINE,1,1) ELSE EXIT;
      END;
      END; { Whitespace }


  Function Open(var fp:text; name: Fname): boolean;
  begin
    Assign(fp,Name);
    {$I-}
    reset(fp);
    {$I+}
    If IOresult <> 0 then
     begin
      Open := False;
      close(fp);
     end
    else
      Open := True;
  end { Open };


     Function IncludeIn(VAR CurStr: buffer): Boolean;
     Var ChkChar: char;
         column: integer;
     begin  {IncludeIn}

     If Language =  'P' then
     begin    {Turbo}
       ChkChar := '-';
       column := pos(search1,CurStr);
       if column <> 0 then
         chkchar := CurStr[column+3]
       else
       begin
         column := Pos(search3,CurStr);
         if column <> 0 then
           chkchar := CurStr[column+4]
         else
         begin
           column := Pos(search2,CurStr);
           if column <> 0 then
             chkchar := CurStr[column+3]
           else
           begin
             column := Pos(search4,CurStr);
             if column <> 0 then
               chkchar := CurStr[column+4]
           end;
         end;
       end;
       if ChkChar in ['+','-'] then IncludeIn := False
       Else IncludeIn := True;
     end { Turbo }
     else
     If Language = 'D' then
           begin {DbaseII}
           If ((Pos('DO ',CurStr) <> 0) OR
              (POS(' DO ',CurStr) <> 0) OR
              (POS('do ',CurStr) <> 0) OR
              (POS(' do ',CurStr) <> 0)) AND
              (POS('WHIL',CurStr)= 0) AND
              (POS('whil',CurStr)= 0) AND
              (POS('WHILE',CurStr)= 0) AND
              (POS('CASE',CurStr)= 0) AND
              (POS('case',CurStr)= 0) AND
              (POS('*',CurStr)= 0)  then
              IncludeIn :=TRUE
           else
              IncludeIn :=FALSE;
           end;   {DbaseII}
     end;  {IncludeIn}


     Procedure ProcessIncludeFile(VAR IncStr: buffer);

     var NameStart, NameEnd: integer;
         IncludeFile: text;
         IncludeFileName: Fname;

       Function Parse(IncStr: buffer): buffer;

       begin    {Parse}
       If Language = 'P' then
       begin    {Turbo}
         NameStart := pos('$I',IncStr)+2;
         while IncStr[NameStart] = ' ' do
           NameStart := Succ(NameStart);
         NameEnd := NameStart;
         while (not (IncStr[NameEnd] in [' ','}','*']))
              AND ((NameEnd - NameStart) <= 14{PathLength})
              do NameEnd := Succ(NameEnd);
         NameEnd := Pred(NameEnd);
         Parse := copy(IncStr,NameStart,(NameEnd-NameStart+1));
       end {Turbo}
       else
       If Language = 'D' then
       begin    {DbaseII}
         if (POS('DO ',IncStr) <> 0) then
         NameStart := pos('DO ',IncStr)+2;
         if (POS('do ',IncStr) <> 0) then
         NameStart := pos('do ',IncStr)+2;
         while IncStr[NameStart] = ' ' do
           NameStart := Succ(NameStart);
         NameEnd := NameStart;
         while (not (IncStr[NameEnd] in [' ']))
              AND ((NameEnd - NameStart) <= 14{PathLength})
              do NameEnd := Succ(NameEnd);
         NameEnd := Pred(NameEnd);
         Parse := copy(IncStr,NameStart,(NameEnd-NameStart+1));
       end {Turbo}
       end {Parse};

VAR Y : Integer;

     begin  {Process include file}
       IncludeFileName := Parse(IncStr);
       If language = 'D' then
       BEGIN
       For Y := 1 to Length(IncludeFileName) do
       IncludeFileName[Y] := Upcase(IncludeFileName[Y]);
       IncludeFileName := IncludeFileName+'.CMD';
       END;
       If not Open(IncludeFile,IncludeFileName) then
       begin
         INPUT_LINE := 'ERROR -- Include file not found:  ' + IncludeFileName;
       end
       Else
       begin
       IF LISTING OR BLOCK THEN
         WRITELN(LST,^M^J'(***** Start of ',INCLUDEFILENAME,' *****)'^M^J);
         while not eof(IncludeFile) do
         begin
           BUFCURSOR:=0;
           NESTUP:= FALSE;
           NESTDN:=FALSE;
           Readln(IncludeFile,INPUT_LINE);
           WHITESPACE;
           PROCESSLINE;
         end;
         IF LISTING OR BLOCK THEN
         WRITELN(LST,^M^J'(***** End of ',INCLUDEFILENAME,' *****)'^M^J);
         close(IncludeFile);
       end;
     end {Process include file};

function ConstStr(C : Char; N : Integer) : Str80;
var
  S : string[80];
begin

  if N < 0 then

    N := 0;
  S[0] := Chr(N);
  FillChar(S[1],N,C);
  ConstStr := S;
end;

procedure BigDash;
var
  I : integer;
begin
  For I := 1 to 79 do
     begin
       Write('-');
      end;
   writeln;
 end;

Function Centered(TheString:Str80):Str80;
begin
  Centered := ConstStr(' ',((80 - Length(TheString)) Div 2)) +
  TheString;
end;


Function Space(Spaces : Integer) : Str80;
Var
  Column : Integer;
  Temp   : Str80;
begin
  Temp :='';
  For Column := 1 to Spaces do
  begin
    Temp := Temp + ' ';
    Space := Temp;
  end;
end;


Procedure LPWRITELN;
Var
  I : Integer;
Begin
  {BUF[BUFCURSOR]:=CHR(13);
  BUFCURSOR:=BUFCURSOR+1;}
  For I := 0 to BUFCURSOR-1 do
  Write(LST,BUF[I]);
  Writeln(LST);
  BUFCURSOR:=0;
  LINECOUNT:=LINECOUNT+1;
    {If (LINECOUNT MOD PAGESIZE) = 0 then
    TITLELINE;}
End;


Procedure INITIALIZE;
Var

  I : Integer;

Begin { INITIALIZE }
   FF:=CHR(12);
   ERROR := FALSE;
   If Upcase(Language) = 'D' then
   Begin {DbaseII}
   For I := 0 to P do
      T[I].KEY := '                ';
   KEY[ 1] := 'ACCE            ';
   KEY[ 2] := 'ACCCEPT         ';
   KEY[ 3] := 'ADD             ';
   KEY[ 4] := 'AND             ';
   KEY[ 5] := 'APPEND          ';
   KEY[ 6] := 'BROWSE          ';
   KEY[ 7] := 'CANCEL          ';
   KEY[ 8] := 'CHANGE          ';
   KEY[ 9] := 'CLEAR           ';
   KEY[10] := 'CONTINUE        ';
   KEY[11] := 'COPY            ';
   KEY[12] := 'COUNT           ';
   KEY[13] := 'CREATE          ';
   KEY[14] := 'DELETE          ';
   KEY[15] := 'DISPLAY         ';
   KEY[16] := 'DO              ';
   KEY[17] := 'EDIT            ';
   KEY[18] := 'EJECT           ';
   KEY[19] := 'ELSE            ';
   KEY[20] := 'ENDC            ';
   KEY[21] := 'ENDCASE         ';
   KEY[22] := 'ENDD            ';
   KEY[23] := 'ENDDO           ';
   KEY[24] := 'ENDI            ';
   KEY[25] := 'ENDIF           ';
   KEY[26] := 'ERASE           ';
   KEY[27] := 'FIELD           ';
   KEY[28] := 'FILE            ';
   KEY[29] := 'FILES           ';
   KEY[30] := 'FIND            ';
   KEY[31] := 'FOR             ';
   KEY[32] := 'GET             ';
   KEY[33] := 'GO              ';
   KEY[34] := 'IF              ';
   KEY[35] := 'INDEX           ';
   KEY[36] := 'INPUT           ';
   KEY[37] := 'INSERT          ';
   KEY[38] := 'JOIN            ';
   KEY[39] := 'LEN             ';
   KEY[40] := 'LIST            ';
   KEY[41] := 'LOCATE          ';
   KEY[42] := 'LOOP            ';
   KEY[43] := 'NOT             ';
   KEY[44] := 'NOTE            ';
   KEY[45] := 'MODIFY          ';
   KEY[46] := 'OFF             ';
   KEY[47] := 'ON              ';
   KEY[48] := 'OR              ';
   KEY[49] := 'PACK            ';
   KEY[50] := 'PICTURE         ';
   KEY[51] := 'POKE            ';
   KEY[52] := 'QUIT            ';
   KEY[53] := 'READ            ';
   KEY[54] := 'RECALL          ';
   KEY[55] := 'RELEASE         ';
   KEY[56] := 'REMARK          ';
   KEY[57] := 'RENAME          ';
   KEY[58] := 'REPLACE         ';
   KEY[59] := 'REPORT          ';
   KEY[60] := 'RESET           ';
   KEY[61] := 'RESTORE         ';
   KEY[62] := 'RETURN          ';
   KEY[63] := 'SAVE            ';
   KEY[64] := 'SAY             ';
   KEY[65] := 'SELECT          ';
   KEY[66] := 'SET             ';
   KEY[67] := 'SKIP            ';
   KEY[68] := 'SORT            ';
   KEY[69] := 'STORE           ';
   KEY[70] := 'STRUCTURE       ';
   KEY[71] := 'SUM             ';
   KEY[72] := 'TO              ';
   KEY[73] := 'TOTAL           ';
   KEY[74] := 'UPDATE          ';
   KEY[75] := 'USE             ';
   KEY[76] := 'WAIT            ';
   KEY[77] := 'WHILE           ';
   KEY[78] := 'WHIL            ';
   KEY[79] := 'WITH            ';
   End;  {DbaseII}

   If Upcase(Language) = 'P' then
   Begin {Turbo}
   For I := 0 to P do
      T[I].KEY := '                ';
   KEY[ 1] := 'AND             ';
   KEY[ 2] := 'ARRAY           ';
   KEY[ 3] := 'BEGIN           ';
   KEY[ 4] := 'BOOLEAN         ';
   KEY[ 5] := 'CASE            ';
   KEY[ 6] := 'CHAR            ';
   KEY[ 7] := 'CONST           ';
   KEY[ 8] := 'DIV             ';
   KEY[ 9] := 'DOWNTO          ';
   KEY[10] := 'DO              ';
   KEY[11] := 'ELSE            ';
   KEY[12] := 'END             ';
   KEY[13] := 'EXIT            ';
   KEY[14] := 'FILE            ';
   KEY[15] := 'FOR             ';
   KEY[16] := 'FUNCTION        ';
   KEY[17] := 'GOTO            ';
   KEY[18] := 'IF              ';
   KEY[19] := 'IN              ';
   KEY[20] := 'INPUT           ';
   KEY[21] := 'INTEGER         ';
   KEY[22] := 'MOD             ';
   KEY[23] := 'NIL             ';
   KEY[24] := 'NOT             ';
   KEY[25] := 'OF              ';
   KEY[26] := 'OR              ';
   KEY[27] := 'OUTPUT          ';
   KEY[28] := 'PACKED          ';
   KEY[29] := 'PROCEDUR        ';
   KEY[30] := 'PROGRAM         ';
   KEY[31] := 'REAL            ';
   KEY[32] := 'RECORD          ';
   KEY[33] := 'REPEAT          ';
   KEY[34] := 'SET             ';
   KEY[35] := 'STRING          ';
   KEY[36] := 'TEXT            ';
   KEY[37] := 'THEN            ';
   KEY[38] := 'TO              ';
   KEY[39] := 'TYPE            ';
   KEY[40] := 'UNTIL           ';
   KEY[41] := 'VAR             ';
   KEY[42] := 'WHILE           ';
   KEY[43] := 'WITH            ';
   KEY[44] := 'WRITE           ';
   KEY[45] := 'WRITELN         ';
   end;    {Turbo}




   LINECOUNT:= 1;
   TOP := P;
   PAGE_NUM := 1 ;
   LITERAL := FALSE ;
   ACOMMENT := FALSE ;
   BCOMMENT := FALSE ;
   NESTLVL := 0 ;
   LAST_KEY := 0 ;
   BAR := '|' ;
   CH  := ' ';

    search1 := '{$'+'I';  { So LISTER can list itself! }
    search2 := '{$'+'i';
    search3 := '(*$'+'I';
    search4 := '(*$'+'i';

End; { INITIALIZE }

Procedure HELP;
begin
  abort := true;
  WRITELN('  To run XLIST:');
  WRITELN('  XLIST <cr>');
  WRITELN('  XLIST ?<cr>  <----gets this help screen.');
  WRITELN('  XLIST INFILE <cr>');
  WRITELN('  XLIST INFILE OUTPUT <cr>');
  WRITELN('  XLIST INFILE OUTPUT F/B/C');
  WRITELN;
  HALT;
end;

Procedure OPENFILES(Var Language : Char);
Var
    I,NUMBLOCKS,OPENERRNUM: Integer;
    OPENOK: Boolean;
    LISTOPTION: Char;
Begin { OPEN }
   CLRSCR;
   GOTOXY(1,1);
   BIGDASH;
   WRITELN(Centered('XLISTPAS.COM * A combination of LISTER & XLIST'));
   WRITELN(Centered(' to XLIST INCLUDED FILES  V 6.2 AUGUST 1987'));
   WRITELN(Centered('MODIFIED BY: ELLIS B. LEVIN OF CHICAGO, IL'));
   WRITELN(Centered('FOR TURBO PASCAL AND DBASEII PROGRAMS'));
   BIGDASH;
   WRITELN(SPACE(10),'1.) TURBO PASCAL AND DBASEII CROSS-REF UTILITY.');
   WRITELN(SPACE(10),'2.) WILL SHOW START AND END OF BLOCKS.');
   WRITELN(SPACE(10),'3.) WILL CALL INCLUDE FILES.');
   BIGDASH;
   WRITELN;
   ABORT := FALSE ;
   Repeat
      NODOT := TRUE;
      Write('FILENAME: ( CR TO QUIT): ');
      if (paramcount >= 1) and (nextime) then
         begin
            FILENAME := paramstr(1);
            writeln(filename);
            nextime := false
         end
      else
         READLN( FILENAME );
         IF  Length(FILENAME) <= 0 then halt;
         FOR I := 1 TO (Length(FILENAME)) do
         FILENAME[I] := Upcase(FILENAME[I]);
         if (NOT ABORT) and (FILENAME = '?') then help;
         If NOT ABORT then
          Begin
           IF Pos( '.PAS', FILENAME) <> 0 THEN