{ Асинхронный контроллер MI1201-AGM

The control units for mass-spectrometer MI1201-AGM
Copyright  (C)	 Aleksandrov O.E., 1998

   Molecular Physics department
   USTU, Ekaterinsburg K-2, 620002
   RUSSIA

   phone 75-48-39
   E-mail: aleks@dpt.ustu.ru

Модуль управления масс-спектрометром МИ1201-АГМ
Copyright (C)	Александров О.Е., 1998

   620002, Екатеринбург К-2
   УГТУ
   Кафедра молекулярной физики

   тел. 75-48-39
   E-mail: aleks@dpt.ustu.ru
+++++++++++++++++++++++++++++++++++++++++++++++++++++
}
unit Mi1201thread;

interface

uses
  Classes, Windows;

type
  tFlag=(fCommandValid, fCommandInProgress, fExecutionInProgress,
	 fDoNotSynchronizeOnCommandComplete,
	 fLocked, fAutoUnLock,
	 fWaitDisable);
  tFlags=set of tFlag;

  tWaitResult=(waitOK, waitTerminated, waitDisable);
  tExitCode=(aecOK, aecLocked, aecBusy, aecNoCommand);

// Реализация витка для методов масс-спектрометра
  TThreadMI1201 = class(TThread)
  private
    prFlags:tFlags;
    prLock:integer;
    prLockedByThreadID:DWORD;

    prOnCommandComplete:TNotifyEvent;
    prCommand:TNotifyEvent;

    prExecutingOnCommandComplete:TNotifyEvent;
    prExecutingCommand:TNotifyEvent;

//---------------------------------------------
// Функции управления витком
    function  GetSynchronizeOnCommandComplete:boolean;
    procedure SetSynchronizeOnCommandComplete(x:boolean);

    function  GetAutoUnLock:boolean;
    procedure SetAutoUnLock(x:boolean);

    procedure SetAsyncCommand(CommandHandler:TNotifyEvent);
    procedure SetOnAsyncCommandComplete(OnCommandCompleteHandler:TNotifyEvent);

  public
    constructor Create; // создание витка
    destructor  Destroy; override; // уничтожение витка

    function Lock:boolean;
    function Locked:boolean;
    function LockedByCurThread:boolean;
    function PropertyChangeAvailable:boolean;
    function UnLock:boolean;

    procedure AsyncCommand(CommandHandler:TNotifyEvent;
			   OnCommandCompleteHandler:TNotifyEvent;
			   var Success:boolean);

    procedure AsyncRun(var Success:boolean);
    property  Command:TNotifyEvent read prCommand write SetAsyncCommand;
    property  OnCommandComplete:TNotifyEvent read prOnCommandComplete write SetOnAsyncCommandComplete;

    function  Busy:boolean;     // =TRUE - процесс занят выполнением команды
    function  Wait:tWaitResult; // ожидание завершения команды или Terminate

    // Выполнение обработчика события OnCommandComplete в режиме синхронизации
    property SynhronizeOnCommandComplete:boolean read GetSynchronizeOnCommandComplete write SetSynchronizeOnCommandComplete;

    // Выполнение автоматического деблокирования контролера в конце выполнения команды
    property AutoUnLock:boolean read GetAutoUnLock write SetAutoUnLock;

  private
  protected
    procedure DoCommandComplete;
    procedure Execute; override;
  end;

implementation

  const SingleControllerLock:word=0;

constructor TThreadMI1201.Create;
begin
  Inc(SingleControllerLock);
  if SingleControllerLock<>1 then begin
    Dec(SingleControllerLock);
    Fail;
  end else begin
    prFlags:=[];
    prLock:=0;
    Lock;
    Inherited Create(True);
    FreeOnTerminate:=True;
  end;
end;

destructor TThreadMI1201.Destroy;
begin
  Lock;
  Inc(prLock);
  if LockedByCurThread then begin
    inherited Destroy;
    if SingleControllerLock=1 then Dec(SingleControllerLock);
  end else begin
    Dec(prLock);
  end;
end;

function TThreadMI1201.Lock:boolean;
begin
  Inc(prLock);
  if (not Busy) and (not Locked) then begin
    Include(prFlags, fLocked);
    prLockedByThreadID:=GetCurrentThreadId;
    Lock:=TRUE;
  end else begin
    Lock:=LockedByCurThread;
  end;
  Dec(prLock);
end;

function TThreadMI1201.Locked:boolean;
begin
  Locked:=(fLocked in prFlags);
end;

function TThreadMI1201.LockedByCurThread:boolean;
begin
  LockedByCurThread:=Locked and (prLockedByThreadID=GetCurrentThreadId);
end;

function TThreadMI1201.UnLock:boolean;
begin
  Inc(prLock);
  if LockedByCurThread then begin
    UnLock:=TRUE;
    Exclude(prFlags, fLocked);
  end else begin
    UnLock:=FALSE;
  end;
  Dec(prLock);
end;

