mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 15:49:26 +02:00
* GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
This commit is contained in:
peter
parent
46d1fc9546
commit
a263b1d40e
@ -369,18 +369,40 @@ implementation
|
||||
|
||||
|
||||
procedure tmemdebug.start;
|
||||
{$ifdef HASGETHEAPSTATUS}
|
||||
var
|
||||
status : THeapStatus;
|
||||
{$endif HASGETHEAPSTATUS}
|
||||
begin
|
||||
{$ifdef HASGETHEAPSTATUS}
|
||||
GetHeapStatus(status);
|
||||
startmem:=status.CurrHeapUsed;
|
||||
{$else HASGETHEAPSTATUS}
|
||||
startmem:=memavail;
|
||||
{$endif HASGETHEAPSTATUS}
|
||||
end;
|
||||
|
||||
|
||||
procedure tmemdebug.stop;
|
||||
{$ifdef HASGETHEAPSTATUS}
|
||||
var
|
||||
status : THeapStatus;
|
||||
{$endif HASGETHEAPSTATUS}
|
||||
begin
|
||||
{$ifdef HASGETHEAPSTATUS}
|
||||
if startmem<>0 then
|
||||
begin
|
||||
GetHeapStatus(status);
|
||||
inc(TotalMem,startmem-status.CurrHeapUsed);
|
||||
startmem:=0;
|
||||
end;
|
||||
{$else HASGETHEAPSTATUS}
|
||||
if startmem<>0 then
|
||||
begin
|
||||
inc(TotalMem,memavail-startmem);
|
||||
startmem:=0;
|
||||
end;
|
||||
{$endif HASGETHEAPSTATUS}
|
||||
end;
|
||||
|
||||
|
||||
@ -2345,7 +2367,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.39 2004-11-15 23:35:30 peter
|
||||
Revision 1.40 2004-11-22 19:34:58 peter
|
||||
* GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
|
||||
|
||||
Revision 1.39 2004/11/15 23:35:30 peter
|
||||
* tparaitem removed, use tparavarsym instead
|
||||
* parameter order is now calculated from paranr value in tparavarsym
|
||||
|
||||
|
||||
@ -203,19 +203,27 @@ end;
|
||||
|
||||
|
||||
function def_status:boolean;
|
||||
{$ifdef HASGETHEAPSTATUS}
|
||||
var
|
||||
hstatus : THeapStatus;
|
||||
{$endif HASGETHEAPSTATUS}
|
||||
begin
|
||||
def_status:=false; { never stop }
|
||||
{ Status info?, Called every line }
|
||||
if ((status.verbosity and V_Status)<>0) then
|
||||
begin
|
||||
if (status.compiledlines=1) then
|
||||
WriteLn(memavail shr 10,' Kb Free');
|
||||
if (status.currentline>0) and (status.currentline mod 100=0) then
|
||||
{$ifdef FPC}
|
||||
WriteLn(status.currentline,' ',DStr(memavail shr 10),'/',DStr(system.heapsize shr 10),' Kb Free');
|
||||
{$else}
|
||||
WriteLn(status.currentline,' ',DStr(memavail shr 10),' Kb Free');
|
||||
{$endif}
|
||||
if (status.compiledlines=1) or
|
||||
(status.currentline mod 100=0) then
|
||||
begin
|
||||
if status.currentline>0 then
|
||||
Write(status.currentline,' ');
|
||||
{$ifdef HASGETHEAPSTATUS}
|
||||
GetHeapStatus(hstatus);
|
||||
WriteLn(DStr(hstatus.CurrHeapUsed shr 10),'/',DStr(hstatus.CurrHeapSize shr 10),' Kb Used');
|
||||
{$else HASGETHEAPSTATUS}
|
||||
WriteLn(DStr(memavail shr 10),'/',DStr(system.heapsize shr 10),' Kb Free');
|
||||
{$endif HASGETHEAPSTATUS}
|
||||
end;
|
||||
end
|
||||
end;
|
||||
|
||||
@ -378,7 +386,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.31 2004-10-15 09:14:16 mazen
|
||||
Revision 1.32 2004-11-22 19:34:58 peter
|
||||
* GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
|
||||
|
||||
Revision 1.31 2004/10/15 09:14:16 mazen
|
||||
- remove $IFDEF DELPHI and related code
|
||||
- remove $IFDEF FPCPROCVAR and related code
|
||||
|
||||
|
||||
@ -375,6 +375,9 @@ var
|
||||
{$ifdef USEEXCEPT}
|
||||
recoverpos : jmp_buf;
|
||||
{$endif}
|
||||
{$ifdef HASGETHEAPSTATUS}
|
||||
hstatus : THeapStatus;
|
||||
{$endif HASGETHEAPSTATUS}
|
||||
begin
|
||||
olddo_stop:=do_stop;
|
||||
do_stop:=@minimal_stop;
|
||||
@ -430,7 +433,12 @@ begin
|
||||
|
||||
DoneVerbose;
|
||||
{$ifdef SHOWUSEDMEM}
|
||||
Writeln('Memory used (heapsize): ',DStr(system.Heapsize shr 10),' Kb');
|
||||
{$ifdef HASGETHEAPSTATUS}
|
||||
GetHeapStatus(hstatus);
|
||||
Writeln('Max Memory used/heapsize: ',DStr(hstatus.MaxHeapUsed shr 10),'/',DStr(hstatus.MaxHeapSize shr 10),' Kb');
|
||||
{$else HASGETHEAPSTATUS}
|
||||
Writeln('Memory used (heapsize): ',DStr(system.Heapsize shr 10),' Kb');
|
||||
{$endif HASGETHEAPSTATUS}
|
||||
{$endif SHOWUSEDMEM}
|
||||
{$ifdef fixLeaksOnError}
|
||||
do_stop;
|
||||
@ -440,7 +448,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.49 2004-10-15 09:14:16 mazen
|
||||
Revision 1.50 2004-11-22 19:34:58 peter
|
||||
* GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
|
||||
|
||||
Revision 1.49 2004/10/15 09:14:16 mazen
|
||||
- remove $IFDEF DELPHI and related code
|
||||
- remove $IFDEF FPCPROCVAR and related code
|
||||
|
||||
|
||||
@ -1750,6 +1750,7 @@ begin
|
||||
def_symbol('STR_USES_VALINT');
|
||||
def_symbol('NOSAVEREGISTERS');
|
||||
def_symbol('SHORTSTRCOMPAREINREG');
|
||||
def_symbol('HASGETHEAPSTATUS');
|
||||
|
||||
{ using a case is pretty useless here (FK) }
|
||||
{ some stuff for TP compatibility }
|
||||
@ -2090,7 +2091,10 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.153 2004-11-17 22:21:35 peter
|
||||
Revision 1.154 2004-11-22 19:34:58 peter
|
||||
* GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
|
||||
|
||||
Revision 1.153 2004/11/17 22:21:35 peter
|
||||
mangledname setting moved to place after the complete proc declaration is read
|
||||
import generation moved to place where body is also parsed (still gives problems with win32)
|
||||
|
||||
|
||||
@ -509,6 +509,9 @@ end;
|
||||
procedure TCompilerStatusDialog.Update;
|
||||
var
|
||||
StatusS,KeyS: string;
|
||||
{$ifdef HASGETHEAPSTATUS}
|
||||
hstatus : THeapStatus;
|
||||
{$endif HASGETHEAPSTATUS}
|
||||
const
|
||||
MaxFileNameSize = 46;
|
||||
begin
|
||||
@ -567,8 +570,14 @@ begin
|
||||
AddFormatParamStr(KillTilde(TargetSwitches^.ItemName(TargetSwitches^.GetCurrSel)));
|
||||
AddFormatParamInt(Status.CurrentLine);
|
||||
AddFormatParamInt(Status.CompiledLines);
|
||||
{$ifdef HASGETHEAPSTATUS}
|
||||
GetHeapStatus(hstatus);
|
||||
AddFormatParamInt(hstatus.CurrHeapUsed div 1024);
|
||||
AddFormatParamInt(hstatus.CurrHeapSize div 1024);
|
||||
{$else}
|
||||
AddFormatParamInt((Heapsize-MemAvail) div 1024);
|
||||
AddFormatParamInt(Heapsize div 1024);
|
||||
{$endif}
|
||||
AddFormatParamInt(Status.ErrorCount);
|
||||
ST^.SetText(
|
||||
FormatStrF(
|
||||
@ -1256,7 +1265,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.32 2004-11-20 14:21:19 florian
|
||||
Revision 1.33 2004-11-22 19:34:58 peter
|
||||
* GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
|
||||
|
||||
Revision 1.32 2004/11/20 14:21:19 florian
|
||||
* implemented reload menu item
|
||||
* increased file history to 9 files
|
||||
|
||||
|
||||
@ -150,22 +150,10 @@ begin
|
||||
CMemSize:=pptrint(p-sizeof(ptrint))^;
|
||||
end;
|
||||
|
||||
Function CMemAvail : ptrint;
|
||||
Procedure CGetHeapStatus(var status:THeapStatus);
|
||||
|
||||
begin
|
||||
CMemAvail:=0;
|
||||
end;
|
||||
|
||||
Function CMaxAvail: ptrint;
|
||||
|
||||
begin
|
||||
CMaxAvail:=0;
|
||||
end;
|
||||
|
||||
Function CHeapSize : ptrint;
|
||||
|
||||
begin
|
||||
CHeapSize:=0;
|
||||
fillchar(status,sizeof(status),0);
|
||||
end;
|
||||
|
||||
|
||||
@ -179,9 +167,7 @@ Const
|
||||
AllocMem : @CAllocMem;
|
||||
ReallocMem : @CReAllocMem;
|
||||
MemSize : @CMemSize;
|
||||
MemAvail : @CMemAvail;
|
||||
MaxAvail : @CMaxAvail;
|
||||
HeapSize : @CHeapSize;
|
||||
GetHeapStatus : @CGetHeapStatus;
|
||||
);
|
||||
|
||||
Var
|
||||
@ -197,7 +183,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 2004-11-21 21:14:14 peter
|
||||
Revision 1.11 2004-11-22 19:34:58 peter
|
||||
* GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
|
||||
|
||||
Revision 1.10 2004/11/21 21:14:14 peter
|
||||
* Freemem(p,0) does nothing
|
||||
|
||||
Revision 1.9 2004/09/19 19:04:11 olle
|
||||
|
||||
147
rtl/inc/heap.inc
147
rtl/inc/heap.inc
@ -70,9 +70,7 @@ const
|
||||
AllocMem: @SysAllocMem;
|
||||
ReAllocMem: @SysReAllocMem;
|
||||
MemSize: @SysMemSize;
|
||||
MemAvail: @SysMemAvail;
|
||||
MaxAvail: @SysMaxAvail;
|
||||
HeapSize: @SysHeapSize;
|
||||
GetHeapStatus: @GetHeapStatus;
|
||||
);
|
||||
|
||||
MemoryMutexManager: TMemoryMutexManager = (
|
||||
@ -130,8 +128,8 @@ type
|
||||
pfreelists = ^tfreelists;
|
||||
|
||||
var
|
||||
internal_memavail : ptrint;
|
||||
internal_heapsize : ptrint;
|
||||
internal_status : THeapStatus;
|
||||
|
||||
freelists_fixed : tfreelists;
|
||||
freelist_var : pmemchunk_var;
|
||||
freeoslist : poschunk;
|
||||
@ -254,62 +252,27 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure FreeMemory(p:pointer;Size:ptrint);
|
||||
begin
|
||||
FreeMem(p,size);
|
||||
end;
|
||||
|
||||
function MaxAvail:ptrint;
|
||||
|
||||
procedure GetHeapStatus(var status:THeapStatus);
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
try
|
||||
MemoryMutexManager.MutexLock;
|
||||
MaxAvail := MemoryManager.MaxAvail();
|
||||
MemoryManager.GetHeapStatus(status);
|
||||
finally
|
||||
MemoryMutexManager.MutexUnlock;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
MaxAvail := MemoryManager.MaxAvail();
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function MemAvail:ptrint;
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
try
|
||||
MemoryMutexManager.MutexLock;
|
||||
MemAvail := MemoryManager.MemAvail();
|
||||
finally
|
||||
MemoryMutexManager.MutexUnlock;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
MemAvail := MemoryManager.MemAvail();
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ FPC Additions }
|
||||
function HeapSize:ptrint;
|
||||
begin
|
||||
if IsMultiThread and MemoryManager.NeedLock then
|
||||
begin
|
||||
try
|
||||
MemoryMutexManager.MutexLock;
|
||||
HeapSize := MemoryManager.HeapSize();
|
||||
finally
|
||||
MemoryMutexManager.MutexUnlock;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
HeapSize := MemoryManager.HeapSize();
|
||||
MemoryManager.GetHeapStatus(status);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -483,46 +446,33 @@ end;
|
||||
{$endif ValueFreemem}
|
||||
|
||||
|
||||
{ Bootstrapping }
|
||||
{$ifndef HASGETHEAPSTATUS}
|
||||
Function Memavail:ptrint;
|
||||
begin
|
||||
result:=0;
|
||||
end;
|
||||
Function Maxavail:ptrint;
|
||||
begin
|
||||
result:=0;
|
||||
end;
|
||||
Function Heapsize:ptrint;
|
||||
begin
|
||||
result:=0;
|
||||
end;
|
||||
{$endif HASGETHEAPSTATUS}
|
||||
|
||||
{*****************************************************************************
|
||||
Heapsize,Memavail,MaxAvail
|
||||
GetHeapStatus
|
||||
*****************************************************************************}
|
||||
|
||||
function SysHeapsize : ptrint;
|
||||
procedure SysGetHeapStatus(var status:THeapStatus);
|
||||
begin
|
||||
Sysheapsize := internal_heapsize;
|
||||
internal_status.CurrHeapFree:=internal_status.CurrHeapSize-internal_status.CurrHeapUsed;
|
||||
status:=internal_status;
|
||||
end;
|
||||
|
||||
|
||||
function SysMemavail : ptrint;
|
||||
begin
|
||||
Sysmemavail := internal_memavail;
|
||||
end;
|
||||
|
||||
|
||||
function SysMaxavail: ptrint;
|
||||
var
|
||||
pmc : pmemchunk_var;
|
||||
i: longint;
|
||||
begin
|
||||
pmc := freelist_var;
|
||||
sysmaxavail := 0;
|
||||
while assigned(pmc) do
|
||||
begin
|
||||
if pmc^.size>sysmaxavail then
|
||||
sysmaxavail := pmc^.size;
|
||||
pmc := pmc^.next_var;
|
||||
end;
|
||||
if sysmaxavail = 0 then
|
||||
begin
|
||||
for i := maxblockindex downto 1 do
|
||||
if assigned(freelists_fixed[i]) then
|
||||
begin
|
||||
sysmaxavail := i shl blockshr;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef DUMPBLOCKS} // TODO
|
||||
procedure DumpBlocks;
|
||||
@ -626,8 +576,7 @@ begin
|
||||
{$ifdef HAS_SYSOSFREE}
|
||||
if freeoslistcount >= 3 then
|
||||
begin
|
||||
dec(internal_heapsize, poc^.size);
|
||||
dec(internal_memavail, poc^.size);
|
||||
dec(internal_status.currheapsize, poc^.size);
|
||||
SysOSFree(poc, poc^.size);
|
||||
end
|
||||
else
|
||||
@ -841,8 +790,9 @@ begin
|
||||
end;
|
||||
end;
|
||||
{ set the total new heap size }
|
||||
inc(internal_memavail,size);
|
||||
inc(internal_heapsize,size);
|
||||
inc(internal_status.currheapsize,size);
|
||||
if internal_status.currheapsize>internal_status.maxheapsize then
|
||||
internal_status.maxheapsize:=internal_status.currheapsize;
|
||||
end;
|
||||
{ initialize os-block }
|
||||
poschunk(result)^.used := 0;
|
||||
@ -1008,7 +958,9 @@ begin
|
||||
size := (size+sizeof(tmemchunk_var_hdr)+(blocksize-1)) and sizemask;
|
||||
sysgetmem := sysgetmem_var(size);
|
||||
end;
|
||||
dec(internal_memavail,size);
|
||||
inc(internal_status.currheapused,size);
|
||||
if internal_status.currheapused>internal_status.maxheapused then
|
||||
internal_status.maxheapused:=internal_status.currheapused;
|
||||
end;
|
||||
|
||||
|
||||
@ -1025,7 +977,7 @@ begin
|
||||
pcurrsize := pcurr^.size and fixedsizemask;
|
||||
if size<>pcurrsize then
|
||||
HandleError(204);
|
||||
inc(internal_memavail,pcurrsize);
|
||||
dec(internal_status.currheapused,pcurrsize);
|
||||
{ insert the block in it's freelist }
|
||||
pcurr^.size := pcurr^.size and (not usedflag);
|
||||
blockindex := pcurrsize shr blockshr;
|
||||
@ -1054,7 +1006,7 @@ begin
|
||||
pcurrsize := pcurr^.size and sizemask;
|
||||
if size<>pcurrsize then
|
||||
HandleError(204);
|
||||
inc(internal_memavail,pcurrsize);
|
||||
inc(internal_status.currheapused,pcurrsize);
|
||||
{ insert the block in it's freelist }
|
||||
pcurr^.size := pcurr^.size and (not usedflag);
|
||||
append_to_list_var(pcurr);
|
||||
@ -1226,7 +1178,7 @@ begin
|
||||
split_block(pcurr, size);
|
||||
SysTryResizeMem := true;
|
||||
end;
|
||||
dec(internal_memavail,size-oldsize);
|
||||
inc(internal_status.currheapused,size-oldsize);
|
||||
{$ifdef TestFreeLists}
|
||||
if test_each then
|
||||
TestFreeLists;
|
||||
@ -1273,21 +1225,6 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
Mark/Release
|
||||
*****************************************************************************}
|
||||
|
||||
procedure release(var p : pointer);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure mark(var p : pointer);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
MemoryMutexManager default hooks
|
||||
*****************************************************************************}
|
||||
@ -1329,13 +1266,15 @@ begin
|
||||
freelist_var := nil;
|
||||
freeoslist := nil;
|
||||
freeoslistcount := 0;
|
||||
internal_heapsize := 0;
|
||||
internal_memavail := 0;
|
||||
fillchar(internal_status,sizeof(internal_status),0);
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.37 2004-10-25 15:38:59 peter
|
||||
Revision 1.38 2004-11-22 19:34:58 peter
|
||||
* GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
|
||||
|
||||
Revision 1.37 2004/10/25 15:38:59 peter
|
||||
* compiler defined HEAP and HEAPSIZE removed
|
||||
|
||||
Revision 1.36 2004/08/10 18:58:36 jonas
|
||||
|
||||
@ -16,6 +16,13 @@
|
||||
|
||||
{ Memorymanager }
|
||||
type
|
||||
THeapStatus = record
|
||||
MaxHeapSize,
|
||||
MaxHeapUsed,
|
||||
CurrHeapSize,
|
||||
CurrHeapUsed,
|
||||
CurrHeapFree : ptrint;
|
||||
end;
|
||||
PMemoryManager = ^TMemoryManager;
|
||||
TMemoryManager = record
|
||||
NeedLock : boolean;
|
||||
@ -25,9 +32,7 @@ type
|
||||
AllocMem : Function(Size:ptrint):Pointer;
|
||||
ReAllocMem : Function(var p:pointer;Size:ptrint):Pointer;
|
||||
MemSize : function(p:pointer):ptrint;
|
||||
MemAvail : Function:ptrint;
|
||||
MaxAvail : Function:ptrint;
|
||||
HeapSize : Function:ptrint;
|
||||
GetHeapStatus : procedure(var status:THeapStatus);
|
||||
end;
|
||||
TMemoryMutexManager = record
|
||||
MutexInit : procedure;
|
||||
@ -56,21 +61,16 @@ 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;
|
||||
Function Sysmemavail:ptrint;
|
||||
Function Sysmaxavail:ptrint;
|
||||
Function Sysheapsize:ptrint;
|
||||
procedure SysGetHeapStatus(var status:THeapStatus);
|
||||
|
||||
{ Tp7 functions }
|
||||
Procedure Getmem(Var p:pointer;Size:ptrint);
|
||||
Procedure Getmemory(Var p:pointer;Size:ptrint);
|
||||
Procedure Freemem(p:pointer;Size:ptrint);
|
||||
Procedure Freememory(p:pointer;Size:ptrint);
|
||||
Function memavail:ptrint;
|
||||
Function maxavail:ptrint;
|
||||
|
||||
{ FPC additions }
|
||||
Function MemSize(p:pointer):ptrint;
|
||||
Function heapsize:ptrint;
|
||||
|
||||
{ Delphi functions }
|
||||
function GetMem(size:ptrint):pointer;
|
||||
@ -80,10 +80,7 @@ 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;
|
||||
|
||||
{ Do nothing functions, are only here for tp7 compat }
|
||||
Procedure mark(var p : pointer);
|
||||
Procedure release(var p : pointer);
|
||||
procedure GetHeapStatus(var status:THeapStatus);
|
||||
|
||||
{$ifndef ValueGetmem}
|
||||
{ Needed to solve overloading problem with call from assembler (PFV) }
|
||||
@ -93,9 +90,19 @@ Procedure AsmGetmem(var p:pointer;size:ptrint);
|
||||
Procedure AsmFreemem(var p:pointer);
|
||||
{$endif ValueFreemem}
|
||||
|
||||
{ Bootstrapping }
|
||||
{$ifndef HASGETHEAPSTATUS}
|
||||
Function Memavail:ptrint;
|
||||
Function Maxavail:ptrint;
|
||||
Function Heapsize:ptrint;
|
||||
{$endif HASGETHEAPSTATUS}
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 2004-06-29 20:50:32 peter
|
||||
Revision 1.12 2004-11-22 19:34:58 peter
|
||||
* GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
|
||||
|
||||
Revision 1.11 2004/06/29 20:50:32 peter
|
||||
* readded support for ReturnIfGrowHeapFails
|
||||
|
||||
Revision 1.10 2004/06/20 09:24:40 peter
|
||||
|
||||
@ -852,23 +852,25 @@ procedure dumpheap;
|
||||
var
|
||||
pp : pheap_mem_info;
|
||||
i : ptrint;
|
||||
ExpectedMemAvail : ptrint;
|
||||
ExpectedHeapFree : ptrint;
|
||||
status : THeapStatus;
|
||||
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);
|
||||
Write(ptext^,'True heap size : ',system.HeapSize);
|
||||
SysGetHeapStatus(status);
|
||||
Write(ptext^,'True heap size : ',status.CurrHeapSize);
|
||||
if EntryMemUsed > 0 then
|
||||
Writeln(ptext^,' (',EntryMemUsed,' used in System startup)')
|
||||
else
|
||||
Writeln(ptext^);
|
||||
Writeln(ptext^,'True free heap : ',MemAvail);
|
||||
ExpectedMemAvail:=system.HeapSize-(getmem8_size-freemem8_size)-
|
||||
Writeln(ptext^,'True free heap : ',status.CurrHeapFree);
|
||||
ExpectedHeapFree:=status.CurrHeapSize-(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);
|
||||
If ExpectedHeapFree<>status.CurrHeapFree then
|
||||
Writeln(ptext^,'Should be : ',ExpectedHeapFree);
|
||||
i:=getmem_cnt-freemem_cnt;
|
||||
while pp<>nil do
|
||||
begin
|
||||
@ -935,19 +937,9 @@ end;
|
||||
No specific tracing calls
|
||||
*****************************************************************************}
|
||||
|
||||
function TraceMemAvail:ptrint;
|
||||
procedure TraceGetHeapStatus(var status:THeapStatus);
|
||||
begin
|
||||
TraceMemAvail:=SysMemAvail;
|
||||
end;
|
||||
|
||||
function TraceMaxAvail:ptrint;
|
||||
begin
|
||||
TraceMaxAvail:=SysMaxAvail;
|
||||
end;
|
||||
|
||||
function TraceHeapSize:ptrint;
|
||||
begin
|
||||
TraceHeapSize:=SysHeapSize;
|
||||
SysGetHeapStatus(status);
|
||||
end;
|
||||
|
||||
|
||||
@ -999,15 +991,16 @@ const
|
||||
AllocMem : @TraceAllocMem;
|
||||
ReAllocMem : @TraceReAllocMem;
|
||||
MemSize : @TraceMemSize;
|
||||
MemAvail : @TraceMemAvail;
|
||||
MaxAvail : @TraceMaxAvail;
|
||||
HeapSize : @TraceHeapsize;
|
||||
GetHeapStatus : @TraceGetHeapStatus;
|
||||
);
|
||||
|
||||
|
||||
procedure TraceInit;
|
||||
var
|
||||
initheapstatus : THeapStatus;
|
||||
begin
|
||||
EntryMemUsed:=System.HeapSize-MemAvail;
|
||||
SysGetHeapStatus(initheapstatus);
|
||||
EntryMemUsed:=initheapstatus.CurrHeapUsed;
|
||||
MakeCRC32Tbl;
|
||||
SetMemoryManager(TraceManager);
|
||||
ptext:=@stderr;
|
||||
@ -1151,7 +1144,10 @@ finalization
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.36 2004-10-25 17:04:07 peter
|
||||
Revision 1.37 2004-11-22 19:34:58 peter
|
||||
* GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
|
||||
|
||||
Revision 1.36 2004/10/25 17:04:07 peter
|
||||
* fix for non-i386
|
||||
|
||||
Revision 1.35 2004/10/25 15:38:59 peter
|
||||
|
||||
@ -1860,7 +1860,7 @@ END;
|
||||
{---------------------------------------------------------------------------}
|
||||
FUNCTION TMemoryStream.ChangeListSize (ALimit: Longint): Boolean;
|
||||
VAR
|
||||
I, W: Longint;
|
||||
W: Longint;
|
||||
Li: LongInt;
|
||||
P: PPointerArray;
|
||||
BEGIN
|
||||
@ -1869,14 +1869,8 @@ BEGIN
|
||||
If (ALimit > MaxPtrs) Then Exit; { To many blocks req }
|
||||
If (ALimit <> 0) Then Begin { Create segment list }
|
||||
Li := ALimit * SizeOf(Pointer); { Block array size }
|
||||
If (MaxAvail > Li) Then Begin
|
||||
GetMem(P, Li); { Allocate memory }
|
||||
FillChar(P^, Li, #0); { Clear the memory }
|
||||
End Else Begin
|
||||
GetMem(P,Li);
|
||||
If P = Nil Then Exit;
|
||||
FillChar(P^, Li, #0); { Clear the memory }
|
||||
End; { Insufficient memory }
|
||||
GetMem(P, Li); { Allocate memory }
|
||||
FillChar(P^, Li, #0); { Clear the memory }
|
||||
If (BlkCount <> 0) AND (BlkList <> Nil) Then { Current list valid }
|
||||
If (BlkCount <= ALimit) Then Move(BlkList^,
|
||||
P^, BlkCount * SizeOf(Pointer)) Else { Move whole old list }
|
||||
@ -1887,15 +1881,7 @@ BEGIN
|
||||
FreeMem(BlkList^[W], BlkSize); { Release memory block }
|
||||
If (P <> Nil) AND (ALimit > BlkCount) Then Begin { Expand stream size }
|
||||
For W := BlkCount To ALimit-1 Do Begin
|
||||
If (MaxAvail < BlkSize) Then Begin { Check enough memory }
|
||||
GetMem(P^[W],BlkSize);
|
||||
If P = Nil Then Begin
|
||||
For I := BlkCount To W-1 Do
|
||||
FreeMem(P^[I], BlkSize); { Free mem allocated }
|
||||
FreeMem(P, Li); { Release memory }
|
||||
Exit;
|
||||
End { Now exit }
|
||||
End Else GetMem(P^[W], BlkSize); { Allocate memory }
|
||||
GetMem(P^[W], BlkSize); { Allocate memory }
|
||||
End;
|
||||
End;
|
||||
If (BlkCount <> 0) AND (BlkList<>Nil) Then
|
||||
@ -3019,7 +3005,10 @@ BEGIN
|
||||
END.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.35 2004-11-02 23:53:19 peter
|
||||
Revision 1.36 2004-11-22 19:34:58 peter
|
||||
* GetHeapStatus added, removed MaxAvail,MemAvail,HeapSize
|
||||
|
||||
Revision 1.35 2004/11/02 23:53:19 peter
|
||||
* fixed crashes with ide and 1.9.x
|
||||
|
||||
Revision 1.34 2004/10/03 17:43:47 florian
|
||||
|
||||
Loading…
Reference in New Issue
Block a user