From 600d2cfbc688585b816f7a6073d8d651d714fc82 Mon Sep 17 00:00:00 2001 From: nickysn Date: Tue, 8 Sep 2015 14:22:16 +0000 Subject: [PATCH] + implemented a win16 heap manager for the near data memory models using the windows local heap git-svn-id: trunk@31578 - --- .gitattributes | 2 + rtl/win16/locheap.inc | 85 ++++++++++++++++++++++++++++++++++++++++++ rtl/win16/locheaph.inc | 16 ++++++++ rtl/win16/system.pp | 22 +++++++++++ 4 files changed, 125 insertions(+) create mode 100644 rtl/win16/locheap.inc create mode 100644 rtl/win16/locheaph.inc diff --git a/.gitattributes b/.gitattributes index ab56e6d57c..1c63b7ce39 100644 --- a/.gitattributes +++ b/.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 diff --git a/rtl/win16/locheap.inc b/rtl/win16/locheap.inc new file mode 100644 index 0000000000..e626244df2 --- /dev/null +++ b/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; + ); diff --git a/rtl/win16/locheaph.inc b/rtl/win16/locheaph.inc new file mode 100644 index 0000000000..0e49cce8d1 --- /dev/null +++ b/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. + + **********************************************************************} diff --git a/rtl/win16/system.pp b/rtl/win16/system.pp index 6b7c23f8dc..81bf05290d 100644 --- a/rtl/win16/system.pp +++ b/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.