library GlobalData;

uses
  Windows,
  GlobalHdr in 'GlobalHdr.pas';

const
  GlobalMutexName = 'MCHGlobalMutex - BBARAgAGBQI4r8mOAAoJEPwzBQsIT9FngEA';
  GlobalMapName = 'MCHGlobalMap   - AJ9Qfi3m4vqgUhKYA7qBfzrMDbkpbQtTWFy';

type
  TLocalInfo = record
    LocalThreads: integer;
  end;

  TSyncHandles = record
    LocalSection: TRTLCriticalSection;
    GlobalMutex: THandle;
  end;

  PGlobalInfo = ^TGlobalInfo;

  TGlobalHandles = record
    FileMapping: THandle;
    GlobalInfo: PGlobalInfo;
  end;

var
  SyncHandles: TSyncHandles;
  LocalInfo: TLocalInfo;
  GlobalHandles: TGlobalHandles;

procedure ReadInfo(var GlobalInfo: TGlobalInfo; var LocalThreads: integer); stdcall;
begin
  WaitForSingleObject(SyncHandles.GlobalMutex, INFINITE);
  EnterCriticalSection(SyncHandles.LocalSection);
  GlobalInfo := GlobalHandles.GlobalInfo^;
  LocalThreads := LocalInfo.LocalThreads;
  LeaveCriticalSection(SyncHandles.LocalSection);
  ReleaseMutex(SyncHandles.GlobalMutex);
end;

procedure SetSharedInteger(NewValue: integer); stdcall;
begin
  WaitForSingleObject(SyncHandles.GlobalMutex, INFINITE);
  GlobalHandles.GlobalInfo.SharedNumber := NewValue;
  ReleaseMutex(SyncHandles.GlobalMutex);
end;

procedure IncSharedInteger; stdcall;
begin
  WaitForSingleObject(SyncHandles.GlobalMutex, INFINITE);
  Inc(GlobalHandles.GlobalInfo.SharedNumber);
  ReleaseMutex(SyncHandles.GlobalMutex);
end;

procedure DecSharedInteger; stdcall;
begin
  WaitForSingleObject(SyncHandles.GlobalMutex, INFINITE);
  Dec(GlobalHandles.GlobalInfo.SharedNumber);
  ReleaseMutex(SyncHandles.GlobalMutex);
end;


function AtomicIncThreadCount: integer;
{returns number of local threads for Delphi Memory Manager}
begin
  WaitForSingleObject(SyncHandles.GlobalMutex, INFINITE);
  EnterCriticalSection(SyncHandles.LocalSection);
  Inc(GlobalHandles.GlobalInfo.GlobalThreads);
  Inc(LocalInfo.LocalThreads);
  result := LocalInfo.LocalThreads;
  LeaveCriticalSection(SyncHandles.LocalSection);
  ReleaseMutex(SyncHandles.GlobalMutex);
end;

procedure AtomicDecThreadCount;
begin
  WaitForSingleObject(SyncHandles.GlobalMutex, INFINITE);
  EnterCriticalSection(SyncHandles.LocalSection);
  Dec(GlobalHandles.GlobalInfo.GlobalThreads);
  Dec(LocalInfo.LocalThreads);
  LeaveCriticalSection(SyncHandles.LocalSection);
  ReleaseMutex(SyncHandles.GlobalMutex);
end;

procedure AtomicIncProcessCount;
begin
  WaitForSingleObject(SyncHandles.GlobalMutex, INFINITE);
  Inc(GlobalHandles.GlobalInfo.GlobalProcesses);
  ReleaseMutex(SyncHandles.GlobalMutex);
end;

procedure AtomicDecProcessCount;
begin
  WaitForSingleObject(SyncHandles.GlobalMutex, INFINITE);
  Dec(GlobalHandles.GlobalInfo.GlobalProcesses);
  ReleaseMutex(SyncHandles.GlobalMutex);
end;

procedure SetupSynchronisation;
begin
  with SyncHandles do
  begin
    InitializeCriticalSection(LocalSection);
    GlobalMutex := CreateMutex(nil, false, GlobalMutexName);
    Assert(GlobalMutex <> INVALID_HANDLE_VALUE);
  end;
end;

procedure CloseSynchronisation;
begin
  with SyncHandles do
  begin
    DeleteCriticalSection(LocalSection);
    CloseHandle(GlobalMutex);
  end;
end;

procedure SetupGlobalInfo;

var
  FirstCaller: boolean;

begin
  with GlobalHandles do
  begin
    WaitForSingleObject(SyncHandles.GlobalMutex, INFINITE);
    FileMapping := CreateFileMapping(High(Cardinal), nil, PAGE_READWRITE,
      0, sizeof(TGlobalInfo), GlobalMapName);
    Assert(FileMapping <> INVALID_HANDLE_VALUE);
    FirstCaller := GetLastError <> ERROR_ALREADY_EXISTS;
    GlobalInfo := MapViewOfFile(FileMapping, FILE_MAP_ALL_ACCESS, 0, 0, 0);
    Assert(GlobalInfo <> nil);
    if FirstCaller then FillMemory(GlobalInfo, sizeof(TGlobalInfo), 0);
    ReleaseMutex(SyncHandles.GlobalMutex);
  end;
end;

procedure CloseGlobalInfo;
begin
  with GlobalHandles do
  begin
    UnmapViewOfFile(GlobalInfo);
    CloseHandle(FileMapping);
  end;
end;

procedure DLLFinalisation;
begin
  AtomicDecThreadCount;
  AtomicDecProcessCount;
  CloseGlobalInfo;
  CloseSynchronisation;
end;

procedure EntryPoint(Reason: integer);
begin
  case Reason of
    DLL_THREAD_ATTACH: if AtomicIncThreadCount > 1 then IsMultiThread := true;
    DLL_THREAD_DETACH: AtomicDecThreadCount;
    DLL_PROCESS_DETACH: DLLFinalisation;
  else
    Assert(false);
  end;
end;

exports
  ReadInfo,
  SetSharedInteger,
  IncSharedInteger,
  DecSharedInteger;

begin
  SetupSynchronisation;
  SetupGlobalInfo;
  AtomicIncProcessCount;
  AtomicIncThreadCount;
  DLLProc := @EntryPoint;
end.