paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 06:22:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

merged changes from heaptrc.pp

Browse Source 
git-svn-id: trunk@7230 -
This commit is contained in:
vincents 2005-06-10 07:00:08 +00:00
parent 85689266c5
commit c077b1d77d
1 changed files with 12 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
components/codetools/memcheck.pas
View File

@ -757,7 +757,7 @@ var
{$endif} {$endif}
procedure CheckPointer(p : pointer);{$ifndef NOSAVEREGISTERS}saveregisters;{$endif}[public, alias : 'FPC_CHECKPOINTER']; procedure CheckPointer(p : pointer);[public, alias : 'FPC_CHECKPOINTER'];
var var
i : ptrint; i : ptrint;
pp : pheap_mem_info; pp : pheap_mem_info;
@ -880,49 +880,25 @@ procedure dumpheap;
var var
pp : pheap_mem_info; pp : pheap_mem_info;
i : ptrint; i : ptrint;
{$IFDEF HASGETHEAPSTATUS}
ExpectedHeapFree : ptrint; ExpectedHeapFree : ptrint;
{$IFDEF HASGETFPCHEAPSTATUS} status : TFPCHeapStatus;
status : TFPCHeapStatus;
{$ELSE}
status : THeapStatus;
{$ENDIF}
{$ELSE}
ExpectedMemAvail : ptrint;
{$ENDIF}
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);
{$IFDEF HASGETHEAPSTATUS} status:=SysGetFPCHeapStatus;
{$IFDEF HASGETFPCHEAPSTATUS}
status:=SysGetFPCHeapStatus;
{$ELSE}
SysGetHeapStatus(status);
{$ENDIF}
Write(ptext^,'True heap size : ',status.CurrHeapSize); Write(ptext^,'True heap size : ',status.CurrHeapSize);
{$ELSE}
Write(ptext^,'True heap size : ',system.HeapSize);
{$ENDIF}
if EntryMemUsed > 0 then if EntryMemUsed > 0 then
Writeln(ptext^,' (',EntryMemUsed,' used in System startup)') Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
else else
Writeln(ptext^); Writeln(ptext^);
{$IFDEF HASGETHEAPSTATUS}
Writeln(ptext^,'True free heap : ',status.CurrHeapFree); Writeln(ptext^,'True free heap : ',status.CurrHeapFree);
ExpectedHeapFree:=status.CurrHeapSize-(getmem8_size-freemem8_size)- ExpectedHeapFree:=status.CurrHeapSize-(getmem8_size-freemem8_size)-
(getmem_cnt-freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size)-EntryMemUsed; (getmem_cnt-freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size)-EntryMemUsed;
If ExpectedHeapFree<>status.CurrHeapFree then If ExpectedHeapFree<>status.CurrHeapFree then
Writeln(ptext^,'Should be : ',ExpectedHeapFree); Writeln(ptext^,'Should be : ',ExpectedHeapFree);
{$ELSE}
Writeln(ptext^,'True free heap : ',MemAvail);
ExpectedMemAvail:=system.HeapSize-(getmem8_size-freemem8_size)-
(getmem_cnt-freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size)-EntryMemUsed;
If ExpectedMemAvail<>MemAvail then
Writeln(ptext^,'Should be : ',ExpectedMemAvail);
{$ENDIF}
i:=getmem_cnt-freemem_cnt; i:=getmem_cnt-freemem_cnt;
while pp<>nil do while pp<>nil do
begin begin
@ -989,40 +965,16 @@ end;
No specific tracing calls No specific tracing calls
*****************************************************************************} *****************************************************************************}
{$IFDEF HASGETHEAPSTATUS} function TraceGetHeapStatus:THeapStatus;
{$IFDEF HASGETFPCHEAPSTATUS}
function TraceGetHeapStatus: THeapStatus;
begin
Result:=SysGetHeapStatus;
end;
function TraceGetFPCHeapStatus: TFPCHeapStatus;
begin
Result:=SysGetFPCHeapStatus;
end;
{$ELSE}
procedure TraceGetHeapStatus(var status:THeapStatus);
begin
SysGetHeapStatus(status);
end;
{$ENDIF}
{$ELSE}
function TraceMemAvail:ptrint;
begin begin
TraceMemAvail:=SysMemAvail; TraceGetHeapStatus:=SysGetHeapStatus;
end; end;
function TraceMaxAvail:ptrint; function TraceGetFPCHeapStatus:TFPCHeapStatus;
begin begin
TraceMaxAvail:=SysMaxAvail; TraceGetFPCHeapStatus:=SysGetFPCHeapStatus;
end; end;
function TraceHeapSize:ptrint;
begin
TraceHeapSize:=SysHeapSize;
end;
{$ENDIF}
{***************************************************************************** {*****************************************************************************
Program Hooks Program Hooks
@ -1072,40 +1024,17 @@ const
AllocMem : @TraceAllocMem; AllocMem : @TraceAllocMem;
ReAllocMem : @TraceReAllocMem; ReAllocMem : @TraceReAllocMem;
MemSize : @TraceMemSize; MemSize : @TraceMemSize;
{$IFDEF HASGETHEAPSTATUS}
GetHeapStatus : @TraceGetHeapStatus; GetHeapStatus : @TraceGetHeapStatus;
{$IFDEF HASGETFPCHEAPSTATUS} GetFPCHeapStatus : @TraceGetFPCHeapStatus;
GetFPCHeapStatus : @TraceGetFPCHeapStatus;
{$ENDIF}
{$ELSE}
MemAvail : @TraceMemAvail;
MaxAvail : @TraceMaxAvail;
HeapSize : @TraceHeapsize;
{$ENDIF}
); );
procedure TraceInit; procedure TraceInit;
{$IFDEF HASGETHEAPSTATUS}
var var
{$IFDEF HASGETFPCHEAPSTATUS} initheapstatus : TFPCHeapStatus;
initheapstatus : TFPCHeapStatus;
{$ELSE}
initheapstatus : THeapStatus;
{$ENDIF}
{$ENDIF}
begin begin
{$IFDEF HASGETHEAPSTATUS}
{$IFDEF HASGETFPCHEAPSTATUS}
initheapstatus:=SysGetFPCHeapStatus; initheapstatus:=SysGetFPCHeapStatus;
EntryMemUsed:=initheapstatus.CurrHeapUsed; EntryMemUsed:=initheapstatus.CurrHeapUsed;
{$ELSE}
SysGetHeapStatus(initheapstatus);
EntryMemUsed:=initheapstatus.CurrHeapUsed;
{$ENDIF}
{$ELSE}
EntryMemUsed:=System.HeapSize-MemAvail;
{$ENDIF}
MakeCRC32Tbl; MakeCRC32Tbl;
SetMemoryManager(TraceManager); SetMemoryManager(TraceManager);
ptext:=@stderr; ptext:=@stderr;
@ -2391,6 +2320,9 @@ end.
{ {
$Log$ $Log$
Revision 1.42 2005/06/10 07:00:08 vincents
merged changes from heaptrc.pp
Revision 1.41 2005/03/07 21:59:43 vincents Revision 1.41 2005/03/07 21:59:43 vincents
changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman changed hexstr(cardinal()) for pointers to dbgs() and other 64-bits fixes from Peter Vreman