program LiTh;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

type
  PJob = ^TJob;
  TJob = class
    private
      fRef    :Integer;
      fCount  :Integer;
      fData   :Pointer;
      fResult :Pointer;
      eOk     :Pointer;
      eWait   :Pointer;
      eRef    :Pointer;
      class procedure Signal(aEvent: Pointer); static; inline;
      class procedure Wait(aEvent: Pointer); static; inline;
    public
      constructor Create;
      destructor  Destroy; override;
      function  IncRef:Integer;
      procedure DecRef;
      function  Send(aData :Pointer):Pointer;
      function  Next(var aData :Pointer; var aResult :PPointer):Boolean;
  end;

constructor TJob.Create;
begin
  eOk := System.MonitorSupport.NewWaitObject();
  eRef := System.MonitorSupport.NewWaitObject();
  eWait := System.MonitorSupport.NewWaitObject();
end;

destructor TJob.Destroy;
begin
  while True do begin
    Wait(eRef);
    if fRef = 1 then Send(nil)
      else if fRef = 0 then Break;
  end;
  System.MonitorSupport.FreeWaitObject(eWait);
  System.MonitorSupport.FreeWaitObject(eRef);
  System.MonitorSupport.FreeWaitObject(eOk);
  inherited;
end;

class procedure TJob.Wait(aEvent: Pointer);
begin
  System.MonitorSupport.WaitOrSignalObject(nil, aEvent, INFINITE);
end;

class procedure TJob.Signal(aEvent: Pointer);
begin
  System.MonitorSupport.WaitOrSignalObject(aEvent, nil, 0);
end;


function TJob.IncRef:Integer;
begin
 Result := AtomicIncrement(fRef);
end;

procedure TJob.DecRef;
begin
  AtomicDecrement(fRef);
  Signal(eRef);
end;

function TJob.Send(aData: Pointer): Pointer;
begin
  System.TMonitor.Enter(Self);        // становимся в очередь
  fData := aData;                     // данные задания
  Signal(eWait);                      // сигнал о задании
  if Assigned(aData) then begin
    Wait(eOk);                        // ожидание выполнения
    Result := fResult;                // забераем результат
WriteLn(IntToStr(NativeInt(Result))); // Debug
  end;
  System.TMonitor.Exit(Self);         // уходим из очереди
end;

function TJob.Next(var aData: Pointer; var aResult: PPointer):Boolean;
begin
  if fCount>0 then Signal(eOk);       // сигнал о выполнении
  Wait(eWait);                        // ожидание задания
  aData := fData;                     // какие данные
  aResult := @fResult;                // куда результат
  Result := Assigned(aData);
  Inc(fCount);
end;

function BeginThread(ThreadFunc: TThreadFunc; Parameter: Pointer): NativeInt;
{$IFDEF POSIX}
 var d : NativeUInt; begin Result := System.BeginThread(nil, ThreadFunc, Parameter, d); end;
{$ENDIF POSIX}
{$IFDEF MSWINDOWS}
 var d : Cardinal;  begin Result := System.BeginThread(nil, 0, ThreadFunc, Parameter, 0, d); end;
{$ENDIF MSWINDOWS}


procedure Thread1(Job:TJob);
var
 aData   : Pointer;
 aResult : PPointer;
begin
 Job.IncRef;
   while Job.Next(aData, aResult)     // данные поступили
     do aResult^ := PByte(aData)+1;   // работаем
 Job.DecRef;
end;

procedure Thread234(Job:TJob);
var
 i      : Integer;
 Data   : Pointer;
 Result : Pointer;
begin
 i := Job.IncRef * 100;
   for i := i to i+3 do begin
     Data := Pointer(i);
     Result := Job.Send(Data);        // делегируем
     Sleep(Random(100));
   end;
 Job.DecRef;
end;
                                      // // // // // // //
var
  i:Integer;
  Job : TJob;
begin
  Job := TJob.Create;
    BeginThread(@Thread1, Job);
    for i := 2 to 4 do BeginThread(@Thread234, Job);
  Job.Free;
  Writeln('Fin');
end.

 //system.pas 
  PMonitorSupport = ^TMonitorSupport;
  TMonitorSupport = record
    // Obtain a synchronization object - usually an auto-reset event or semaphore
    NewSyncObject: function: Pointer;
    // Free the synchronization object obtained from NewSyncObject
    FreeSyncObject: procedure (SyncObject: Pointer);
    // Obtain a wait object - usually an auto-reset event or semaphore - these should be cached
    NewWaitObject: function: Pointer;
    // Return the wait object from NewWaitObject back to the cache
    FreeWaitObject: procedure (WaitObject: Pointer);
    // Wait for either a SyncObject or WaitObject or signal an object
    // o WaitOrSignalObject(nil, Obj, Timeout); - Wait for <Timeout> time or until <Obj> is signaled
    // o WaitOrSignalObject(Obj, nil, 0); - Signal <Obj> and return. Timeout and WaitObject params ignored.
    WaitOrSignalObject: function (SignalObject, WaitObject: Pointer; Timeout: Cardinal): Cardinal;
  end;