mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-12 23:09:40 +02:00
* added an option to use target-specific memory manager instead of standard. This is controlled by HAS_MEMORYMANAGER and HAS_MT_MEMORYMANAGER defines.
* wince executables use C memory manager now (as all apps compiled by eVC++). It saves 5.5 KB of exe size. git-svn-id: trunk@4282 -
This commit is contained in:
parent
887781a6b9
commit
e062922528
@ -15,12 +15,24 @@
|
||||
|
||||
{****************************************************************************}
|
||||
|
||||
{ Do not use standard memory manager }
|
||||
{ Custom memory manager is Multi Threaded and does not require locking }
|
||||
{ define HAS_MT_MEMORYMANAGER}
|
||||
|
||||
{ Do not use standard memory manager }
|
||||
{ Custom memory manager requires locking when threading is used }
|
||||
{ define HAS_MEMORYMANAGER}
|
||||
|
||||
{ Try to find the best matching block in general freelist }
|
||||
{ define BESTMATCH}
|
||||
|
||||
{ DEBUG: Dump info when the heap needs to grow }
|
||||
{ define DUMPGROW}
|
||||
|
||||
{$ifdef HAS_MT_MEMORYMANAGER}
|
||||
{$define HAS_MEMORYMANAGER}
|
||||
{$endif HAS_MT_MEMORYMANAGER}
|
||||
|
||||
const
|
||||
{$ifdef CPU64}
|
||||
blocksize = 32; { at least size of freerecord }
|
||||
@ -58,7 +70,11 @@ procedure SysHeapMutexUnlock;forward;
|
||||
{ Memory manager }
|
||||
const
|
||||
MemoryManager: TMemoryManager = (
|
||||
{$ifdef HAS_MT_MEMORYMANAGER}
|
||||
NeedLock: false;
|
||||
{$else HAS_MT_MEMORYMANAGER}
|
||||
NeedLock: true;
|
||||
{$endif HAS_MT_MEMORYMANAGER}
|
||||
GetMem: @SysGetMem;
|
||||
FreeMem: @SysFreeMem;
|
||||
FreeMemSize: @SysFreeMemSize;
|
||||
@ -76,6 +92,7 @@ const
|
||||
MutexUnlock: @SysHeapMutexUnlock;
|
||||
);
|
||||
|
||||
{$ifndef HAS_MEMORYMANAGER}
|
||||
type
|
||||
poschunk = ^toschunk;
|
||||
{ keep size of this record dividable by 16 }
|
||||
@ -135,6 +152,7 @@ var
|
||||
freeoslist : poschunk;
|
||||
freeoslistcount : dword;
|
||||
|
||||
{$endif HAS_MEMORYMANAGER}
|
||||
|
||||
{*****************************************************************************
|
||||
Memory Manager
|
||||
@ -436,7 +454,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{$ifndef HAS_MEMORYMANAGER}
|
||||
{*****************************************************************************
|
||||
GetHeapStatus
|
||||
*****************************************************************************}
|
||||
@ -1244,6 +1262,7 @@ begin
|
||||
SysReAllocMem := p;
|
||||
end;
|
||||
|
||||
{$endif HAS_MEMORYMANAGER}
|
||||
|
||||
{*****************************************************************************
|
||||
MemoryMutexManager default hooks
|
||||
@ -1273,6 +1292,7 @@ begin
|
||||
runerror(244);
|
||||
end;
|
||||
|
||||
{$ifndef HAS_MEMORYMANAGER}
|
||||
|
||||
{*****************************************************************************
|
||||
InitHeap
|
||||
@ -1289,3 +1309,5 @@ begin
|
||||
freeoslistcount := 0;
|
||||
fillchar(internal_status,sizeof(internal_status),0);
|
||||
end;
|
||||
|
||||
{$endif HAS_MEMORYMANAGER}
|
||||
|
@ -289,6 +289,7 @@ end;
|
||||
Heap Mutex Protection
|
||||
*****************************************************************************}
|
||||
|
||||
{$ifndef HAS_MT_MEMORYMANAGER}
|
||||
var
|
||||
HeapMutex : TRTLCriticalSection;
|
||||
|
||||
@ -324,6 +325,8 @@ end;
|
||||
begin
|
||||
SetMemoryMutexManager(Win32MemoryMutexManager);
|
||||
end;
|
||||
|
||||
{$endif HAS_MT_MEMORYMANAGER}
|
||||
|
||||
Const
|
||||
wrSignaled = 0;
|
||||
@ -463,6 +466,8 @@ begin
|
||||
RTLEventWaitForTimeout :=@intRTLEventWaitForTimeout;
|
||||
end;
|
||||
SetThreadManager(WinThreadManager);
|
||||
{$ifndef HAS_MT_MEMORYMANAGER}
|
||||
InitHeapMutexes;
|
||||
{$endif HAS_MT_MEMORYMANAGER}
|
||||
ThreadID := GetCurrentThreadID;
|
||||
end;
|
||||
|
@ -24,6 +24,7 @@ interface
|
||||
{$define WINCE_EXCEPTION_HANDLING}
|
||||
{$define DISABLE_NO_THREAD_MANAGER}
|
||||
{$define HAS_CMDLINE}
|
||||
{$define HAS_MT_MEMORYMANAGER}
|
||||
|
||||
{ include system-independent routine headers }
|
||||
{$I systemh.inc}
|
||||
@ -1576,7 +1577,77 @@ procedure InitWinCEWidestrings;
|
||||
widestringmanager.LowerWideStringProc:=@WinCEWideLower;
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
Memory manager
|
||||
****************************************************************************}
|
||||
|
||||
function malloc(Size : ptrint) : Pointer; external 'coredll';
|
||||
procedure free(P : pointer); external 'coredll';
|
||||
function realloc(P : Pointer; Size : ptrint) : pointer; external 'coredll';
|
||||
function _msize(P : pointer): ptrint; external 'coredll';
|
||||
|
||||
function SysGetMem (Size : ptrint) : Pointer;
|
||||
begin
|
||||
Result:=malloc(Size);
|
||||
end;
|
||||
|
||||
Function SysFreeMem (P : pointer) : ptrint;
|
||||
begin
|
||||
free(P);
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
Function SysFreeMemSize(p:pointer;Size:ptrint):ptrint;
|
||||
begin
|
||||
Result:=0;
|
||||
if size < 0 then
|
||||
runerror(204)
|
||||
else
|
||||
if (size > 0) and (p <> nil) then
|
||||
begin
|
||||
if (size <> _msize(p)) then
|
||||
runerror(204);
|
||||
Result:=SysFreeMem(P);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function SysAllocMem(Size : ptrint) : Pointer;
|
||||
begin
|
||||
Result:=SysGetMem(Size);
|
||||
if Result <> nil then
|
||||
FillChar(Result^, Size, 0);
|
||||
end;
|
||||
|
||||
Function SysReAllocMem (var p:pointer;Size:ptrint):Pointer;
|
||||
begin
|
||||
Result:=realloc(p, Size);
|
||||
p:=Result;
|
||||
end;
|
||||
|
||||
function SysTryResizeMem(var p:pointer;size : ptrint):boolean;
|
||||
var
|
||||
res: pointer;
|
||||
begin
|
||||
res:=realloc(p, Size);
|
||||
Result:=(res <> nil) or (Size = 0);
|
||||
if Result then
|
||||
p:=res;
|
||||
end;
|
||||
|
||||
function SysMemSize(P : pointer): ptrint;
|
||||
begin
|
||||
Result:=_msize(P);
|
||||
end;
|
||||
|
||||
function SysGetHeapStatus:THeapStatus;
|
||||
begin
|
||||
fillchar(Result,sizeof(Result),0);
|
||||
end;
|
||||
|
||||
function SysGetFPCHeapStatus:TFPCHeapStatus;
|
||||
begin
|
||||
fillchar(Result,sizeof(Result),0);
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
Error Message writing using messageboxes
|
||||
@ -1712,8 +1783,6 @@ begin
|
||||
if not IsLibrary then
|
||||
SysInstance:=GetModuleHandle(nil);
|
||||
MainInstance:=SysInstance;
|
||||
{ Setup heap }
|
||||
InitHeap;
|
||||
SysInitExceptions;
|
||||
if not IsLibrary then
|
||||
begin
|
||||
|
Loading…
Reference in New Issue
Block a user