{ Общий предок контроллеров.

Управление состоянием и кодами ошибок объектов }

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

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

   Molecular Physics department	 	620002, Екатеринбург, К-2
   USTU, Ekaterinsburg, K-2, 620002     УГТУ,
   RUSSIA     	   			Кафедра молекулярной физики
   phone 75-48-39                       тел. 75-48-39

   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
Unit c_Ctrl;
{$IfNDef Seg16}
// !!! Компиляция без директивы { $DEFINE Seg16 } требует Delphi 3
{$EndIF}

INTERFACE
{   USES CmdsFlow;}

type
  tStatusData=record { флаг состояния объекта }
    Flag,InverseFlag:word;
  end;

  { Коды ошибок }
  tErrorCodes=({$I C_ErrCds.Inc});
  tErrorCode=word;

  { Коды ошибок }
  tCtrlAlive=(aYes, aMayBeYes, aMayBeNo, aNo);
  tFlag=(fInitDone, fExInitDone, fExDoneDone, fSetCommandInProgresSuccess);
  tFlags=set of tFlag;

  tWord=record
    case byte of
    0: (w:word);
    1: (b1,b2:Byte);
    2: (LoByte,HiByte:Byte);
    3: (b:array[1..2] of Byte);
  end;

  tDWord=record
    case byte of
    0: (dw:array[1..2] of word);
    1: (w1,w2:Word);
    2: (b1,b2,b3,b4:byte);
    3: (b:array[1..4] of Byte);
  end;

  tData=record
    ErrorCode:tErrorCode; { код ошибки }
  end;

  tPortValuesArray=array[word] of byte;
  tPPortValuesArray=^tPortValuesArray;

  tPortsArrayData=record
    Ptr:tPPortValuesArray;
    Size:word;
  end;

  tTmpData=record
    Flags:tFlags;
    Status:tStatusData;
    CtrlPresent:tCtrlAlive;
    PortsArrayData:tPortsArrayData
  end;


  tName=string[16];

  tCtrl=object
    Err:word;
    function Name:tName; virtual; {Имя контроллера - пока используется
				   только методами Save/exRestore}

{ НЕисполняемые функции (без ввода/вывода в порты)}
    constructor Init;
    destructor  Done;

    function  IsExInitDone:boolean;
    procedure SetExInitDone(x:boolean);
    function  CheckExInitDone:boolean;
    function  IsExDoneDone:boolean;
    procedure SetExDoneDone(x:boolean);

    { Возвращает результат автообнаружения контроллера }
    function   Present:tCtrlAlive;
    { Возвращает результат проверки наличия СЕТИ (220В) - включенности контроллера }
    function   exIsPowerON:boolean;

    { Обработка ошибок }
    procedure SetErrorCode(ErrCode:tErrorCode);
    procedure ErrorHook; virtual; { процедура вызывается каждый раз,
				  когда устанавливается ненулевой код ошибки
				  методом SetErrorCode }
    procedure SetNoError; virtual;
    function  ErrorMessage(en:tErrorCode):string; virtual;
    function  CurErrorMessage:string;
      { Возвращает код ошибки последней операции }
    function  ErrorCode:tErrorCode;
    function  NoError:boolean;
    function  Error:boolean;
    function  NotInitialized:boolean;

   { Сохранение/восстановление состояния контроллера }
      { основные методы}
    function  DataSize:word;
    function  Save(var DataPtr:pointer):boolean;
    function  Restore(var DataPtr:pointer):boolean;
      { вспомогательные методы}
    procedure StoreData(var ToPtr:pointer; var Data; Size:word);
    procedure RestoreData(var FromPtr:pointer; var Data; Size:word);
    function  StoreDataEx(var ToPtr:pointer; var Data; Size:word):boolean;
    function  RestoreDataEx(var FromPtr:pointer; var Data; Size:word):boolean;

    procedure ClearPortsDataX(var PD:array of byte);

    { Управление выполнением многопотоковых команд }
{    procedure InitGlobalCommandFlowControl;
    procedure InitCommandFlowControl;
    function  SetCommandInProgres:boolean;
    function  AnyCommandInProgres:boolean;
    function  CommandInProgres:boolean;
    procedure ClearCommandInProgres;
    function  SetCommandInProgresSuccess:boolean;}

