mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2026-01-08 11:01:41 +01:00
* Convert heap to ptruint.
git-svn-id: trunk@7950 -
This commit is contained in:
daniel
parent
0d8594a705
commit
0c3a2a257d
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -4897,7 +4897,7 @@ rtl/nds/prt07.as -text
|
||||
rtl/nds/prt09.as -text
|
||||
rtl/nds/sysdir.inc -text
|
||||
rtl/nds/sysfile.inc -text
|
||||
rtl/nds/sysheap.inc -text
|
||||
rtl/nds/sysheap.inc svneol=native#text/x-pascal
|
||||
rtl/nds/sysos.inc -text
|
||||
rtl/nds/sysosh.inc -text
|
||||
rtl/nds/systhrd.inc -text
|
||||
|
||||
@ -20,7 +20,7 @@
|
||||
OS Memory allocation / deallocation
|
||||
****************************************************************************}
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
{$IFDEF MOSFPC_MEMDEBUG}
|
||||
var values: array[0..2] of dword;
|
||||
{$ENDIF}
|
||||
@ -36,7 +36,7 @@ end;
|
||||
|
||||
{$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
{$IFDEF MOSFPC_MEMDEBUG}
|
||||
var values: array[0..2] of dword;
|
||||
{$ENDIF}
|
||||
|
||||
@ -16,7 +16,7 @@
|
||||
**********************************************************************}
|
||||
function sbrk2 (size : longint):pointer; cdecl; external name 'sbrk';
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
begin
|
||||
result := sbrk2(size);
|
||||
{ result:=Fpmmap(nil,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
|
||||
@ -29,7 +29,7 @@ end;
|
||||
|
||||
{$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
begin
|
||||
// fpmunmap(p, size);
|
||||
// WriteLn('TODO : SysOSFree');
|
||||
|
||||
@ -18,14 +18,14 @@
|
||||
****************************************************************************}
|
||||
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
begin
|
||||
result := pointer($02000000);
|
||||
end;
|
||||
|
||||
{ $define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
@ -65,14 +65,14 @@ asm
|
||||
end {['eax', 'edx']};
|
||||
{$ENDIF DUMPGROW}
|
||||
|
||||
function SysOSAlloc (Size: ptrint): pointer;
|
||||
function SysOSAlloc (Size: ptruint): pointer;
|
||||
begin
|
||||
SysOSAlloc := Sbrk (Size);
|
||||
end;
|
||||
|
||||
{.$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree (P: pointer; Size: ptrint);
|
||||
procedure SysOSFree (P: pointer; Size: ptruint);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
@ -18,13 +18,13 @@
|
||||
****************************************************************************}
|
||||
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
begin
|
||||
result := pointer($02000000);
|
||||
end;
|
||||
|
||||
{ $define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
begin
|
||||
end;
|
||||
|
||||
@ -22,7 +22,7 @@
|
||||
|
||||
function __sbrk(size:longint):longint;cdecl;external;
|
||||
|
||||
function SysOSAlloc (size: PtrInt): pointer; assembler;
|
||||
function SysOSAlloc (size: ptruint): pointer; assembler;
|
||||
asm
|
||||
{$ifdef SYSTEMDEBUG}
|
||||
cmpb $1,accept_sbrk
|
||||
@ -51,7 +51,7 @@ end;
|
||||
}
|
||||
{.$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
@ -35,37 +35,34 @@ Const
|
||||
LibName = 'c';
|
||||
{$endif}
|
||||
|
||||
Function Malloc (Size : ptrint) : Pointer; {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'malloc';
|
||||
Function Malloc (Size : ptruint) : Pointer; {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'malloc';
|
||||
Procedure Free (P : pointer); {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'free';
|
||||
function ReAlloc (P : Pointer; Size : ptrint) : pointer; {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'realloc';
|
||||
Function CAlloc (unitSize,UnitCount : ptrint) : pointer; {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'calloc';
|
||||
function ReAlloc (P : Pointer; Size : ptruint) : pointer; {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'realloc';
|
||||
Function CAlloc (unitSize,UnitCount : ptruint) : pointer; {$ifdef win32}stdcall{$else}cdecl{$endif}; external LibName name 'calloc';
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
pptrint = ^ptrint;
|
||||
|
||||
Function CGetMem (Size : ptrint) : Pointer;
|
||||
Function CGetMem (Size : ptruint) : Pointer;
|
||||
|
||||
begin
|
||||
CGetMem:=Malloc(Size+sizeof(ptrint));
|
||||
CGetMem:=Malloc(Size+sizeof(ptruint));
|
||||
if (CGetMem <> nil) then
|
||||
begin
|
||||
pptrint(CGetMem)^ := size;
|
||||
inc(CGetMem,sizeof(ptrint));
|
||||
Pptruint(CGetMem)^ := size;
|
||||
inc(CGetMem,sizeof(ptruint));
|
||||
end;
|
||||
end;
|
||||
|
||||
Function CFreeMem (P : pointer) : ptrint;
|
||||
Function CFreeMem (P : pointer) : ptruint;
|
||||
|
||||
begin
|
||||
if (p <> nil) then
|
||||
dec(p,sizeof(ptrint));
|
||||
dec(p,sizeof(ptruint));
|
||||
Free(P);
|
||||
CFreeMem:=0;
|
||||
end;
|
||||
|
||||
Function CFreeMemSize(p:pointer;Size:ptrint):ptrint;
|
||||
Function CFreeMemSize(p:pointer;Size:ptruint):ptruint;
|
||||
|
||||
begin
|
||||
if size<=0 then
|
||||
@ -76,58 +73,58 @@ begin
|
||||
end;
|
||||
if (p <> nil) then
|
||||
begin
|
||||
if (size <> pptrint(p-sizeof(ptrint))^) then
|
||||
if (size <> Pptruint(p-sizeof(ptruint))^) then
|
||||
runerror(204);
|
||||
end;
|
||||
CFreeMemSize:=CFreeMem(P);
|
||||
end;
|
||||
|
||||
Function CAllocMem(Size : ptrint) : Pointer;
|
||||
Function CAllocMem(Size : ptruint) : Pointer;
|
||||
|
||||
begin
|
||||
CAllocMem:=calloc(Size+sizeof(ptrint),1);
|
||||
CAllocMem:=calloc(Size+sizeof(ptruint),1);
|
||||
if (CAllocMem <> nil) then
|
||||
begin
|
||||
pptrint(CAllocMem)^ := size;
|
||||
inc(CAllocMem,sizeof(ptrint));
|
||||
Pptruint(CAllocMem)^ := size;
|
||||
inc(CAllocMem,sizeof(ptruint));
|
||||
end;
|
||||
end;
|
||||
|
||||
Function CReAllocMem (var p:pointer;Size:ptrint):Pointer;
|
||||
Function CReAllocMem (var p:pointer;Size:ptruint):Pointer;
|
||||
|
||||
begin
|
||||
if size=0 then
|
||||
begin
|
||||
if p<>nil then
|
||||
begin
|
||||
dec(p,sizeof(ptrint));
|
||||
dec(p,sizeof(ptruint));
|
||||
free(p);
|
||||
p:=nil;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
inc(size,sizeof(ptrint));
|
||||
inc(size,sizeof(ptruint));
|
||||
if p=nil then
|
||||
p:=malloc(Size)
|
||||
else
|
||||
begin
|
||||
dec(p,sizeof(ptrint));
|
||||
dec(p,sizeof(ptruint));
|
||||
p:=realloc(p,size);
|
||||
end;
|
||||
if (p <> nil) then
|
||||
begin
|
||||
pptrint(p)^ := size-sizeof(ptrint);
|
||||
inc(p,sizeof(ptrint));
|
||||
Pptruint(p)^ := size-sizeof(ptruint);
|
||||
inc(p,sizeof(ptruint));
|
||||
end;
|
||||
end;
|
||||
CReAllocMem:=p;
|
||||
end;
|
||||
|
||||
Function CMemSize (p:pointer): ptrint;
|
||||
Function CMemSize (p:pointer): ptruint;
|
||||
|
||||
begin
|
||||
CMemSize:=pptrint(p-sizeof(ptrint))^;
|
||||
CMemSize:=Pptruint(p-sizeof(ptruint))^;
|
||||
end;
|
||||
|
||||
function CGetHeapStatus:THeapStatus;
|
||||
|
||||
104
rtl/inc/heap.inc
104
rtl/inc/heap.inc
@ -132,7 +132,7 @@ type
|
||||
|
||||
poschunk = ^toschunk;
|
||||
toschunk = record
|
||||
size : ptrint;
|
||||
size : 0..high(ptrint); {Cannot be ptruint because used field is signed.}
|
||||
next_free : poschunk;
|
||||
prev_any : poschunk;
|
||||
next_any : poschunk;
|
||||
@ -145,7 +145,7 @@ type
|
||||
pmemchunk_fixed = ^tmemchunk_fixed;
|
||||
tmemchunk_fixed = record
|
||||
{ aligning is done automatically in alloc_oschunk }
|
||||
size : ptrint;
|
||||
size : ptruint;
|
||||
next_fixed,
|
||||
prev_fixed : pmemchunk_fixed;
|
||||
end;
|
||||
@ -153,9 +153,9 @@ type
|
||||
ppmemchunk_var = ^pmemchunk_var;
|
||||
pmemchunk_var = ^tmemchunk_var;
|
||||
tmemchunk_var = record
|
||||
prevsize : ptrint;
|
||||
prevsize : ptruint;
|
||||
freelists : pfreelists;
|
||||
size : ptrint;
|
||||
size : ptruint;
|
||||
next_var,
|
||||
prev_var : pmemchunk_var;
|
||||
end;
|
||||
@ -166,12 +166,12 @@ type
|
||||
record. }
|
||||
tmemchunk_fixed_hdr = record
|
||||
{ aligning is done automatically in alloc_oschunk }
|
||||
size : ptrint;
|
||||
size : ptruint;
|
||||
end;
|
||||
tmemchunk_var_hdr = record
|
||||
prevsize : ptrint;
|
||||
prevsize : ptruint;
|
||||
freelists : pfreelists;
|
||||
size : ptrint;
|
||||
size : ptruint;
|
||||
end;
|
||||
|
||||
pfpcheapstatus = ^tfpcheapstatus;
|
||||
@ -244,22 +244,22 @@ begin
|
||||
or (MemoryManager.FreeMem<>@SysFreeMem);
|
||||
end;
|
||||
|
||||
procedure GetMem(Var p:pointer;Size:ptrint);
|
||||
procedure GetMem(Var p:pointer;Size:ptruint);
|
||||
begin
|
||||
p := MemoryManager.GetMem(Size);
|
||||
end;
|
||||
|
||||
procedure GetMemory(Var p:pointer;Size:ptrint);
|
||||
procedure GetMemory(Var p:pointer;Size:ptruint);
|
||||
begin
|
||||
GetMem(p,size);
|
||||
end;
|
||||
|
||||
procedure FreeMem(p:pointer;Size:ptrint);
|
||||
procedure FreeMem(p:pointer;Size:ptruint);
|
||||
begin
|
||||
MemoryManager.FreeMemSize(p,Size);
|
||||
end;
|
||||
|
||||
procedure FreeMemory(p:pointer;Size:ptrint);
|
||||
procedure FreeMemory(p:pointer;Size:ptruint);
|
||||
begin
|
||||
FreeMem(p,size);
|
||||
end;
|
||||
@ -277,52 +277,52 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function MemSize(p:pointer):ptrint;
|
||||
function MemSize(p:pointer):ptruint;
|
||||
begin
|
||||
MemSize := MemoryManager.MemSize(p);
|
||||
end;
|
||||
|
||||
|
||||
{ Delphi style }
|
||||
function FreeMem(p:pointer):ptrint;[Public,Alias:'FPC_FREEMEM_X'];
|
||||
function FreeMem(p:pointer):ptruint;[Public,Alias:'FPC_FREEMEM_X'];
|
||||
begin
|
||||
FreeMem := MemoryManager.FreeMem(p);
|
||||
end;
|
||||
|
||||
function FreeMemory(p:pointer):ptrint;
|
||||
function FreeMemory(p:pointer):ptruint;
|
||||
begin
|
||||
FreeMemory := FreeMem(p);
|
||||
end;
|
||||
|
||||
function GetMem(size:ptrint):pointer;
|
||||
function GetMem(size:ptruint):pointer;
|
||||
begin
|
||||
GetMem := MemoryManager.GetMem(Size);
|
||||
end;
|
||||
|
||||
function GetMemory(size:ptrint):pointer;
|
||||
function GetMemory(size:ptruint):pointer;
|
||||
begin
|
||||
GetMemory := GetMem(size);
|
||||
end;
|
||||
|
||||
function AllocMem(Size:ptrint):pointer;
|
||||
function AllocMem(Size:ptruint):pointer;
|
||||
begin
|
||||
AllocMem := MemoryManager.AllocMem(size);
|
||||
end;
|
||||
|
||||
|
||||
function ReAllocMem(var p:pointer;Size:ptrint):pointer;
|
||||
function ReAllocMem(var p:pointer;Size:ptruint):pointer;
|
||||
begin
|
||||
ReAllocMem := MemoryManager.ReAllocMem(p,size);
|
||||
end;
|
||||
|
||||
function ReAllocMemory(var p:pointer;Size:ptrint):pointer;
|
||||
function ReAllocMemory(var p:pointer;Size:ptruint):pointer;
|
||||
begin
|
||||
ReAllocMemory := ReAllocMem(p,size);
|
||||
end;
|
||||
|
||||
|
||||
{ Needed for calls from Assembler }
|
||||
function fpc_getmem(size:ptrint):pointer;compilerproc;[public,alias:'FPC_GETMEM'];
|
||||
function fpc_getmem(size:ptruint):pointer;compilerproc;[public,alias:'FPC_GETMEM'];
|
||||
begin
|
||||
fpc_GetMem := MemoryManager.GetMem(size);
|
||||
end;
|
||||
@ -368,7 +368,7 @@ end;
|
||||
{$ifdef DUMPBLOCKS} // TODO
|
||||
procedure DumpBlocks(loc_freelists: pfreelists);
|
||||
var
|
||||
s,i,j : ptrint;
|
||||
s,i,j : ptruint;
|
||||
hpfixed : pmemchunk_fixed;
|
||||
hpvar : pmemchunk_var;
|
||||
begin
|
||||
@ -427,7 +427,7 @@ end;
|
||||
|
||||
{$ifdef HEAP_DEBUG}
|
||||
|
||||
function find_fixed_mc(loc_freelists: pfreelists; chunkindex: ptrint;
|
||||
function find_fixed_mc(loc_freelists: pfreelists; chunkindex: ptruint;
|
||||
pmc: pmemchunk_fixed): boolean;
|
||||
var
|
||||
pmc_temp: pmemchunk_fixed;
|
||||
@ -469,7 +469,7 @@ procedure remove_freed_fixed_chunks(poc: poschunk);
|
||||
var
|
||||
pmc, pmc_end: pmemchunk_fixed;
|
||||
fixedlist: ppmemchunk_fixed;
|
||||
chunksize: ptrint;
|
||||
chunksize: ptruint;
|
||||
begin
|
||||
{ exit if this is a var size os chunk, function only applicable to fixed size }
|
||||
if poc^.used < 0 then
|
||||
@ -486,7 +486,7 @@ end;
|
||||
|
||||
procedure free_oschunk(loc_freelists: pfreelists; poc: poschunk);
|
||||
var
|
||||
pocsize: ptrint;
|
||||
pocsize: ptruint;
|
||||
begin
|
||||
remove_freed_fixed_chunks(poc);
|
||||
if assigned(poc^.prev_any) then
|
||||
@ -579,10 +579,10 @@ end;
|
||||
Split block
|
||||
*****************************************************************************}
|
||||
|
||||
function split_block(pcurr: pmemchunk_var; size: ptrint): ptrint;
|
||||
function split_block(pcurr: pmemchunk_var; size: ptruint): ptruint;
|
||||
var
|
||||
pcurr_tmp : pmemchunk_var;
|
||||
size_flags, oldsize, sizeleft: ptrint;
|
||||
size_flags, oldsize, sizeleft: ptruint;
|
||||
begin
|
||||
size_flags := pcurr^.size;
|
||||
oldsize := size_flags and sizemask;
|
||||
@ -616,7 +616,7 @@ end;
|
||||
procedure concat_two_blocks(mc_left, mc_right: pmemchunk_var);
|
||||
var
|
||||
mc_tmp : pmemchunk_var;
|
||||
size_right : ptrint;
|
||||
size_right : ptruint;
|
||||
begin
|
||||
// mc_right can't be a fixed size block
|
||||
if mc_right^.size and fixedsizeflag<>0 then
|
||||
@ -684,11 +684,11 @@ end;
|
||||
*****************************************************************************}
|
||||
|
||||
function find_free_oschunk(loc_freelists: pfreelists;
|
||||
minsize, maxsize: ptrint; var size: ptrint): poschunk;
|
||||
minsize, maxsize: ptruint; var size: ptruint): poschunk;
|
||||
var
|
||||
pmc: pmemchunk_fixed;
|
||||
prev_poc, poc: poschunk;
|
||||
pocsize: ptrint;
|
||||
pocsize: ptruint;
|
||||
begin
|
||||
poc := loc_freelists^.oslist;
|
||||
prev_poc := nil;
|
||||
@ -724,7 +724,7 @@ begin
|
||||
result := poc;
|
||||
end;
|
||||
|
||||
function alloc_oschunk(loc_freelists: pfreelists; chunkindex, size: ptrint): pointer;
|
||||
function alloc_oschunk(loc_freelists: pfreelists; chunkindex, size: ptruint): pointer;
|
||||
var
|
||||
pmc,
|
||||
pmc_next : pmemchunk_fixed;
|
||||
@ -733,9 +733,9 @@ var
|
||||
prev_poc : poschunk;
|
||||
minsize,
|
||||
maxsize,
|
||||
i : ptrint;
|
||||
chunksize : ptrint;
|
||||
pocsize : ptrint;
|
||||
i : ptruint;
|
||||
chunksize : ptruint;
|
||||
pocsize : ptruint;
|
||||
status : pfpcheapstatus;
|
||||
begin
|
||||
{ increase size by size needed for os block header }
|
||||
@ -745,7 +745,7 @@ begin
|
||||
if chunkindex<>0 then
|
||||
maxsize := 1 shl (32-fixedoffsetshift)
|
||||
else
|
||||
maxsize := high(ptrint);
|
||||
maxsize := high(ptruint);
|
||||
{ blocks available in freelist? }
|
||||
poc := find_free_oschunk(loc_freelists, minsize, maxsize, size);
|
||||
if not assigned(poc) and (assigned(orphaned_freelists.waitfixed)
|
||||
@ -886,11 +886,11 @@ end;
|
||||
SysGetMem
|
||||
*****************************************************************************}
|
||||
|
||||
function SysGetMem_Fixed(chunksize: ptrint): pointer;
|
||||
function SysGetMem_Fixed(chunksize: ptruint): pointer;
|
||||
var
|
||||
pmc, pmc_next: pmemchunk_fixed;
|
||||
poc: poschunk;
|
||||
chunkindex: ptrint;
|
||||
chunkindex: ptruint;
|
||||
loc_freelists: pfreelists;
|
||||
begin
|
||||
{ try to find a block in one of the freelists per size }
|
||||
@ -940,12 +940,12 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function SysGetMem_Var(size: ptrint): pointer;
|
||||
function SysGetMem_Var(size: ptruint): pointer;
|
||||
var
|
||||
pcurr : pmemchunk_var;
|
||||
pbest : pmemchunk_var;
|
||||
loc_freelists : pfreelists;
|
||||
iter : longint;
|
||||
iter : cardinal;
|
||||
begin
|
||||
result:=nil;
|
||||
{ free pending items }
|
||||
@ -953,7 +953,7 @@ begin
|
||||
try_finish_waitvarlist(loc_freelists);
|
||||
pbest := nil;
|
||||
pcurr := loc_freelists^.varlist;
|
||||
iter := high(longint);
|
||||
iter := high(iter);
|
||||
while assigned(pcurr) and (iter>0) do
|
||||
begin
|
||||
if (pcurr^.size>size) then
|
||||
@ -1001,7 +1001,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function SysGetMem(size : ptrint):pointer;
|
||||
function SysGetMem(size : ptruint):pointer;
|
||||
begin
|
||||
{ Something to allocate ? }
|
||||
if size<=0 then
|
||||
@ -1055,10 +1055,10 @@ begin
|
||||
leavecriticalsection(heap_lock);
|
||||
end;
|
||||
|
||||
function SysFreeMem_Fixed(loc_freelists: pfreelists; pmc: pmemchunk_fixed): ptrint;
|
||||
function SysFreeMem_Fixed(loc_freelists: pfreelists; pmc: pmemchunk_fixed): ptruint;
|
||||
var
|
||||
chunkindex,
|
||||
chunksize: ptrint;
|
||||
chunksize: ptruint;
|
||||
poc: poschunk;
|
||||
pmc_next: pmemchunk_fixed;
|
||||
begin
|
||||
@ -1093,9 +1093,9 @@ begin
|
||||
result := chunksize;
|
||||
end;
|
||||
|
||||
function SysFreeMem_Var(loc_freelists: pfreelists; pmcv: pmemchunk_var): ptrint;
|
||||
function SysFreeMem_Var(loc_freelists: pfreelists; pmcv: pmemchunk_var): ptruint;
|
||||
var
|
||||
chunksize: ptrint;
|
||||
chunksize: ptruint;
|
||||
begin
|
||||
chunksize := pmcv^.size and sizemask;
|
||||
if loc_freelists <> pmcv^.freelists then
|
||||
@ -1116,7 +1116,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function SysFreeMem(p: pointer): ptrint;
|
||||
function SysFreeMem(p: pointer): ptruint;
|
||||
var
|
||||
pmc: pmemchunk_fixed;
|
||||
loc_freelists: pfreelists;
|
||||
@ -1196,7 +1196,7 @@ end;
|
||||
SysFreeMemSize
|
||||
*****************************************************************************}
|
||||
|
||||
Function SysFreeMemSize(p: pointer; size: ptrint):ptrint;
|
||||
Function SysFreeMemSize(p: pointer; size: ptruint):ptruint;
|
||||
begin
|
||||
if size<=0 then
|
||||
begin
|
||||
@ -1213,7 +1213,7 @@ end;
|
||||
SysMemSize
|
||||
*****************************************************************************}
|
||||
|
||||
function SysMemSize(p: pointer): ptrint;
|
||||
function SysMemSize(p: pointer): ptruint;
|
||||
begin
|
||||
result := pmemchunk_fixed(pointer(p)-sizeof(tmemchunk_fixed_hdr))^.size;
|
||||
if (result and fixedsizeflag) = 0 then
|
||||
@ -1233,7 +1233,7 @@ end;
|
||||
SysAllocMem
|
||||
*****************************************************************************}
|
||||
|
||||
function SysAllocMem(size: ptrint): pointer;
|
||||
function SysAllocMem(size: ptruint): pointer;
|
||||
begin
|
||||
result := MemoryManager.GetMem(size);
|
||||
if result<>nil then
|
||||
@ -1245,11 +1245,11 @@ end;
|
||||
SysResizeMem
|
||||
*****************************************************************************}
|
||||
|
||||
function SysTryResizeMem(var p: pointer; size: ptrint): boolean;
|
||||
function SysTryResizeMem(var p: pointer; size: ptruint): boolean;
|
||||
var
|
||||
chunksize,
|
||||
oldsize,
|
||||
currsize : ptrint;
|
||||
currsize : ptruint;
|
||||
pcurr : pmemchunk_var;
|
||||
pnext : pmemchunk_var;
|
||||
begin
|
||||
@ -1330,11 +1330,11 @@ end;
|
||||
SysResizeMem
|
||||
*****************************************************************************}
|
||||
|
||||
function SysReAllocMem(var p: pointer; size: ptrint):pointer;
|
||||
function SysReAllocMem(var p: pointer; size: ptruint):pointer;
|
||||
var
|
||||
newsize,
|
||||
oldsize,
|
||||
minsize : ptrint;
|
||||
minsize : ptruint;
|
||||
p2 : pointer;
|
||||
begin
|
||||
{ Free block? }
|
||||
|
||||
@ -20,7 +20,7 @@ type
|
||||
MaxHeapUsed,
|
||||
CurrHeapSize,
|
||||
CurrHeapUsed,
|
||||
CurrHeapFree : ptrint;
|
||||
CurrHeapFree : ptruint;
|
||||
end;
|
||||
THeapStatus = record
|
||||
TotalAddrSpace: Cardinal;
|
||||
@ -38,12 +38,12 @@ type
|
||||
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;
|
||||
Getmem : Function(Size:ptruint):Pointer;
|
||||
Freemem : Function(p:pointer):ptruint;
|
||||
FreememSize : Function(p:pointer;Size:ptruint):ptruint;
|
||||
AllocMem : Function(Size:ptruint):Pointer;
|
||||
ReAllocMem : Function(var p:pointer;Size:ptruint):Pointer;
|
||||
MemSize : function(p:pointer):ptruint;
|
||||
InitThread : procedure;
|
||||
DoneThread : procedure;
|
||||
RelocateHeap : procedure;
|
||||
@ -59,40 +59,40 @@ function IsMemoryManagerSet: Boolean;
|
||||
const
|
||||
MaxKeptOSChunks: DWord = 4; { if more than MaxKeptOSChunks are free, the heap manager will release
|
||||
chunks back to the OS }
|
||||
growheapsizesmall : ptrint=32*1024; { fixed-size small blocks will grow with 32k }
|
||||
growheapsize1 : ptrint=256*1024; { < 256k will grow with 256k }
|
||||
growheapsize2 : ptrint=1024*1024; { > 256k will grow with 1m }
|
||||
growheapsizesmall : ptruint=32*1024; { fixed-size small blocks will grow with 32k }
|
||||
growheapsize1 : ptruint=256*1024; { < 256k will grow with 256k }
|
||||
growheapsize2 : ptruint=1024*1024; { > 256k will grow with 1m }
|
||||
var
|
||||
ReturnNilIfGrowHeapFails : boolean;
|
||||
|
||||
{ Default MemoryManager functions }
|
||||
Function SysGetmem(Size:ptrint):Pointer;
|
||||
Function SysFreemem(p:pointer):ptrint;
|
||||
Function SysFreememSize(p:pointer;Size:ptrint):ptrint;
|
||||
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 SysGetmem(Size:ptruint):Pointer;
|
||||
Function SysFreemem(p:pointer):ptruint;
|
||||
Function SysFreememSize(p:pointer;Size:ptruint):ptruint;
|
||||
Function SysMemSize(p:pointer):ptruint;
|
||||
Function SysAllocMem(size:ptruint):Pointer;
|
||||
function SysTryResizeMem(var p:pointer;size:ptruint):boolean;
|
||||
Function SysReAllocMem(var p:pointer;size:ptruint):Pointer;
|
||||
function SysGetHeapStatus:THeapStatus;
|
||||
function SysGetFPCHeapStatus:TFPCHeapStatus;
|
||||
|
||||
{ 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);
|
||||
Procedure Getmem(Var p:pointer;Size:ptruint);
|
||||
Procedure Getmemory(Var p:pointer;Size:ptruint);
|
||||
Procedure Freemem(p:pointer;Size:ptruint);
|
||||
Procedure Freememory(p:pointer;Size:ptruint);
|
||||
|
||||
{ FPC additions }
|
||||
Function MemSize(p:pointer):ptrint;
|
||||
Function MemSize(p:pointer):ptruint;
|
||||
|
||||
{ Delphi functions }
|
||||
function GetMem(size:ptrint):pointer;
|
||||
function GetMemory(size:ptrint):pointer;
|
||||
function Freemem(p:pointer):ptrint;
|
||||
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;
|
||||
function GetMem(size:ptruint):pointer;
|
||||
function GetMemory(size:ptruint):pointer;
|
||||
function Freemem(p:pointer):ptruint;
|
||||
function Freememory(p:pointer):ptruint;
|
||||
function AllocMem(Size:ptruint):pointer;
|
||||
function ReAllocMem(var p:pointer;Size:ptruint):pointer;
|
||||
function ReAllocMemory(var p:pointer;Size:ptruint):pointer;
|
||||
function GetHeapStatus:THeapStatus;
|
||||
function GetFPCHeapStatus:TFPCHeapStatus;
|
||||
|
||||
|
||||
@ -43,7 +43,7 @@ type
|
||||
|
||||
{ Allows to add info pre memory block, see ppheap.pas of the compiler
|
||||
for example source }
|
||||
procedure SetHeapExtraInfo( size : ptrint;fillproc : tfillextrainfoproc;displayproc : tdisplayextrainfoproc);
|
||||
procedure SetHeapExtraInfo(size : ptruint;fillproc : tfillextrainfoproc;displayproc : tdisplayextrainfoproc);
|
||||
|
||||
{ Redirection of the output to a file }
|
||||
procedure SetHeapTraceOutput(const name : string);
|
||||
@ -82,15 +82,12 @@ const
|
||||
|
||||
implementation
|
||||
|
||||
type
|
||||
pptrint = ^ptrint;
|
||||
|
||||
const
|
||||
{ allows to add custom info in heap_mem_info, this is the size that will
|
||||
be allocated for this information }
|
||||
extra_info_size : ptrint = 0;
|
||||
exact_info_size : ptrint = 0;
|
||||
EntryMemUsed : ptrint = 0;
|
||||
extra_info_size : ptruint = 0;
|
||||
exact_info_size : ptruint = 0;
|
||||
EntryMemUsed : ptruint = 0;
|
||||
{ function to fill this info up }
|
||||
fill_extra_info_proc : TFillExtraInfoProc = nil;
|
||||
display_extra_info_proc : TDisplayExtraInfoProc = nil;
|
||||
@ -122,7 +119,7 @@ type
|
||||
next : pheap_mem_info;
|
||||
todolist : ppheap_mem_info;
|
||||
todonext : pheap_mem_info;
|
||||
size : ptrint;
|
||||
size : ptruint;
|
||||
sig : longword;
|
||||
{$ifdef EXTRA}
|
||||
release_sig : longword;
|
||||
@ -143,11 +140,11 @@ type
|
||||
heap_mem_root : pheap_mem_info;
|
||||
heap_free_todo : pheap_mem_info;
|
||||
getmem_cnt,
|
||||
freemem_cnt : ptrint;
|
||||
freemem_cnt : ptruint;
|
||||
getmem_size,
|
||||
freemem_size : ptrint;
|
||||
freemem_size : ptruint;
|
||||
getmem8_size,
|
||||
freemem8_size : ptrint;
|
||||
freemem8_size : ptruint;
|
||||
error_in_heap : boolean;
|
||||
inside_trace_getmem : boolean;
|
||||
end;
|
||||
@ -190,9 +187,9 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Function UpdateCrc32(InitCrc:longword;var InBuf;InLen:ptrint):longword;
|
||||
Function UpdateCrc32(InitCrc:longword;var InBuf;InLen:ptruint):longword;
|
||||
var
|
||||
i : ptrint;
|
||||
i : ptruint;
|
||||
p : pchar;
|
||||
begin
|
||||
p:=@InBuf;
|
||||
@ -207,18 +204,18 @@ end;
|
||||
Function calculate_sig(p : pheap_mem_info) : longword;
|
||||
var
|
||||
crc : longword;
|
||||
pl : pptrint;
|
||||
pl : pptruint;
|
||||
begin
|
||||
crc:=cardinal($ffffffff);
|
||||
crc:=UpdateCrc32(crc,p^.size,sizeof(ptrint));
|
||||
crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(ptrint));
|
||||
crc:=UpdateCrc32(crc,p^.size,sizeof(ptruint));
|
||||
crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(ptruint));
|
||||
if p^.extra_info_size>0 then
|
||||
crc:=UpdateCrc32(crc,p^.extra_info^,p^.exact_info_size);
|
||||
if add_tail then
|
||||
begin
|
||||
{ Check also 4 bytes just after allocation !! }
|
||||
pl:=pointer(p)+p^.extra_info_size+sizeof(theap_mem_info)+p^.size;
|
||||
crc:=UpdateCrc32(crc,pl^,sizeof(ptrint));
|
||||
crc:=UpdateCrc32(crc,pl^,sizeof(ptruint));
|
||||
end;
|
||||
calculate_sig:=crc;
|
||||
end;
|
||||
@ -227,11 +224,11 @@ end;
|
||||
Function calculate_release_sig(p : pheap_mem_info) : longword;
|
||||
var
|
||||
crc : longword;
|
||||
pl : pptrint;
|
||||
pl : pptruint;
|
||||
begin
|
||||
crc:=$ffffffff;
|
||||
crc:=UpdateCrc32(crc,p^.size,sizeof(ptrint));
|
||||
crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(ptrint));
|
||||
crc:=UpdateCrc32(crc,p^.size,sizeof(ptruint));
|
||||
crc:=UpdateCrc32(crc,p^.calls,tracesize*sizeof(ptruint));
|
||||
if p^.extra_info_size>0 then
|
||||
crc:=UpdateCrc32(crc,p^.extra_info^,p^.exact_info_size);
|
||||
{ Check the whole of the whole allocation }
|
||||
@ -242,7 +239,7 @@ begin
|
||||
begin
|
||||
{ Check also 4 bytes just after allocation !! }
|
||||
pl:=pointer(p)+p^.extra_info_size+sizeof(theap_mem_info)+p^.size;
|
||||
crc:=UpdateCrc32(crc,pl^,sizeof(ptrint));
|
||||
crc:=UpdateCrc32(crc,pl^,sizeof(ptruint));
|
||||
end;
|
||||
calculate_release_sig:=crc;
|
||||
end;
|
||||
@ -254,14 +251,14 @@ end;
|
||||
*****************************************************************************}
|
||||
|
||||
function InternalFreeMemSize(loc_info: pheap_info; p: pointer; pp: pheap_mem_info;
|
||||
size: ptrint; release_todo_lock: boolean): ptrint; forward;
|
||||
function TraceFreeMem(p: pointer): ptrint; forward;
|
||||
size: ptruint; release_todo_lock: boolean): ptruint; forward;
|
||||
function TraceFreeMem(p: pointer): ptruint; forward;
|
||||
|
||||
procedure call_stack(pp : pheap_mem_info;var ptext : text);
|
||||
var
|
||||
i : ptrint;
|
||||
i : ptruint;
|
||||
begin
|
||||
writeln(ptext,'Call trace for block $',hexstr(ptrint(pointer(pp)+sizeof(theap_mem_info)),2*sizeof(pointer)),' size ',pp^.size);
|
||||
writeln(ptext,'Call trace for block $',hexstr(pointer(pp)+sizeof(theap_mem_info)),' size ',pp^.size);
|
||||
for i:=1 to tracesize do
|
||||
if pp^.calls[i]<>nil then
|
||||
writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
|
||||
@ -275,9 +272,9 @@ end;
|
||||
|
||||
procedure call_free_stack(pp : pheap_mem_info;var ptext : text);
|
||||
var
|
||||
i : ptrint;
|
||||
i : ptruint;
|
||||
begin
|
||||
writeln(ptext,'Call trace for block at $',hexstr(ptrint(pointer(pp)+sizeof(theap_mem_info)),2*sizeof(pointer)),' size ',pp^.size);
|
||||
writeln(ptext,'Call trace for block at $',hexstr(pointer(pp)+sizeof(theap_mem_info)),' size ',pp^.size);
|
||||
for i:=1 to tracesize div 2 do
|
||||
if pp^.calls[i]<>nil then
|
||||
writeln(ptext,BackTraceStrFunc(pp^.calls[i]));
|
||||
@ -295,7 +292,7 @@ end;
|
||||
|
||||
procedure dump_already_free(p : pheap_mem_info;var ptext : text);
|
||||
begin
|
||||
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),2*sizeof(pointer)),' released');
|
||||
Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' released');
|
||||
call_free_stack(p,ptext);
|
||||
Writeln(ptext,'freed again at');
|
||||
dump_stack(ptext,get_caller_frame(get_frame));
|
||||
@ -303,7 +300,7 @@ end;
|
||||
|
||||
procedure dump_error(p : pheap_mem_info;var ptext : text);
|
||||
begin
|
||||
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),2*sizeof(pointer)),' invalid');
|
||||
Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' invalid');
|
||||
Writeln(ptext,'Wrong signature $',hexstr(p^.sig,8),' instead of ',hexstr(calculate_sig(p),8));
|
||||
dump_stack(ptext,get_caller_frame(get_frame));
|
||||
end;
|
||||
@ -311,9 +308,9 @@ end;
|
||||
{$ifdef EXTRA}
|
||||
procedure dump_change_after(p : pheap_mem_info;var ptext : text);
|
||||
var pp : pchar;
|
||||
i : ptrint;
|
||||
i : ptruint;
|
||||
begin
|
||||
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),2*sizeof(pointer)),' invalid');
|
||||
Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' invalid');
|
||||
Writeln(ptext,'Wrong release CRC $',hexstr(p^.release_sig,8),' instead of ',hexstr(calculate_release_sig(p),8));
|
||||
Writeln(ptext,'This memory was changed after call to freemem !');
|
||||
call_free_stack(p,ptext);
|
||||
@ -324,9 +321,9 @@ begin
|
||||
end;
|
||||
{$endif EXTRA}
|
||||
|
||||
procedure dump_wrong_size(p : pheap_mem_info;size : ptrint;var ptext : text);
|
||||
procedure dump_wrong_size(p : pheap_mem_info;size : ptruint;var ptext : text);
|
||||
begin
|
||||
Writeln(ptext,'Marked memory at $',HexStr(ptrint(pointer(p)+sizeof(theap_mem_info)),2*sizeof(pointer)),' invalid');
|
||||
Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' invalid');
|
||||
Writeln(ptext,'Wrong size : ',p^.size,' allocated ',size,' freed');
|
||||
dump_stack(ptext,get_caller_frame(get_frame));
|
||||
{ the check is done to be sure that the procvar is not overwritten }
|
||||
@ -339,7 +336,7 @@ end;
|
||||
|
||||
function is_in_getmem_list (loc_info: pheap_info; p : pheap_mem_info) : boolean;
|
||||
var
|
||||
i : ptrint;
|
||||
i : ptruint;
|
||||
pp : pheap_mem_info;
|
||||
begin
|
||||
is_in_getmem_list:=false;
|
||||
@ -401,9 +398,9 @@ end;
|
||||
TraceGetMem
|
||||
*****************************************************************************}
|
||||
|
||||
Function TraceGetMem(size:ptrint):pointer;
|
||||
Function TraceGetMem(size:ptruint):pointer;
|
||||
var
|
||||
allocsize,i : ptrint;
|
||||
allocsize,i : ptruint;
|
||||
oldbp,
|
||||
bp : pointer;
|
||||
pl : pdword;
|
||||
@ -422,7 +419,7 @@ begin
|
||||
allocsize:=size+sizeof(theap_mem_info)+extra_info_size;
|
||||
{$endif cpuarm}
|
||||
if add_tail then
|
||||
inc(allocsize,sizeof(ptrint));
|
||||
inc(allocsize,sizeof(ptruint));
|
||||
{ if ReturnNilIfGrowHeapFails is true
|
||||
SysGetMem can return nil }
|
||||
p:=SysGetMem(allocsize);
|
||||
@ -463,7 +460,7 @@ begin
|
||||
pp^.extra_info:=nil;
|
||||
if add_tail then
|
||||
begin
|
||||
pl:=pointer(pp)+allocsize-pp^.extra_info_size-sizeof(ptrint);
|
||||
pl:=pointer(pp)+allocsize-pp^.extra_info_size-sizeof(ptruint);
|
||||
{$ifdef FPC_SUPPORTS_UNALIGNED}
|
||||
unaligned(pl^):=$DEADBEEF;
|
||||
{$else FPC_SUPPORTS_UNALIGNED}
|
||||
@ -510,9 +507,9 @@ end;
|
||||
*****************************************************************************}
|
||||
|
||||
function CheckFreeMemSize(loc_info: pheap_info; pp: pheap_mem_info;
|
||||
size, ppsize: ptrint): boolean; inline;
|
||||
size, ppsize: ptruint): boolean; inline;
|
||||
var
|
||||
i: ptrint;
|
||||
i: ptruint;
|
||||
bp : pointer;
|
||||
ptext : ^text;
|
||||
{$ifdef EXTRA}
|
||||
@ -615,18 +612,18 @@ begin
|
||||
end;
|
||||
|
||||
function InternalFreeMemSize(loc_info: pheap_info; p: pointer; pp: pheap_mem_info;
|
||||
size: ptrint; release_todo_lock: boolean): ptrint;
|
||||
size: ptruint; release_todo_lock: boolean): ptruint;
|
||||
var
|
||||
i,ppsize : ptrint;
|
||||
i,ppsize : ptruint;
|
||||
bp : pointer;
|
||||
extra_size: ptrint;
|
||||
extra_size: ptruint;
|
||||
release_mem: boolean;
|
||||
begin
|
||||
{ save old values }
|
||||
extra_size:=pp^.extra_info_size;
|
||||
ppsize:= size+sizeof(theap_mem_info)+pp^.extra_info_size;
|
||||
if add_tail then
|
||||
inc(ppsize,sizeof(ptrint));
|
||||
inc(ppsize,sizeof(ptruint));
|
||||
{ do various checking }
|
||||
release_mem := CheckFreeMemSize(loc_info, pp, size, ppsize);
|
||||
if release_todo_lock then
|
||||
@ -638,13 +635,13 @@ begin
|
||||
{ return the correct size }
|
||||
dec(i,sizeof(theap_mem_info)+extra_size);
|
||||
if add_tail then
|
||||
dec(i,sizeof(ptrint));
|
||||
dec(i,sizeof(ptruint));
|
||||
InternalFreeMemSize:=i;
|
||||
end else
|
||||
InternalFreeMemSize:=size;
|
||||
end;
|
||||
|
||||
function TraceFreeMemSize(p:pointer;size:ptrint):ptrint;
|
||||
function TraceFreeMemSize(p:pointer;size:ptruint):ptruint;
|
||||
var
|
||||
loc_info: pheap_info;
|
||||
pp: pheap_mem_info;
|
||||
@ -682,7 +679,7 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TraceMemSize(p:pointer):ptrint;
|
||||
function TraceMemSize(p:pointer):ptruint;
|
||||
var
|
||||
pp : pheap_mem_info;
|
||||
begin
|
||||
@ -691,9 +688,9 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
function TraceFreeMem(p:pointer):ptrint;
|
||||
function TraceFreeMem(p:pointer):ptruint;
|
||||
var
|
||||
l : ptrint;
|
||||
l : ptruint;
|
||||
pp : pheap_mem_info;
|
||||
begin
|
||||
if p=nil then
|
||||
@ -705,7 +702,7 @@ begin
|
||||
l:=SysMemSize(pp);
|
||||
dec(l,sizeof(theap_mem_info)+pp^.extra_info_size);
|
||||
if add_tail then
|
||||
dec(l,sizeof(ptrint));
|
||||
dec(l,sizeof(ptruint));
|
||||
{ this can never happend normaly }
|
||||
if pp^.size>l then
|
||||
begin
|
||||
@ -726,19 +723,19 @@ end;
|
||||
ReAllocMem
|
||||
*****************************************************************************}
|
||||
|
||||
function TraceReAllocMem(var p:pointer;size:ptrint):Pointer;
|
||||
function TraceReAllocMem(var p:pointer;size:ptruint):Pointer;
|
||||
var
|
||||
newP: pointer;
|
||||
allocsize,
|
||||
movesize,
|
||||
i : ptrint;
|
||||
i : ptruint;
|
||||
oldbp,
|
||||
bp : pointer;
|
||||
pl : pdword;
|
||||
pp : pheap_mem_info;
|
||||
oldsize,
|
||||
oldextrasize,
|
||||
oldexactsize : ptrint;
|
||||
oldexactsize : ptruint;
|
||||
old_fill_extra_info_proc : tfillextrainfoproc;
|
||||
old_display_extra_info_proc : tdisplayextrainfoproc;
|
||||
loc_info: pheap_info;
|
||||
@ -794,7 +791,7 @@ begin
|
||||
allocsize:=size+sizeof(theap_mem_info)+pp^.extra_info_size;
|
||||
{$endif cpuarm}
|
||||
if add_tail then
|
||||
inc(allocsize,sizeof(ptrint));
|
||||
inc(allocsize,sizeof(ptruint));
|
||||
{ Try to resize the block, if not possible we need to do a
|
||||
getmem, move data, freemem }
|
||||
if not SysTryResizeMem(pp,allocsize) then
|
||||
@ -838,7 +835,7 @@ begin
|
||||
pp^.extra_info:=nil;
|
||||
if add_tail then
|
||||
begin
|
||||
pl:=pointer(pp)+allocsize-pp^.extra_info_size-sizeof(ptrint);
|
||||
pl:=pointer(pp)+allocsize-pp^.extra_info_size-sizeof(ptruint);
|
||||
{$ifdef FPC_SUPPORTS_UNALIGNED}
|
||||
unaligned(pl^):=$DEADBEEF;
|
||||
{$else FPC_SUPPORTS_UNALIGNED}
|
||||
@ -912,7 +909,7 @@ var
|
||||
|
||||
procedure CheckPointer(p : pointer); [public, alias : 'FPC_CHECKPOINTER'];
|
||||
var
|
||||
i : ptrint;
|
||||
i : ptruint;
|
||||
pp : pheap_mem_info;
|
||||
loc_info: pheap_info;
|
||||
{$ifdef go32v2}
|
||||
@ -1051,7 +1048,7 @@ begin
|
||||
goto _exit
|
||||
else
|
||||
begin
|
||||
writeln(ptext^,'pointer $',hexstr(ptrint(p),2*sizeof(pointer)),' points into invalid memory block');
|
||||
writeln(ptext^,'pointer $',hexstr(p),' points into invalid memory block');
|
||||
dump_error(pp,ptext^);
|
||||
runerror(204);
|
||||
end;
|
||||
@ -1063,7 +1060,7 @@ begin
|
||||
halt(1);
|
||||
end;
|
||||
end;
|
||||
writeln(ptext^,'pointer $',hexstr(ptrint(p),2*sizeof(pointer)),' does not point to valid memory block');
|
||||
writeln(ptext^,'pointer $',hexstr(p),' does not point to valid memory block');
|
||||
dump_error(p,ptext^);
|
||||
runerror(204);
|
||||
_exit:
|
||||
@ -1077,7 +1074,7 @@ procedure dumpheap;
|
||||
var
|
||||
pp : pheap_mem_info;
|
||||
i : ptrint;
|
||||
ExpectedHeapFree : ptrint;
|
||||
ExpectedHeapFree : ptruint;
|
||||
status : TFPCHeapStatus;
|
||||
ptext : ^text;
|
||||
loc_info: pheap_info;
|
||||
@ -1153,7 +1150,7 @@ end;
|
||||
AllocMem
|
||||
*****************************************************************************}
|
||||
|
||||
function TraceAllocMem(size:ptrint):Pointer;
|
||||
function TraceAllocMem(size:ptruint):Pointer;
|
||||
begin
|
||||
TraceAllocMem:=SysAllocMem(size);
|
||||
end;
|
||||
@ -1254,7 +1251,7 @@ end;
|
||||
*****************************************************************************}
|
||||
|
||||
Procedure SetHeapTraceOutput(const name : string);
|
||||
var i : ptrint;
|
||||
var i : ptruint;
|
||||
begin
|
||||
if useownfile then
|
||||
begin
|
||||
@ -1273,7 +1270,7 @@ begin
|
||||
writeln(ownfile);
|
||||
end;
|
||||
|
||||
procedure SetHeapExtraInfo( size : ptrint;fillproc : tfillextrainfoproc;displayproc : tdisplayextrainfoproc);
|
||||
procedure SetHeapExtraInfo( size : ptruint;fillproc : tfillextrainfoproc;displayproc : tdisplayextrainfoproc);
|
||||
begin
|
||||
{ the total size must stay multiple of 8, also allocate 2 pointers for
|
||||
the fill and display procvars }
|
||||
@ -1369,7 +1366,7 @@ end;
|
||||
Function GetEnv(envvar: string): string;
|
||||
var
|
||||
s : string;
|
||||
i : ptrint;
|
||||
i : ptruint;
|
||||
hp,p : pchar;
|
||||
begin
|
||||
getenv:='';
|
||||
@ -1408,7 +1405,7 @@ Function GetEnv(P:string):Pchar;
|
||||
}
|
||||
var
|
||||
ep : ppchar;
|
||||
i : ptrint;
|
||||
i : ptruint;
|
||||
found : boolean;
|
||||
Begin
|
||||
p:=p+'='; {Else HOST will also find HOSTNAME, etc}
|
||||
@ -1439,7 +1436,7 @@ end;
|
||||
|
||||
procedure LoadEnvironment;
|
||||
var
|
||||
i,j : ptrint;
|
||||
i,j : ptruint;
|
||||
s : string;
|
||||
begin
|
||||
s:=Getenv('HEAPTRC');
|
||||
|
||||
@ -19,18 +19,15 @@
|
||||
|
||||
{ function to allocate size bytes more for the program }
|
||||
{ must return the first address of new data space or nil if failed }
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
begin
|
||||
result := NewPtr(size);
|
||||
end;
|
||||
|
||||
{$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
begin
|
||||
DisposePtr(p);
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -20,7 +20,7 @@
|
||||
OS Memory allocation / deallocation
|
||||
****************************************************************************}
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
{$IFDEF MOSFPC_MEMDEBUG}
|
||||
var values: array[0..2] of dword;
|
||||
{$ENDIF}
|
||||
@ -36,7 +36,7 @@ end;
|
||||
|
||||
{$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
{$IFDEF MOSFPC_MEMDEBUG}
|
||||
var values: array[0..2] of dword;
|
||||
{$ENDIF}
|
||||
|
||||
@ -1,34 +1,34 @@
|
||||
{
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 2005 by Free Pascal development team
|
||||
|
||||
Low level memory functions
|
||||
|
||||
Heap functions unit for Nintendo DS
|
||||
Copyright (c) 2006 by Francesco Lombardi
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{*****************************************************************************
|
||||
OS Memory allocation / deallocation
|
||||
****************************************************************************}
|
||||
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
begin
|
||||
result := nil;//pointer($02000000);
|
||||
end;
|
||||
|
||||
{ $define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
begin
|
||||
|
||||
end;
|
||||
{
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 2005 by Free Pascal development team
|
||||
|
||||
Low level memory functions
|
||||
|
||||
Heap functions unit for Nintendo DS
|
||||
Copyright (c) 2006 by Francesco Lombardi
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{*****************************************************************************
|
||||
OS Memory allocation / deallocation
|
||||
****************************************************************************}
|
||||
|
||||
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
begin
|
||||
result := nil;//pointer($02000000);
|
||||
end;
|
||||
|
||||
{ $define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
@ -93,14 +93,14 @@ end;
|
||||
OS Memory allocation / deallocation
|
||||
****************************************************************************}
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
begin
|
||||
result := sbrk(size);
|
||||
end;
|
||||
|
||||
{$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
var i : longint;
|
||||
begin
|
||||
//fpmunmap(p, size);
|
||||
@ -119,12 +119,12 @@ end;
|
||||
|
||||
{$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
begin
|
||||
_free (p);
|
||||
end;
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
begin
|
||||
SysOSAlloc := _malloc (size);
|
||||
end;
|
||||
|
||||
@ -32,7 +32,7 @@ var HeapSbrkBlockList : ^THeapSbrkBlockList = nil;
|
||||
{ must return the first address of new data space or nil if fail }
|
||||
{ for netware all allocated blocks are saved to free them at }
|
||||
{ exit (to avoid message "Module did not release xx resources") }
|
||||
Function SysOSAlloc(size : longint):pointer;
|
||||
Function SysOSAlloc(size : ptruint):pointer;
|
||||
var P2 : POINTER;
|
||||
i : longint;
|
||||
Slept : longint;
|
||||
@ -106,7 +106,7 @@ end;
|
||||
|
||||
{$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
var i : longint;
|
||||
begin
|
||||
if HeapSbrkReleased then
|
||||
@ -133,7 +133,7 @@ begin
|
||||
_free (p);
|
||||
end;
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
begin
|
||||
SysOSAlloc := _Alloc(size,HeapAllocResourceTag);
|
||||
end;
|
||||
|
||||
@ -54,7 +54,7 @@ end ['EAX'];
|
||||
}
|
||||
|
||||
|
||||
function SysOSAlloc (Size: PtrInt): pointer;
|
||||
function SysOSAlloc (Size: ptruint): pointer;
|
||||
var
|
||||
P: pointer;
|
||||
RC: cardinal;
|
||||
@ -103,7 +103,7 @@ end;
|
||||
|
||||
{$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree (P: pointer; Size: PtrInt);
|
||||
procedure SysOSFree (P: pointer; Size: ptruint);
|
||||
{$IFDEF EXTDUMPGROW}
|
||||
var
|
||||
RC: cardinal;
|
||||
|
||||
@ -18,14 +18,14 @@
|
||||
****************************************************************************}
|
||||
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
{$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
@ -15,7 +15,7 @@
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
begin
|
||||
result:=Fpmmap(nil,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
|
||||
if result=pointer(-1) then
|
||||
@ -26,7 +26,7 @@ end;
|
||||
|
||||
{$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
begin
|
||||
fpmunmap(p, size);
|
||||
end;
|
||||
|
||||
@ -31,20 +31,20 @@
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
function SysOSAlloc(size: ptrint): pointer;
|
||||
function SysOSAlloc(size: ptruint): pointer;
|
||||
var
|
||||
p : pointer;
|
||||
begin
|
||||
p := HeapAlloc(GetProcessHeap, 0, size);
|
||||
{$ifdef DUMPGROW}
|
||||
Writeln('new heap part at $',hexstr(ptrint(p),sizeof(ptrint)*2), ' size = ',WinAPIHeapSize(GetProcessHeap()));
|
||||
Writeln('new heap part at $',hexstr(p), ' size = ',WinAPIHeapSize(GetProcessHeap()));
|
||||
{$endif}
|
||||
SysOSAlloc := p;
|
||||
end;
|
||||
|
||||
{$define HAS_SYSOSFREE}
|
||||
|
||||
procedure SysOSFree(p: pointer; size: ptrint);
|
||||
procedure SysOSFree(p: pointer; size: ptruint);
|
||||
begin
|
||||
HeapFree(GetProcessHeap, 0, p);
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user