heaph.inc 3.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by the Free Pascal development team
  5. Heap manager interface section
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. { Memorymanager }
  13. type
  14. PMemoryManager = ^TMemoryManager;
  15. TMemoryManager = record
  16. Getmem : Function(Size:Longint):Pointer;
  17. Freemem : Function(var p:pointer):Longint;
  18. FreememSize : Function(var p:pointer;Size:Longint):Longint;
  19. AllocMem : Function(Size:longint):Pointer;
  20. ReAllocMem : Function(var p:pointer;Size:longint):Pointer;
  21. MemSize : function(p:pointer):Longint;
  22. MemAvail : Function:Longint;
  23. MaxAvail : Function:Longint;
  24. HeapSize : Function:Longint;
  25. end;
  26. procedure GetMemoryManager(var MemMgr: TMemoryManager);
  27. procedure SetMemoryManager(const MemMgr: TMemoryManager);
  28. function IsMemoryManagerSet: Boolean;
  29. { Variables }
  30. const
  31. growheapsize1 : longint=256*1024; { < 256k will grow with 256k }
  32. growheapsize2 : longint=1024*1024; { > 256k will grow with 1m }
  33. ReturnNilIfGrowHeapFails : boolean = false;
  34. var
  35. heaporg,heapptr,heapend,heaperror,freelist : pointer;
  36. { Default MemoryManager functions }
  37. Function SysGetmem(Size:Longint):Pointer;
  38. Function SysFreemem(var p:pointer):Longint;
  39. Function SysFreememSize(var p:pointer;Size:Longint):Longint;
  40. Function SysMemSize(p:pointer):Longint;
  41. Function SysAllocMem(size:longint):Pointer;
  42. function SysTryResizeMem(var p:pointer;size : longint):boolean;
  43. Function SysReAllocMem(var p:pointer;size:longint):Pointer;
  44. Function Sysmemavail:Longint;
  45. Function Sysmaxavail:Longint;
  46. Function Sysheapsize:longint;
  47. { Tp7 functions }
  48. Procedure Getmem(Var p:pointer;Size:Longint);
  49. Procedure Freemem(Var p:pointer;Size:Longint);
  50. Function memavail:Longint;
  51. Function maxavail:Longint;
  52. { FPC additions }
  53. Function MemSize(p:pointer):Longint;
  54. Function heapsize:longint;
  55. { Delphi functions }
  56. function GetMem(size:longint):pointer;
  57. function Freemem(var p:pointer):longint;
  58. function AllocMem(Size:Longint):pointer;
  59. function ReAllocMem(var p:pointer;Size:Longint):pointer;
  60. { Needed to solve overloading problem with call from assembler (PFV) }
  61. Procedure AsmGetmem(var p:pointer;size:Longint);
  62. Procedure AsmFreemem(var p:pointer);
  63. { Do nothing functions, are only here for tp7 compat }
  64. Procedure mark(var p : pointer);
  65. Procedure release(var p : pointer);
  66. {
  67. $Log$
  68. Revision 1.18 2000-04-07 21:10:35 pierre
  69. + ReturnNilIfGrowHeapFails used in objects unit
  70. to handle TMemoryStream out of memory properly
  71. as MaxAvail is not a good test anymore.
  72. Revision 1.17 2000/02/09 16:59:30 peter
  73. * truncated log
  74. Revision 1.16 2000/01/31 23:41:30 peter
  75. * reallocmem fixed for freemem() call when size=0
  76. Revision 1.15 2000/01/20 12:35:35 jonas
  77. * fixed problem with reallocmem and heaptrc
  78. Revision 1.14 2000/01/07 16:41:34 daniel
  79. * copyright 2000
  80. Revision 1.13 2000/01/07 16:32:24 daniel
  81. * copyright 2000 added
  82. Revision 1.12 1999/11/01 13:56:50 peter
  83. * freemem,reallocmem now get var argument
  84. Revision 1.11 1999/10/30 17:39:05 peter
  85. * memorymanager expanded with allocmem/reallocmem
  86. Revision 1.10 1999/09/17 17:14:12 peter
  87. + new heap manager supporting delphi freemem(pointer)
  88. }