paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 04:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ implemented MemAvail and MaxAvail for the win16 global heap

Browse Source 
git-svn-id: trunk@37691 -
This commit is contained in:
nickysn 2017-12-06 15:05:37 +00:00
parent 52f81da69c
commit 46db6a6174
2 changed files with 54 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
rtl/win16/glbheap.inc
View File

@ -390,6 +390,57 @@ circular linked list.
p := result;
end;
function MemAvail: LongInt;
var
CurBlock: Word;
CurBlockP: PGlobalHeapBlockHeader;
CurSubBlock: PFreeSubBlock;
begin
result:=GetFreeSpace(0);
CurBlock:=HeapList;
if CurBlock=0 then
exit;
repeat
CurBlockP:=Ptr(CurBlock,0);
CurSubBlock:=Ptr(CurBlock,CurBlockP^.FirstFreeOfs);
while Ofs(CurSubBlock^)<>0 do
begin
if CurSubBlock^.Size>2 then
Inc(result,CurSubBlock^.Size-2);
CurSubBlock:=Ptr(CurBlock,CurSubBlock^.Next);
end;
CurBlock:=CurBlockP^.NextBlockSeg;
until CurBlock=HeapList;
end;
function MaxAvail: LongInt;
var
CurBlock: Word;
CurBlockP: PGlobalHeapBlockHeader;
CurSubBlock: PFreeSubBlock;
begin
result:=GlobalCompact(0);
if result>(65536-SizeOf(TGlobalHeapBlockHeader)-2) then
exit;
CurBlock:=HeapList;
if CurBlock=0 then
exit;
repeat
CurBlockP:=Ptr(CurBlock,0);
if CurBlockP^.TotalFreeSpaceInBlock>(result+2) then
begin
CurSubBlock:=Ptr(CurBlock,CurBlockP^.FirstFreeOfs);
while Ofs(CurSubBlock^)<>0 do
begin
if CurSubBlock^.Size>(result+2) then
result:=CurSubBlock^.Size-2;
CurSubBlock:=Ptr(CurBlock,CurSubBlock^.Next);
end;
end;
CurBlock:=CurBlockP^.NextBlockSeg;
until CurBlock=HeapList;
end;
const
GlobalHeapMemoryManager: TMemoryManager = (
NeedLock: false; // Obsolete

3
rtl/win16/glbheaph.inc
View File

@ -21,3 +21,6 @@
HeapLimit: Word=1024;
HeapBlock: Word=8192;
HeapAllocFlags: Word=2; { 2=GMEM_MOVEABLE }
function MemAvail: LongInt;
function MaxAvail: LongInt;