{ Исполняемые функции (ввода/вывод в порты)}
    procedure exInit; virtual;
    procedure exDone; virtual;
    procedure exDetectCtrl(var x:tCtrlAlive); virtual;

{ Вспомогательные функции определния наличия питания, см. exIsPowerON}
    function PortsNumber:word; virtual;
    function exReadSafePorts(var PortsValues:tPortValuesArray; Count:word):boolean; virtual;


    private
{      prCommandFlowControl:tCommandFlowControl;}
      prData:tData;
      prTmpData:tTmpData;

      function DeallocatePortsData:boolean;
      function AllocatePortsData(aSize:word):boolean;

  end;

{ Поцедура очень быстрой проверки статуса объекта
Вход:ES:BX (EBX) ->Self; Выход:CF=0 если статус OK; Изменение: AX=tErrorCode }
function CheckStatus:tErrorCode;

IMPLEMENTATION
  USES
    StrMode, DataSave,
{$IfNDef Seg16} Windows, {$EndIF} MiscFunc;


{var
 gvCommandFlowControl:tCommandFlowControl;}

const
  cStatusFlag=$1234;

function tCtrl.Name;
begin
  Name:='Ctrl';
end;

(*procedure tCtrl.exRestore;
begin
  RestoreData(DataPtr, prData, SizeOf(prData));
end;*)

(*procedure tCtrl.Save;
begin
  StoreData(DataPtr, prData, SizeOf(prData));
end;*)

function tCtrl.Restore(var DataPtr:pointer):boolean;
begin
  Restore:=RestoreDataEx(DataPtr, prData, SizeOf(prData));
end;

function tCtrl.Save(var DataPtr:pointer):boolean;
begin
  Save:=StoreDataEx(DataPtr, prData, SizeOf(prData));
end;

procedure  tCtrl.RestoreData;
  var OK:boolean;
begin
  OK:=(DataSave.tPtrData(FromPtr)^.Name=Name);
  if OK then begin
    if NoError then begin
      if IsExInitDone then
        DataSave.tPtrData(FromPtr)^.Extract(Data, Size, OK);
      FromPtr:=DataSave.tPtrData(FromPtr)^.Next;
      if not OK then begin
        SetErrorCode(tErrorCode(ecDataRestoreFail));
      end;
    end else begin
      FromPtr:=DataSave.tPtrData(FromPtr)^.Next;
    end;
{$IfDef DEBUG}
  end else begin
    OK:=FALSE;
{$EndIf}
  end;
end;

function  tCtrl.RestoreDataEx;
  var OK:boolean; PData:tPtrData;
begin
  PData:=tPtrData(FromPtr);
  OK:=(PData^.Name=Name);
  if OK then begin
    PData^.Extract(Data, Size, OK);
    if OK then
      FromPtr:=PData^.Next;
{$IfDef DEBUG}
  end else begin
    OK:=FALSE;
{$EndIf}
  end;
  RestoreDataEx:=OK;
end;

procedure tCtrl.StoreData;
  var OK:boolean;
begin
  if NoError then begin
    DataSave.tPtrData(ToPtr)^.Init(Size);
    DataSave.tPtrData(ToPtr)^.Store(Data, Size, 1, Name ,OK);
    if OK then begin
      ToPtr:=DataSave.tPtrData(ToPtr)^.Next;
    end else begin
      SetErrorCode(tErrorCode(ecDataSaveFail));
    end;
  end;
end;

function tCtrl.StoreDataEx(var ToPtr:pointer; var Data; Size:word):boolean;
  var OK:boolean; PData:tPtrData;
begin
  PData:=tPtrData(ToPtr);
  PData^.Init(Size);
  PData^.Store(Data, Size, 1, Name ,OK);
  if OK then begin
    ToPtr:=DataSave.tPtrData(ToPtr)^.Next;
  end;
  StoreDataEx:=OK;
end;

function tCtrl.DataSize;
begin
  DataSize:=SizeOf(DataSave.tData)+SizeOf(prData);
