paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-07 09:07:19 +01:00
Code Issues Packages Projects Releases Wiki Activity

* implementation of tiny heap's GetMem changed, so that it doesn't use FreeMem

Browse Source 
internally.

git-svn-id: trunk@28580 -
This commit is contained in:
nickysn 2014-09-01 23:37:00 +00:00
parent 768e090006
commit 9b41b10350
1 changed files with 17 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
rtl/inc/tinyheap.inc
View File

@ -86,7 +86,7 @@
function SysTinyGetMem(Size: ptruint): pointer; function SysTinyGetMem(Size: ptruint): pointer;
var var
p, prev: PTinyHeapBlock; p, prev, p2: PTinyHeapBlock;
AllocSize, RestSize: ptruint; AllocSize, RestSize: ptruint;
begin begin
{$ifdef DEBUG_TINY_HEAP} {$ifdef DEBUG_TINY_HEAP}
@ -114,15 +114,25 @@
RestSize := 0; RestSize := 0;
end; end;
if prev = nil then if RestSize > 0 then
TinyHeapBlocks := p^.Next begin
p2 := pointer(TTinyHeapPointerArithmeticType(p)+AllocSize);
p2^.Next := p^.Next;
p2^.Size := EncodeTinyHeapFreeBlockSize(RestSize);
if prev = nil then
TinyHeapBlocks := p2
else
prev^.next := p2;
end
else else
prev^.next := p^.next; begin
if prev = nil then
TinyHeapBlocks := p^.Next
else
prev^.next := p^.next;
end;
PTinyHeapMemBlockSize(p)^ := size; PTinyHeapMemBlockSize(p)^ := size;
if RestSize > 0 then
InternalTinyFreeMem(pointer(TTinyHeapPointerArithmeticType(p)+AllocSize), RestSize);
end end
else else
if ReturnNilIfGrowHeapFails then if ReturnNilIfGrowHeapFails then