home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tug__002 / stackuse.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-08-08  |  5.0 KB  |  142 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. Version 1.0. Author Richard S. Sadowsky. This unit, when used in a Turbo
  37. Pascal 4.0 program will automaticall report information about stack usage.
  38. This is very useful during program development. The following information
  39. is reported about the stack: total stack space, unused stack space and
  40. stack space used by your program.
  41.  
  42. * ASSOCIATED FILES
  43. STACKUSE.PAS
  44. TESTSTAC.PAS
  45.  
  46. * CHECKED BY
  47. DRM 08/08/88
  48.  
  49. * KEYWORDS
  50. TURBO PASCAL V4.0
  51.  
  52. ==========================================================================
  53. }
  54. {***********************************************************
  55.   StackUse - A unit to report stack usage information
  56.  
  57.   by Richard S. Sadowsky
  58.   version 1.0 7/18/88
  59.   released to the public domain
  60.  
  61.   Inspired by a idea by Kim Kokkonen.
  62.  
  63.   This unit, when used in a Turbo Pascal 4.0 program, will
  64.   automatically report information about stack usage.  This
  65.   is very useful during program development.  The following
  66.   information is reported about the stack:
  67.  
  68.   total stack space
  69.   Unused stack space
  70.   Stack spaced used by your program
  71.  
  72.   The unit's initialization code handles three things, it
  73.   figures out the total stack space, it initializes the
  74.   unused stack space to a known value, and it sets up an
  75.   ExitProc to automatically report the stack usage at
  76.   termination.  The total stack space is calculated by
  77.   adding 4 to the current stack pointer on entry into
  78.   the unit.  This works because on entry into a unit the
  79.   only thing on the stack is the 2 word (4 bytes) far
  80.   return value.  This is obviously version and compiler
  81.   specific.
  82.  
  83.   The ExitProc StackReport handles the math of calculating
  84.   the used and unused amount of stack space, and displays
  85.   this information.  Note that the original ExitProc
  86.   (Sav_ExitProc) is restored immediately on entry to
  87.   StackReport.  This is a good idea in ExitProc in case
  88.   a runtime (or I/O) error occurs in your ExitProc!
  89.  
  90.   I hope you find this unit as useful as I have!
  91.  
  92. ***********************************************************}
  93. {$R-,S-} { we don't need no stinkin range or stack checking! }
  94. unit StackUse;
  95.  
  96. interface
  97.  
  98. var
  99.   Sav_ExitProc     : Pointer; { to save the previous ExitProc }
  100.   StartSPtr        : Word;    { holds the total stack size    }
  101.  
  102. implementation
  103.  
  104. {$F+} { this is an ExitProc so it must be compiled as far }
  105. procedure StackReport;
  106.  
  107. { This procedure may take a second or two to execute, especially }
  108. { if you have a large stack. The time is spent examining the     }
  109. { stack looking for our init value ($AA). }
  110.  
  111. var
  112.   I                : Word;
  113.  
  114. begin
  115.   ExitProc := Sav_ExitProc; { restore original exitProc first }
  116.  
  117.   I := 0;
  118.   { step through stack from bottom looking for $AA, stop when found }
  119.   while I < SPtr do
  120.     if Mem[SSeg:I] <> $AA then begin
  121.       { found $AA so report the stack usage info }
  122.       WriteLn('total stack space : ',StartSPtr);
  123.       WriteLn('unused stack space: ', I);
  124.       WriteLn('stack space used  : ',StartSPtr - I);
  125.       I := SPtr; { end the loop }
  126.     end
  127.     else
  128.       inc(I); { look in next byte }
  129. end;
  130. {$F-}
  131.  
  132.  
  133. begin
  134.   StartSPtr := SPtr + 4; { on entry into a unit, only the FAR return }
  135.                          { address has been pushed on the stack.     }
  136.                          { therefore adding 4 to SP gives us the     }
  137.                          { total stack size. }
  138.   FillChar(Mem[SSeg:0], SPtr - 20, $AA); { init the stack   }
  139.   Sav_ExitProc := ExitProc;              { save exitproc    }
  140.   ExitProc     := @StackReport;          { set our exitproc }
  141. end.
  142.