unit u_test;
{$mode objfpc}

interface

uses
	windows, sysutils;

type
TLog = class
private
  FLogFile: Text;
  FCS: TRTLCRITICALSECTION;
  FSemReaders, FSemWriters: THandle;
  FActive: Integer;
  FWaitingReaders, FWaitingWriters: Integer;
  procedure WriteString(const Str: string);

public
  constructor Create(FileName: String);
  destructor Destroy; override;

  procedure Write(const SenderName, Str: string);

  procedure WaitToWrite;
  procedure WaitToRead;
  procedure Done;
end;

var
	Log: TLog;

implementation

const
	TimeFormat = 'yyyy-mm-dd hh:mm:ss.zzz';

// TLog -----

// private

constructor TLog.Create(FileName: String);
begin
  inherited Create;
  InitializeCriticalSection(FCS);
  FSemReaders:=CreateSemaphore(nil,0,MAXINT,nil);
  FSemWriters:=CreateSemaphore(nil,0,MAXINT,nil);

	{$I-}
	Assign(FLogFile, FileName);
	if FileExists(FileName) then Append(FLogFile) else Rewrite(FLogFile);
	{$I+}
	if (IOResult = 0) and (FileName <> '') then begin
		WriteString('');
		WriteString('*** Start session ***');
	end else begin
		Writeln('Can''t create or open log file. Program halted.');
		Halt(0);
	end;

end;

destructor TLog.Destroy;
begin
	WriteString('*** End session ***');
	Close(FLogFile);

  CloseHandle(FSemWriters);
  CloseHandle(FSemReaders);
  DeleteCriticalSection(FCS);
  inherited Destroy;
end;

procedure TLog.Done;
var
  Sem: THandle;
  nCount: Cardinal;
begin
  EnterCriticalSection(FCS);
  try
    if (FActive > 0) then begin
      Dec(FActive);
    end
    else begin
      Inc(FActive);
    end;
    Sem:=0;
    if (FActive = 0) then begin
      if (FWaitingWriters > 0) then begin
        FActive:=-1;
        Dec(FWaitingWriters);
        Sem:=FSemWriters;
        nCount:=1;
      end
      else if (FWaitingReaders > 0) then begin
        FActive:=FWaitingReaders;
        FWaitingReaders:=0;
        Sem:=FSemReaders;
        nCount:=FActive;
      end;
    end;
  finally
    LeaveCriticalSection(FCS);
  end;
  if (Sem <> 0) then begin
    ReleaseSemaphore(Sem,nCount,nil);
  end;
end;

procedure TLog.WaitToRead;
var
  ResourceWritePending: Boolean;
begin
  EnterCriticalSection(FCS);
  try
    ResourceWritePending:=(FWaitingWriters > 0) or (FActive < 0);
    if ResourceWritePending then begin
      Inc(FWaitingReaders);
    end
    else begin
      Inc(FActive);
    end;
  finally
    LeaveCriticalSection(FCS);
  end;
  if ResourceWritePending then begin
    WaitForSingleObject(FSemReaders,INFINITE);
  end;
end;

procedure TLog.WaitToWrite;
var
  ResourseOwned: Boolean;
begin
  EnterCriticalSection(FCS);
  try
    ResourseOwned:=(FActive <> 0);
    if ResourseOwned then begin
      Inc(FWaitingWriters);
    end
    else begin
      FActive:=-1;
    end;
  finally
    LeaveCriticalSection(FCS);
  end;
  if ResourseOwned then begin
    WaitForSingleObject(FSemWriters,INFINITE);
  end;
end;

procedure TLog.WriteString(const Str: string);
begin
  {$I-}
  WriteLn(FLogFile, Str);
  Flush(FLogFile);
  {$I+}
  if IOResult <> 0 then begin
    writeln('Can''t write to log file. Program halted.');
	 Halt(0);
  end;
end;

procedure TLog.Write(const SenderName, Str: string);
begin
	WriteString(FormatDateTime(TimeFormat, Now) + ' Note: "' + SenderName + '" - ' + Str);
end;


initialization
	Log := TLog.Create('threads.txt');
finalization
   Log.Destroy;
end.