home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / bpos2tv.zip / OMEMORY.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-07  |  2KB  |  88 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal for Windows Run-time Library       }
  5. {       ObjectWindows Unit                              }
  6. {                                                       }
  7. {       Copyright (c) 1991 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit OMemory;
  12.  
  13. interface
  14.  
  15. const
  16.   SafetyPoolSize: Word = 8192;
  17.  
  18. procedure InitMemory;
  19. procedure DoneMemory;
  20. function LowMemory: Boolean;
  21. procedure RestoreMemory;
  22. function MemAlloc(Size: Word): Pointer;
  23. function MemAllocSeg(Size: Word): Pointer;
  24.  
  25. implementation
  26.  
  27. uses OS2Def, BSEDos;
  28.  
  29. const
  30.   SafetyPool: Pointer = nil;
  31.   DisablePool: Boolean = False;
  32.  
  33. function LowMemory: Boolean;
  34. begin
  35.   LowMemory := SafetyPool = nil;
  36. end;
  37.  
  38. procedure RestoreMemory;
  39. begin
  40.   if LowMemory then
  41.     GetMem(SafetyPool, SafetyPoolSize);
  42. end;
  43.  
  44. function MemAlloc(Size: Word): Pointer;
  45. var
  46.   Tmp: Pointer;
  47. begin
  48.   DisablePool := True;
  49.   GetMem(Tmp, Size);
  50.   MemAlloc := Tmp;
  51.   DisablePool := False;
  52. end;
  53.  
  54. function MemAllocSeg(Size: Word): Pointer;
  55. var
  56.   Selector : SEL;
  57. begin
  58.   DosAllocSeg(Size, @Selector, 0);
  59.   DosLockSeg(Selector);
  60.   MemAllocSeg := Ptr(Selector, 0);
  61. end;
  62.  
  63. function HeapFunc(Size: Word): Integer; far;
  64. begin
  65.   if Size <> 0 then
  66.     if DisablePool then HeapFunc := 1
  67.     else if LowMemory then HeapFunc := 0
  68.     else
  69.     begin
  70.       FreeMem(SafetyPool, SafetyPoolSize);
  71.       SafetyPool := nil;
  72.       HeapFunc := 2;
  73.     end;
  74. end;
  75.  
  76. procedure InitMemory;
  77. begin
  78.   RestoreMemory;
  79.   HeapError := @HeapFunc;
  80. end;
  81.  
  82. procedure DoneMemory;
  83. begin
  84.   FreeMem(SafetyPool, SafetyPoolSize);
  85.   SafetyPool := nil;
  86. end;
  87.  
  88. end.