home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / progpas / opstack.arj / OPSTACK.PAS < prev   
Pascal/Delphi Source File  |  1990-01-15  |  8KB  |  261 lines
  1. {$S-,R-,I-,B-,D-}
  2.  
  3. {*********************************************************}
  4. {*                   OPSTACK.PAS 1.00                    *}
  5. {*                by TurboPower Software                 *}
  6. {*********************************************************}
  7.  
  8. unit OpStack;
  9.   {-Unit for monitoring stack and heap usage}
  10.  
  11. interface
  12.  
  13. const
  14.   {If True, results are reported automatically at the end of the program. Set
  15.    to False if you want to display results in another manner.}
  16.   ReportStackUsage : Boolean = True;
  17.  
  18. var
  19.   {The following variables, like the two procedures that follow, are interfaced
  20.    solely for the purpose of displaying results. You should never alter any of
  21.    these variables.}
  22.   OurSS : Word;              {value of SS register when program began}
  23.   InitialSP : Word;          {value of SP register when program began}
  24.   LowestSP : Word;           {lowest value for SP register}
  25.   HeapHigh : Pointer;        {highest address pointed to by HeapPtr}
  26.   FreePtrLow : Word;         {lowest address pointed to by FreePtr}
  27.  
  28. procedure CalcStackUsage(var StackUsage : Word;   {stack}
  29.                          var HeapUsage : LongInt; {heap}
  30.                          var FreeUsage : Word;    {free list}
  31.                          var MemUsage : LongInt); {total}
  32.   {-Calculate stack and heap usage}
  33.  
  34. procedure ShowStackUsage;
  35.   {-Display stack and heap usage information}
  36.  
  37. {The next two routines are interfaced in case you need or want to deinstall the
  38.  INT $8 handler temporarily, as you might when using the Exec procedure in the
  39.  DOS unit.}
  40.  
  41. procedure InstallInt8;
  42.   {-Save INT $8 vector and install our ISR, if not already installed}
  43.  
  44. procedure RestoreInt8;
  45.   {-Restore the old INT $8 handler if our ISR is installed}
  46.  
  47. {The following routine allows you to alter the rate at which samples are taken.
  48.  For it to have any effect, it must be preceded by a call to RestoreInt8 and
  49.  followed by a call to InstallInt8.}
  50.  
  51. procedure SetSampleRate(Rate : Word);
  52.   {-Set number of samples per second. Default is 1165, minimum is 18.}
  53.  
  54.   {==========================================================================}
  55.  
  56. implementation
  57.  
  58. type
  59.   SegOfs =                   {structure of a 32-bit pointer}
  60.     record
  61.       Offset, Segment : Word;
  62.     end;
  63. const
  64.   Int8Installed : Boolean = False;  {True if our INT $8 handler is installed}
  65.   DefaultRate = 1024;        {corresponds to 1165 samples/second}
  66. var
  67.   SaveInt8 : ^Pointer;       {pointer to original INT $8 vector}
  68.   SaveExitProc : Pointer;    {saved value for ExitProc}
  69.   Vectors : array[0..$FF] of Pointer absolute $0:$0;
  70.   Rate8253,
  71.   Counts,
  72.   CountsPerTick : Word;
  73.  
  74.   procedure IntsOff;
  75.     {-Turn off CPU interrupts}
  76.   inline($FA);
  77.  
  78.   procedure IntsOn;
  79.     {-Turn on CPU interrupts}
  80.   inline($FB);
  81.  
  82.   {$L OPSTACK.OBJ}
  83.  
  84.   procedure ActualSaveInt8;
  85.     {-Actually a pointer variable in CS}
  86.     external {OPSTACK} ;
  87.  
  88.   procedure Int8;
  89.     {-Interrupt service routine used to monitor stack and heap usage}
  90.     external {OPSTACK} ;
  91.  
  92.   procedure SetTimerRate(Rate : Word);
  93.     {-Program system 8253 timer number 0 to run at specified rate}
  94.   begin
  95.     IntsOff;
  96.     Port[$43] := $36;
  97.     Port[$40] := Lo(Rate);
  98.     inline($EB/$00);         {null jump}
  99.     Port[$40] := Hi(Rate);
  100.     IntsOn;
  101.   end;
  102.  
  103.   procedure InstallInt8;
  104.     {-Save INT $8 vector and install our ISR, if not already installed}
  105.   begin
  106.     {make sure we're not already installed, in case we are called twice.
  107.      if we don't do this check, SaveInt8 could get pointed to *our* ISR}
  108.     if not Int8Installed then begin
  109.       {save the current vector}
  110.       SaveInt8^ := Vectors[$8];
  111.  
  112.       {Set counts til next system timer tick}
  113.       Counts := 0;
  114.  
  115.       {Keep interrupts off}
  116.       IntsOff;
  117.  
  118.       {Take over the timer tick}
  119.       Vectors[$8] := @Int8;
  120.  
  121.       {Reprogram the timer to run at the new rate}
  122.       SetTimerRate(Rate8253);
  123.  
  124.       {restore interrupts}
  125.       IntsOn;
  126.  
  127.       {now we're installed}
  128.       Int8Installed := True;
  129.     end;
  130.   end;
  131.  
  132.   procedure RestoreInt8;
  133.     {-Restore the old INT $8 handler if our ISR is installed}
  134.   begin
  135.     {if we're currently installed, then deinstall}
  136.     if Int8Installed then begin
  137.       {no more samples}
  138.       IntsOff;
  139.  
  140.       {Give back the timer interrupt}
  141.       Vectors[$8] := SaveInt8^;
  142.  
  143.       {Reprogram the clock to run at normal rate}
  144.       SetTimerRate(0);
  145.  
  146.       {Normal interrupts again}
  147.       IntsOn;
  148.  
  149.       {no longer installed}
  150.       Int8Installed := False;
  151.     end;
  152.   end;
  153.  
  154.   procedure SetSampleRate(Rate : Word);
  155.     {-Set number of samples per second. Default is 1165, minimum is 18.}
  156.   var
  157.     Disable : Boolean;
  158.   begin
  159.     if (Rate >= 18) then begin
  160.       {deactivate Int8 temporarily if necessary}
  161.       Disable := Int8Installed;
  162.       if Disable then
  163.         RestoreInt8;
  164.  
  165.       Rate8253 := LongInt($123400) div LongInt(Rate);
  166.       CountsPerTick := LongInt($10000) div LongInt(Rate8253);
  167.  
  168.       {reactivate Int8 if necessary}
  169.       if Disable then
  170.         InstallInt8;
  171.     end;
  172.   end;
  173.  
  174.   procedure CalcStackUsage(var StackUsage : Word;
  175.                            var HeapUsage : LongInt;
  176.                            var FreeUsage : Word;    {free list}
  177.                            var MemUsage : LongInt);
  178.     {-Calculate stack and heap usage}
  179.   begin
  180.     {calculate stack usage}
  181.     StackUsage := InitialSP-LowestSP;
  182.  
  183.     {calculate heap usage}
  184.     HeapUsage :=
  185.       (LongInt(SegOfs(HeapHigh).Segment-SegOfs(HeapOrg).Segment) * 16) +
  186.        LongInt(SegOfs(HeapHigh).Offset-SegOfs(HeapOrg).Offset);
  187.  
  188.     {calculate free list usage}
  189.     if FreePtrLow = $FFFF then
  190.       FreeUsage := 0
  191.     else
  192.       FreeUsage := $10000-LongInt(FreePtrLow);
  193.  
  194.     {calculate total memory usage}
  195.     MemUsage :=
  196.       (LongInt(SegOfs(HeapHigh).Segment-PrefixSeg) * 16) +
  197.       SegOfs(HeapHigh).Offset;
  198.   end;
  199.  
  200.   procedure ShowStackUsage;
  201.     {-Display stack and heap usage information}
  202.   var
  203.     StackUsage : Word;
  204.     HeapUsage : LongInt;
  205.     FreeUsage : Word;
  206.     MemUsage : LongInt;
  207.   begin
  208.     {calculate stack and heap usage}
  209.     CalcStackUsage(StackUsage, HeapUsage, FreeUsage, MemUsage);
  210.  
  211.     {show them}
  212.     WriteLn('Stack usage:     ', StackUsage, ' bytes.');
  213.     WriteLn('Heap usage:      ', HeapUsage, ' bytes.');
  214.     WriteLn('Free list usage: ', FreeUsage, ' bytes.');
  215.     WriteLn('Memory usage:    ', MemUsage, ' bytes.');
  216.   end;
  217.  
  218.   {$F+}  {Don't forget that exit handlers are always called FAR!}
  219.   procedure OurExitProc;
  220.     {-Deinstalls our INT $8 handler and reports stack/heap usage}
  221.   begin
  222.     {restore ExitProc}
  223.     ExitProc := SaveExitProc;
  224.  
  225.     {restore INT $8}
  226.     RestoreInt8;
  227.  
  228.     {show results if desired}
  229.     if ReportStackUsage then
  230.       ShowStackUsage;
  231.   end;
  232.   {$F-}
  233.  
  234. begin
  235.   {initialize SaveInt8}
  236.   SaveInt8 := @ActualSaveInt8;
  237.  
  238.   {initialize Rate8253 and CountsPerTick}
  239.   SetSampleRate(DefaultRate);
  240.  
  241.   {save current value for SS}
  242.   OurSS := SSeg;
  243.  
  244.   {save current value of SP and account for the return address on the stack}
  245.   InitialSP := SPtr+SizeOf(Pointer);
  246.   LowestSP := InitialSP;
  247.  
  248.   {save current position of HeapPtr}
  249.   HeapHigh := HeapPtr;
  250.  
  251.   {initialize FreePtrLow}
  252.   FreePtrLow := $FFFF;
  253.  
  254.   {install our ISR}
  255.   InstallInt8;
  256.  
  257.   {save ExitProc and install our exit handler}
  258.   SaveExitProc := ExitProc;
  259.   ExitProc := @OurExitProc;
  260. end.
  261.