{$C-,A-,I-,V-,R-}
{++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
{+                                                      +}
{+  PROGRAM TITLE:      Cross Reference Generator       +}
{+                                                      +}
{+  WRITTEN BY:         Peter Grogono                   +}
{+  DATE WRITTEN:       ?                               +}
{+                                                      +}
{+  SUMMARY:                                            +}
{+      1. Output Files:                                +}
{+         a. first output file is a numbered listing   +}
{+            of the input source                       +}
{+         b. second output file is cross reference     +}
{+            with each identifier followed by the      +}
{+            line numbers on which it appears.         +}
{+      2. Listing Device:                              +}
{+         The numbered source listing may optionally   +}
{+         be routed to the screen or printer (but not  +}
{+         both).                                       +}
{+                                                      +}
{+  MODIFICATION RECORD:                                +}
{
    06 Jan 85: by Alan D. Hull, 42489 Castle Ct., Canton, MI. 48188
               Added default answers to prompts, added line
               processing display

    01 Dec 84: by Donald W. Smith, Silicon Valley FOG.
               Adapted from MS-DOS to CP/M:
               Filename from 20 to 14 bytes
               Changed "with" Level as required.
               Split into two files XREFT.PAS, XREFT1.INC.
               Added defaults for the file name input.
}

{+                                                      +}
{+      17-APR-84       -Modified for Turbo Pascal so   +}
{+                       $ includes are supported       +}
{+                                                      +}
{+                                                      +}
{++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
PROGRAM XREFT;
{ Cross Reference Generator }
CONST
        alfa_length     =  15;
        dflt_str_len    = 255;
        entrygap        =    0;   { # of blank lines between line numbers}
        heading         : string[23] = 'Cross-Reference Listing';
        headingsize     =    3;   {number of lines for heading}
        LLmax           = dflt_str_len;
        MaxOnLine       =   8;
        Maxlines        = MAXINT; {longest document permitted}
        MaxWordlen      = alfa_length;{longest word read without truncation}
        Maxlinelen      =   80;   {length of output line}
        MaxOnPage       =   60;   {size of output page}
        NumKeys         =   70;   {number of Pascal reseve words}
                                  {Read your Pascal manuals on this one!}
        NumberWidth     =    6;
        space           : char = ' ';
TYPE
        ALFA    = string[alfa_length];
        CHARNAME = (lletter, uletter, digit, blank, quote, atab,
                      EndOfLine, FileMark, otherchar );
        CHARINFO = RECORD
                     name : charname;
                     valu : CHAR
                   END;
        COUNTER = 1..Maxlines;
        pageindex = BYTE;
        Wordindex = 1..MaxWordlen;
        Queuepointer = ^Queueitem;
        Queueitem = RECORD
                        linenumber : counter;
                        NextInQueue: Queuepointer
                    END;
        EntryType = RECORD
                        Wordvalue : alfa;
                        FirstInQueue,
                        lastinQueue: Queuepointer
                     END;
        treepointer = ^node;
        node = RECORD
                 entry : EntryType;
                 left,
                 right : treepointer
               END;
        GenStr  = string[255];
VAR
  bell          : CHAR;
  fatal_error   : BOOLEAN;
  FILE_ID,                      { Input file name }
  PRN_ID,                       { basic file name + '.PRN' }
  New_ID        : string[14];   { basic file name + '.XRF' }
  form_feed     : CHAR;
  Key           : ARRAY[1..NumKeys] OF alfa;
  LISTING       : BOOLEAN;
  tab           : CHAR;
  WordTree      : treepointer;
  GAP           : char      ;
  Currentline   : INTEGER;
  FOUT: TEXT; { print output file }
  XOUT: TEXT; { xref  output file }

{$I XREF1.INC }


PROCEDURE PrintTree(tree: treepointer);
{
GLOBAL
        MaxOnLine   = max line references per line
        NumberWidth = field for each number
}
VAR
  pageposition: pageindex;
   PROCEDURE PrintEntry(subtree: treepointer;
                        VAR position: pageindex);
   VAR  ix: Wordindex;
        itemcount : 0..Maxlinelen;
        itemptr : Queuepointer;
        PROCEDURE PrintLine(VAR Currentposition: pageindex;
                                newlines: pageindex);
        VAR
          linecounter: pageindex;
        BEGIN
          IF (Currentposition + newlines) < MaxOnPage THEN
            BEGIN
                FOR linecounter:=1 TO newlines DO WRITELN(XOUT);
                Currentposition := Currentposition + newlines;
            END
          ELSE
            BEGIN
              PAGE(XOUT);
              WRITELN(XOUT,heading);
              FOR linecounter := 1 TO headingsize - 1 DO
                 WRITELN(XOUT);
              Currentposition := headingsize + 1;
            END
        END;{PrintLine}

   BEGIN{PrintEntry}
     IF subtree<>nil THEN
        WITH subtree^ DO BEGIN
          PrintEntry(left,position);
          PrintLine(position,entrygap + 1);
          WITH entry DO BEGIN
            FOR ix := 1 to length(WordValue) do WRITE(XOUT, WordValue[ix]);
            WRITE(XOUT, space:(MaxWordLen-length(WordValue)));
            itemcount := 0;
            itemptr := FirstInQueue;
            WHILE itemptr <> nil DO
              BEGIN
                itemcount := itemcount + 1;
                IF itemcount > MaxOnLine THEN
                  BEGIN
                    PrintLine(position,1);
                    WRITE(XOUT, space:MaxWordlen);
                    itemcount := 1;
                  END;
                WRITE(XOUT, itemptr^.linenumber: numberwidth);
                itemptr := itemptr^.NextInQueue;
              END;{WHILE}
          END; {WITH entry}
          PrintEntry(right,position);
        END; {WITH subtree^}
   END; {PrintEntry}

BEGIN{PrintTree}
  PagePosition := MaxOnPage;
  PrintEntry(tree,PagePosition);
END; {of PrintTree}{CLOSE(New_ID);}

FUNCTION ConnectFiles: boolean;
TYPE
  Linebuffer = string[80];
VAR
  ix  : BYTE;
  InChar    : Char;
  DotPos    : Integer;

 { "SubProcedure" used once to get proper file names }
 Procedure GetNames;
  Begin
   WRITELN('Enter filename  (.PAS, PRN, and XRF appended as required)') ;
   WRITELN ;
   WRITE('Input File: ');
   READLN(FILE_ID);

   DotPos := Length(File_ID);            { Use an available variable }
   If DotPos = 0 THEN HALT;              { for a quick Sanity check  }

   DotPos := Pos( '.', File_ID );
   If DotPos = 0 THEN                    { If NO extension (.) }
     Begin
      File_ID := ( File_ID + '.PAS' );
      DotPos  := Pos( '.', File_ID )
     End;

   Prn_ID := Copy (File_ID, 1, DotPos) ; { Get base filename with dot }
   Prn_ID := ( Prn_ID + 'PRN' );         { and add the proper extension }
   New_ID := Copy (File_ID, 1, DotPos) ;
   New_ID := ( New_ID + 'XRF' );

   Writeln;
   Writeln (' Input is from : ',File_Id);
   Writeln (' Print Out to  : ',Prn_Id);
   Writeln (' Cross Ref to  : ',New_Id);
   Writeln;
   Write (' Is this acceptable (Y/N)?  <Y>:');
   Read (Kbd,InChar);
   Writeln;
   If NOT ((InChar=^M) OR (UpCase(InChar)='Y')) THEN
    Begin
     Writeln ('--- Supply complete filenames ---');
     WRITE('Printed output to: ');
     READLN(PRN_ID);
     WRITELN;
     WRITE('Cross-Reference output to: ');
     READLN(NEW_ID);
     WRITELN;
    End;
   End;   { "Sub" Procedure GetNames }

BEGIN     { ConnectFiles *** execution starts here *** }
   File_ID := '';
   fatal_error := FALSE;
   ConnectFiles := TRUE;
   GetNames;
   Assign(fout,PRN_ID);
   Rewrite(FOUT);
   if IOresult <> 0 then begin
      writeln('Could not open ',PRN_ID,' (print output file).');
      ConnectFiles := FALSE;
      fatal_error  := TRUE;
      end;
  assign(xout,NEW_ID);
  Rewrite(Xout) ;
  if IOresult <> 0 then begin
     writeln('Could not open ',NEW_ID,' (xref output file).');
     ConnectFiles := FALSE;
     fatal_error := TRUE;
     end;
END{ of ConnectFiles };

PROCEDURE Initialize;
VAR
  Ch: CHAR;
BEGIN
  bell := ^G; GAP := ' ' ;
  Currentline := 0;
  IF ConnectFiles THEN
    BEGIN
        Key[ 1] := 'ABSOLUTE';
        Key[ 2] := 'AND';
        Key[ 3] := 'ARRAY';
        Key[ 4] := 'ASSIGN';
        Key[ 5] := 'BEGIN';
        Key[ 6] := 'BOOLEAN';
        Key[ 7] := 'BYTE';
        Key[ 8] := 'CASE';
        Key[ 9] := 'CHAIN';
        Key[10] := 'CHAR';
        Key[11] := 'CHR';
        Key[12] := 'CLOSE';
        Key[13] := 'CONCAT';
        Key[14] := 'CONST';
        Key[15] := 'COPY';
        Key[16] := 'DELETE';
        Key[17] := 'DIV';
        Key[18] := 'DO';
        Key[19] := 'DOWNTO';
        Key[20] := 'ELSE';
        Key[21] := 'END';
        Key[22] := 'EOF';
        Key[23] := 'EOLN';
        Key[24] := 'EXECUTE';
        Key[25] := 'EXIT';
        Key[26] := 'EXTERNAL';
        Key[27] := 'FALSE';
        Key[28] := 'FILE';
        Key[29] := 'FILLCHAR';
        Key[30] := 'FOR';
        Key[31] := 'FORWARD';
        Key[32] := 'FUNCTION';
        Key[33] := 'GOTO';
        Key[34] := 'IF';
        Key[35] := 'IN';
        Key[36] := 'INLINE';
        Key[37] := 'INPUT';
        Key[38] := 'INTEGER';
        Key[39] := 'LABEL';
        Key[40] := 'LENGTH';
        Key[41] := 'MOD';
        Key[42] := 'NIL';
        Key[43] := 'NOT';
        Key[44] := 'OF';
        Key[45] := 'OR';
        Key[46] := 'ORD';
        Key[47] := 'OUTPUT';
        Key[48] := 'PACKED';
        Key[49] := 'PROCEDURE';
        Key[50] := 'PROGRAM';
        Key[51] := 'REAL';
        Key[52] := 'RECORD';
        Key[53] := 'REPEAT';
        Key[54] := 'SET';
        Key[55] := 'SHL';
        Key[56] := 'SHR';
        Key[57] := 'STRING';
        Key[58] := 'SUCC';
        Key[59] := 'TEXT';
        Key[60] := 'THEN';
        Key[61] := 'TO';
        Key[62] := 'TRUE';
        Key[63] := 'TYPE';
        Key[64] := 'UNTIL';
        Key[65] := 'VAR';
        Key[66] := 'WHILE';
        Key[67] := 'WITH';
        Key[68] := 'WRITE';
        Key[69] := 'WRITELN';
        Key[70] := 'XOR';
        tab     := CHR(9);  { ASCII Tab character }
        form_feed := CHR(12);  gap  := CHR(32);
        WRITE('List file to console (Y/N)? <N>:');
        READ(kbd,Ch);
        LISTING := ( (Ch='Y') OR (Ch='y') );
        WRITELN; WRITELN;
    END; {IF ConnectFiles}
END; {of Initialize}

BEGIN { Cross Reference }
  CLRSCR;
  LOWVIDEO;
  WRITELN(' ':22, 'CROSS REFERENCE GENERATOR');
  WRITELN(' ':15, 'Turbo Pascal 2.0 CP/M-80 V2.2 Jan. 5, 1985');
  WRITELN;WRITELN;WRITELN;
  Initialize;
  IF NOT fatal_error THEN
    BEGIN
      WordTree := NIL;          {Make the Tree empty}
      writeln('Pass 1 [Listing] Begins ...');BuildTree(WordTree, FILE_ID);
      close(FOUT) ;
      writeln('Pass 2 [Cross-Ref] Begins ...');PrintTree(WordTree);
      writeln('Pass 2 [Cross-Ref] Complete..');
      close(XOUT);
    END;
  WRITELN;
END. { Cross Reference }