home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ECO30603.ZIP / ECO30603.LZH / ECOLIBII / ECO_STAK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-08  |  8.2 KB  |  249 lines
  1. (*
  2.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  3.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  4.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  5.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  6.     ▓▓▓▓▓▓▓▓·──                                              ──·▓▓▓▓▓▓▓▓▓▓▓
  7.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  8.     ▓▓▓▓▓▓▓▓   Unit was conceived, designed and written         ░░▓▓▓▓▓▓▓▓▓
  9.     ▓▓▓▓▓▓▓▓   by Floor A.C. Naaijkens for                      ░░▓▓▓▓▓▓▓▓▓
  10.     ▓▓▓▓▓▓▓▓   UltiHouse Software / The ECO Group.              ░░▓▓▓▓▓▓▓▓▓
  11.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  12.     ▓▓▓▓▓▓▓▓   (C) MCMXCII by EUROCON PANATIONAL CORPORATION.   ░░▓▓▓▓▓▓▓▓▓
  13.     ▓▓▓▓▓▓▓▓   All Rights Reserved for The ECO Group.           ░░▓▓▓▓▓▓▓▓▓
  14.     ▓▓▓▓▓▓▓▓                                                    ░░▓▓▓▓▓▓▓▓▓
  15.     ▓▓▓▓▓▓▓▓│                                                  │░░▓▓▓▓▓▓▓▓▓
  16.     ▓▓▓▓▓▓▓▓·──                                              ──·░░▓▓▓▓▓▓▓▓▓
  17.     ▓▓▓▓▓▓▓▓▓▓░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░▓▓▓▓▓▓▓▓▓
  18.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  19.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  20.     ▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓
  21. *)
  22. {$S-,R-,I-,B-,D-,F-}
  23. unit eco_stak;
  24.   {-unit for monitoring stack and heap usage}
  25. interface
  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.  
  40. procedure calcstackusage(var stackusage : word; var heapusage : longint);
  41.   {-calculate stack and heap usage}
  42.  
  43. procedure showstackusage;
  44.   {-display stack and heap usage information}
  45.  
  46. {The next two routines are interfaced in case you need or want to deinstall the
  47.  INT $8 handler temporarily, as you might when using the Exec procedure in the
  48.  dos unit.}
  49.  
  50. procedure installint8;
  51.   {-save int $8 vector and install our isr, if not already installed}
  52.  
  53. procedure restoreint8;
  54.   {-restore the old int $8 handler if our isr is installed}
  55.  
  56. {The following routine allows you to alter the rate at which samples are taken.
  57.  For it to have any effect, it must be preceded by a call to RestoreInt8 and
  58.  followed by a call to installint8.}
  59.  
  60. procedure setsamplerate(rate : word);
  61.   {-set number of samples per second. default is 1165, minimum is 18.}
  62.  
  63.   {==========================================================================}
  64.  
  65. implementation
  66.  
  67. type
  68.   segofs =                   {structure of a 32-bit pointer}
  69.     record
  70.       offset, segment : word;
  71.     end;
  72. const
  73.   int8installed : boolean = false;  {true if our int $8 handler is installed}
  74.   defaultrate = 1024;        {corresponds to 1165 samples/second}
  75. var
  76.   saveint8 : ^pointer;       {pointer to original int $8 vector}
  77.   saveexitproc : pointer;    {saved value for exitproc}
  78.   vectors : array[0..$ff] of pointer absolute $0:$0;
  79.   rate8253,
  80.   counts,
  81.   countspertick : word;
  82.  
  83.   procedure intsoff;
  84.     {-turn off cpu interrupts}
  85.   inline($fa);
  86.  
  87.   procedure intson;
  88.     {-turn on cpu interrupts}
  89.   inline($fb);
  90.  
  91.   {$L ECO_STAK.OBJ}
  92.  
  93.   procedure actualsaveint8;
  94.     {-actually a pointer variable in cs}
  95.     external {tpstack} ;
  96.  
  97.   procedure int8;
  98.     {-interrupt service routine used to monitor stack and heap usage}
  99.     external {tpstack} ;
  100.  
  101.   procedure settimerrate(rate : word);
  102.     {-program system 8253 timer number 0 to run at specified rate}
  103.   begin                      {settimerrate}
  104.     intsoff;
  105.     port[$43] := $36;
  106.     port[$40] := lo(rate);
  107.     inline($eb/$00);         {null jump}
  108.     port[$40] := hi(rate);
  109.     intson;
  110.   end;                       {settimerrate}
  111.  
  112.   procedure installint8;
  113.     {-save int $8 vector and install our isr, if not already installed}
  114.   begin                      {installint8}
  115.     {make sure we're not already installed, in case we are called twice.
  116.      if we don't do this check, SaveInt8 could get pointed to *our* ISR}
  117.     if not int8installed then begin
  118.       {save the current vector}
  119.       saveint8^ := vectors[$8];
  120.  
  121.       {set counts til next system timer tick}
  122.       counts := 0;
  123.  
  124.       {keep interrupts off}
  125.       intsoff;
  126.  
  127.       {take over the timer tick}
  128.       vectors[$8] := @int8;
  129.  
  130.       {reprogram the timer to run at the new rate}
  131.       settimerrate(rate8253);
  132.  
  133.       {restore interrupts}
  134.       intson;
  135.  
  136.       {now we're installed}
  137.       int8installed := true;
  138.     end;
  139.   end;                       {installint8}
  140.  
  141.   procedure restoreint8;
  142.     {-restore the old int $8 handler if our isr is installed}
  143.   begin                      {restoreint8}
  144.     {if we're currently installed, then deinstall}
  145.     if int8installed then begin
  146.       {no more samples}
  147.       intsoff;
  148.  
  149.       {give back the timer interrupt}
  150.       vectors[$8] := saveint8^;
  151.  
  152.       {reprogram the clock to run at normal rate}
  153.       settimerrate(0);
  154.  
  155.       {normal interrupts again}
  156.       intson;
  157.  
  158.       {no longer installed}
  159.       int8installed := false;
  160.     end;
  161.   end;                       {restoreint8}
  162.  
  163.   procedure setsamplerate(rate : word);
  164.     {-set number of samples per second. default is 1165, minimum is 18.}
  165.   var
  166.     disable : boolean;
  167.   begin                      {setsamplerate}
  168.     if (rate >= 18) then begin
  169.       {deactivate int8 temporarily if necessary}
  170.       disable := int8installed;
  171.       if disable then
  172.         restoreint8;
  173.  
  174.       rate8253 := longint($123400) div longint(rate);
  175.       countspertick := longint($10000) div longint(rate8253);
  176.  
  177.       {reactivate int8 if necessary}
  178.       if disable then
  179.         installint8;
  180.     end;
  181.   end;                       {setsamplerate}
  182.  
  183.   procedure calcstackusage(var stackusage : word; var heapusage : longint);
  184.     {-calculate stack and heap usage}
  185.   begin                      {calcstackusage}
  186.     {calculate stack usage}
  187.     stackusage := initialsp-lowestsp;
  188.  
  189.     {calculate heap usage}
  190.     heapusage :=
  191.       (longint(segofs(heaphigh).segment-segofs(heaporg).segment) * 16) +
  192.        longint(segofs(heaphigh).offset-segofs(heaporg).offset);
  193.   end;                       {calcstackusage}
  194.  
  195.   procedure showstackusage;
  196.     {-display stack and heap usage information}
  197.   var
  198.     stackusage : word;
  199.     heapusage : longint;
  200.   begin                      {showstackusage}
  201.     {calculate stack and heap usage}
  202.     calcstackusage(stackusage, heapusage);
  203.  
  204.     {show them}
  205.     writeln('Stack usage: ', stackusage, ' bytes.');
  206.     writeln('Heap usage:  ', heapusage, ' bytes.');
  207.   end;                       {showstackusage}
  208.  
  209.   {$F+}  {Don't forget that exit handlers are always called FAR!}
  210.   procedure ourexitproc;
  211.     {-deinstalls our int $8 handler and reports stack/heap usage}
  212.   begin                      {ourexitproc}
  213.     {restore exitproc}
  214.     exitproc := saveexitproc;
  215.  
  216.     {restore int $8}
  217.     restoreint8;
  218.  
  219.     {show results if desired}
  220.     if reportstackusage then
  221.       showstackusage;
  222.   end;                       {ourexitproc}
  223.   {$F-}
  224.  
  225. begin                        {tpstack}
  226.   {initialize saveint8}
  227.   saveint8 := @actualsaveint8;
  228.  
  229.   {initialize rate8253 and countspertick}
  230.   setsamplerate(defaultrate);
  231.  
  232.   {save current value for ss}
  233.   ourss := sseg;
  234.  
  235.   {save current value of sp and account for the return address on the stack}
  236.   initialsp := sptr+sizeof(pointer);
  237.   lowestsp := initialsp;
  238.  
  239.   {save current position of heapptr}
  240.   heaphigh := heapptr;
  241.  
  242.   {install our isr}
  243.   installint8;
  244.  
  245.   {save exitproc and install our exit handler}
  246.   saveexitproc := exitproc;
  247.   exitproc := @ourexitproc;
  248. end.                         {tpstack}
  249.