home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / MacBinary II+ 1.0.0 / source / MyMemory.unit < prev    next >
Encoding:
Text File  |  1992-11-19  |  1.6 KB  |  82 lines  |  [TEXT/PJMM]
  1. unit MyMemory;
  2.  
  3. interface
  4.  
  5. { These should really be changed to inlines }
  6.     procedure MDisposePtr (var p: univ ptr);
  7.     procedure MNewPtr (var p: univ ptr; size: longInt);
  8.     procedure MFillDisposePtr (var p: univ ptr);
  9.     procedure MFillNewPtr (var p: univ ptr; size: longInt);
  10.     procedure MFill (p: univ ptr; size: longInt; val: integer);
  11.     procedure MFillLong (p: univ ptr; size: longInt; val: longInt);
  12. { ptr and size must be long alligned }
  13.  
  14. implementation
  15.  
  16.     const
  17.         fill_byte = $E5; { odd, big, negative, easily recognizable }
  18.  
  19.     function CheckPtr (p: ptr): boolean;
  20.     begin
  21.         if p = nil then
  22.             DebugStr('Memory Error!');
  23.         CheckPtr := p <> nil;
  24.     end;
  25.  
  26.     procedure MDisposePtr (var p: univ ptr);
  27.     begin
  28.         if CheckPtr(p) then begin
  29.             DisposPtr(p);
  30.         end;
  31.         p := nil;
  32.     end;
  33.  
  34.     procedure MNewPtr (var p: univ ptr; size: longInt);
  35.     begin
  36.         p := NewPtr(size);
  37.     end;
  38.  
  39.     procedure MFillDisposePtr (var p: univ ptr);
  40.     begin
  41.         if CheckPtr(p) then begin
  42.             MFill(p, GetPtrSize(p), fill_byte);
  43.             DisposPtr(p);
  44.         end;
  45.         p := nil;
  46.     end;
  47.  
  48.     procedure MFillNewPtr (var p: univ ptr; size: longInt);
  49.     begin
  50.         p := NewPtr(size);
  51.         if p <> nil then
  52.             MFill(p, GetPtrSize(p), fill_byte);
  53.     end;
  54.  
  55.     procedure MFill (p: univ ptr; size: longInt; val: integer);
  56.         var
  57.             i: longInt;
  58.     begin
  59.         if CheckPtr(p) then begin
  60.             for i := longInt(p) to longInt(p) + size - 1 do begin
  61.                 ptr(i)^ := val;
  62.             end;
  63.         end;
  64.     end;
  65.  
  66.     procedure MFillLong (p: univ ptr; size: longInt; val: longInt);
  67.         type
  68.             longPtr = ^longInt;
  69.         var
  70.             i: longInt;
  71.     begin
  72.         if CheckPtr(p) then begin
  73.             i := longInt(p);
  74.             while size > 3 do begin
  75.                 longPtr(i)^ := val;
  76.                 i := i + 4;
  77.                 size := size - 4;
  78.             end;
  79.         end;
  80.     end;
  81.  
  82. end.