home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / pascal / PROFILER.ZIP / LISTPRF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-01-02  |  9.8 KB  |  267 lines
  1.   program PrintAddresses;
  2. {Prints address information saved by PROFILE}
  3. {Definitions}
  4.  
  5. const
  6.     MaxSeg = 200;         {maximum number of different segments}
  7.     nul    = '';
  8. type
  9.     MaxString = string[255];   {generic big string}
  10.     string4   = string[4];     {string of length 4}
  11. var
  12.     bins:     array[0..2048] of real;  {allow 2048 address bins}
  13.     TableOfs: integer absolute CSeg:$5C; {PROFILE stores seg:ofs of}
  14.     TableSeg: integer absolute CSeg:$5E; {the data table here}
  15.     SampSeg:  integer;
  16.     SampOfs:  integer;
  17.     NSampls:  integer;           {No. of samples in table}
  18.     NSeg:     integer;           {No. of different segments}
  19.     NBIOS:    integer;           {No. of hits in BIOS}
  20.     NFD:      integer;           {No. of hits in FD ROM}
  21.     i,j,k,n:  integer;           {global integer counters}
  22.     SegArray: array [1..MaxSeg,1..2] of integer;
  23.                {SegArray[i,1] = value of ith segment
  24.                 SegArray[i,2] = # of occurrences of ith segment}
  25.     DoPrint:  boolean;           {logical print flag}
  26.  
  27. {$V-} {Disable type checking of character arguments}
  28.  
  29. procedure print (instring:MaxString); {write to PRN if DoPrint true,
  30.                                         otherwise just to screen}
  31.     begin
  32.                           write  (     instring);
  33.        if (DoPrint) then  write  (LST, instring);
  34.     end;
  35. procedure println (instring: MaxString);  {same as print, but write LF too}
  36.     begin
  37.                           writeln (     instring);
  38.        if (DoPrint) then  writeln (LST, instring);
  39.     end;
  40. function Hex (Hexint:integer): string4; {converts integer into four character
  41.                                          hexadecimal string}
  42.     const
  43.        HexCh: array[0..15] of char = '0123456789ABCDEF';
  44.     var
  45.        HexHi, HexLo: integer;
  46.     begin;
  47.        HexHi := Hi(HexInt);
  48.        HexLo := Lo(HexInt);
  49.        Hex   := HexCh [HexHi div 16] +
  50.                 HexCh [HexHi - 16*(HexHi div 16)] +
  51.                 HexCh [HexLo div 16] +
  52.                 HexCh [HexLo - 16*(HexLo div 16)];
  53.     end;
  54. procedure AddSeg (Segval: integer);
  55.     var
  56.        oldseg: boolean;   {increments the tally of hits on a segment in
  57.                            segment array or adds a segment to the segment array}
  58.     begin
  59.        oldseg := false;
  60.        for i := 1 to NSeg do
  61.        begin
  62.           if (Segval = SegArray[i,1]) then
  63.           begin
  64.              oldseg := true;
  65.              SegArray[i,2] := SegArray[i,2] + 1;
  66.           end;
  67.        end;
  68.        if (oldseg = false) then
  69.           if (NSeg < MaxSeg) then
  70.           begin
  71.              NSeg := NSeg + 1;
  72.              SegArray [NSeg,1] := Segval;
  73.              SegArray [NSeg,2] := 1;
  74.           end;
  75.     end;
  76. procedure Loop;  {loop over hits, doing accumulations and conversions}
  77.     begin
  78.       NSeg := 0;
  79.       NFD  := 0;
  80.       NBIOS := 0;
  81.       NSampls := MemW [TableSeg:(TableOfs-2)];
  82.     {PROFILE stuffs number of samples before beginning of table here}
  83.       n := 0;
  84.       for i := 1 to NSampls do  {loop over number of samples}
  85.       begin
  86.         SampSeg := MemW [TableSeg:(TableOfs + n + 2)]; {get segment}
  87.     {update list of segments - count ROM hits - increment index into table}
  88.         AddSeg (SampSeg);
  89.         if (SampSeg = $F000) then NBIOS := NBIOS + 1;
  90.         if (SampSeg = $C800) then NFD := NFD + 1;
  91.         n := n + 4;
  92.       end;
  93.     end;       {end loop over number of samples}
  94. procedure PrintTotals;
  95.     {output first screen of total tallies}
  96.     begin
  97.       ClrScr; LowVideo;  gotoxy (31,1);   writeln('Execution Profiler');
  98.       writeln;
  99. writeln('Location of accumulated address table and length (all hex):');
  100. writeln('Segment = ', Hex(TableSeg), '  Offset   = ',
  101.               Hex(TableOfs),'   Length = ', Hex(NSampls));
  102. writeln;
  103. writeln ('Code segment for this program is: ', Hex(CSeg)); writeln;
  104. writeln ('There are ', NSeg, ' distinct CS registers:'); writeln;
  105.       for i := 1 to NSeg do
  106.         writeln ('# ', i:4, ' is ', Hex (SegArray[i,1]),
  107.                  '; there were ', SegArray[i,2]:6 , ' counts.');
  108.         writeln;
  109.         writeln ('There were ', NSampls:6, ' total counts, spanning ',
  110.                        (NSampls/18.2):10:2, ' seconds.');
  111.    {NOTE: seconds printout assumes clock not speeded up}
  112.         writeln;
  113. writeln ('There were ', NFD:6, ' counts in fixed Disk Control ',
  114.                         '(CS=C800).');
  115.         writeln;
  116.         writeln ('there were ', NBIOS:6, ' counts in BIOS (CS=F000).');
  117.         writeln; writeln; writeln ('Press return to continue ... ');
  118.         readln;
  119.       end;
  120. procedure SegHist;  {prints out a histogram}
  121.     var
  122.       maxcount : integer;
  123.       ans      : char;
  124.       xn, xs   : real;
  125.       NDots    : integer;
  126.       nstrng   : MaxString;
  127.     begin
  128.       ClrScr;  gotoxy(30,1);  write ('Segment Histogram');
  129.       gotoxy(1,5);
  130.       write('Do you want to print the histogram (y/n)? ');
  131.       readln (ans);     DoPrint := false;
  132.       if ((ans = 'y') or (ans = 'Y')) then DoPrint := true;
  133.       ClrScr;      gotoxy(30,1);      println ('Segment Histogram');
  134.       xn := NSampls;
  135.       println (nul);
  136.       print ( '        0');
  137.       print ( '                                 .5');
  138.       print ( '                                 1.0');
  139.       print ( '        |');
  140.       print ( '                                  |');
  141.       print ( '                                  |');
  142.       println (nul);     println(nul);
  143.       for i := 1 to NSeg do
  144.         begin
  145.           xs := SegArray [i,2];
  146.           bins [i] := xs / xn;
  147.           print (Hex (SegArray[i,1]) + ' >   ');
  148.           NDots := round (70.*bins [i]) ;
  149.           for j := 1 to NDots do print ('*');
  150.           println (nul);
  151.         end;
  152.       println (nul);
  153.       Str (NSeg:4, nstrng);
  154.       println ('There were ' + nstrng + '  different segments.');
  155.       Str (NSampls:4, nstrng);
  156.       println ('There were ' + nstrng + ' total counts');
  157.       writeln;  writeln ('Press return to continue . . . .'); readln;
  158.     end;
  159. procedure OfsHist;     {prints offset histogram}
  160.     label  EndOfsHist;
  161.     var
  162.       maxcount, NDots, iseg, iwidth, nbins, ncounts: integer;
  163.       index, offset, segment, minofs, maxofs, ofslabel: integer;
  164.       ans:      char;
  165.       xn, xs:   real;
  166.       nstrng:   MaxString;
  167.       ListAll:  boolean;
  168.     begin
  169.       repeat
  170.       minofs := $ffff;   maxofs := 0;
  171.       ClrScr;
  172.       gotoxy(30,1);      write ('Offset Histogram');
  173.       gotoxy(1,5);
  174. write('Enter the number of the segment you want (0 to end): ');
  175.       readln (iseg);
  176.       if (iseg = 0) then goto EndOfsHist;
  177.       nbins := 10;
  178.       gotoxy(1,6);
  179.       write('Enter the number of bins desired (< = 2048): ');
  180.       readln (nbins);
  181.       write('Do you want to print the histogram (y/n)? ');
  182.       readln (ans);
  183.       DoPrint := false;
  184.       if ((ans = 'y') or (ans = 'Y')) then DoPrint := true;
  185.       write('Do you wnat to display empty bins (y/n)? ');
  186.       readln (ans);
  187.       ListAll := false;
  188.       if ((ans = 'y') or (ans = 'Y')) then ListAll := true;
  189.       ClrScr;     gotoxy(24,1);
  190.       println ('Offset Histogram for Segment '
  191.                                        + Hex (SegArray[iseg,1]));
  192.       println (nul);      print ( '             ');
  193.       print ( '0                              .5');
  194.       print ( '                              1.0');
  195.       println (nul);      print ( '             ');
  196.       print ( '|                               |');
  197.       print ( '                                |');
  198.       println (nul);    println (nul);
  199.       for i := 0 to nbins       {zero out count array and scalars}
  200.                  do bins [i] := 0;
  201.       ncounts := 0;
  202.       n := 0;                   {find max and min offsets /2}
  203.       for i := 0 to NSampls do
  204.         begin
  205.           SampSeg := MemW [TableSeg:(TableOfs + n + 2)];
  206.           SampOfs := MemW [TableSeg:(TableOfs + n    )];
  207.           n := n + 4;
  208.           if (SampSeg = SegArray[iseg,1]) then
  209.           begin
  210.             if ( Hex (SampOfs) > Hex (maxofs) ) then maxofs := SampOfs;
  211.             if ( Hex (SampOfs) < Hex (minofs) ) then minofs := SampOfs;
  212.           end;
  213.         end;
  214.         iwidth := (maxofs - minofs) div nbins;      {words per bin}
  215.         if (iwidth = 0) then iwidth := 1;
  216.         n := 0;                  {accumulate counts in the bins}
  217.         for i := 1 to NSampls do
  218.         begin
  219.           SampSeg := MemW [TableSeg:(TableOfs + n + 2)];
  220.           SampOfs := MemW [TableSeg:(TableOfs + n    )];
  221.           n := n + 4;
  222.           if (SampSeg = SegArray[iseg,1]) then
  223.           begin
  224.             ncounts := ncounts + 1;
  225.             index := (SampOfs - minofs) div iwidth;
  226.             bins [index] := bins [index] + 1.;
  227.           end;
  228.         end;
  229.         ofslabel := minofs;         {print the histogram}
  230.         if (ncounts > 0) then
  231.         begin
  232.           for i := 0 to nbins do
  233.           begin
  234.             if ( (bins[i] > 0) or (ListAll) ) then
  235.             begin
  236.               print ( Hex (ofslabel) + '+' + Hex (iwidth) + ' >  ');
  237.               NDots := round (65.*(bins [i] / ncounts));
  238.               if ( (NDots = 0) and (bins [i] <> 0) ) then NDots := 1;
  239.               for j := 1 to NDots do print ('*');
  240.               println (nul);
  241.             end;
  242.             ofslabel := ofslabel + iwidth;
  243.           end;
  244.         end;
  245.         println (nul);
  246.         Str (ncounts:4, nstrng);       {print final statistics}
  247.         println ('There were ' + nstrng + ' counts in this segment. ' +
  248.                           Hex (SegArray[iseg,1]));
  249.         println ('Minimum offset in this segment was ' + Hex (minofs));
  250.         println ('Maximum offset in this segment was ' + Hex (maxofs));
  251.         writeln;    writeln ('Press return to continue . . .');
  252.         readln;
  253.         until (false);
  254. EndOfsHist:
  255.     end;
  256.  
  257. {MAIN:}
  258.  
  259.     begin;
  260.     Loop;
  261.     PrintTotals;
  262.     Seghist;
  263.     OfsHist;
  264. end.
  265.  
  266.  
  267.