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

rtl/inc/heap.inc

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

rtl/win/systhrd.inc

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

rtl/wince/system.pp

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