home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / overinit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-11-04  |  5.3 KB  |  160 lines
  1. unit overinit;
  2. {$F+,O-}
  3.  
  4. INTERFACE
  5.  
  6. function heapfunc(size: word): integer;
  7.  
  8.  
  9. {ShrinkOverlay:  Free memory by dynamically reducing overlay buffer
  10.                 during program execution. "Robbing Peter to pay Paul"
  11.  
  12. Steve Safigan 8/14/90  CompuServe ID 72251,2274
  13. Universal Tax Systems, Inc.
  14. 102 Margo Trail
  15. Rome, GA  30161
  16. (404) 232-7757
  17.  
  18. Donated to the public domain.
  19. Thanks to Kim Kokonen for providing direction.
  20. Thanks to ????? for upgrading to version 6.0 and for the HEAPERROR hook.
  21.  
  22. The most common means of reducing run-time memory requirements is by using
  23. overlays.  This presents a paradox, because the overlay buffer must be
  24. fixed at program startup, reducing total free memory.  The programmer is
  25. usually forced to define the smallest overlay buffer he (she) can get away
  26. with in order to leave enough room for dynamic variables.  This slows
  27. program performance as the program has to swap code into and out of the
  28. overlay buffer often.
  29.  
  30. A better solution is to start the program with a very large overlay buffer
  31. to reduce swapping.  As the program requires more dynamic memory, the
  32. boundary between the overlay buffer and the heap can be adjusted to provide
  33. more memory to the heap, and less to the overlay buffer.  Eventually,
  34. the overlay buffer may be reduced to a minimum size.  At this point, the
  35. program may be thrashing terribly, but it may be more acceptable than
  36. running out of memory completely.
  37.  
  38. Unfortunately, TP does not support changing the overlay buffer size
  39. after any variables are allocated.  But the routine ShrinkOverlay does.
  40. It works by clearing the overlay buffer, changing the boundary between the
  41. overlay buffer and the heap, then adding a free list entry to the heap.
  42.  
  43. ShrinkOverlay may be called explicitly by your program, or it may be called
  44. explicitly by a HEAPERROR routine when your program runs out of heap
  45. space.  If you call ShrinkOverlay explicitly, it must take the following
  46. form:
  47.  
  48.    MEMORY_AMT := $8000
  49.    IF MAXAVAIL < $8000 THEN ShrinkOverlay(MEMORY_AMT);
  50.  
  51. MEMORY_AMT is the amount of memory to rob from the overlay buffer.  It
  52. must be passed via a variable, because ShrinkOverlay returns the
  53. amount of memory actually freed.  If the overlay buffer is already at
  54. its minimum size, or if no heap free list entries are available,
  55. ShrinkOverlay returns 0.  The maximum amount of memory freed in a single
  56. call to ShrinkOverlay is 64K.  ShrinkOverlay will round the memory freed
  57. to the next higher multiple of 16 bytes, so that it frees an even
  58. number of paragraphs.
  59.  
  60. You may instead wish to use the supplied HEAPFUNC in order to invoke
  61. ShrinkOverlay automatically when the heap runs out of space.  In order
  62. to use heapfunc, you must include the following line in your main
  63. program:
  64.  
  65.    heaperror := @heapfunc;
  66.  
  67. This replaces TP's standard heap error handling routine with HEAPFUNC.
  68.  
  69.  
  70. Although calling ShrinkOverlay is as simple as that, there are a few
  71. additional steps needed in order to initialize.  The sample unit OVERINIT
  72. shows initializing the memory buffer in preparation for ShrinkOverlay.
  73. Since this unit initializes the overlay buffer, it should appear first
  74. in your USES clause.  You may replace the overlay initialization section
  75. with your own.
  76.  
  77. The variable MinimumOverlay must be initialized to the minimum overlay
  78. buffer size your program will accept.  This value must not be less than
  79. the initial value of OVRGETBUF, or you will not be able to fit your
  80. largest overlayed unit into the overlay buffer.
  81.  
  82. This version was submitted to me as an upgrade to my TP5.5 Version.
  83. Regrettably, I have thrown out the fax I received listing the author of
  84. this version!  If the author would like to identify himself, I would be
  85. happy to give him full credit.
  86.  
  87. If anybody has any corrections or enhancements to ShrinkOverlay, contact
  88. me at the above address.  Although it seems to work fine on my machine,
  89. I can't warrant that it will work properly in all environments.  I'm
  90. looking for an implementation that would reverse this routine and restore
  91. the overlay buffer to its original size.  Any ideas?}
  92.  
  93. IMPLEMENTATION
  94.  
  95. uses
  96.   overlay;
  97.  
  98. type
  99.   linktype = record
  100.     next: pointer;
  101.     bytes: word;
  102.     paragraphs: word;
  103.   end;
  104.  
  105.   os = record
  106.     o,s: word;
  107.   end;
  108.  
  109. var
  110.   minimumoverlay: longint;
  111.  
  112. procedure shrinkoverlay(var size: word);
  113. var
  114.   tempsize: word;
  115.   work: linktype;
  116. begin
  117.   if ovrgetbuf - size < minimumoverlay then
  118.     size := ovrgetbuf - minimumoverlay;
  119.   size := size - (size mod 16);
  120.   if size > 0 then
  121.   begin
  122.     tempsize := size div 16;
  123.     ovrclearbuf;
  124.     dec(ovrheapend,tempsize);
  125.     os(heaporg).s := ovrheapend;
  126.     os(heaporg).o := 0;
  127.     work.next := freelist;
  128.     work.paragraphs := tempsize;
  129.     work.bytes := 0;
  130.     move(work,heaporg^,8);
  131.     freelist := heaporg;
  132.     if ovrgetretry > ovrgetbuf then
  133.       ovrsetretry(ovrgetbuf div 3);
  134.   end;
  135. end;
  136.  
  137. function heapfunc(size: word): integer;
  138. var
  139.   x: word;
  140. begin
  141.   if size > 0 then
  142.   begin
  143.     x := size + 16;
  144.     if maxavail < size then
  145.       shrinkoverlay(x)
  146.     else
  147.       x := 0;
  148.     if x < size then
  149.       heapfunc := 0
  150.     else
  151.       heapfunc := 2;
  152.   end;
  153. end;
  154.  
  155.  
  156. begin
  157.   minimumoverlay := ovrgetbuf;
  158.   ovrsetbuf(ovrgetbuf + $F000);  {set your own value here}
  159.   ovrsetretry(ovrgetbuf div 3);
  160. end.