paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-19 05:29:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix getheapstatus bootstrapping

Browse Source
This commit is contained in:
peter 2005-03-04 16:49:34 +00:00
parent abb3f82ceb
commit 617bd39762
4 changed files with 126 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
rtl/inc/cmem.pp
View File

@ -150,6 +150,7 @@ begin
CMemSize:=pptrint(p-sizeof(ptrint))^; CMemSize:=pptrint(p-sizeof(ptrint))^;
end; end;
{$ifdef HASGETFPCHEAPSTATUS}
function CGetHeapStatus:THeapStatus; function CGetHeapStatus:THeapStatus;
var res: THeapStatus; var res: THeapStatus;
@ -164,6 +165,13 @@ function CGetFPCHeapStatus:TFPCHeapStatus;
begin begin
fillchar(CGetFPCHeapStatus,sizeof(CGetFPCHeapStatus),0); fillchar(CGetFPCHeapStatus,sizeof(CGetFPCHeapStatus),0);
end; end;
{$else HASGETFPCHEAPSTATUS}
Procedure CGetHeapStatus(var status:THeapStatus);
begin
fillchar(status,sizeof(status),0);
end;
{$endif HASGETFPCHEAPSTATUS}
Const Const
@ -177,7 +185,9 @@ Const
ReallocMem : @CReAllocMem; ReallocMem : @CReAllocMem;
MemSize : @CMemSize; MemSize : @CMemSize;
GetHeapStatus : @CGetHeapStatus; GetHeapStatus : @CGetHeapStatus;
{$ifdef HASGETFPCHEAPSTATUS}
GetFPCHeapStatus: @CGetFPCHeapStatus; GetFPCHeapStatus: @CGetFPCHeapStatus;
{$endif HASGETFPCHEAPSTATUS}
); );
Var Var
@ -193,7 +203,10 @@ end.
{ {
$Log$ $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!) * getFPCheapstatus (no, FPC HEAP, not FP CHEAP!)
Revision 1.12 2005/02/14 17:13:22 peter Revision 1.12 2005/02/14 17:13:22 peter

50
rtl/inc/heap.inc
View File

@ -71,7 +71,9 @@ const
ReAllocMem: @SysReAllocMem; ReAllocMem: @SysReAllocMem;
MemSize: @SysMemSize; MemSize: @SysMemSize;
GetHeapStatus: @SysGetHeapStatus; GetHeapStatus: @SysGetHeapStatus;
GetFPCHeapStatus: @SysFPCGetHeapStatus; {$ifdef HASGETFPCHEAPSTATUS}
GetFPCHeapStatus: @SysGetFPCHeapStatus;
{$endif HASGETFPCHEAPSTATUS}
); );
MemoryMutexManager: TMemoryMutexManager = ( MemoryMutexManager: TMemoryMutexManager = (
@ -129,7 +131,11 @@ type
pfreelists = ^tfreelists; pfreelists = ^tfreelists;
var var
{$ifdef HASGETFPCHEAPSTATUS}
internal_status : TFPCHeapStatus; internal_status : TFPCHeapStatus;
{$else HASGETFPCHEAPSTATUS}
internal_status : THeapStatus;
{$endif HASGETFPCHEAPSTATUS}
freelists_fixed : tfreelists; freelists_fixed : tfreelists;
freelist_var : pmemchunk_var; freelist_var : pmemchunk_var;
@ -260,6 +266,7 @@ begin
end; end;
{$ifdef HASGETFPCHEAPSTATUS}
function GetHeapStatus:THeapStatus; function GetHeapStatus:THeapStatus;
begin begin
if IsMultiThread and MemoryManager.NeedLock then if IsMultiThread and MemoryManager.NeedLock then
@ -294,6 +301,24 @@ begin
Result:=MemoryManager.GetFPCHeapStatus(); Result:=MemoryManager.GetFPCHeapStatus();
end; end;
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 GetHeapStatus
*****************************************************************************} *****************************************************************************}
function SysFPCGetHeapStatus:TFPCHeapStatus; {$ifdef HASGETFPCHEAPSTATUS}
function SysGetFPCHeapStatus:TFPCHeapStatus;
begin begin
internal_status.CurrHeapFree:=internal_status.CurrHeapSize-internal_status.CurrHeapUsed; internal_status.CurrHeapFree:=internal_status.CurrHeapSize-internal_status.CurrHeapUsed;
result:=internal_status; result:=internal_status;
@ -501,12 +527,19 @@ begin
result.TotalAddrSpace :=0; result.TotalAddrSpace :=0;
result.TotalUncommitted :=0; result.TotalUncommitted :=0;
result.TotalCommitted :=0; result.TotalCommitted :=0;
result.FreeSmall :=0; result.FreeSmall :=0;
result.FreeBig :=0; result.FreeBig :=0;
result.Unused :=0; result.Unused :=0;
result.Overhead :=0; result.Overhead :=0;
result.HeapErrorCode :=0; result.HeapErrorCode :=0;
end; 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$ $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 * small typo fix on last commit
Revision 1.45 2005/03/02 10:46:10 marco Revision 1.45 2005/03/02 10:46:10 marco

