paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-23 22:09:45 +02:00
Code Issues Packages Projects Releases Wiki Activity

* MemoryManager record has a field NeedLock if the wrapper functions

Browse Source 
need to provide locking for multithreaded programs
This commit is contained in:
peter 2002-10-30 20:39:13 +00:00
parent 766e8d35f6
commit ca3679e4bf
3 changed files with 33 additions and 18 deletions

37
rtl/inc/heap.inc
View File

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

7
rtl/inc/heaph.inc
View File

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

7
rtl/inc/heaptrc.pp
View File

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