From 406d5b7b3de5f13439f4b0d3a0816ceee1b673a8 Mon Sep 17 00:00:00 2001
From: nickysn <nickysn@gmail.com>
Date: Sun, 27 Sep 2015 13:00:27 +0000
Subject: [PATCH] + 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 | 2 +
rtl/win16/glbheap.inc | 136 +++++++++++++++++++++++++++++++++++++++++
rtl/win16/glbheaph.inc | 22 +++++++
rtl/win16/system.pp | 8 +--
4 files changed, 163 insertions(+), 5 deletions(-)
create mode 100644 rtl/win16/glbheap.inc
create mode 100644 rtl/win16/glbheaph.inc
diff --git a/.gitattributes b/.gitattributes
index 03a8e3b093..367e4b4b3d 100644
--- a/.gitattributes
+++ b/.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
diff --git a/rtl/win16/glbheap.inc b/rtl/win16/glbheap.inc
new file mode 100644
index 0000000000..a0e27251a8
--- /dev/null
+++ b/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;
+ );
diff --git a/rtl/win16/glbheaph.inc b/rtl/win16/glbheaph.inc
new file mode 100644
index 0000000000..0f0f90cc8e
--- /dev/null
+++ b/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 }
diff --git a/rtl/win16/system.pp b/rtl/win16/system.pp
index 354ef2d3c5..281afa003b 100644
--- a/rtl/win16/system.pp
+++ b/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;