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-M03.INC
< prev
next >
Wrap
Text File
|
1987-04-18
|
6KB
|
138 lines
{.pa}
{************************* procedure PrintTree ******************************}
procedure PrintTree (var Tree :TreePointer;
var TableFile :text;
var Status :Info;
var SourceName,
TableName :NameType );
{ This procedure writes the table of identifiers along with a list of
appropriate line numbers to a text file specified by the user. }
const
WNumber = 4; { max. width of line number }
MaxWidthOfPage = 80; { max. width of page }
var
I :integer; { loop index }
LNumber, { line number }
TotalPerLine, { total number of items per line }
Sp :Index; { spaces to skip identifier field }
Screen :text; { screen output }
{***************************** procedure DeQueue *************************}
procedure DeQueue (var Entry :EntryType;
var LNumber :Index );
{ This procedure will take a line number from the queue. }
begin
if Entry.Head <> nil then
begin
LNumber := Entry.Head^.LineNumber;
Entry.Head := Entry.Head^.Next
end
end; { procedure DeQueue }
{************************** procedure VisitAndPrint **********************}
procedure VisitAndPrint (Tree :TreePointer);
{ This procedure will print the identifier & its line numbers. }
var
NumberPerIdent, { line numbers per identifier }
PreviousLNumber, { previous line number }
ItemsPerLine :Index; { counter of numbers per line }
begin
NumberPerIdent := 0;
PreviousLNumber := 0;
ItemsPerLine := 0; { 1st index of table }
with Tree^ do
begin
write(TableFile,Entry.Ident:0,' ');
while Entry.Head <> nil do
begin
DeQueue (Entry,LNumber); { get a LNumber }
NumberPerIdent := NumberPerIdent + 1; { count all idents }
if PreviousLNumber <> LNumber then { no duplicate line }
begin { numbers allowed }
ItemsPerLine := ItemsPerLine + 1;
PreviousLNumber := LNumber;
if ItemsPerLine <= TotalPerLine then
write(TableFile,LNumber:WNumber,' ':WNumber-1)
else
begin
ItemsPerLine := 1;
writeln(TableFile);
write(TableFile,' ':Sp,LNumber:WNumber,' ':WNumber-1)
end
end
end;
writeln(TableFile); { carriage return remaining numbers }
if NumberPerIdent > Status.MostUsedNumber then
begin
Status.MostUsedNumber := NumberPerIdent;
Status.MostUsedIdent := Entry.Ident
end
else
if NumberPerIdent <= Status.LeastUsedNumber then
begin
Status.LeastUsedNumber := NumberPerIdent;
Status.LeastUsedIdent := Entry.Ident
end
end { with Tree^ }
end; { procedure VisitAndPrint }
{*************************** procedure TraverseLNR ************************}
procedure TraverseLNR (Tree :TreePointer);
{ This procedure will visit each node of the tree & print its contents by
using the LNR method. }
begin
if Tree <> nil then
begin
TraverseLNR (Tree^.Left);
VisitAndPrint (Tree);
TraverseLNR (Tree^.Right);
end
end; { procedure TraverseLNR }
{*************************** procedure PrintTree ****************************}
begin
Sp := MaxIdentLength + 4; { indenting space }
TotalPerLine := (MaxWidthOfPage-MaxIdentLength - 4) { compute numbers }
div (WNumber * 2); { per line }
assign (Screen,'con:');
reset (Screen);
writeln(TableFile);
writeln(TableFile,'Cross Reference Table of ',SourceName:0);
writeln(TableFile);
for I := 1 to 12 do
begin { clear frame }
gotoxy(1,I+2); ClrEol;
end; { for }
gotoxy(1,13); write('Writing Table to ',TableName,'':25);
TraverseLNR (Tree); { write identifiers }
writeln(TableFile);
writeln(TableFile);
write (TableFile,'=====================================' );
writeln(TableFile,'======================================');
writeln(TableFile);
writeln(TableFile,'Analysis of ',SourceName);
writeln(TableFile);
DisplayStatus (Status,TableFile); { write status of source file }
close(TableFile);
gotoxy(1,13); clreol;
gotoxy(1,3); writeln('Analysis of ',SourceName); writeln;
DisplayStatus (Status,Screen); { display status of source file }
release(Tree);
end; { procedure PrintTree }