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