* 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:
yury 2006-07-23 10:23:31 +00:00
parent 887781a6b9
commit e062922528
3 changed files with 99 additions and 3 deletions

View File

@ -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}

View File

@ -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;

View File

@ -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