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

* handle gracefully freeing a subblock that is located at the end of its block

Browse Source 
(with no free space after it) in the win16 global heap manager

git-svn-id: trunk@37636 -
This commit is contained in:
nickysn 2017-12-01 13:39:20 +00:00
parent 87d5cc014f
commit 163ee92ef5
1 changed files with 4 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
rtl/win16/glbheap.inc
View File

@ -215,20 +215,19 @@ circular linked list.
begin
PrevSubBlock:=nil;
CurSubBlock:=Ptr(CurBlock,CurBlockP^.FirstFreeOfs);
while Ofs(CurSubBlock^)<Ofs(Addr^) do
while (Ofs(CurSubBlock^)<>0) and (Ofs(CurSubBlock^)<Ofs(Addr^)) do
begin
PrevSubBlock:=CurSubBlock;
CurSubBlock:=Ptr(CurBlock,CurSubBlock^.Next);
if Ofs(CurSubBlock^)=0 then
HandleError(204);
end;
if PrevSubBlock=nil then
HandleError(204);
{ merge with previous free block? }
if Ofs(PrevSubBlock^)+PrevSubBlock^.Size=Ofs(Addr^) then
begin
Inc(PrevSubBlock^.Size,ASize);
{ merge with next as well? }
if (Ofs(PrevSubBlock^)+PrevSubBlock^.Size)=Ofs(CurSubBlock^) then
if (Ofs(CurSubBlock^)<>0) and ((Ofs(PrevSubBlock^)+PrevSubBlock^.Size)=Ofs(CurSubBlock^)) then
begin
Inc(PrevSubBlock^.Size,CurSubBlock^.Size);
PrevSubBlock^.Next:=CurSubBlock^.Next;
@ -237,7 +236,7 @@ circular linked list.
else
begin
PrevSubBlock^.Next:=Ofs(Addr^);
if (Ofs(Addr^)+ASize)=Ofs(CurSubBlock^) then
if (Ofs(CurSubBlock^)<>0) and ((Ofs(Addr^)+ASize)=Ofs(CurSubBlock^)) then
with PFreeSubBlock(Addr)^ do
begin
Next:=CurSubBlock^.Next;