home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / CLEARMEM.ZIP / CLEARMEM.PAS
Encoding:
Pascal/Delphi Source File  |  1991-06-06  |  3.7 KB  |  136 lines
  1. (*
  2.  
  3. CLEARMEM - A Turbo Pascal unit to automatically initialize the heap, stack, or
  4. data segment to a fixed value.
  5.  
  6. Written by D.J. Murdoch for the public domain.
  7.  
  8. Interface:
  9.  
  10.   const
  11.     filler : byte = 0;
  12.  
  13. This byte is used as the initial value.  A good choice for turning up
  14. uninitialized variables is $FF - this will often cause a range check, and will
  15. cause runtime error 207 if you try to use an uninitialized single, double or
  16. extended.
  17.  
  18.   procedure clear_heap;
  19.  
  20. This procedure fills the heap with filler bytes.  Automatically called in the
  21. initialization section.
  22.  
  23.   procedure clear_globals;
  24.  
  25. This procedure fills all global variables (except those in the system unit) with
  26. filler bytes.  Very dangerous!  *Not* called in the initialization section
  27. (unless you change it).  Written for TP 6.0; the source code gives hints on how
  28. to change it for other versions.
  29.  
  30.   procedure clear_stack;
  31.  
  32. This procedure fills the unused part of the stack with filler bytes.
  33.  
  34. SAFETY
  35.  
  36. It's safe to call clear_heap any time; it'll fill all free blocks of 6 bytes or
  37. more on the heap with the filler byte.  It won't necessarily do a perfect fill
  38. if the heap is fragmented, because the free list will overwrite the filler.
  39.  
  40. It's also safe to call clear_stack any time, but is a bit less effective.  Any
  41. interrupts that happen after your call will mess up the stack that you've just
  42. cleared, so local variables won't necessarily be properly initialized.  It
  43. doesn't touch anything already allocated.
  44.  
  45. It's definitely *NOT* safe to call clear_globals any time except at the very
  46. beginning of your program, and only then from the initialization section of this
  47. unit, and only if this is the very first unit that you Use in the main program.
  48.  
  49. *)
  50.  
  51.   unit clearmem;
  52.  
  53.   { Unit to clear all memory to a fixed value at the start of the program }
  54.   { Written by D.J. Murdoch for the public domain. }
  55.  
  56.   interface
  57.  
  58.   const
  59.     filler : byte = 0;
  60.  
  61.   procedure clear_heap;
  62.  
  63.   procedure clear_globals;
  64.  
  65.   procedure clear_stack;
  66.  
  67.   implementation
  68.  
  69.   type
  70.     block_rec_ptr = ^block_rec;
  71.     block_rec = record
  72.       next : block_rec_ptr;
  73.       size : word;
  74.     end;
  75.  
  76.   procedure clear_heap;
  77.   var
  78.     prev,
  79.     current : block_rec_ptr;
  80.     howmuch : word;
  81.   begin
  82.     { First grab as much as possible and link it into a list }
  83.     prev := nil;
  84.     while maxavail >= sizeof(block_rec)  do
  85.     begin
  86.       if maxavail < 65520 then
  87.         howmuch := maxavail
  88.       else
  89.         howmuch := 65520;
  90.       getmem(current,howmuch);
  91.       current^.next := prev;
  92.       current^.size := howmuch;
  93.       prev := current;
  94.     end;
  95.  
  96.     { Now fill all those blocks with filler }
  97.     while prev <> nil do
  98.     begin
  99.       current := prev;
  100.       prev := current^.next;
  101.       howmuch := current^.size;
  102.       fillchar(current^,howmuch,filler);
  103.       freemem(current,howmuch);
  104.     end;
  105.   end;
  106.  
  107.   procedure clear_globals;
  108.   var
  109.     where : pointer;
  110.     howmuch : word;
  111.   begin
  112.     where := @test8087;                { The last const in the system unit }
  113.     inc(word(where),sizeof(test8087)); { Just past that }
  114.     howmuch := ofs(input)              { The first var in the system unit }
  115.                - ofs(where^);
  116.     fillchar(where^,howmuch,filler);
  117.   end;
  118.  
  119.   procedure clear_stack;
  120.   var
  121.     where : pointer;
  122.     howmuch : word;
  123.   begin
  124.     where := ptr(sseg,stacklimit);
  125.     howmuch := sptr-stacklimit-14;   { leave room for the fillchar parameters
  126.                                        and return address }
  127.     fillchar(where^,howmuch,filler);
  128.   end;
  129.  
  130.   begin
  131.     clear_heap;
  132.     clear_stack;
  133.     {  clear_globals;  }  { Uncomment this only if this unit is the first one
  134.                             in the main program's Uses list!!! }
  135.   end.
  136.