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

* fix for bug report 929

Browse Source
This commit is contained in:
pierre 2000-04-27 15:35:50 +00:00
parent 71cbe13810
commit a3434cc825
1 changed files with 27 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
rtl/inc/heaptrc.pp
View File

@ -75,6 +75,7 @@ const
{ allows to add custom info in heap_mem_info }
extra_info_size : longint = 0;
exact_info_size : longint = 0;
EntryMemUsed : longint = 0;
{ function to fill this info up }
fill_extra_info : FillExtraInfoType = nil;
error_in_heap : boolean = false;
@ -553,6 +554,11 @@ var
{$ifdef win32}
var
StartUpHeapEnd : pointer;
{ I found no symbol for start of text section :(
so we usee the _mainCRTStartup which should be
in wprt0.ow or wdllprt0.ow PM }
text_begin : cardinal;external name '_mainCRTStartup';
data_end : cardinal;external name '__data_end__';
{$endif}
procedure CheckPointer(p : pointer);[public, alias : 'FPC_CHECKPOINTER'];
@ -598,7 +604,10 @@ begin
if (cardinal(p)>=$40000) and (p<=HeapOrg) then
goto _exit;
{ inside stack ? }
if (cardinal(startupheapend)<Win32StackTop) and (cardinal(p)>cardinal(startupheapend)) and
asm
movl %ebp,get_ebp
end;
if (cardinal(p)>get_ebp) and
(cardinal(p)<Win32StackTop) then
goto _exit;
{$endif win32}
@ -681,16 +690,23 @@ procedure dumpheap;
var
pp : pheap_mem_info;
i : longint;
ExpectedMemAvail : longint;
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);
Writeln(ptext^,'True heap size : ',system.HeapSize);
Write(ptext^,'True heap size : ',system.HeapSize);
if EntryMemUsed > 0 then
Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
else
Writeln(ptext^);
Writeln(ptext^,'True free heap : ',MemAvail);
Writeln(ptext^,'Should be : ',system.HeapSize-(getmem8_size-freemem8_size)-
(getmem_cnt-freemem_cnt)*(sizeof(theap_mem_info)+extra_info_size));
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);
i:=getmem_cnt-freemem_cnt;
while pp<>nil do
begin
@ -836,9 +852,9 @@ begin
pheap_mem_info(p)^.previous:=heap_mem_root;
pheap_mem_info(p)^.next:=nil;
{$ifdef EXTRA}
pheap_mem_info(p)^.next_valid:=nil;
pheap_mem_info(p)^.prev_valid:=nil;
if assigned(heap_valid_last) then
heap_valid_last^.next_valid:=pheap_mem_info(p);
heap_valid_last^.prev_valid:=pheap_mem_info(p);
heap_valid_last:=pheap_mem_info(p);
if not assigned(heap_valid_first) then
heap_valid_first:=pheap_mem_info(p);
@ -958,6 +974,7 @@ procedure SetExtraInfo( size : longint;func : fillextrainfotype);
end;
Initialization
EntryMemUsed:=System.HeapSize-MemAvail;
MakeCRC32Tbl;
SetMemoryManager(TraceManager);
ptext:=@stderr;
@ -977,7 +994,10 @@ finalization
end.
{
$Log$
Revision 1.41 2000-02-10 13:59:35 peter
Revision 1.42 2000-04-27 15:35:50 pierre
* fix for bug report 929
Revision 1.41 2000/02/10 13:59:35 peter
* fixed bug with reallocmem to use the wrong size when copying the
data to the new allocated pointer