mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 22:29:24 +02:00
* fix getheapstatus bootstrapping
This commit is contained in:
peter
parent
abb3f82ceb
commit
617bd39762
@ -150,6 +150,7 @@ begin
|
||||
CMemSize:=pptrint(p-sizeof(ptrint))^;
|
||||
end;
|
||||
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
function CGetHeapStatus:THeapStatus;
|
||||
|
||||
var res: THeapStatus;
|
||||
@ -164,6 +165,13 @@ function CGetFPCHeapStatus:TFPCHeapStatus;
|
||||
begin
|
||||
fillchar(CGetFPCHeapStatus,sizeof(CGetFPCHeapStatus),0);
|
||||
end;
|
||||
{$else HASGETFPCHEAPSTATUS}
|
||||
Procedure CGetHeapStatus(var status:THeapStatus);
|
||||
|
||||
begin
|
||||
fillchar(status,sizeof(status),0);
|
||||
end;
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
|
||||
|
||||
Const
|
||||
@ -177,7 +185,9 @@ Const
|
||||
ReallocMem : @CReAllocMem;
|
||||
MemSize : @CMemSize;
|
||||
GetHeapStatus : @CGetHeapStatus;
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
GetFPCHeapStatus: @CGetFPCHeapStatus;
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
);
|
||||
|
||||
Var
|
||||
@ -193,7 +203,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 2005-02-28 15:38:38 marco
|
||||
Revision 1.14 2005-03-04 16:49:34 peter
|
||||
* fix getheapstatus bootstrapping
|
||||
|
||||
Revision 1.13 2005/02/28 15:38:38 marco
|
||||
* getFPCheapstatus (no, FPC HEAP, not FP CHEAP!)
|
||||
|
||||
Revision 1.12 2005/02/14 17:13:22 peter
|
||||
|
||||
@ -71,7 +71,9 @@ const
|
||||
ReAllocMem: @SysReAllocMem;
|
||||
MemSize: @SysMemSize;
|
||||
GetHeapStatus: @SysGetHeapStatus;
|
||||
GetFPCHeapStatus: @SysFPCGetHeapStatus;
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
GetFPCHeapStatus: @SysGetFPCHeapStatus;
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
);
|
||||
|
||||
MemoryMutexManager: TMemoryMutexManager = (
|
||||
@ -129,7 +131,11 @@ type
|
||||
pfreelists = ^tfreelists;
|
||||
|
||||
var
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
internal_status : TFPCHeapStatus;
|
||||
{$else HASGETFPCHEAPSTATUS}
|
||||
internal_status : THeapStatus;
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
|
||||
freelists_fixed : tfreelists;
|
||||
freelist_var : pmemchunk_var;
|
||||
@ -260,6 +266,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
function GetHeapStatus:THeapStatus;
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
@ -294,6 +301,24 @@ begin
|
||||
Result:=MemoryManager.GetFPCHeapStatus();
|
||||
end;
|
||||
end;
|
||||
{$else HASGETFPCHEAPSTATUS}
|
||||
procedure GetHeapStatus(var status:THeapStatus);
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
try
|
||||
MemoryMutexManager.MutexLock;
|
||||
MemoryManager.GetHeapStatus(status);
|
||||
finally
|
||||
MemoryMutexManager.MutexUnlock;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
MemoryManager.GetHeapStatus(status);
|
||||
end;
|
||||
end;
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
|
||||
|
||||
|
||||
@ -486,7 +511,8 @@ end;
|
||||
GetHeapStatus
|
||||
*****************************************************************************}
|
||||
|
||||
function SysFPCGetHeapStatus:TFPCHeapStatus;
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
function SysGetFPCHeapStatus:TFPCHeapStatus;
|
||||
begin
|
||||
internal_status.CurrHeapFree:=internal_status.CurrHeapSize-internal_status.CurrHeapUsed;
|
||||
result:=internal_status;
|
||||
@ -501,12 +527,19 @@ begin
|
||||
result.TotalAddrSpace :=0;
|
||||
result.TotalUncommitted :=0;
|
||||
result.TotalCommitted :=0;
|
||||
result.FreeSmall :=0;
|
||||
result.FreeBig :=0;
|
||||
result.Unused :=0;
|
||||
result.Overhead :=0;
|
||||
result.FreeSmall :=0;
|
||||
result.FreeBig :=0;
|
||||
result.Unused :=0;
|
||||
result.Overhead :=0;
|
||||
result.HeapErrorCode :=0;
|
||||
end;
|
||||
{$else}
|
||||
procedure SysGetHeapStatus(var status:THeapStatus);
|
||||
begin
|
||||
internal_status.CurrHeapFree:=internal_status.CurrHeapSize-internal_status.CurrHeapUsed;
|
||||
status:=internal_status;
|
||||
end;
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
|
||||
|
||||
|
||||
@ -1322,7 +1355,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.46 2005-03-02 14:25:19 marco
|
||||
Revision 1.47 2005-03-04 16:49:34 peter
|
||||
* fix getheapstatus bootstrapping
|
||||
|
||||
Revision 1.46 2005/03/02 14:25:19 marco
|
||||
* small typo fix on last commit
|
||||
|
||||
Revision 1.45 2005/03/02 10:46:10 marco
|
||||
|
||||
@ -16,6 +16,7 @@
|
||||
|
||||
{ Memorymanager }
|
||||
type
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
TFPCHeapStatus = record
|
||||
MaxHeapSize,
|
||||
MaxHeapUsed,
|
||||
@ -35,18 +36,31 @@ type
|
||||
Overhead: Cardinal;
|
||||
HeapErrorCode: Cardinal;
|
||||
end;
|
||||
{$else HASGETFPCHEAPSTATUS}
|
||||
THeapStatus = record
|
||||
MaxHeapSize,
|
||||
MaxHeapUsed,
|
||||
CurrHeapSize,
|
||||
CurrHeapUsed,
|
||||
CurrHeapFree : ptrint;
|
||||
end;
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
|
||||
PMemoryManager = ^TMemoryManager;
|
||||
TMemoryManager = record
|
||||
NeedLock : boolean;
|
||||
Getmem : Function(Size:ptrint):Pointer;
|
||||
Freemem : Function(p:pointer):ptrint;
|
||||
FreememSize : Function(p:pointer;Size:ptrint):ptrint;
|
||||
AllocMem : Function(Size:ptrint):Pointer;
|
||||
ReAllocMem : Function(var p:pointer;Size:ptrint):Pointer;
|
||||
MemSize : function(p:pointer):ptrint;
|
||||
GetHeapStatus : function :THeapStatus;
|
||||
NeedLock : boolean;
|
||||
Getmem : Function(Size:ptrint):Pointer;
|
||||
Freemem : Function(p:pointer):ptrint;
|
||||
FreememSize : Function(p:pointer;Size:ptrint):ptrint;
|
||||
AllocMem : Function(Size:ptrint):Pointer;
|
||||
ReAllocMem : Function(var p:pointer;Size:ptrint):Pointer;
|
||||
MemSize : function(p:pointer):ptrint;
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
GetHeapStatus : function :THeapStatus;
|
||||
GetFPCHeapStatus : function :TFPCHeapStatus;
|
||||
{$else HASGETFPCHEAPSTATUS}
|
||||
GetHeapStatus : procedure(var status:THeapStatus);
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
end;
|
||||
|
||||
TMemoryMutexManager = record
|
||||
@ -77,8 +91,12 @@ Function SysMemSize(p:pointer):ptrint;
|
||||
Function SysAllocMem(size:ptrint):Pointer;
|
||||
function SysTryResizeMem(var p:pointer;size : ptrint):boolean;
|
||||
Function SysReAllocMem(var p:pointer;size:ptrint):Pointer;
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
function SysGetHeapStatus:THeapStatus;
|
||||
function SysFPCGetHeapStatus:TFPCHeapStatus;
|
||||
function SysGetFPCHeapStatus:TFPCHeapStatus;
|
||||
{$else}
|
||||
procedure SysGetHeapStatus(var status:THeapStatus);
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
|
||||
{ Tp7 functions }
|
||||
Procedure Getmem(Var p:pointer;Size:ptrint);
|
||||
@ -97,8 +115,12 @@ function Freememory(p:pointer):ptrint;
|
||||
function AllocMem(Size:ptrint):pointer;
|
||||
function ReAllocMem(var p:pointer;Size:ptrint):pointer;
|
||||
function ReAllocMemory(var p:pointer;Size:ptrint):pointer;
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
function GetHeapStatus:THeapStatus;
|
||||
function GetFPCHeapStatus:TFPCHeapStatus;
|
||||
{$else}
|
||||
procedure GetHeapStatus(var status:THeapStatus);
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
|
||||
{$ifndef ValueGetmem}
|
||||
{ Needed to solve overloading problem with call from assembler (PFV) }
|
||||
@ -117,7 +139,10 @@ Function Heapsize:ptrint;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.14 2005-02-28 15:38:38 marco
|
||||
Revision 1.15 2005-03-04 16:49:34 peter
|
||||
* fix getheapstatus bootstrapping
|
||||
|
||||
Revision 1.14 2005/02/28 15:38:38 marco
|
||||
* getFPCheapstatus (no, FPC HEAP, not FP CHEAP!)
|
||||
|
||||
Revision 1.13 2005/02/14 17:13:22 peter
|
||||
|
||||
@ -854,14 +854,22 @@ var
|
||||
pp : pheap_mem_info;
|
||||
i : ptrint;
|
||||
ExpectedHeapFree : ptrint;
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
status : TFPCHeapStatus;
|
||||
{$else HASGETFPCHEAPSTATUS}
|
||||
status : THeapStatus;
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
begin
|
||||
pp:=heap_mem_root;
|
||||
Writeln(ptext^,'Heap dump by heaptrc unit');
|
||||
Writeln(ptext^,getmem_cnt, ' memory blocks allocated : ',getmem_size,'/',getmem8_size);
|
||||
Writeln(ptext^,freemem_cnt,' memory blocks freed : ',freemem_size,'/',freemem8_size);
|
||||
Writeln(ptext^,getmem_cnt-freemem_cnt,' unfreed memory blocks : ',getmem_size-freemem_size);
|
||||
status:=SysFPCGetHeapStatus;
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
status:=SysGetFPCHeapStatus;
|
||||
{$else HASGETFPCHEAPSTATUS}
|
||||
SysGetHeapStatus(status);
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
Write(ptext^,'True heap size : ',status.CurrHeapSize);
|
||||
if EntryMemUsed > 0 then
|
||||
Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
|
||||
@ -938,6 +946,7 @@ end;
|
||||
No specific tracing calls
|
||||
*****************************************************************************}
|
||||
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
function TraceGetHeapStatus:THeapStatus;
|
||||
begin
|
||||
TraceGetHeapStatus:=SysGetHeapStatus;
|
||||
@ -945,8 +954,14 @@ end;
|
||||
|
||||
function TraceGetFPCHeapStatus:TFPCHeapStatus;
|
||||
begin
|
||||
TraceGetFPCHeapStatus:=SysFPCGetHeapStatus;
|
||||
TraceGetFPCHeapStatus:=SysGetFPCHeapStatus;
|
||||
end;
|
||||
{$else HASGETFPCHEAPSTATUS}
|
||||
procedure TraceGetHeapStatus(var status:THeapStatus);
|
||||
begin
|
||||
SysGetHeapStatus(status);
|
||||
end;
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
@ -997,16 +1012,28 @@ const
|
||||
AllocMem : @TraceAllocMem;
|
||||
ReAllocMem : @TraceReAllocMem;
|
||||
MemSize : @TraceMemSize;
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
GetHeapStatus : @TraceGetHeapStatus;
|
||||
GetFPCHeapStatus : @TraceGetFPCHeapStatus;
|
||||
{$else HASGETFPCHEAPSTATUS}
|
||||
GetHeapStatus : @TraceGetHeapStatus;
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
);
|
||||
|
||||
|
||||
procedure TraceInit;
|
||||
var
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
initheapstatus : TFPCHeapStatus;
|
||||
{$else HASGETFPCHEAPSTATUS}
|
||||
initheapstatus : THeapStatus;
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
begin
|
||||
initheapstatus:=SysFPCGetHeapStatus;
|
||||
{$ifdef HASGETFPCHEAPSTATUS}
|
||||
initheapstatus:=SysGetFPCHeapStatus;
|
||||
{$else HASGETFPCHEAPSTATUS}
|
||||
SysGetHeapStatus(initheapstatus);
|
||||
{$endif HASGETFPCHEAPSTATUS}
|
||||
EntryMemUsed:=initheapstatus.CurrHeapUsed;
|
||||
MakeCRC32Tbl;
|
||||
SetMemoryManager(TraceManager);
|
||||
@ -1151,7 +1178,10 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.40 2005-02-28 15:38:38 marco
|
||||
Revision 1.41 2005-03-04 16:49:34 peter
|
||||
* fix getheapstatus bootstrapping
|
||||
|
||||
Revision 1.40 2005/02/28 15:38:38 marco
|
||||
* getFPCheapstatus (no, FPC HEAP, not FP CHEAP!)
|
||||
|
||||
Revision 1.39 2005/02/14 17:13:22 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user