home *** CD-ROM | disk | FTP | other *** search
- {.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 }