home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast.iso / pcmag / vol6n20.zip / PROFIL.ZIP / DRAWHIST.PRF < prev    next >
Text File  |  1987-01-11  |  11KB  |  319 lines
  1. { These procedures handle the bookwork to display histograms of the program's }
  2. { execution profile.  The histograms can be displayed on the screen or on the }
  3. { printer.                                                                    }
  4.  
  5. const
  6.   FirstPrintLine = 6;
  7.   LastPrintLine  = 60;
  8.   LastScreenLine = 25;
  9.   Printing : boolean = false ;
  10.  
  11. var
  12.   LineNum        : integer ;
  13.  
  14. { This procedure begins a new page.  If the output is going to the printer    }
  15. { ( Printing = true ), it issues a formfeed, then skips lines to              }
  16. { FirstPrintLine.  If output is going to the screen, it clears the screen.    }
  17. { In either case, it keeps track of the current output line number.           }
  18. procedure PrintNewPage ;
  19. begin
  20.   if Printing then
  21.   begin
  22.     Write(LST, ^L) ;
  23.     LineNum := 1;
  24.     while LineNum < FirstPrintLine do
  25.     begin
  26.       WriteLn( LST );
  27.       LineNum := succ(LineNum);
  28.     end;
  29.   end
  30.   else
  31.   begin
  32.     ClearScreen ;
  33.     LineNum := 1 ;
  34.   end;
  35. end; { procedure PrintNewPage  }
  36.  
  37. { Test for whether output will be going to last line of screen or page }
  38. function EndPage : boolean ;
  39. begin
  40.   if Printing then
  41.      EndPage := (LineNum = LastPrintLine)
  42.   else
  43.      EndPage := (LineNum = LastScreenLine) ;
  44. end; { function EndPage  }
  45.  
  46. { Print text line, either to the printer or to the screen }
  47. procedure Print( Text : string80 ) ;
  48. begin
  49.   if Printing then
  50.      WriteLn(LST, Text)
  51.   else
  52.     FastWrite( Text, LineNum, 1, TextAttr ) ;
  53.   LineNum := succ(LineNum) ;
  54. end; { procedure Print( Text : string80 )  }
  55.  
  56.  
  57. { Bins is the number of bins being combined into one output line.  First is   }
  58. { the index of the first bin going into the current output line.  This        }
  59. { function returns the total number of hits in the bins from First to         }
  60. { First + Bins, which tells the program how many hits to show on the current  }
  61. { output line.                                                                }
  62.  
  63. function RowLength( First, Hi, Bins : integer ) : integer ;
  64. var
  65.   I, Count, Limit : integer ;
  66. begin
  67.   Count := 0 ;
  68.   Limit := pred( Bins ) ;
  69.   { next line makes sure we're not counting data outside the array }
  70.   if (succ(Hi-First)) < Limit then Limit := succ(Hi-First) ;
  71.   for I := 0 to Limit do
  72.     Count := Count + Bin^[First+I] ;
  73.   RowLength := Count ;
  74. end; { function RowLength( First, Hi, Bins : integer )  }
  75.  
  76. { Find the largest number of hits for any one output line }
  77. function MaxLength( Low, Hi, Bins : integer ) : integer ;
  78. var
  79.   TempLength, MaxSoFar, First : integer ;
  80. begin
  81.   MaxSoFar := 0 ;
  82.   First := Low ;
  83.   while First <= Hi do
  84.   begin
  85.     TempLength := RowLength( First, Hi, Bins ) ;
  86.     if TempLength > MaxSoFar then MaxSoFar := TempLength ;
  87.     First := First + Bins ;
  88.   end;
  89.   MaxLength := MaxSoFar ;
  90. end; { function MaxLength( Low, Hi, Bins : integer )  }
  91.  
  92. { Convert an integer to a hex string }
  93. function HexStr( Num : integer ) : string4 ;
  94. const
  95.   HexChar : array[0..15] of char = '0123456789ABCDEF' ;
  96. var
  97.   LoByte,
  98.   HiByte : integer ;
  99. begin
  100.   LoByte := Lo( Num ) ;
  101.   HiByte := Hi( Num ) ;
  102.   HexStr := HexChar[ HiByte shr 4 ] +
  103.             HexChar[ HiByte and $0F ] +
  104.             HexChar[ LoByte shr 4 ] +
  105.             HexChar[ LoByte and $0F ] ;
  106. end; { function HexStr( Num : integer )  }
  107.  
  108. procedure DrawHist( Low, Hi, Bins : integer ) ;
  109. const
  110.   DotLine : string80 = '********************************************************************************' ;
  111. var
  112.   SegStr : string4 ;
  113.   Factor : real ;
  114.   First  : integer ;
  115.   ch     : char ;
  116. begin
  117.   SegStr := HexStr( CountSeg ) ;
  118.   Factor := 70./MaxLength( Low, Hi, Bins ) ; { 70 characters per line }
  119.   First := Low ;
  120.   while First <= Hi do
  121.   begin
  122.     PrintNewPage ;
  123.     Print( '                               Execution Profile' ) ;
  124.     Print( '' ) ;
  125.     while ((not EndPage) and (First <= Hi)) do
  126.     begin
  127.       { Set line length to 70*Hits/MaxHits }
  128.       DotLine[0] := chr(trunc(RowLength( First, Hi, Bins )*Factor + 0.5 )) ;
  129.       { Print the current line }
  130.       Print( SegStr + ':' + HexStr( CountOfs + BinSize*(First) ) + ' ' + DotLine ) ;
  131.       First := First + Bins ;
  132.     end; {while}
  133.     { get here when screen or page is full, or when the display is done }
  134.     if not Printing then
  135.     begin
  136.       if First <= Hi then
  137.          First := First - Bins ;
  138.       FastWrite( 'Press any key to continue...', 25, 1, EmphAttr ) ;
  139.       Read(KBD, ch ) ;
  140.     end; {if}
  141.   end; {while}
  142.   if Printing then WriteLn( LST, ^L );
  143. end; { procedure DrawHist( Low, Hi, Bins : integer )  }
  144.  
  145.  
  146. { Search the array Bin^ for the first and last non-zero entries.  Don't need  }
  147. { to display anything outside this range.                                     }
  148.  
  149. procedure FindLimits( var LowerLimit, UpperLimit : integer ) ;
  150. begin
  151.   LowerLimit := 0 ;
  152.   while ( (LowerLimit < 4095) and (Bin^[LowerLimit] = 0) ) do
  153.     LowerLimit := succ( LowerLimit ) ;
  154.   UpperLimit := 4095 ;
  155.   while ( (UpperLimit >= LowerLimit) and (Bin^[UpperLimit] = 0) ) do
  156.     UpperLimit := pred( UpperLimit ) ;
  157. end; { procedure FindLimits( var LowerLimit, UpperLimit : integer )  }
  158.  
  159.  
  160. { Get number of bins to combine on each line.  If nothing is specified by the }
  161. { user, the program determines the proper number to produce exactly one page  }
  162. { of output.                                                                  }
  163.  
  164. procedure GetRowSize( NumBins : integer ; var BinsPerRow : integer ) ;
  165. begin
  166.   BinsPerRow := 0 ;
  167.   FastWrite( 'Number of bins to combine:', 8, 14, TextAttr ) ;
  168.   GotoXY( 41, 8 ) ;
  169.   ReadLn( BinsPerRow ) ;
  170.   HideCursor ;
  171.   if BinsPerRow > NumBins then BinsPerRow := succ(NumBins) ;
  172.   if BinsPerRow <= 0 then
  173.      case Printing  of
  174.        false : BinsPerRow := NumBins div (LastScreenLine - 3) + 1;
  175.        true  : BinsPerRow := NumBins div (LastPrintLine - FirstPrintLine - 2) + 1;
  176.      end; {case}
  177. end; { procedure GetRowSize( NumBins : integer ; var BinsPerRow : integer )  }
  178.  
  179. { Convert hex input to integer }
  180. procedure Convert( Text : string4 ; var Value : integer ; var OK : boolean ) ;
  181. begin
  182.   Value := 0 ;
  183.   OK := true ;
  184.   while Text <> '' do
  185.   begin
  186.     Text[1] := Upcase( Text[1] ) ;
  187.     case Text[1] of
  188.       ' ' : ;
  189.       '0'..'9' : Value := Value*16 + ord(Text[1]) - ord('0') ;
  190.       'A'..'F' : Value := Value*16 + ord(Text[1]) - ord('A') + 10 ;
  191.       else OK := false ;
  192.     end; {case}
  193.     delete( Text, 1, 1 ) ;
  194.   end; {while}
  195. end; { procedure Convert( Text : string4 ; var Value : integer ; var OK : boolean )  }
  196.  
  197.  
  198. { Called when user wants to display a different range of addresses. Prompts   }
  199. { for new range and inputs it, making sure bounds are between LowerLimit and  }
  200. { UpperLimit.                                                                 }
  201.  
  202. procedure GetRange( LowerLimit, UpperLimit : integer ;
  203.                     var Lower, Upper : integer ) ;
  204. var
  205.   TempStr : string4 ;
  206.   OK      : boolean ;
  207. begin
  208.   FastWrite( 'New Range:', 8, 14, EmphAttr ) ;
  209.   FastWrite( HexStr(CountSeg) + ':', 8, 30, EmphAttr ) ;
  210.   repeat
  211.     FastWrite( '    ', 8, 35, TextAttr ) ;
  212.     GotoXY( 35, 8 ) ;
  213.     ReadLn( TempStr ) ;
  214.     Convert( TempStr, Lower, OK ) ;
  215.   until OK ;
  216.   Lower := (Lower-CountOfs) div BinSize ;
  217.   if ((Lower + $8000) < (LowerLimit + $8000)) then Lower := LowerLimit ;
  218.   if ((Lower + $8000) > (UpperLimit + $8000)) then Lower := UpperLimit ;
  219.   FastWrite( HexStr(CountSeg) + ':', 8, 41, EmphAttr ) ;
  220.   repeat
  221.     FastWrite( '    ', 8, 46, TextAttr ) ;
  222.     GotoXY( 46, 8 ) ;
  223.     ReadLn( TempStr ) ;
  224.     Convert( TempStr, Upper, OK ) ;
  225.   until OK ;
  226.   HideCursor ;
  227.   Upper := (Upper-CountOfs) div BinSize ;
  228.   if ((Upper + $8000) > (UpperLimit + $8000)) then Upper := UpperLimit ;
  229.   if ((Upper + $8000) < (Lower + $8000)) then Upper := Lower ;
  230.   FastWrite( BlankLine, 8, 1, TextAttr ) ;
  231. end; { procedure GetRange }
  232.  
  233. { Convert unsigned decimal integer to text string }
  234. function CardStr( Num : integer ) : string5 ;
  235. var
  236.   TempStr : string[6] ;
  237.   TempNum : real ;
  238. begin
  239.   TempNum := 1.* Num ;
  240.   if TempNum < 0. then TempNum := TempNum + 65536. ;
  241.   str( TempNum:5:0, TempStr ) ;
  242.   CardStr := TempStr ;
  243. end; { function CardStr( Num : integer )  }
  244.  
  245. { Count total hits }
  246. function HitCount( Lower, Upper : integer ) : integer ;
  247. var
  248.   I,
  249.   HitsSoFar : integer ;
  250. begin
  251.   HitsSoFar := 0 ;
  252.   for I := Lower to Upper do
  253.     HitsSoFar := HitsSoFar + Bin^[I] ;
  254.   HitCount := HitsSoFar ;
  255. end; { function HitCount( Lower, Upper :integer )  }
  256.  
  257. { Display memory range on specified Line }
  258. procedure DisplayLimits( Lower, Upper : integer ; Line : byte ; Text : string80 ) ;
  259. begin
  260.   FastWrite( BlankLine, Line, 1, TextAttr ) ;
  261.   FastWrite( Text, Line, 14, TextAttr ) ;
  262.   FastWrite( HexStr(CountSeg)+':'+HexStr(CountOfs+BinSize*Lower), Line, 30, TextAttr ) ;
  263.   FastWrite( HexStr(CountSeg)+':'+HexStr(CountOfs+BinSize*succ(Upper)-1), Line, 41, TextAttr ) ;
  264.   FastWrite( CardStr(succ(Upper-Lower)), Line, 53, TextAttr ) ;
  265.   FastWrite( CardStr(HitCount(Lower,Upper)), Line, 61, TextAttr ) ;
  266. end; { procedure DisplayLimits( Lower, Upper : integer ; Line : byte ; Text : string80 ) }
  267.  
  268. procedure ShowProfile ;
  269. var
  270.   LowerLimit, UpperLimit,
  271.   DispLower, DispUpper,
  272.   BinsPerRow             : integer ;
  273.   done                   : boolean ;
  274.   ch                     : char ;
  275.  
  276. { Show a histogram on the screen or on the printer }
  277. procedure ShowHist( prtg : boolean ) ;
  278. begin
  279.   Printing := prtg;
  280.   GetRowSize( DispUpper-DispLower, BinsPerRow ) ;
  281.   DrawHist( DispLower, DispUpper, BinsPerRow ) ;
  282.   DrawProfileScreen;
  283. end; { procedure ShowHist( prtg : boolean )  }
  284.  
  285. { Display data and menu }
  286. begin
  287.   DrawProfileScreen ;
  288.   FindLimits( LowerLimit, UpperLimit ) ;
  289.   DispLower := LowerLimit ;
  290.   DispUpper := UpperLimit ;
  291.   done := false ;
  292.   repeat
  293.     FastWrite( 'Low        High      Bins    Hits', 5, 33, EmphAttr ) ;
  294.     DisplayLimits( LowerLimit, UpperLimit, 6, 'Full Range:' ) ;
  295.     DisplayLimits( DispLower, DispUpper, 7, 'Display Range:' ) ;
  296.     FastWrite( '0 to exit', 10, 30, TextAttr ) ;
  297.     FastWrite( '1 to change display range', 11, 30, TextAttr ) ;
  298.     FastWrite( '2 to display histogram', 12, 30, TextAttr ) ;
  299.     FastWrite( '3 to print histogram', 13, 30, TextAttr ) ;
  300.     FastWrite( 'Indicate selection:', 15, 30, EmphAttr ) ;
  301.     GotoXY( 50, 15 ) ;
  302.     repeat
  303.       Read(KBD, ch) ;
  304.     until ch in [ '0', '1', '2', '3' ] ;
  305.     { Erase the menu }
  306.     FastWrite( BlankLine, 10, 1, TextAttr ) ;
  307.     FastWrite( BlankLine, 11, 1, TextAttr ) ;
  308.     FastWrite( BlankLine, 12, 1, TextAttr ) ;
  309.     FastWrite( BlankLine, 13, 1, TextAttr ) ;
  310.     FastWrite( BlankLine, 15, 1, TextAttr ) ;
  311.     case ch of
  312.       '0' : done := true ;
  313.       '1' : GetRange( LowerLimit, UpperLimit, DispLower, DispUpper ) ;
  314.       '2' : ShowHist( false ) ;
  315.       '3' : ShowHist( true ) ;
  316.     end; {case}
  317.   until done ;
  318. end; { procedure ShowProfile  }
  319.