home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Phoenix CD 2.0
/
Phoenix_CD.cdr
/
02a
/
pctj1186.zip
/
LISTPRF.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-09-19
|
10KB
|
271 lines
program PrintAddresses;
{ Prints address information saved by PROFILE }
{ DEFINITIONS: }
const
MaxSeg = 200; {Maximum number of different segments}
nul = ''; {Null character string}
type
MaxString = string[255]; {Generic big string}
string4 = string[4]; {String of length 4}
var
bins: array[0..2048] of real; {Allow 2048 address bins}
TableOfs: integer absolute CSeg:$5C; {PROFILE stores seg:ofs of}
TableSeg: integer absolute CSeg:$5E; {the data table here}
SampSeg: integer; {Segment of a sample in table}
SampOfs: integer; {Offset of a sample in table}
NSampls: integer; {No. of samples in table}
NSeg: integer; {No. of different segments}
NBIOS: integer; {No. of hist in BIOS}
NFD: integer; {No. of hits in Fixed Disk ROM}
i,j,k,n: integer; {Global Integer counters}
SegArray: array [1..MaxSeg,1..2] of integer;
{ SegArray[i,1] = value of ith segment
SegArray[i,2] = # occurrences of ith segment }
DoPrint: boolean; {Logical print flag}
{$V-} {Disable type checking of character arguments.}
procedure print (instring: MaxString);
{ writes to printer if DoPrint true, otherwise to screen }
begin
write ( instring);
if (DoPrint) then write (LST, instring);
end;
procedure println (instring: MaxString);
{ same as print, but writes line feed too }
begin
writeln ( instring);
if (DoPrint) then writeln (LST, instring);
end;
function Hex (HexInt: integer): string4;
{ Converts an integer into a four character hexadecimal string }
const
HexCh: array[0..15] of char = '0123456789ABCDEF';
var
HexHi, HexLo: integer;
begin;
HexHi := Hi(HexInt);
HexLo := Lo(HexInt);
Hex := HexCh [HexHi div 16] +
HexCh [HexHi - 16*(HexHi div 16)] +
HexCh [HexLo div 16] +
HexCh [HexLo - 16*(HexLo div 16)];
end;
procedure AddSeg (Segval: integer);
var
oldseg: boolean;
{ increments the tally of hits on a segment in segment array
or adds a segment to the segment array}
begin
oldseg := false;
for i := 1 to NSeg do
begin
if (Segval = SegArray[i,1]) then
begin
oldseg := true;
SegArray[i,2] := SegArray[i,2] + 1;
end;
end;
if (oldseg = false) then
if (NSeg < MaxSeg) then
begin
NSeg := NSeg + 1;
SegArray [NSeg,1] := Segval;
SegArray [NSeg,2] := 1;
end;
end;
procedure Loop;
{ Loop over hits, doing accumulations and conversions }
begin
NSeg := 0;
NFD := 0;
NBIOS := 0;
NSampls := MemW [TableSeg:(TableOfs-2)];
{ PROFILE stuffs number of samples before beginning of table here }
n := 0;
for i := 1 to NSampls do { Loop over the number of samples }
begin
SampSeg := MemW [TableSeg:(TableOfs + n + 2)]; { get segment }
{ update the list of segments - count ROM hits - increment index
into table. }
AddSeg (SampSeg);
if (SampSeg = $F000) then NBIOS := NBIOS + 1;
if (SampSeg = $C800) then NFD := NFD + 1;
n := n + 4;
end;
end; { End loop over the number of samples }
procedure PrintTotals;
{ Output first screen of total tallies }
begin
ClrScr; gotoxy (31,1); writeln ('Execution Profiler');
writeln;
writeln('Location of accumulated address table & length (all hex):');
writeln('Seg = ', Hex(TableSeg), ' Ofs = ',
Hex(TableOfs),' Length = ', Hex(NSampls));
writeln;
writeln ('Code segment for this program is: ', Hex(CSeg)); writeln;
writeln ('There are ', NSeg, ' distinct CS registers:'); writeln;
for i := 1 to NSeg do
writeln ('# ', i:4, ' is ', Hex (SegArray[i,1]),
'; there were ', SegArray[i,2]:6 , ' counts.');
writeln;
writeln ('There were ', NSampls:6, ' total counts, spanning ',
(NSampls/18.2):10:2, ' seconds.');
{NOTE: seconds printout assumes clock not speeded up }
writeln;
writeln ('There were ', NFD:6, ' counts in Fixed Disk Control ',
'(CS=C800).');
writeln;
writeln ('There were ', NBIOS:6, ' counts in BIOS (CS=F000).');
writeln; writeln; writeln('Press return to continue...');
readln;
end;
procedure SegHist;
{ prints out a segment histogram }
var
maxcount: integer;
ans: char;
xn, xs: real;
NDots: integer;
nstrng: MaxString;
begin
ClrScr; gotoxy(30,1); write ('Segment Histogram');
gotoxy(1,5);
write('Do you want to print the histogram (y/n)? ');
readln (ans); DoPrint := false;
if ((ans = 'y') or (ans = 'Y')) then DoPrint := true;
ClrScr; gotoxy(30,1); println ('Segment Histogram');
xn := NSampls;
println (nul);
print ( ' 0');
print ( ' .5');
print ( ' 1.0');
print ( ' |');
print ( ' |');
print ( ' |');
println (nul); println (nul);
for i := 1 to NSeg do
begin
xs := SegArray [i,2];
bins [i] := xs / xn;
print (Hex (SegArray[i,1]) + ' > ');
NDots := round (70.*bins [i]);
for j := 1 to NDots do print ('*');
println (nul);
end;
println (nul);
Str (NSeg:4, nstrng);
println ('There were ' + nstrng + ' different segments.');
Str (NSampls:4, nstrng);
println ('There were ' + nstrng + ' total counts');
writeln; writeln ('Press return to continue...'); readln;
end;
procedure OfsHist; { prints out an offset histogram }
label EndOfsHist;
var
maxcount, NDots, iseg, iwidth, nbins, ncounts: integer;
index, offset, segment, minofs, maxofs, ofslabel: integer;
ans: char;
xn, xs: real;
nstrng: MaxString;
ListAll: boolean;
begin
repeat
minofs := $ffff; maxofs := 0;
ClrScr;
gotoxy(30,1); write ('Offset Histogram');
gotoxy(1,5);
write('Enter the number of the segment you want (0 to end): ');
readln (iseg);
if (iseg = 0) then goto EndOfsHist;
nbins := 10;
gotoxy(1,6);
write('Enter the number of bins desired (< = 2048): ');
readln (nbins);
write('Do you want to print the histogram (y/n)? ');
readln (ans);
DoPrint := false;
if ((ans = 'y') or (ans = 'Y')) then DoPrint := true;
write('Do you want to display empty bins (y/n)? ');
readln (ans);
ListAll := false;
if ((ans = 'y') or (ans = 'Y')) then ListAll := true;
ClrScr; gotoxy(24,1);
println ('Offset Histogram for Segment '
+ Hex (SegArray[iseg,1]));
println (nul); print ( ' ');
print ( '0 .5');
print ( ' 1.0');
println (nul); print ( ' ');
print ( '| |');
print ( ' |');
println (nul); println (nul);
for i := 0 to nbins { zero out count array and scalars }
do bins [i] := 0;
ncounts := 0;
n := 0; { find max and min offsets (/2) }
for i := 1 to NSampls do
begin
SampSeg := MemW [TableSeg:(TableOfs + n + 2)];
SampOfs := MemW [TableSeg:(TableOfs + n )];
n := n + 4;
if (SampSeg = SegArray[iseg,1]) then
begin
if ( Hex (SampOfs) > Hex (maxofs) ) then maxofs := SampOfs;
if ( Hex (Sampofs) < Hex (minofs) ) then minofs := SampOfs;
end;
end;
iwidth := (maxofs - minofs) div nbins; { words per bin }
if (iwidth = 0) then iwidth := 1;
n := 0; { accumulate counts in the bins }
for i := 1 to NSampls do
begin
SampSeg := MemW [TableSeg:(TableOfs + n + 2)];
SampOfs := MemW [TableSeg:(TableOfs + n )];
n := n + 4;
if (SampSeg = SegArray[iseg,1]) then
begin
ncounts := ncounts + 1;
index := (SampOfs - minofs) div iwidth;
bins [index] := bins [index] + 1.;
end;
end;
ofslabel := minofs; { print the histogram }
if (ncounts > 0) then
begin
for i := 0 to nbins do
begin
if ( (bins[i] > 0) or (ListAll) ) then
begin
print (Hex (ofslabel) + '+' +
Hex (iwidth) + ' > ');
NDots := round (65.*(bins [i] / ncounts));
if ( (NDots = 0) and (bins [i] <> 0) ) then NDots := 1;
for j := 1 to NDots do print ('*');
println (nul);
end;
ofslabel := ofslabel + iwidth;
end;
end;
println (nul);
Str (ncounts:4, nstrng); { print final statistics }
println ('There were ' + nstrng + ' counts in this segment, ' +
Hex (SegArray[iseg,1]));
println ('Minimum offset in this segment was ' + Hex (minofs));
println ('Maximum offset in this segment was ' + Hex (maxofs));
writeln; writeln ('Press return to continue...');
readln;
until (false);
EndOfsHist:
end;
{ MAIN: }
begin;
Loop; { Initial loop over samples }
PrintTotals; { Print total hits, segments, etc. }
SegHist; { Print Segment Histogram }
OfsHist; { Print Offset Histograms for selected segments }
end.