end;

    { Управление выполнением многопотоковых команд }
{procedure tCtrl.InitGlobalCommandFlowControl;
begin
  gvCommandFlowControl.Initialize;
end;

function tCtrl.SetCommandInProgres;
begin
  if gvCommandFlowControl.SetCommandInProgres then begin
    SetCommandInProgres:=TRUE;
    Include(prData.Flags, fSetCommandInProgresSuccess);
  end else begin
    SetCommandInProgres:=FALSE;
    Exclude(prData.Flags, fSetCommandInProgresSuccess);
  end;
end;

function tCtrl.AnyCommandInProgres:boolean;
begin
  AnyCommandInProgres:=gvCommandFlowControl.CommandInProgres;
end;

function tCtrl.CommandInProgres:boolean;
begin
  CommandInProgres:=prCommandFlowControl.CommandInProgres;
end;

procedure tCtrl.ClearCommandInProgres;
begin
  if not gvCommandFlowControl.ClearCommandInProgres then begin
    SetErrorCode(tErrorCode(ecCommandFlowControlFail));
  end;
end;

function tCtrl.SetCommandInProgresSuccess:boolean;
begin
  SetCommandInProgresSuccess:=(fSetCommandInProgresSuccess in prData.Flags);
end;

procedure tCtrl.InitCommandFlowControl;
begin
  prCommandFlowControl.Initialize;
end;
}
procedure CtrlOk; forward;
procedure CtrlBad; forward;

constructor tCtrl.Init;
begin
  SetErrorCode(tErrorCode(ecOK));
{  InitCommandFlowControl;}
  prTmpData.Flags:=[fInitDone];
  prTmpData.PortsArrayData.Ptr:=NIL;
  prTmpData.PortsArrayData.Size:=0;
end;

procedure tCtrl.exInit;
begin
  SetNoError;
  exDetectCtrl(prTmpData.CtrlPresent);
  SetExInitDone(NoError);
  SetExDoneDone(FALSE);
end;

{procedure tCtrl.exReInit;
begin
  SetExInitDone(NoError);
  SetExDoneDone(FALSE);
end;}

procedure tCtrl.exDone;
begin
  if IsExDoneDone or not IsExInitDone then Exit;
  SetExInitDone(False);
  SetExDoneDone(NoError);
end;

destructor  tCtrl.Done;
begin
  if NotInitialized then Exit;
  SetNoError;
  exDone;
  SetErrorCode(tErrorCode(ecNotInitialized));
  Exclude(prTmpData.Flags, fInitDone);
  DeallocatePortsData;
end;

function tCtrl.DeallocatePortsData:boolean;
begin
  if (prTmpData.PortsArraydata.Size>0) and (prTmpData.PortsArrayData.Ptr<>NIL) then begin
    FreeMem(prTmpData.PortsArrayData.Ptr,prTmpData.PortsArraydata.Size);
    prTmpData.PortsArrayData.Size:=0;
    prTmpData.PortsArrayData.Ptr:=NIL;
  end;
  DeallocatePortsData:=(prTmpData.PortsArraydata.Size=0) and (prTmpData.PortsArrayData.Ptr=NIL);
end;

procedure tCtrl.ErrorHook;
begin
  { процедура вызывается каждый раз,
  когда устанавливается ненулевой код ошибки }
end;

function   tCtrl.Present:tCtrlAlive;
begin
  Present:=prTmpData.CtrlPresent;
end;

procedure tCtrl.exDetectCtrl(var x:tCtrlAlive);
begin
  x:=aNo;
end;

function tCtrl.exReadSafePorts(var PortsValues:tPortValuesArray; Count:word):boolean;
  var i:word;
begin
  for i:=0 to Pred(Count) do begin
    PortsValues[i]:=0;
  end;
  exReadSafePorts:=TRUE;
end;

function tCtrl.PortsNumber:word;
begin
  PortsNumber:=0;
end;

function tCtrl.AllocatePortsData(aSize:word):boolean;
begin
  AllocatePortsData:=FALSE;
  if (prTmpData.PortsArrayData.Ptr<>NIL) and (prTmpData.PortsArrayData.Size>=aSize) then begin
    AllocatePortsData:=TRUE;
  end else if DeallocatePortsData then begin
    GetMem(prTmpData.PortsArrayData.Ptr,aSize);
    prTmpData.PortsArrayData.Size:=aSize;
    AllocatePortsData:=TRUE;
  end;
end;