45
rtl/inc/heaph.inc
View File

@ -16,6 +16,7 @@
{ Memorymanager } { Memorymanager }
type type
{$ifdef HASGETFPCHEAPSTATUS}
TFPCHeapStatus = record TFPCHeapStatus = record
MaxHeapSize, MaxHeapSize,
MaxHeapUsed, MaxHeapUsed,
@ -35,18 +36,31 @@ type
Overhead: Cardinal; Overhead: Cardinal;
HeapErrorCode: Cardinal; HeapErrorCode: Cardinal;
end; end;
{$else HASGETFPCHEAPSTATUS}
THeapStatus = record
MaxHeapSize,
MaxHeapUsed,
CurrHeapSize,
CurrHeapUsed,
CurrHeapFree : ptrint;
end;
{$endif HASGETFPCHEAPSTATUS}
PMemoryManager = ^TMemoryManager; PMemoryManager = ^TMemoryManager;
TMemoryManager = record TMemoryManager = record
NeedLock : boolean; NeedLock : boolean;
Getmem : Function(Size:ptrint):Pointer; Getmem : Function(Size:ptrint):Pointer;
Freemem : Function(p:pointer):ptrint; Freemem : Function(p:pointer):ptrint;
FreememSize : Function(p:pointer;Size:ptrint):ptrint; FreememSize : Function(p:pointer;Size:ptrint):ptrint;
AllocMem : Function(Size:ptrint):Pointer; AllocMem : Function(Size:ptrint):Pointer;
ReAllocMem : Function(var p:pointer;Size:ptrint):Pointer; ReAllocMem : Function(var p:pointer;Size:ptrint):Pointer;
MemSize : function(p:pointer):ptrint; MemSize : function(p:pointer):ptrint;
GetHeapStatus : function :THeapStatus; {$ifdef HASGETFPCHEAPSTATUS}
GetHeapStatus : function :THeapStatus;
GetFPCHeapStatus : function :TFPCHeapStatus; GetFPCHeapStatus : function :TFPCHeapStatus;
{$else HASGETFPCHEAPSTATUS}
GetHeapStatus : procedure(var status:THeapStatus);
{$endif HASGETFPCHEAPSTATUS}
end; end;
TMemoryMutexManager = record TMemoryMutexManager = record
@ -77,8 +91,12 @@ Function SysMemSize(p:pointer):ptrint;
Function SysAllocMem(size:ptrint):Pointer; Function SysAllocMem(size:ptrint):Pointer;
function SysTryResizeMem(var p:pointer;size : ptrint):boolean; function SysTryResizeMem(var p:pointer;size : ptrint):boolean;
Function SysReAllocMem(var p:pointer;size:ptrint):Pointer; Function SysReAllocMem(var p:pointer;size:ptrint):Pointer;
{$ifdef HASGETFPCHEAPSTATUS}
function SysGetHeapStatus:THeapStatus; function SysGetHeapStatus:THeapStatus;
function SysFPCGetHeapStatus:TFPCHeapStatus; function SysGetFPCHeapStatus:TFPCHeapStatus;
{$else}
procedure SysGetHeapStatus(var status:THeapStatus);
{$endif HASGETFPCHEAPSTATUS}
{ Tp7 functions } { Tp7 functions }
Procedure Getmem(Var p:pointer;Size:ptrint); Procedure Getmem(Var p:pointer;Size:ptrint);
@ -97,8 +115,12 @@ function Freememory(p:pointer):ptrint;
function AllocMem(Size:ptrint):pointer; function AllocMem(Size:ptrint):pointer;
function ReAllocMem(var p:pointer;Size:ptrint):pointer; function ReAllocMem(var p:pointer;Size:ptrint):pointer;
function ReAllocMemory(var p:pointer;Size:ptrint):pointer; function ReAllocMemory(var p:pointer;Size:ptrint):pointer;
{$ifdef HASGETFPCHEAPSTATUS}
function GetHeapStatus:THeapStatus; function GetHeapStatus:THeapStatus;
function GetFPCHeapStatus:TFPCHeapStatus; function GetFPCHeapStatus:TFPCHeapStatus;
{$else}
procedure GetHeapStatus(var status:THeapStatus);
{$endif HASGETFPCHEAPSTATUS}
{$ifndef ValueGetmem} {$ifndef ValueGetmem}
{ Needed to solve overloading problem with call from assembler (PFV) } { Needed to solve overloading problem with call from assembler (PFV) }
@ -117,7 +139,10 @@ Function Heapsize:ptrint;
{ {
$Log$ $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!) * getFPCheapstatus (no, FPC HEAP, not FP CHEAP!)
Revision 1.13 2005/02/14 17:13:22 peter Revision 1.13 2005/02/14 17:13:22 peter

38
rtl/inc/heaptrc.pp
View File

@ -854,14 +854,22 @@ var
pp : pheap_mem_info; pp : pheap_mem_info;
i : ptrint; i : ptrint;
ExpectedHeapFree : ptrint; ExpectedHeapFree : ptrint;
{$ifdef HASGETFPCHEAPSTATUS}
status : TFPCHeapStatus; status : TFPCHeapStatus;
{$else HASGETFPCHEAPSTATUS}
status : THeapStatus;
{$endif HASGETFPCHEAPSTATUS}
begin begin
pp:=heap_mem_root; pp:=heap_mem_root;
Writeln(ptext^,'Heap dump by heaptrc unit'); Writeln(ptext^,'Heap dump by heaptrc unit');
Writeln(ptext^,getmem_cnt, ' memory blocks allocated : ',getmem_size,'/',getmem8_size); Writeln(ptext^,getmem_cnt, ' memory blocks allocated : ',getmem_size,'/',getmem8_size);
Writeln(ptext^,freemem_cnt,' memory blocks freed : ',freemem_size,'/',freemem8_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); 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); Write(ptext^,'True heap size : ',status.CurrHeapSize);
if EntryMemUsed > 0 then if EntryMemUsed > 0 then
Writeln(ptext^,' (',EntryMemUsed,' used in System startup)') Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
@ -938,6 +946,7 @@ end;
No specific tracing calls No specific tracing calls
*****************************************************************************} *****************************************************************************}
{$ifdef HASGETFPCHEAPSTATUS}
function TraceGetHeapStatus:THeapStatus; function TraceGetHeapStatus:THeapStatus;
begin begin
TraceGetHeapStatus:=SysGetHeapStatus; TraceGetHeapStatus:=SysGetHeapStatus;
@ -945,8 +954,14 @@ end;
function TraceGetFPCHeapStatus:TFPCHeapStatus; function TraceGetFPCHeapStatus:TFPCHeapStatus;
begin begin
TraceGetFPCHeapStatus:=SysFPCGetHeapStatus; TraceGetFPCHeapStatus:=SysGetFPCHeapStatus;
end; end;
{$else HASGETFPCHEAPSTATUS}
procedure TraceGetHeapStatus(var status:THeapStatus);
begin
SysGetHeapStatus(status);
end;
{$endif HASGETFPCHEAPSTATUS}
{***************************************************************************** {*****************************************************************************
@ -997,16 +1012,28 @@ const
AllocMem : @TraceAllocMem; AllocMem : @TraceAllocMem;
ReAllocMem : @TraceReAllocMem; ReAllocMem : @TraceReAllocMem;
MemSize : @TraceMemSize; MemSize : @TraceMemSize;
{$ifdef HASGETFPCHEAPSTATUS}
GetHeapStatus : @TraceGetHeapStatus; GetHeapStatus : @TraceGetHeapStatus;
GetFPCHeapStatus : @TraceGetFPCHeapStatus; GetFPCHeapStatus : @TraceGetFPCHeapStatus;
{$else HASGETFPCHEAPSTATUS}
GetHeapStatus : @TraceGetHeapStatus;
{$endif HASGETFPCHEAPSTATUS}
); );
procedure TraceInit; procedure TraceInit;
var var
{$ifdef HASGETFPCHEAPSTATUS}
initheapstatus : TFPCHeapStatus; initheapstatus : TFPCHeapStatus;
{$else HASGETFPCHEAPSTATUS}
initheapstatus : THeapStatus;
{$endif HASGETFPCHEAPSTATUS}
begin begin
initheapstatus:=SysFPCGetHeapStatus; {$ifdef HASGETFPCHEAPSTATUS}
initheapstatus:=SysGetFPCHeapStatus;
{$else HASGETFPCHEAPSTATUS}
SysGetHeapStatus(initheapstatus);
{$endif HASGETFPCHEAPSTATUS}
EntryMemUsed:=initheapstatus.CurrHeapUsed; EntryMemUsed:=initheapstatus.CurrHeapUsed;
MakeCRC32Tbl; MakeCRC32Tbl;
SetMemoryManager(TraceManager); SetMemoryManager(TraceManager);
@ -1151,7 +1178,10 @@ finalization
end. end.
{ {
$Log$ $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!) * getFPCheapstatus (no, FPC HEAP, not FP CHEAP!)
Revision 1.39 2005/02/14 17:13:22 peter Revision 1.39 2005/02/14 17:13:22 peter