ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/CPM/TURBOPAS/CROSSREF.ARK/CR-M04.INC

Text File | 1987-04-18 | 5KB | 169 lines

{.pa}
{****************************** function Compare ****************************}

function Compare (var Source,Table :NameType) :boolean;

{ This function will compare the two file names to determine if they're the
  same. }

var
   I :integer;

begin
   for I := 1 to length(Source) do
      Source[I] := upcase(Source[I]);
   for I := 1 to length(Table) do
      Table[I] := upcase(Table[I]);
   if Source = Table then
      Compare := true
   else
      Compare := false;
end;   { function Compare }
{.pa}
{**************************** procedure OpenFile ****************************}

procedure OpenFile(var InFile,TableFile :text;
                   var Stop             :boolean;
                   var SourceName,
                       TableName        :NameType);

{ This procedure allows the user to enter the source file name and it will
  open the file.  Then it will allow the user to enter the Table and Listing
  file names. }

var
   Valid    :boolean;                    { program name valid }

begin
   repeat
      gotoxy(1,14); write('Enter source file name? (Return to exit) ');
      buflen := 14;
      readln(SourceName); ClrEol;
      assign(InFile,SourceName);
      {$I-} reset(InFile); {$I+}          { error checking }
      Valid := (IOresult = 0);
      if SourceName = '' then
         Stop := true                     { don't cross-ref a program }
      else
         if not Valid then
            begin
               gotoxy(5,15); write(chr(7),'File ',SourceName,' not found.')
            end
   until Valid or Stop;
   if not Stop then
      begin
         gotoxy(1,15); ClrEol;
         repeat
            gotoxy(1,16);
            write('Enter table output file name? ');    { enter table name }
            buflen := 14;
            readln(TableName); ClrEol;
            if Compare(SourceName,TableName) then
               begin
                  gotoxy(5,17); write(chr(7),'Cannot have same file names!');
                  Valid := false;
               end
            else
               Valid := true;
         until Valid and (length(TableName) > 0);
         assign(TableFile,TableName);
         rewrite(TableFile);
         gotoxy(1,14); ClrEol;
         gotoxy(1,16); ClrEol;
         gotoxy(1,17); ClrEol;
      end;
end;   { procedure EnterFileName }
{.pa}
{************************* function AnotherCross ****************************}

function AnotherCross: boolean;

{ This function prompts the user with a question whether to cross-reference
  another program.  A true boolean flag is returned if the response is 'Y',
  otherwise false. }

var
   Response:char;           { answer to question }

begin
   if not Stop then
      begin
         writeln;
         repeat
            gotoxy(1,23);
            write('Do you want to cross-reference another program? (Y/N) ');
            buflen := 1;
            readln(Response);
         until Response in ['Y','y','N','n'];
         AnotherCross := (Response in ['Y','y']);
      end
   else
      AnotherCross := false;
end;  { procedure AnotherCross }
{.pa}
{*************************** procedure InitializeTree ***********************}

procedure InitializeTree (var Tree :TreePointer);

begin
   mark(Tree);
   release(Tree);
   Tree := nil;
end;  { procedure InitializeTree }

{************************ procedure InitializeStatus ************************}

procedure InitializeStatus (var Status :Info);

{ This procedure will initialize the variables of Status. }

var
   I :Index;          { loop index }

begin
   with Status do
      begin
         TotalLines := 0;
         CommentLines := 0;
         BlankLines := 0;
         Comments := 0;
         TotalIdents := 0;
         DifferentIdents := 0;
         TotalReserved := 0;
         MostUsedNumber := 0;
         LeastUsedNumber := MaxInt;
         AvgIdentLength := 0.0;
         for I := 1 to MaxIdentLength do
            begin
               MostUsedIdent[I] := ' ';
               LeastUsedIdent[I] := ' '
            end;
         for I := 1 to MaxReservedWords do
            UsedReserved[I] := 0;
      end   { with Status }
end;  { procedure InitializeStatus }
{.pa}
{***************************** procedure Titles ******************************}

procedure Titles;

{ This procedure will display the title's of the program. }

begin
   clrscr;
   gotoxy(33,1); write('Cross Reference');
   gotoxy(64,1); write('version 4');
   gotoxy(30,2);
   writeln ('Written by Milton Hom');
   writeln;
   writeln ('      This program will produce a cross reference table of');
   writeln ('      identifiers and perform a simple analysis of a TURBO');
   writeln ('      Pascal program.  The table and analyis will be written');
   writeln ('      to a disk file specified by the user.');
   writeln;
   writeln ('      NOTE:');
   writeln ('         Include file(s) are not recognized by this program.');
   writeln ('         They must be cross referenced individually.');
   writeln
end;   { procedure Titles }