function TThreadMI1201.PropertyChangeAvailable:boolean;
begin
  PropertyChangeAvailable:=(not Busy) and (not Locked or LockedByCurThread);
end;

function TThreadMI1201.Wait:tWaitResult; // ожидание завершения команды
  
  function DoWait:boolean;
  begin
    DoWait:=(not (fWaitDisable in prFlags)) and Busy and (not Terminated);
  end;

  var CurPriority:integer;
begin
  if DoWait then begin
    CurPriority:=GetThreadPriority(GetCurrentThreadId);
    SetThreadPriority(GetCurrentThreadId, THREAD_PRIORITY_LOWEST);
    while DoWait do;
    SetThreadPriority(GetCurrentThreadId, CurPriority);
  end;
//  while (not (fWaitDisable in prFlags)) and Busy and (not Terminated) do;
  if Terminated then
    Wait:=waitTerminated
  else if (fWaitDisable in prFlags) then
    Wait:=waitDisable
  else
    Wait:=waitOK;
end;


function  TThreadMI1201.Busy:boolean; //  процесс занят выполнением команды
begin
  Busy:=(fCommandValid in prFlags) or (prLock>1);
end;

procedure TThreadMI1201.AsyncCommand(CommandHandler:TNotifyEvent;
				     OnCommandCompleteHandler:TNotifyEvent;
				     var Success:boolean);
begin
  Success:=False;
  Lock;
  Inc(prLock);
  if LockedByCurThread and (not Busy) then begin
    if (@CommandHandler<>NIL) then begin
      prCommand:=CommandHandler;
      prOnCommandComplete:=OnCommandCompleteHandler;
      Include(prFlags, fCommandValid);
      Success:=True;
      Suspended:=False;
    end;
  end;
  Dec(prLock);
end;

procedure TThreadMI1201.SetAsyncCommand(CommandHandler:TNotifyEvent);
begin
  Lock;
  Inc(prLock);
  if PropertyChangeAvailable then begin
    prCommand:=CommandHandler;
  end;
  Dec(prLock);
end;

procedure TThreadMI1201.SetOnAsyncCommandComplete(OnCommandCompleteHandler:TNotifyEvent);
begin
  Lock;
  Inc(prLock);
  if PropertyChangeAvailable then begin
    prOnCommandComplete:=OnCommandCompleteHandler;
  end;
  Dec(prLock);
end;


procedure TThreadMI1201.AsyncRun(var Success:boolean);
begin
  Success:=False;
  Lock;
  Inc(prLock);
  if PropertyChangeAvailable then begin
    if (@prCommand<>NIL) then begin
      Include(prFlags, fCommandValid);
      Success:=True;
      Suspended:=False;
    end;
  end;
  Dec(prLock);
end;

procedure TThreadMI1201.Execute;
begin { Place thread code here }
  while not Terminated do begin
    if (fCommandValid in prFlags) then begin
      Include(prFlags, fExecutionInProgress);

      prExecutingCommand:=prCommand;
      prExecutingOnCommandComplete:=prOnCommandComplete;

      Include(prFlags, fCommandInProgress);
      prExecutingCommand(Self); // исполнение команды
      Exclude(prFlags, fCommandInProgress);

      Exclude(prFlags, fCommandValid);

      if (fDoNotSynchronizeOnCommandComplete in prFlags) Then begin
	DoCommandComplete;
      end else begin
	Synchronize(DoCommandComplete);
      end;

      if (fAutoUnLock in prFlags) AND (not Busy) then Exclude(prFlags, fLocked);

      Exclude(prFlags, fExecutionInProgress);
    end else begin
      Suspended:=True;
    end;
  end;
end;

procedure TThreadMI1201.DoCommandComplete;
begin
  if (@prExecutingOnCommandComplete<>NIL) then begin
    Include(prFlags, fWaitDisable);
    prExecutingOnCommandComplete(Self);
    prExecutingOnCommandComplete:=NIL;
    Exclude(prFlags, fWaitDisable);
  end;
end;

function TThreadMI1201.GetSynchronizeOnCommandComplete:boolean;
begin
  GetSynchronizeOnCommandComplete:= not (fDoNotSynchronizeOnCommandComplete in prFlags);
end;

procedure TThreadMI1201.SetSynchronizeOnCommandComplete(x:boolean);
begin
  Inc(prLock);
  if PropertyChangeAvailable then begin
    if x then Exclude(prFlags, fDoNotSynchronizeOnCommandComplete)
	 else Include(prFlags, fDoNotSynchronizeOnCommandComplete);
  end;
  Dec(prLock);
end;

function TThreadMI1201.GetAutoUnLock:boolean;
begin
  GetAutoUnLock:=(fAutoUnlock in prFlags);
end;

procedure TThreadMI1201.SetAutoUnLock(x:boolean);
begin
  Inc(prLock);
  if PropertyChangeAvailable then begin
    if x then Include(prFlags, fAutoUnlock)
	 else Exclude(prFlags, fAutoUnlock);
  end;
  Dec(prLock);
end;

END.