home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
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
< prev
next >
Wrap
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 }