home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tug__002 / tpstack.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-08  |  8.8 KB  |  287 lines
  1. {TUG PDS CERT 1.01 (Pascal)
  2.  
  3. ==========================================================================
  4.  
  5.                   TUG PUBLIC DOMAIN SOFTWARE CERTIFICATION
  6.  
  7. The Turbo User Group (TUG) is recognized by Borland International as the
  8. official support organization for Turbo languages.  This file has been
  9. compiled and verified by the TUG library staff.  We are reasonably certain
  10. that the information contained in this file is public domain material, but
  11. it is also subject to any restrictions applied by its author.
  12.  
  13. This diskette contains PROGRAMS and/or DATA determined to be in the PUBLIC
  14. DOMAIN, provided as a service of TUG for the use of its members.  The
  15. Turbo User Group will not be liable for any damages, including any lost
  16. profits, lost savings or other incidental or consequential damages arising
  17. out of the use of or inability to use the contents, even if TUG has been
  18. advised of the possibility of such damages, or for any claim by any
  19. other party.
  20.  
  21. To the best of our knowledge, the routines in this file compile and function
  22. properly in accordance with the information described below.
  23.  
  24. If you discover an error in this file, we would appreciate it if you would
  25. report it to us.  To report bugs, or to request information on membership
  26. in TUG, please contact us at:
  27.  
  28.              Turbo User Group
  29.              PO Box 1510
  30.              Poulsbo, Washington USA  98370
  31.  
  32. --------------------------------------------------------------------------
  33.                        F i l e    I n f o r m a t i o n
  34.  
  35. * DESCRIPTION
  36. Unit for monitoring stack and heap usage.
  37.  
  38. * ASSOCIATED FILES
  39. TPSTACK.PAS
  40. TPSTACK.ASM
  41. TPSTACK.DOC
  42. TPSTACK.OBJ
  43.  
  44. * CHECKED BY
  45. DRM 08/08/88
  46.  
  47. * KEYWORDS
  48. TURBO PASCAL V4.0
  49.  
  50. ==========================================================================
  51. }
  52. {$S-,R-,I-,B-,D-,F-}
  53.  
  54. {*********************************************************}
  55. {*                   TPSTACK.PAS 1.00                    *}
  56. {*                by TurboPower Software                 *}
  57. {*********************************************************}
  58.  
  59. unit TpStack;
  60.   {-Unit for monitoring stack and heap usage}
  61.  
  62. interface
  63.  
  64. const
  65.   {If True, results are reported automatically at the end of the program. Set
  66.    to False if you want to display results in another manner.}
  67.   ReportStackUsage : Boolean = True;
  68.  
  69. var
  70.   {The following variables, like the two procedures that follow, are interfaced
  71.    solely for the purpose of displaying results. You should never alter any of
  72.    these variables.}
  73.   OurSS : Word;              {value of SS register when program began}
  74.   InitialSP : Word;          {value of SP register when program began}
  75.   LowestSP : Word;           {lowest value for SP register}
  76.   HeapHigh : Pointer;        {highest address pointed to by HeapPtr}
  77.  
  78. procedure CalcStackUsage(var StackUsage : Word; var HeapUsage : LongInt);
  79.   {-Calculate stack and heap usage}
  80.  
  81. procedure ShowStackUsage;
  82.   {-Display stack and heap usage information}
  83.  
  84. {The next two routines are interfaced in case you need or want to deinstall the
  85.  INT $8 handler temporarily, as you might when using the Exec procedure in the
  86.  DOS unit.}
  87.  
  88. procedure InstallInt8;
  89.   {-Save INT $8 vector and install our ISR, if not already installed}
  90.  
  91. procedure RestoreInt8;
  92.   {-Restore the old INT $8 handler if our ISR is installed}
  93.  
  94. {The following routine allows you to alter the rate at which samples are taken.
  95.  For it to have any effect, it must be preceded by a call to RestoreInt8 and
  96.  followed by a call to InstallInt8.}
  97.  
  98. procedure SetSampleRate(Rate : Word);
  99.   {-Set number of samples per second. Default is 1165, minimum is 18.}
  100.  
  101.   {==========================================================================}
  102.  
  103. implementation
  104.  
  105. type
  106.   SegOfs =                   {structure of a 32-bit pointer}
  107.     record
  108.       Offset, Segment : Word;
  109.     end;
  110. const
  111.   Int8Installed : Boolean = False;  {True if our INT $8 handler is installed}
  112.   DefaultRate = 1024;        {corresponds to 1165 samples/second}
  113. var
  114.   SaveInt8 : ^Pointer;       {pointer to original INT $8 vector}
  115.   SaveExitProc : Pointer;    {saved value for ExitProc}
  116.   Vectors : array[0..$FF] of Pointer absolute $0:$0;
  117.   Rate8253,
  118.   Counts,
  119.   CountsPerTick : Word;
  120.  
  121.   procedure IntsOff;
  122.     {-Turn off CPU interrupts}
  123.   inline($FA);
  124.  
  125.   procedure IntsOn;
  126.     {-Turn on CPU interrupts}
  127.   inline($FB);
  128.  
  129.   {$L TPSTACK.OBJ}
  130.  
  131.   procedure ActualSaveInt8;
  132.     {-Actually a pointer variable in CS}
  133.     external {TPSTACK} ;
  134.  
  135.   procedure Int8;
  136.     {-Interrupt service routine used to monitor stack and heap usage}
  137.     external {TPSTACK} ;
  138.  
  139.   procedure SetTimerRate(Rate : Word);
  140.     {-Program system 8253 timer number 0 to run at specified rate}
  141.   begin                      {SetTimerRate}
  142.     IntsOff;
  143.     Port[$43] := $36;
  144.     Port[$40] := Lo(Rate);
  145.     inline($EB/$00);         {null jump}
  146.     Port[$40] := Hi(Rate);
  147.     IntsOn;
  148.   end;                       {SetTimerRate}
  149.  
  150.   procedure InstallInt8;
  151.     {-Save INT $8 vector and install our ISR, if not already installed}
  152.   begin                      {InstallInt8}
  153.     {make sure we're not already installed, in case we are called twice.
  154.      if we don't do this check, SaveInt8 could get pointed to *our* ISR}
  155.     if not Int8Installed then begin
  156.       {save the current vector}
  157.       SaveInt8^ := Vectors[$8];
  158.  
  159.       {Set counts til next system timer tick}
  160.       Counts := 0;
  161.  
  162.       {Keep interrupts off}
  163.       IntsOff;
  164.  
  165.       {Take over the timer tick}
  166.       Vectors[$8] := @Int8;
  167.  
  168.       {Reprogram the timer to run at the new rate}
  169.       SetTimerRate(Rate8253);
  170.  
  171.       {restore interrupts}
  172.       IntsOn;
  173.  
  174.       {now we're installed}
  175.       Int8Installed := True;
  176.     end;
  177.   end;                       {InstallInt8}
  178.  
  179.   procedure RestoreInt8;
  180.     {-Restore the old INT $8 handler if our ISR is installed}
  181.   begin                      {RestoreInt8}
  182.     {if we're currently installed, then deinstall}
  183.     if Int8Installed then begin
  184.       {no more samples}
  185.       IntsOff;
  186.  
  187.       {Give back the timer interrupt}
  188.       Vectors[$8] := SaveInt8^;
  189.  
  190.       {Reprogram the clock to run at normal rate}
  191.       SetTimerRate(0);
  192.  
  193.       {Normal interrupts again}
  194.       IntsOn;
  195.  
  196.       {no longer installed}
  197.       Int8Installed := False;
  198.     end;
  199.   end;                       {RestoreInt8}
  200.  
  201.   procedure SetSampleRate(Rate : Word);
  202.     {-Set number of samples per second. Default is 1165, minimum is 18.}
  203.   var
  204.     Disable : Boolean;
  205.   begin                      {SetSampleRate}
  206.     if (Rate >= 18) then begin
  207.       {deactivate Int8 temporarily if necessary}
  208.       Disable := Int8Installed;
  209.       if Disable then
  210.         RestoreInt8;
  211.  
  212.       Rate8253 := LongInt($123400) div LongInt(Rate);
  213.       CountsPerTick := LongInt($10000) div LongInt(Rate8253);
  214.  
  215.       {reactivate Int8 if necessary}
  216.       if Disable then
  217.         InstallInt8;
  218.     end;
  219.   end;                       {SetSampleRate}
  220.  
  221.   procedure CalcStackUsage(var StackUsage : Word; var HeapUsage : LongInt);
  222.     {-Calculate stack and heap usage}
  223.   begin                      {CalcStackUsage}
  224.     {calculate stack usage}
  225.     StackUsage := InitialSP-LowestSP;
  226.  
  227.     {calculate heap usage}
  228.     HeapUsage :=
  229.       (LongInt(SegOfs(HeapHigh).Segment-SegOfs(HeapOrg).Segment) * 16) +
  230.        LongInt(SegOfs(HeapHigh).Offset-SegOfs(HeapOrg).Offset);
  231.   end;                       {CalcStackUsage}
  232.  
  233.   procedure ShowStackUsage;
  234.     {-Display stack and heap usage information}
  235.   var
  236.     StackUsage : Word;
  237.     HeapUsage : LongInt;
  238.   begin                      {ShowStackUsage}
  239.     {calculate stack and heap usage}
  240.     CalcStackUsage(StackUsage, HeapUsage);
  241.  
  242.     {show them}
  243.     WriteLn('Stack usage: ', StackUsage, ' bytes.');
  244.     WriteLn('Heap usage:  ', HeapUsage, ' bytes.');
  245.   end;                       {ShowStackUsage}
  246.  
  247.   {$F+}  {Don't forget that exit handlers are always called FAR!}
  248.   procedure OurExitProc;
  249.     {-Deinstalls our INT $8 handler and reports stack/heap usage}
  250.   begin                      {OurExitProc}
  251.     {restore ExitProc}
  252.     ExitProc := SaveExitProc;
  253.  
  254.     {restore INT $8}
  255.     RestoreInt8;
  256.  
  257.     {show results if desired}
  258.     if ReportStackUsage then
  259.       ShowStackUsage;
  260.   end;                       {OurExitProc}
  261.   {$F-}
  262.  
  263. begin                        {TpStack}
  264.   {initialize SaveInt8}
  265.   SaveInt8 := @ActualSaveInt8;
  266.  
  267.   {initialize Rate8253 and CountsPerTick}
  268.   SetSampleRate(DefaultRate);
  269.  
  270.   {save current value for SS}
  271.   OurSS := SSeg;
  272.  
  273.   {save current value of SP and account for the return address on the stack}
  274.   InitialSP := SPtr+SizeOf(Pointer);
  275.   LowestSP := InitialSP;
  276.  
  277.   {save current position of HeapPtr}
  278.   HeapHigh := HeapPtr;
  279.  
  280.   {install our ISR}
  281.   InstallInt8;
  282.  
  283.   {save ExitProc and install our exit handler}
  284.   SaveExitProc := ExitProc;
  285.   ExitProc := @OurExitProc;
  286. end.                         {TpStack}
  287.