Prechádzať zdrojové kódy

* MemoryManager record has a field NeedLock if the wrapper functions
need to provide locking for multithreaded programs

peter 23 rokov pred
rodič
commit
ca3679e4bf
3 zmenil súbory, kde vykonal 33 pridanie a 18 odobranie
  1. 21 16
      rtl/inc/heap.inc
  2. 6 1
      rtl/inc/heaph.inc
  3. 6 1
      rtl/inc/heaptrc.pp

+ 21 - 16
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.
 

+ 6 - 1
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

+ 6 - 1
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