1{
2    This file is part of the Free Pascal run time library.
3    Copyright (c) 1999-2000 by the Free Pascal development team
4
5    Heap manager interface section
6
7    See the file COPYING.FPC, included in this distribution,
8    for details about the copyright.
9
10    This program is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13
14 **********************************************************************}
15
16{ Memorymanager }
17type
18  TFPCHeapStatus = record
19    MaxHeapSize,
20    MaxHeapUsed,
21    CurrHeapSize,
22    CurrHeapUsed,
23    CurrHeapFree  : ptruint;
24  end;
25  THeapStatus = record
26    TotalAddrSpace: Cardinal;
27    TotalUncommitted: Cardinal;
28    TotalCommitted: Cardinal;
29    TotalAllocated: Cardinal;
30    TotalFree: Cardinal;
31    FreeSmall: Cardinal;
32    FreeBig: Cardinal;
33    Unused: Cardinal;
34    Overhead: Cardinal;
35    HeapErrorCode: Cardinal;
36  end;
37
38  PMemoryManager = ^TMemoryManager;
39  TMemoryManager = record
40    NeedLock            : boolean;   // Obsolete
41    Getmem              : Function(Size:ptruint):Pointer;
42    Freemem             : Function(p:pointer):ptruint;
43    FreememSize         : Function(p:pointer;Size:ptruint):ptruint;
44    AllocMem            : Function(Size:ptruint):Pointer;
45    ReAllocMem          : Function(var p:pointer;Size:ptruint):Pointer;
46    MemSize             : function(p:pointer):ptruint;
47    InitThread          : procedure;
48    DoneThread          : procedure;
49    RelocateHeap        : procedure;
50    GetHeapStatus       : function :THeapStatus;
51    GetFPCHeapStatus    : function :TFPCHeapStatus;
52  end;
53
54procedure GetMemoryManager(var MemMgr: TMemoryManager);
55procedure SetMemoryManager(const MemMgr: TMemoryManager);
56function  IsMemoryManagerSet: Boolean;
57
58{ Variables }
59const
60  MaxKeptOSChunks: DWord = 4; { if more than MaxKeptOSChunks are free, the heap manager will release
61                              chunks back to the OS }
62  growheapsizesmall : ptruint=32*1024; { fixed-size small blocks will grow with 32k }
63  growheapsize1 : ptruint=256*1024;  { < 256k will grow with 256k }
64  growheapsize2 : ptruint=1024*1024; { > 256k will grow with 1m }
65var
66  ReturnNilIfGrowHeapFails : boolean;
67
68{$ifdef EMBEDDED}
69  {$define FPC_NO_DEFAULT_MEMORYMANAGER}
70{$endif EMBEDDED}
71
72{$ifndef FPC_NO_DEFAULT_MEMORYMANAGER}
73{ Default MemoryManager functions }
74Function  SysGetmem(Size:ptruint):Pointer;
75Function  SysFreemem(p:pointer):ptruint;
76Function  SysFreememSize(p:pointer;Size:ptruint):ptruint;
77Function  SysMemSize(p:pointer):ptruint;
78Function  SysAllocMem(size:ptruint):Pointer;
79function  SysTryResizeMem(var p:pointer;size:ptruint):boolean;
80Function  SysReAllocMem(var p:pointer;size:ptruint):Pointer;
81function  SysGetHeapStatus:THeapStatus;
82function  SysGetFPCHeapStatus:TFPCHeapStatus;
83{$endif FPC_NO_DEFAULT_MEMORYMANAGER}
84
85{$ifdef FPC_HAS_FEATURE_HEAP}
86{ Tp7 functions }
87Procedure Getmem(Out p:pointer;Size:ptruint);
88Procedure Getmemory(Out p:pointer;Size:ptruint);
89Procedure Freemem(p:pointer;Size:ptruint);
90Procedure Freememory(p:pointer;Size:ptruint);
91
92{ FPC additions }
93Function  MemSize(p:pointer):ptruint;
94
95{ Delphi functions }
96function GetMem(size:ptruint):pointer;
97function GetMemory(size:ptruint):pointer; cdecl;
98function Freemem(p:pointer):ptruint;
99function Freememory(p:pointer):ptruint; cdecl;
100function AllocMem(Size:ptruint):pointer;
101function ReAllocMem(var p:pointer;Size:ptruint):pointer;
102function ReAllocMemory(p:pointer;Size:ptruint):pointer; cdecl;
103function GetHeapStatus:THeapStatus;
104function GetFPCHeapStatus:TFPCHeapStatus;
105{$endif FPC_HAS_FEATURE_HEAP}
106
107