+ implemented a win16 heap manager for the far data memory models, using the

global heap; TODO: allocate heap in blocks and perform suballocation for small
  memory blocks, because the number of global heap blocks is limited

git-svn-id: trunk@31846 -

.gitattributes

@@ -9700,6 +9700,8 @@ rtl/win/wininc/unifun.inc svneol=native#text/plain
 rtl/win/winres.inc svneol=native#text/plain
 rtl/win16/Makefile svneol=native#text/plain
 rtl/win16/Makefile.fpc svneol=native#text/plain
+rtl/win16/glbheap.inc svneol=native#text/plain
+rtl/win16/glbheaph.inc svneol=native#text/plain
 rtl/win16/locheap.inc svneol=native#text/plain
 rtl/win16/locheaph.inc svneol=native#text/plain
 rtl/win16/prt0c.asm svneol=native#text/plain

rtl/win16/glbheap.inc

@@ -0,0 +1,136 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2015 by the Free Pascal development team
+
+    This file implements heap management for 16-bit Windows
+    using the Windows global heap.
+
+    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.
+
+ **********************************************************************}
+
+    function SysGlobalGetMem(Size: ptruint): pointer;
+      var
+        hglob: HGLOBAL;
+      begin
+        hglob:=GlobalAlloc(HeapAllocFlags, Size);
+        if hglob=0 then
+          if ReturnNilIfGrowHeapFails then
+            begin
+              result:=nil;
+              exit;
+            end
+          else
+            HandleError(203);
+        result:=GlobalLock(hglob);
+        if result=nil then
+          HandleError(204);
+      end;
+
+    function SysGlobalFreeMem(Addr: Pointer): ptruint;
+      var
+        hglob: HGLOBAL;
+      begin
+        if Addr<>nil then
+          begin
+            hglob:=HGLOBAL(GlobalHandle(Seg(Addr^)));
+            if hglob=0 then
+              HandleError(204);
+            result:=GlobalSize(hglob);
+            if GlobalUnlock(hglob) then
+              HandleError(204);
+            if GlobalFree(hglob)<>0 then
+              HandleError(204);
+          end
+        else
+          result:=0;
+      end;
+
+    function SysGlobalFreeMemSize(Addr: Pointer; Size: Ptruint): ptruint;
+      begin
+        result:=SysGlobalFreeMem(addr);
+      end;
+
+    function SysGlobalAllocMem(size: ptruint): pointer;
+      var
+        hglob: HGLOBAL;
+      begin
+        hglob:=GlobalAlloc(HeapAllocFlags or GMEM_ZEROINIT, Size);
+        if hglob=0 then
+          if ReturnNilIfGrowHeapFails then
+            begin
+              result:=nil;
+              exit;
+            end
+          else
+            HandleError(203);
+        result:=GlobalLock(hglob);
+        if result=nil then
+          HandleError(204);
+      end;
+
+    function SysGlobalReAllocMem(var p: pointer; size: ptruint):pointer;
+      var
+        hglob: HGLOBAL;
+      begin
+        if size=0 then
+          begin
+            SysGlobalFreeMem(p);
+            result := nil;
+          end
+        else if p=nil then
+          result := SysGlobalAllocMem(size)
+        else
+          begin
+            hglob:=HGLOBAL(GlobalHandle(Seg(p^)));
+            if hglob=0 then
+              HandleError(204);
+            if GlobalUnlock(hglob) then
+              HandleError(204);
+            hglob:=GlobalReAlloc(hglob,size,HeapAllocFlags or GMEM_ZEROINIT);
+            if hglob=0 then
+              if ReturnNilIfGrowHeapFails then
+                begin
+                  result:=nil;
+                  p:=nil;
+                  exit;
+                end
+              else
+                HandleError(203);
+            result:=GlobalLock(hglob);
+            if result=nil then
+              HandleError(204);
+          end;
+        p := result;
+      end;
+
+    function SysGlobalMemSize(p: pointer): ptruint;
+      var
+        hglob: HGLOBAL;
+      begin
+        hglob:=HGLOBAL(GlobalHandle(Seg(p^)));
+        if hglob=0 then
+          HandleError(204);
+        result:=GlobalSize(hglob);
+      end;
+
+    const
+      GlobalHeapMemoryManager: TMemoryManager = (
+        NeedLock: false;  // Obsolete
+        GetMem: @SysGlobalGetMem;
+        FreeMem: @SysGlobalFreeMem;
+        FreeMemSize: @SysGlobalFreeMemSize;
+        AllocMem: @SysGlobalAllocMem;
+        ReAllocMem: @SysGlobalReAllocMem;
+        MemSize: @SysGlobalMemSize;
+        InitThread: nil;
+        DoneThread: nil;
+        RelocateHeap: nil;
+        GetHeapStatus: nil;
+        GetFPCHeapStatus: nil;
+      );

rtl/win16/glbheaph.inc

@@ -0,0 +1,22 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2015 by the Free Pascal development team
+
+    This file contains the interface section of the heap
+    management implementation for 16-bit Windows that uses
+    the Windows global heap.
+
+    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.
+
+ **********************************************************************}
+
+    var
+      { BP7 compatible vars }
+      HeapLimit: Word=1024;
+      HeapBlock: Word=8192;
+      HeapAllocFlags: Word=2;  { 2=GMEM_MOVEABLE }

rtl/win16/system.pp

@@ -19,8 +19,7 @@ interface
 {$IFDEF FPC_X86_DATA_NEAR}
 {$I locheaph.inc}
 {$ELSE FPC_X86_DATA_NEAR}
-{ todo: implement a working win16 heap manager for the far data models }
-{$I tnyheaph.inc}
+{$I glbheaph.inc}
 {$ENDIF FPC_X86_DATA_NEAR}
 
 const
@@ -152,8 +151,7 @@ procedure MsDos_Carry(var Regs: Registers); external name 'FPC_MSDOS_CARRY';
 {$IFDEF FPC_X86_DATA_NEAR}
 {$I locheap.inc}
 {$ELSE FPC_X86_DATA_NEAR}
-{ todo: implement a working win16 heap manager for the far data models }
-{$I tinyheap.inc}
+{$I glbheap.inc}
 {$ENDIF FPC_X86_DATA_NEAR}
 
 
@@ -373,7 +371,7 @@ begin
 {$ifdef FPC_X86_DATA_NEAR}
   SetMemoryManager(LocalHeapMemoryManager);
 {$else FPC_X86_DATA_NEAR}
-{ todo: implement a working win16 heap manager for the far data models }
+  SetMemoryManager(GlobalHeapMemoryManager);
 {$endif FPC_X86_DATA_NEAR}
 end;