function tCtrl.exIsPowerON:boolean;
  var i, imax:word; pON:boolean;
begin
  imax:=PortsNumber;
  pON:=Error or (imax=0);
  if (not pON) then begin
    if AllocatePortsData(imax) then begin
      pON:=not exReadSafePorts(prTmpData.PortsArrayData.Ptr^,prTmpData.PortsArrayData.Size);
      if not pON then begin
        for i:=0 to Pred(imax) do begin
          pON:=prTmpData.PortsArrayData.Ptr^[i]<>$FF;
          if pON then break;
        end;
      end;
    end;
  end;
  exIsPowerON:=pON;
end;

function tCtrl.IsExInitDone:boolean;
begin
  IsExInitDone:=(fExInitDone in prTmpData.Flags);
end;

procedure tCtrl.SetExInitDone(x:boolean);
begin
  if x then begin
    Include(prTmpData.Flags,fExInitDone);
    SetExDoneDone(False);
  end else Exclude(prTmpData.Flags,fExInitDone);
end;

function tCtrl.CheckExInitDone;
begin
  if (not IsExInitDone) then begin
    CheckExInitDone:=False;
    SetErrorCode(tErrorCode(ecNotInitialized));
  end else begin
    CheckExInitDone:=TRUE;
  end;
end;

function tCtrl.IsExDoneDone:boolean;
begin
  IsExDoneDone:=(fExDoneDone in prTmpData.Flags);
end;

procedure tCtrl.SetExDoneDone(x:boolean);
begin
  if x then begin
    Include(prTmpData.Flags,fExDoneDone);
  end else
    Exclude(prTmpData.Flags,fExDoneDone);
end;

procedure tCtrl.SetNoError;
begin
  SetErrorCode(0);
end;

function tCtrl.NotInitialized:boolean;
begin
  NotInitialized:=(ErrorCode=word(ecNotInitialized));
end;

function  tCtrl.ErrorCode:tErrorCode;
{$IfDef Seg16}
assembler;
  asm
    les bx,Self;
    call CheckStatus
  end;
{$Else}
begin
  If @Self<>NIL then
    try
      If (prTmpData.Status.Flag)=(not prTmpData.Status.InverseFlag) then
        Result:=prData.ErrorCode
      else
        Result:=word(ecNotInitialized)
    except
      Result:=word(ecNotInitialized)
    end
  else
    Result:=word(ecNotInitialized);
end;
{$EndIF}

function  tCtrl.Error:boolean;
begin
  Error:=ErrorCode<>0;
end;

function  tCtrl.NoError:boolean;
begin
  NoError:=ErrorCode=0;
end;

procedure tCtrl.SetErrorCode(ErrCode:tErrorCode);
{$IfDef Seg16}
begin
  if ErrCode=0 then begin
    asm les bx,Self; call CtrlOK; end;
  end else begin
    asm
      les bx,Self; mov ax,ErrCode; call CtrlBad;
    end;
    ErrorHook;
  end;
end;
{$Else}
begin
  if ErrCode=0 then begin
    prTmpData.Status.Flag:=cStatusFlag;
    prTmpData.Status.InverseFlag:=word(not word(cStatusFlag));
    prData.ErrorCode:=0;
    Err:=0;
  end else if NoError then begin
    prData.ErrorCode:=ErrCode;
    Err:=ErrCode;
    ErrorHook;
  end;
end;
{$EndIF}

function tCtrl.CurErrorMessage:string;
begin
  CurErrorMessage:=ErrorMessage(ErrorCode);
end;

function tCtrl.ErrorMessage(en:tErrorCode):string;
begin
  case tErrorCodes(en) of
    ecOK:
	ErrorMessage:='Ошибки нет';
    ecAbort:
	ErrorMessage:='Остановка выполнения по требованию';
    ecNotInitialized:
	ErrorMessage:='Контроллер не инициализирован';
    ecBadBus:
	ErrorMessage:='Шина не инициализирована';
    ecExInitDoesNotDone:
	ErrorMessage:='Не выполнена инициализация аппаратуры';
    ecDataSaveFail:
	ErrorMessage:='Ошибка сохранения параметров контроллера';
    ecDataRestoreFail:
	ErrorMessage:='Ошибка восстановления параметров контроллера';
    ecIncorrectData:
	ErrorMessage:='Некорректные или поврежденные данные состояния контроллера';

    Else
      ErrorMessage:='Ошибочное состояние контроллера';

  end;
