diff --git a/rtl/inc/heap.inc b/rtl/inc/heap.inc index 6bcf0f8799..fde5edbdfe 100644 --- a/rtl/inc/heap.inc +++ b/rtl/inc/heap.inc @@ -63,6 +63,7 @@ procedure SysHeapMutexUnlock;forward; { Memory manager } const MemoryManager: TMemoryManager = ( + NeedLock: true; GetMem: @SysGetMem; FreeMem: @SysFreeMem; FreeMemSize: @SysFreeMemSize; @@ -133,7 +134,7 @@ end; procedure GetMemoryManager(var MemMgr:TMemoryManager); begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -151,7 +152,7 @@ end; procedure SetMemoryManager(const MemMgr:TMemoryManager); begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -169,7 +170,7 @@ end; function IsMemoryManagerSet:Boolean; begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -189,7 +190,7 @@ end; procedure GetMem(Var p:pointer;Size:Longint); begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -207,7 +208,7 @@ end; procedure FreeMem(p:pointer;Size:Longint); begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -225,7 +226,7 @@ end; function MaxAvail:Longint; begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -243,7 +244,7 @@ end; function MemAvail:Longint; begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -262,7 +263,7 @@ end; { FPC Additions } function HeapSize:Longint; begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -280,7 +281,7 @@ end; function MemSize(p:pointer):Longint; begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -299,7 +300,7 @@ end; { Delphi style } function FreeMem(p:pointer):Longint; begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -317,7 +318,7 @@ end; function GetMem(size:longint):pointer; begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -335,7 +336,7 @@ end; function AllocMem(Size:Longint):pointer; begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -353,7 +354,7 @@ end; function ReAllocMem(var p:pointer;Size:Longint):pointer; begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -374,7 +375,7 @@ end; { Needed for calls from Assembler } function fpc_getmem(size:longint):pointer;compilerproc;[public,alias:'FPC_GETMEM']; begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -403,7 +404,7 @@ end; procedure fpc_freemem(p:pointer);compilerproc;[public,alias:'FPC_FREEMEM']; begin - if IsMultiThread then + if IsMultiThread and MemoryManager.NeedLock then begin try MemoryMutexManager.MutexLock; @@ -1264,7 +1265,11 @@ end; { $Log$ - Revision 1.17 2002-10-30 19:54:19 peter + Revision 1.18 2002-10-30 20:39:13 peter + * MemoryManager record has a field NeedLock if the wrapper functions + need to provide locking for multithreaded programs + + Revision 1.17 2002/10/30 19:54:19 peter * remove wrong lock from SysMemSize, MemSize() does the locking already. diff --git a/rtl/inc/heaph.inc b/rtl/inc/heaph.inc index 9f857b9079..2a9f20e185 100644 --- a/rtl/inc/heaph.inc +++ b/rtl/inc/heaph.inc @@ -18,6 +18,7 @@ type PMemoryManager = ^TMemoryManager; TMemoryManager = record + NeedLock : boolean; Getmem : Function(Size:Longint):Pointer; Freemem : Function(p:pointer):Longint; FreememSize : Function(p:pointer;Size:Longint):Longint; @@ -89,7 +90,11 @@ Procedure AsmFreemem(var p:pointer); { $Log$ - Revision 1.5 2002-10-14 19:39:17 peter + Revision 1.6 2002-10-30 20:39:13 peter + * MemoryManager record has a field NeedLock if the wrapper functions + need to provide locking for multithreaded programs + + Revision 1.5 2002/10/14 19:39:17 peter * threads unit added for thread support Revision 1.4 2002/09/07 15:07:45 peter diff --git a/rtl/inc/heaptrc.pp b/rtl/inc/heaptrc.pp index 74662f1a8d..e7d3e817fd 100644 --- a/rtl/inc/heaptrc.pp +++ b/rtl/inc/heaptrc.pp @@ -984,6 +984,7 @@ end; const TraceManager:TMemoryManager=( + NeedLock : true; Getmem : @TraceGetMem; Freemem : @TraceFreeMem; FreememSize : @TraceFreeMemSize; @@ -1149,7 +1150,11 @@ finalization end. { $Log$ - Revision 1.19 2002-10-05 15:19:46 carl + Revision 1.20 2002-10-30 20:39:13 peter + * MemoryManager record has a field NeedLock if the wrapper functions + need to provide locking for multithreaded programs + + Revision 1.19 2002/10/05 15:19:46 carl * bugfix of assigning to external filename output Revision 1.18 2002/09/09 15:45:49 jonas