소스 검색

+ implemented MemAvail and MaxAvail for the win16 global heap

git-svn-id: trunk@37691 -
nickysn 7 년 전
부모
커밋
46db6a6174
2개의 변경된 파일54개의 추가작업 그리고 0개의 파일을 삭제
  1. 51 0
      rtl/win16/glbheap.inc
  2. 3 0
      rtl/win16/glbheaph.inc

+ 51 - 0
rtl/win16/glbheap.inc

@@ -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 - 0
rtl/win16/glbheaph.inc

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