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

  windows local heap

git-svn-id: trunk@31578 -

.gitattributes

@@ -9697,6 +9697,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/locheap.inc svneol=native#text/plain
+rtl/win16/locheaph.inc svneol=native#text/plain
 rtl/win16/prt0c.asm svneol=native#text/plain
 rtl/win16/prt0comn.asm svneol=native#text/plain
 rtl/win16/prt0h.asm svneol=native#text/plain

rtl/win16/locheap.inc

@@ -0,0 +1,85 @@
+{
+    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 local 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 SysLocalGetMem(Size: ptruint): pointer;
+      begin
+        result:=NearPointer(LocalAlloc(LMEM_FIXED, Size));
+        if not ReturnNilIfGrowHeapFails and (result=nil) then
+          HandleError(203);
+      end;
+
+    function SysLocalFreeMem(Addr: Pointer): ptruint;
+      begin
+        if Addr<>nil then
+          begin
+            result:=LocalSize(THandle(Addr));
+            if LocalFree(THandle(Addr))<>0 then
+              HandleError(204);
+          end
+        else
+          result:=0;
+      end;
+
+    function SysLocalFreeMemSize(Addr: Pointer; Size: Ptruint): ptruint;
+      begin
+        result:=SysLocalFreeMem(addr);
+      end;
+
+    function SysLocalAllocMem(size: ptruint): pointer;
+      begin
+        result:=NearPointer(LocalAlloc(LMEM_FIXED or LMEM_ZEROINIT, Size));
+        if not ReturnNilIfGrowHeapFails and (result=nil) then
+          HandleError(203);
+      end;
+
+    function SysLocalReAllocMem(var p: pointer; size: ptruint):pointer;
+      begin
+        if size=0 then
+          begin
+            SysLocalFreeMem(p);
+            result := nil;
+          end
+        else if p=nil then
+          result := SysLocalAllocMem(size)
+        else
+          begin
+            result := NearPointer(LocalReAlloc(THandle(p), size, LMEM_MOVEABLE or LMEM_ZEROINIT));
+            if not ReturnNilIfGrowHeapFails and (result=nil) then
+              HandleError(203);
+          end;
+        p := result;
+      end;
+
+    function SysLocalMemSize(p: pointer): ptruint;
+      begin
+        result:=LocalSize(THandle(p));
+      end;
+
+    const
+      LocalHeapMemoryManager: TMemoryManager = (
+        NeedLock: false;  // Obsolete
+        GetMem: @SysLocalGetMem;
+        FreeMem: @SysLocalFreeMem;
+        FreeMemSize: @SysLocalFreeMemSize;
+        AllocMem: @SysLocalAllocMem;
+        ReAllocMem: @SysLocalReAllocMem;
+        MemSize: @SysLocalMemSize;
+        InitThread: nil;
+        DoneThread: nil;
+        RelocateHeap: nil;
+        GetHeapStatus: nil;
+        GetFPCHeapStatus: nil;
+      );

rtl/win16/locheaph.inc

@@ -0,0 +1,16 @@
+{
+    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 local 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.
+
+ **********************************************************************}

rtl/win16/system.pp

@@ -16,7 +16,12 @@ interface
 {$DEFINE HAS_CMDLINE}
 
 {$I systemh.inc}
+{$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}
+{$ENDIF FPC_X86_DATA_NEAR}
 
 const
   LineEnding = #13#10;
@@ -138,7 +143,13 @@ type
 
 {$I system.inc}
 
+{$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}
+{$ENDIF FPC_X86_DATA_NEAR}
+
 
 {*****************************************************************************
                               ParamStr/Randomize
@@ -272,6 +283,15 @@ end;
                          SystemUnit Initialization
 *****************************************************************************}
 
+procedure InitWin16Heap;
+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 }
+{$endif FPC_X86_DATA_NEAR}
+end;
+
 procedure SysInitStdIO;
 begin
   OpenStdIO(Input,fmInput,StdInputHandle);
@@ -305,4 +325,6 @@ begin
       StackLength := pStackBot-pStackTop;
     end;
 {$endif}
+{ Setup heap }
+  InitWin16Heap;
 end.