end;

{ * PRIVATE секция }

{ * Процедуры быстрой проверки состояния объекта}

function CheckStatus:tErrorCode; assembler;
{$IfDef Seg16}
{ Вход:ES:BX->Self; Выход:AX=0, CF=0 если статус OK;
	  иначе AX=ErrorCode, CF=1.
	  Изменение: AX }
  asm
    mov ax,es:c_Ctrl.tCtrl([bx]).prStatus.Flag
    not ax
    sub ax,es:c_Ctrl.tCtrl([bx]).prStatus.InverseFlag
    jz @StatusOK
      mov ax,es:c_Ctrl.tCtrl([bx]).prData.ErrorCode
      or ax,ax; jnz @Cont
	mov ax,ecNotInitialized
	mov es:c_Ctrl.tCtrl([bx]).prData.ErrorCode,ax
      @Cont:
      stc
    @StatusOK:
  end;
{$Else}
{ Вход:EBX->Self; Выход:AX=0, CF=0 если статус OK;
	  иначе AX=ErrorCode, CF=1. Изменение: AX }
  asm
    xor ax,ax
    or ebx,ebx; jz @StatusOK
    mov ax,c_Ctrl.tCtrl([ebx]).prTmpData.Status.Flag
    not ax
    sub ax,c_Ctrl.tCtrl([ebx]).prTmpData.Status.InverseFlag
    jz @StatusOK
      mov ax,c_Ctrl.tCtrl([ebx]).prData.ErrorCode
      or ax,ax; jnz @Cont
	mov ax,ecNotInitialized
	mov c_Ctrl.tCtrl([ebx]).prData.ErrorCode,ax
      @Cont:
      stc
    @StatusOK:
  end;
{$EndIF}

procedure CtrlOk; assembler;
{$IfDef Seg16}
{ Вход:ES:BX->Self; Изменение: AX }
  asm
    mov ax,cStatusFlag
    mov es:c_Ctrl.tCtrl([bx]).prStatus.Flag,ax
    not ax
    mov es:c_Ctrl.tCtrl([bx]).prStatus.InverseFlag,ax
    xor ax,ax
    mov es:c_Ctrl.tCtrl([bx]).prData.ErrorCode,ax
    clc
  end;
{$Else}
{ Вход:EBX->Self; Изменение: AX }
  asm
    mov ax,cStatusFlag
    mov c_Ctrl.tCtrl([ebx]).prTmpData.Status.Flag,ax
    not ax
    mov c_Ctrl.tCtrl([ebx]).prTmpData.Status.InverseFlag,ax
    xor ax,ax
    mov c_Ctrl.tCtrl([ebx]).prData.ErrorCode,ax
    mov c_Ctrl.tCtrl([ebx]).Err,ax
    clc
  end;
{$EndIF}

procedure CtrlBad; assembler;
{$IfDef Seg16}
{ Вход:ES:BX->Self; AX:ErrorCode; Изменение: DX }
  asm
    xor dx,dx
    mov es:c_Ctrl.tCtrl([bx]).prStatus.Flag,dx
    mov es:c_Ctrl.tCtrl([bx]).prStatus.InverseFlag,dx
    mov es:c_Ctrl.tCtrl([bx]).prData.ErrorCode,ax
    mov es:c_Ctrl.tCtrl([bx]).Err,ax
    stc
  end;
{$Else}
{ Вход: EBX->Self; AX:ErrorCode; Изменение: - }
  asm
    mov c_Ctrl.tCtrl([ebx]).prData.ErrorCode,ax
    mov c_Ctrl.tCtrl([ebx]).Err,ax
    mov c_Ctrl.tCtrl([ebx]).prTmpData.Status.Flag,0
    mov c_Ctrl.tCtrl([ebx]).prTmpData.Status.InverseFlag,0
    stc
  end;
{$EndIF}

procedure tCtrl.ClearPortsDataX(var PD:array of byte);
begin
  FillStr(@PD, SizeOf(PD), $FF);
end;

{BEGIN
  gvCommandFlowControl.Initialize;}
END.