{ Контроллер ввода/вывода в порты }

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

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-47-15
   E-mail: aleks@dpt.ustu.ru

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

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-47-15
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
Unit c_Bus;
{$IfNDef Seg16}
// !!! Компиляция без директивы { $DEFINE Seg16 } требует Delphi 3
{$EndIF}

{$X+}

INTERFACE
  USES
    MiTypes, c_Ctrl;

const
    cDefaultBasePort      =$ED00; { базовый порт МИ1201-AGM-по умолчанию }

    cDefaultTimerCalibratePortShift=$90; { порт для калибровки таймера.
	Годится любой, лишь бы чтение из него ничего не нарушало.}


    cDefaultOutDelay      =10;    { число циклов задержки для последовательной
				    записи в порт (OutBytes) по умолчанию }
    cDefaultInDelay       =10;    { число циклов задержки для последовательного
				    чтения из порта (InBytes) по умолчанию }

    cDefaultSingleOutDelay=False; { задержка после однократной записи (OutByte) в порт }
    cDefaultSingleInDelay =False; { задержка после однократного чтения (InByte) из порта }

  type

  { Коды ошибок вызова функций шины }
  tErrorCodes=({$I C_ErrCds.Inc},
	       ecTooSlowMachine,
		ecFailConnectDriver,
		ecFailReadDriver,
		ecFailWriteDriver,
                ecFailCalibrateTimer,
                ecFailLoadEmulator
		);
  tErrorCodesSet=set of tErrorCodes;

{ внутренние Флаги }
  tFlag=(fSingleOutDelay, fSingleInDelay);
  tFlags=set of tFlag;

{$IfNDef Seg16}
  tMaskB=record
    case byte of
     0:(PattMask:word);
     1:(Patt,Mask:byte);
  end;
{$EndIf NDef Seg16}
 tCounter={$IfNDef Seg16}cardinal{$Else}longint{$EndIf};

  tData=record
    Flags:tFlags;
    BasePort:word;
    CorrectCount:word;
    OutDelay:word;
    InDelay:word;
    CalibrationPort:word;
    CalibrationPortShift:word;
  end;

  tTmpData=record
    DelayCoefficient:tCounter;
    MinDelayInterval:word;
    MinDelayCoefficient:tCounter;
  end;

{ Объект управления шиной (громко сказано..)}
  tCtrlPtr=^tCtrl;
  tCtrl=object(c_Ctrl.tCtrl)
    function Name:tName; virtual;

{ НЕисполняемые функции (без ввода/вывода в порты)}
    { Инициализация (без ввода/вывода в порты)
    BasePort - базовый порт}
    constructor Init(BasePort:word);
    constructor InitDefault;
    function    Emulator:boolean;

   { Установка параметров (без ввода/вывода в порты)}
    procedure OutDelay(x:word);
    procedure InDelay(x:word);
    procedure SingleOutDelay(x:boolean);
    procedure SingleInDelay(x:boolean);

    { Чтение текущих значений параметров (без ввода/вывода в порты)}
    function  CurOutDelay:word;
    function  CurInDelay:word;
    function  CurSingleOutDelay:boolean;
    function  CurSingleInDelay:boolean;

{$IfNDef Seg16}
    function  PortIOViaDeviceDriver:boolean;
{$EndIf NDef Seg16}

    { Вспомогательные функции  (без ввода/вывода в порты)}
    { Задержка на Time миллисекунд }
    procedure Delay(Time:tTiks);
    procedure Delay0(Time:tTiks); // не ждет если Time=0;

    { Задержка на на минимальный интервал Time_mks }
    function  MinDelayInterval_mks:word;
    procedure Delay_min(Time:word);

    { Текстовое описание кода ошибки ErrorMessage }
    function ErrorMessage(en:c_Ctrl.tErrorCode):string; virtual;

{ Сохранение/восстановление состояния контроллера }
    function    DataSize:word;
//    procedure   Save(var DataPtr:pointer);
//    procedure   exRestore(var DataPtr:pointer);
    function Restore(var DataPtr:pointer):boolean;
    function Save(var DataPtr:pointer):boolean;

{ Исполняемые функции (ввод/вывод в порты)}

    procedure   exInit; virtual;
    procedure   exUseEmulator(status:boolean);

    { Ввод/вывод байта в порт: "базовый порт"+PortShift  }
    function  exInByte(PortShift:word):Byte;
    procedure exOutByte(PortShift:word; B:Byte);

    { Ввод/вывод байта в порт: Port  }
    function  exInByteX(Port:word):Byte; {$IfNDef Seg16} register; {$EndIf}
    procedure exOutByteX(Port:word; B:Byte); {$IfNDef Seg16} register; {$EndIf}

    { Ввод/вывод строки байтов Data длиной Size
    в порт: "базовый порт"+PortShift  }
    procedure exInBytes(PortShift:word; var Data; Size:word);
    procedure exOutBytes(PortShift:word; var Data; Size:word);

    { Ввод/вывод строки байтов Data длиной Size в порт: Port  }
    procedure exInBytesX(Port:word; var Data; Size:word); {$IfNDef Seg16} register; {$EndIf}
    procedure exOutBytesX(Port:word; var Data; Size:word); {$IfNDef Seg16} register; {$EndIf}

    { Ожидание в течении TimeOut миллисекунд события:
      Patt=(значение в порту "базовый порт"+PortShift) AND Mask. }
    function  exWait(PortShift:word;
		     Mask,Patt:Byte;
		     Time:tTiks):tErrorCode; {$IfNDef Seg16}pascal;{$EndIf NDef Seg16}


    { ЛЕНИВОЕ (опрос порта производится только раз за интервал TimeStep [мс])
      ожидание в течении TimeOut миллисекунд события:
      Patt=(значение в порту "базовый порт"+PortShift) AND Mask. \
      ЧТЕНИЕ порта с интервалом в 1 мсек }
    function  exLazyWaitX(Port:word; Mask,Patt:Byte;
		     Time_ms:tTiks; TimeStep_ms:word):tErrorCode;
    { ЛЕНИВОЕ (опрос порта производится только раз за интервал TimeStep [мс])
      ожидание в течении TimeOut миллисекунд события:
      Patt=(значение в порту "базовый порт"+PortShift) AND Mask. \
      ЧТЕНИЕ порта с интервалом в TimeStep_ms мсек }
    function  exLazyWait(PortShift:word; Mask,Patt:Byte;
		     Time_ms:tTiks; TimeStep_ms:word):tErrorCode;

    { ЛЕНИВОЕ (см. выше) ожидание.
      ВОЗВРАЩАЕТ значение>=0 - дождались, значение = времени ожидания
                 значение<0 - НЕ дождались, значение = -(код ошибки)}
     function exLazyWaitEx(PortShift:word; Mask,Patt:Byte;
                  Time_ms:tTiks; TimeStep_ms:word):integer;
     function exLazyWaitXEx(Port:word; Mask,Patt:Byte;
                  Time_ms:tTiks; TimeStep_ms:word):integer;

    { Ожидание в течении TimeOut миллисекунд события:
      Patt=(значение в порту "базовый порт"+PortShift) AND Mask. }
    function  exWaitX(Port:word;
		     Mask,Patt:Byte;
		     Time:tTiks):tErrorCode; {$IfNDef Seg16}pascal;{$EndIf NDef Seg16}


    { Ввод/вывод байта в порт: Port
      +
      Ожидание в течении Time миллисекунд события:
      Patt=(значение в порту WaitPort) AND Mask.
	ОТЛИЧИЕ от exWait - если Time=0, то все равно ожидает 1 мс}
    function  exOutByteAndWaitX(Port:word; ByteOut:byte;
				WaitPort:word;
				Mask,Patt:Byte;
				Time:tTiks):tErrorCode;{$IfNDef Seg16} pascal;{$EndIf}

   { Ввод/вывод байта в порт: BasePort+PortShift
    Ожидание в течении Time миллисекунд события:
    Patt=(значение в порту BasePort+WaitPortShift) AND Mask. }
    function  exOutByteAndWait(PortShift:word; ByteOut:byte;
			       WaitPortShift:word;
			       Mask,Patt:Byte; Time:longint):tErrorCode;

    function  exScanPorts(var Ports; Size:word; Mask,Patt:Byte):word;
    function  exScanNotFFPorts(var Ports; Size:word):word;
    function  exScanPortsX(var Ports; Size:word; Mask,Patt:Byte):word;
    function  exScanNotFFPortsX(var Ports; Size:word):word;

    procedure SetCalibratePort(Port:word);
    function CurCalibratePort:word;

    private
      prData:tData;
      prTmpData:tTmpData;

{$IfNDef Seg16}
//    procedure DelayLoop;
    function Wait1msec(Port:word; MaskPatt:tMaskB):boolean; register;
    function WaitMinInterval(Port:word; MaskPatt:tMaskB):boolean; register;
{$EndIf NDef Seg16}
      procedure exCalibrateWait;
      function PortShift2Port(PortShift:word):word;
    procedure exDetectCtrl(var x:tCtrlAlive); virtual;
  end;


IMPLEMENTATION
  USES
{$IfNDef NoEmulator}
    MI1201AGM_Emulator_DLL_Headers,
{$EndIf}
    DataSave, MiscFunc, StrTrs32 {$IfNDef Seg16}, PortsIO, Windows{$EndIf};

{$IfNDef Seg16}
type
  TByteArray=array[word] of Byte;
  TPByteArray=^TByteArray;
{$EndIf}


{$IfDef Seg16}
procedure GetPortInDX; forward;
{$EndIf}

{$IfNDef NoEmulator}
{$IfNDef Seg16}
function Emulator:boolean;
begin
  Emulator:=MI1201AGM_Emulator_DLL_Headers.EmulatorEnable;
end;

procedure UseEmulator(status:boolean);
begin
  if status then begin
    If MI1201AGM_Emulator_DLL_Headers.LoadEmulator then begin
      PortsIO.SetExternalInOutByte(
        @MI1201AGM_Emulator_DLL_Headers.InByte,
        @MI1201AGM_Emulator_DLL_Headers.OutByte,
        @MI1201AGM_Emulator_DLL_Headers.LastError
      );
    end;
  end else begin
     PortsIO.ReSetInOutByte;
     MI1201AGM_Emulator_DLL_Headers.UnLoadEmulator;
  end;
end;
{$EndIf}
{$EndIf}

procedure tCtrl.exUseEmulator(status:boolean);
begin
{$IfNDef NoEmulator}
{$IfNDef Seg16}
  c_Bus.UseEmulator(status);
  if Emulator<>status then begin
    SetErrorCode(tErrorCode(ecFailLoadEmulator));
  end;
{$EndIf}
{$EndIf}
end;

function tCtrl.Emulator:boolean;
begin
{$IfNDef NoEmulator}
{$IfNDef Seg16}
  Emulator:=c_Bus.Emulator;
{$Else}
  Emulator:=FALSE;
{$EndIf}
{$Else}
  Emulator:=FALSE;
{$EndIf}
end;

{------------------------------------------------------------------------}
{ Инициализация (без ввода/вывода в порты)}
constructor tCtrl.Init(BasePort:word);
begin
  Inherited Init;

  prTmpData.DelayCoefficient:=0;

  prData.BasePort:=BasePort;
  OutDelay(cDefaultOutDelay);
  InDelay (cDefaultInDelay);

  SingleOutDelay(cDefaultSingleOutDelay);
  SingleInDelay (cDefaultSingleInDelay);
  SetCalibratePort(prData.BasePort+cDefaultTimerCalibratePortShift);
end;

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

procedure tCtrl.exInit;
begin
  Inherited exInit;
  If IsExInitDone then begin
  {$IfNDef Seg16}
    if PortsIO.IsError then
      SetErrorCode(tErrorCode(ecFailConnectDriver));
    PortsIO.InByte(CurCalibratePort);
    if PortsIO.IsError then
      SetErrorCode(tErrorCode(ecFailConnectDriver));
  {$EndIf NDef Seg16}
    exCalibrateWait;
    SetExInitDone(NoError);
  end;
end;

{$IfNDef Seg16}
function  tCtrl.PortIOViaDeviceDriver:boolean;
begin
  Result:=PortsIO.UsingDeviceIOControl;
end;
{$EndIf NDef Seg16}

(*procedure tCtrl.SetNoError;
begin
  if not (tErrorCodes(ErrorCode) in cFatalErrors) then
    Inherited SetNoError;
end;
*)

constructor tCtrl.InitDefault;
begin
  Init(cDefaultBasePort);
end;

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

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

function tCtrl.Restore(var DataPtr:pointer):boolean;
begin
  if Inherited Restore(DataPtr) then
    Restore:=RestoreDataEx(DataPtr, prData, SizeOf(prData))
  else
    Restore:=FALSE;
end;

function tCtrl.Save(var DataPtr:pointer):boolean;
begin
  if Inherited Save(DataPtr) then
    Save:=StoreDataEx(DataPtr, prData, SizeOf(prData))
  else
    Save:=FALSE;
end;

function tCtrl.DataSize:word;
begin
  DataSize:=Inherited DataSize + DataSave.SizeOfData(SizeOf(prData));
end;

{------------------------------------------------------------------------}
{ Установка параметров (без ввода/вывода в порты)}
procedure tCtrl.OutDelay(x:word);
begin
  prData.OutDelay:=x;
end;

procedure tCtrl.InDelay(x:word);
begin
  prData.InDelay:=x;
end;

procedure tCtrl.SingleOutDelay(x:boolean);
begin
  if x then Include(prData.Flags, fSingleOutDelay)
       else Exclude(prData.Flags, fSingleOutDelay);
end;

procedure tCtrl.SingleInDelay(x:boolean);
begin
  if x then Include(prData.Flags, fSingleInDelay)
       else Exclude(prData.Flags, fSingleInDelay);
end;

procedure tCtrl.SetCalibratePort;
begin
  prData.CalibrationPort:=Port;
  prData.CalibrationPortShift:=Port-prData.BasePort;
end;

{------------------------------------------------------------------------}
{ Чтение текущих значений параметров (без ввода/вывода в порты)}
function  tCtrl.CurOutDelay:word;
begin
  CurOutDelay:=prData.OutDelay;
end;

function  tCtrl.CurInDelay:word;
begin
  CurInDelay:=prData.InDelay;
end;

function  tCtrl.CurSingleOutDelay:boolean;
begin
  CurSingleOutDelay:=(fSingleOutDelay in prData.Flags);
end;

function  tCtrl.CurSingleInDelay:boolean;
begin
  CurSingleInDelay:=(fSingleInDelay in prData.Flags);
end;

function tCtrl.CurCalibratePort:word;
begin
  CurCalibratePort:=prData.CalibrationPort;
end;

function tCtrl.ErrorMessage(en:tErrorCode):string;
begin
  case tErrorCodes(en) of
    ecTimeOut:
      ErrorMessage:='Не удалось дождаться события (c_Bus)';
    ecTooSlowMachine:
      ErrorMessage:='Слишком медленная машина, не удается откалибровать таймер';
    ecFailConnectDriver:
      ErrorMessage:='Не удалось подключиться к драйверу ввода/вывода в порты, возможно не установлен или не запущен'+
		    ' драйвер (только Windows NT/2000)';
    ecFailReadDriver:
      ErrorMessage:='Ошибка чтения порта '+
		    {$IfNDef Seg16 --- Delphi ---}
		    DWord2HexStr(LastIOPort) +
		    {$EndIf NDef Seg16 --- Delphi ---}
		    'h через к драйвер ввода/вывода в порты, возможно не'+
		    ' установлен драйвер или неверно заданы диапазоны портов (Windows NT/2000).';
    ecFailWriteDriver:
      ErrorMessage:='Ошибка записи в порт '+
		    {$IfNDef Seg16 --- Delphi ---}
		    DWord2HexStr(LastIOPort) +
		    {$EndIf NDef Seg16 --- Delphi ---}
		    'h через к драйвер ввода/вывода в порты, возможно не'+
		    ' установлен драйвер или неверно заданы диапазоны портов (Windows NT/2000)';
    ecFailLoadEmulator:
      ErrorMessage:='Не найден эмулятор (MI1201AGM_Emulator_DLL.dll).';
    else
      ErrorMessage:=Inherited ErrorMessage(en)+' (c_Bus)';
  end;
end;

function tCtrl.PortShift2Port(PortShift:word):word;
{$IfDef Seg16 --- DOS & Protected mode ---}
assembler;
asm
  les bx,Self
  mov ax,PortShift
  add ax,es:tCtrl([bx]).prData.BasePort
end;
{$Else --- Delphi ---- }
begin
  Result:=prData.BasePort+PortShift;
end;
{$EndIF}

{------------------------------------------------------------------------}
{ Исполняемые функции (ввод/вывод в порты)}

procedure tCtrl.exOutByte(PortShift:word; B:Byte);
begin
  exOutByteX(PortShift2Port(PortShift), B);
end;

function  tCtrl.exInByte(PortShift:word):Byte;
begin
  exInByte:=exInByteX(PortShift2Port(PortShift));
end;

procedure tCtrl.exOutBytes(PortShift:word; var Data; Size:word);
begin
  exOutBytesX(PortShift2Port(PortShift), Data, Size);
end;

procedure tCtrl.exInBytes(PortShift:word; var Data; Size:word);
begin
  exInBytesX(PortShift2Port(PortShift), Data, Size);
end;

{$IfNDef Seg16}
(*procedure tCtrl.DelayLoop;
assembler;
asm
  test Self.prData.Flags,(1 shl fSingleOutDelay); jz @SkipDelay
    push eax
      call PortsIO.UsingDeviceIOControl;
      or ax,ax; jz @SkipDelay
    pop eax
    mov cx,Self.prData.OutDelay;
    @DelayLoop: jcxz @SkipDelay
      dec cx;
    jmp @DelayLoop
  @SkipDelay:
end;*)
{begin
 if PortsIO.UsingDeviceIOControl then Exit;
asm
  test Self.prData.Flags,(1 shl fSingleOutDelay); jz @SkipDelay
    mov cx,Self.prData.OutDelay;
    @DelayLoop: jcxz @SkipDelay
      dec cx;
    jmp @DelayLoop
  @SkipDelay:
end;
end;}
{$EndIF}

procedure tCtrl.exOutByteX(Port:word; B:Byte);
{$IfDef Seg16 --- DOS & Protected mode ---}
assembler;
asm
  les bx,Self
  call CheckStatus; jc @End
    mov dx,Port
    mov al,B
    out dx,al
    { Цикл задержки }
    test es:tCtrl([bx]).prData.Flags,(1 shl fSingleOutDelay);jz @SkipDelay
      mov cx,es:tCtrl([bx]).prData.OutDelay
      @DelayLoop: jcxz @SkipDelay
	dec cx;
      jmp @DelayLoop
    @SkipDelay:
  @End:
end;
{$Else --- Delphi ---- }
begin
  if NoError then begin
    PortsIO.OutByte(b, Port);
    if PortsIO.IsError then
      SetErrorCode(tErrorCode(ecFailWriteDriver))
{			   else DelayLoop;}
  end;
end;
{$EndIF}

function  tCtrl.exInByteX(Port:word):Byte;
{$IfDef Seg16 --- DOS & Protected mode ---}
assembler;
asm
  les bx,Self
  call CheckStatus; jc @End
    mov dx,Port
    in al,dx
    { Цикл задержки }
    test es:tCtrl([bx]).prData.Flags,(1 shl fSingleInDelay); jz @SkipDelay
      mov cx,es:tCtrl([bx]).prData.InDelay;
      @DelayLoop: jcxz @SkipDelay
	dec cx;
      jmp @DelayLoop
    @SkipDelay:
  @End:
end;
{$Else --- Delphi ---- }
begin
  if NoError then begin
    Result:=PortsIO.InByte(Port);
    if PortsIO.IsError then
      SetErrorCode(tErrorCode(ecFailReadDriver))
{			   else DelayLoop;}
  end else begin
    Result:=$FF;
  end;
end;
{$EndIF}

procedure tCtrl.exOutBytesX(Port:word; var Data; Size:word);
{$IfDef Seg16 --- DOS & Protected mode ---}
assembler;
asm
  les bx,Self
  call CheckStatus; jc @End
    mov dx,Port
    mov cx,Size
    push ds
      lds si,Data
      cld
      @loop:
	outsb
	{ Цикл задержки }
	mov ax,es:tCtrl([bx]).prData.OutDelay; or ax,ax; jz @SkipDelay
	  @DelayLoop: dec ax; jnz @DelayLoop
	@SkipDelay:
      loop @loop
    pop ds
  @End:
end;
{$Else --- Delphi ---- }
  var i:word;
begin
  i:=0;
  while (i<Size) and (NoError) do begin
    PortsIO.OutByte(TByteArray(Data)[i], Port);
    if PortsIO.IsError then
      SetErrorCode(tErrorCode(ecFailWriteDriver))
{			   else DelayLoop};
    Inc(i);
  end;
end;
{$EndIF}

procedure tCtrl.exInBytesX(Port:word; var Data; Size:word);
{$IfDef Seg16 --- DOS & Protected mode ---}
assembler;
asm
  les bx,Self
  call CheckStatus; jc @End
    mov dx,Port
    mov cx,Size; les di,Data
    cld
    @loop:
      insb
      { Цикл задержки }
      mov ax,es:tCtrl([bx]).prData.InDelay; or ax,ax; jz @SkipDelay
	@DelayLoop: dec ax; jnz @DelayLoop
      @SkipDelay:
    loop @loop
  @End:
end;
{$Else --- Delphi ---- }
  var i:word;
begin
  i:=0;
  while (i<Size) and (NoError) do begin
    TByteArray(Data)[i]:=PortsIO.InByte(Port);
    if PortsIO.IsError then
      SetErrorCode(tErrorCode(ecFailReadDriver))
{			   else DelayLoop};
    Inc(i);
  end;
end;
{$EndIF}

procedure tCtrl.Delay;
  var ti:tTimeInterval;
begin
{$IfDef Seg16 --- DOS & Protected mode ---}
  if Time>0 then
    exWait(prData.CalibrationPortShift, $00,$FF, Time);
{$Else --- Delphi ---- }
    if (Time<=200) and NoError then begin
      Sleep(Time);
    end else begin
      ti.Start(Time);
      while (ti.TimeLeft>100) and NoError  do begin
        Sleep(100); // Функция ядра Win32 - останавливает выполнение витка.
      end;
      if NoError then
        Sleep(ti.TimeLeft);
    end;
{$Endif}
end;

procedure tCtrl.Delay0;
  var ti:tTimeInterval;
begin
  if Time>0 then
{$IfDef Seg16 --- DOS & Protected mode ---}
    exWait(prData.CalibrationPortShift, $00,$FF, Time);
{$Else --- Delphi ---- }
    if Time>0 then begin
      ti.Start(Time);
      while (ti.TimeLeft>100) and NoError do begin
        Sleep(10); // Функция ядра Win32 - останавливает выполнение витка.
       	         // Соответственно процессор освобождается для других задач.
      end;
      if NoError then
        Sleep(ti.TimeLeft);
    end;
{$Endif}
end;

{$IfDef Seg16 --- DOS & Protected mode ---}
procedure Wait1msec; forward;
{$Endif}

function tCtrl.exWait;
begin
  exWait:=tErrorCode(exWaitX(prData.BasePort+PortShift,  Mask,Patt,Time));
end;

{$R-}
function tCtrl.exWaitX;
{ Ожидает <Time> миллисекунд события
  (Порт[BasePort+PortShift] and <MASK>) = <PATT>.
  Возвращает: 0 - если дождалась, иначе код ошибки ecOutOfTime. }
{$IfDef Seg16 --- DOS & Protected mode ---}
  var DelayCoef:longint; ec:word;
begin
  ec:=ErrorCode;
  If ec=0 then begin { отмена исполнения при наличии ошибки }
    DelayCoef:=prData.DelayCoefficient;
    asm
      les bx,Self
      { Установка в DX порта для ввода}
      mov dx,Port

      { Установка в ES:[DI] безопасного адреса для цикла ожидания }
      mov es,Seg0040; xor di,di
      mov ah,es:[di]

      { Подготовка маски и образца для цикла }
      mov bh,Mask; mov bl,Patt

      { Цикл ожидания }
      @WaitLoop:
	sub word(Time),1; sbb word(Time[2]),0; jc @ErrorExit
	mov cx,word(DelayCoef); mov si,word(DelayCoef[2])
	call Wait1msec; jz @End
      jmp @WaitLoop
      @ErrorExit: or bh,bh; jz @End
	mov ax,ecTimeOut;
      jmp @End1
      @End: xor ax,ax
      @End1:
      mov ec,ax
    end;
    if ec<>0 then
      SetErrorCode(tErrorCode(ec));
  end;
  exWaitX:=ec;
end;

{$Else --- Delphi ---- }
  var
    MP:TMaskB;  EventOccured:boolean; ti:tTimeInterval;
begin
  If NoError then begin { отмена исполнения при наличии ошибки }
    MP.Mask:=Mask;
    MP.Patt:=Patt;
    EventOccured:=FALSE;
    ti.Start(Time);
    repeat
       if Wait1msec(Port, MP) then begin
         ti.CancelInterval;
         EventOccured:=TRUE;
       end;
    until ti.IntervalEnd or Error;
    if PortsIO.IsError then
      SetErrorCode(tErrorCode(ecFailReadDriver))
    else if not EventOccured then
      SetErrorCode(tErrorCode(ecTimeOut));
  end;
  Result:=tErrorCode(ErrorCode);
end;

{$Endif}

function tCtrl.exLazyWaitX;
{ ЛЕНИВО ожидает <Time> миллисекунд события
  (Порт[Port] and <MASK>) = <PATT>. С интервалом TimeStep.
  Возвращает: 0 - если дождалась, иначе код ошибки ecOutOfTime. }
{$IfNDef Seg16 --- Delphi ---}
  var Event:boolean; ti:tTimeInterval;
begin
  if NoError then begin
    Event:=((PortsIO.InByte(Port) and Mask)=Patt);
    if (not Event) and (not PortsIO.IsError) then begin
      ti.Start(Time_ms);
      if TimeStep_ms>Time_ms then
        TimeStep_ms:=(Time_ms shr 2);
      repeat
        Event:=((PortsIO.InByte(Port) and Mask)=Patt);
        if not Event then begin
          Sleep(TimeStep_ms);
          Event:=((PortsIO.InByte(Port) and Mask)=Patt);
        end;
      until Event or ti.IntervalEnd or PortsIO.IsError or Error;
      if (not Event) and (not PortsIO.IsError) and NoError then begin
        Event:=((PortsIO.InByte(Port) and Mask)=Patt);
      end;
    end;
    if PortsIO.IsError then begin
      SetErrorCode(Ord(ecFailReadDriver));
    end else if not Event then begin
      SetErrorCode(Ord(ecTimeOut));
    end;
  end;
  exLazyWaitX:=tErrorCode(ErrorCode);
end;
{$ELSE NDef Seg16 --- DOS ---}
begin
  exLazyWaitX:=exWaitX(Port,Mask,Patt,Time_ms);
end;
{$EndIf NDef Seg16 --- Delphi ---}

{$IfNDef Seg16 --- Delphi ---}
function tCtrl.exLazyWaitEx;
begin
  exLazyWaitEx:=exLazyWaitXEx(PortShift2Port(PortShift), Mask,Patt, Time_ms,TimeStep_ms);
end;

function tCtrl.exLazyWaitXEx;
{ ЛЕНИВО ожидает <Time> миллисекунд события
  (Порт[Port] and <MASK>) = <PATT>. С интервалом TimeStep.
  Возвращает: 0 - если дождалась, иначе код ошибки ecOutOfTime. }
  var Event:boolean; ti:tTimeInterval;
begin
  exLazyWaitXEx:=0;
  if NoError then begin
    ti.Start(Time_ms);
    Event:=((PortsIO.InByte(Port) and Mask)=Patt);
    if (not Event) and (not PortsIO.IsError) then begin
      if TimeStep_ms>Time_ms then
        TimeStep_ms:=(Time_ms shr 2);
      repeat
        Event:=((PortsIO.InByte(Port) and Mask)=Patt);
        if not Event then begin
          Sleep(TimeStep_ms);
          Event:=((PortsIO.InByte(Port) and Mask)=Patt);
        end;
      until Event or ti.IntervalEnd or PortsIO.IsError or Error;
      if (not Event) and (not PortsIO.IsError) and NoError then begin
        Event:=((PortsIO.InByte(Port) and Mask)=Patt);
      end;
    end;
    exLazyWaitXEx:=ti.TimeSpend;
    if PortsIO.IsError then begin
      SetErrorCode(Ord(ecFailReadDriver));
    end else if not Event then begin
      SetErrorCode(Ord(ecTimeOut));
    end;
  end;
  if Error then
    exLazyWaitXEx:=-ErrorCode;
end;
{$EndIf NDef Seg16 --- Delphi ---}

function tCtrl.exLazyWait;
{ Ожидает <Time> миллисекунд события
  (Порт[BasePort+PortShift] and <MASK>) = <PATT>. С интервалом TimeStep.
  Возвращает: 0 - если дождалась, иначе код ошибки ecOutOfTime. }
begin
  exLazyWait:=exLazyWaitX(PortShift2Port(PortShift), Mask,Patt, Time_ms,TimeStep_ms);
end;

{ Ввод/вывод байта в порт: Port
  Ожидание в течении Time миллисекунд события:
    Patt=(значение в порту WaitPort) AND Mask. }
function  tCtrl.exOutByteAndWaitX(Port:word; ByteOut:byte;
				  WaitPort:word; Mask,Patt:Byte; Time:tTiks):tErrorCode;
{$IfDef Seg16 --- DOS & Protected mode ---}
  var DelayCoef:longint; ec:word;
begin
  ec:=ErrorCode;
  If ec=0 then begin { отмена исполнения при наличии ошибки }
    DelayCoef:=prData.DelayCoefficient;
    asm
      les bx,Self
{      call CheckStatus; jc @End1}

      { Установка в CX порта для ввода}
      mov cx,WaitPort

      { Установка в ES:[DI] безопасного адреса для цикла ожидания }
      mov es,Seg0040; xor di,di
      mov ah,es:[di]

      { Подготовка маски и образца для цикла }
      mov bh,Mask; mov bl,Patt

{ Вывод байта }
    mov dx,Port
    mov al,ByteOut
    out dx,al

      { Установка в DX порта для ввода}
      mov DX,CX
      { Цикл ожидания }
      @WaitLoop:
	mov cx,word(DelayCoef); mov si,word(DelayCoef[2])
	call Wait1msec; jz @End
	sub word(Time),1; sbb word(Time[2]),0; jc @ErrorExit
      jmp @WaitLoop
      @ErrorExit: or bh,bh; jz @End
	mov ax,ecTimeOut;
      jmp @End1
      @End: xor ax,ax
      @End1:
      mov ec,ax
    end;
    if ec<>0 then
      SetErrorCode(tErrorCode(ec));
  end;
  exOutByteAndWaitX:=ec;
end;

{$Else --- Delphi ---- }
pascal;
begin
  If NoError then begin { отмена исполнения при наличии ошибки }
    PortsIO.OutByte(ByteOut, Port);
    if PortsIO.IsError then begin
      SetErrorCode(Ord(ecFailWriteDriver));
    end else begin
      exWaitX(WaitPort, Mask, Patt, Time);
    end;
  end;
  Result:=ErrorCode;
end;
{$Endif}

{ Ввод/вывод байта в порт: BasePort+PortShift
  Ожидание в течении Time миллисекунд события:
    Patt=(значение в порту BasePort+WaitPortShift) AND Mask. }
function  tCtrl.exOutByteAndWait(PortShift:word; ByteOut:byte;
				 WaitPortShift:word; Mask,Patt:Byte; Time:longint):tErrorCode;
begin
  exOutByteAndWait:=exOutByteAndWaitX(
			 (PortShift+prData.BasePort), ByteOut,
			 (WaitPortShift+prData.BasePort), Mask,Patt, Time
		    );
end;

function  tCtrl.exScanPortsX(var Ports; Size:word; Mask,Patt:Byte):word;
 type tWordsArray=array[1..$FF] of Word;
 var cnt:word; i:word;
begin
  cnt:=0;
  for i:=1 to Size do begin
    if (exInByteX(tWordsArray(Ports)[i]) AND Mask) = Patt then Inc(cnt);
  end;
  exScanPortsX:=cnt;
end;

function  tCtrl.exScanPorts(var Ports; Size:word; Mask,Patt:Byte):word;
 type tWordsArray=array[1..$FF] of Word;
 var cnt:word; i:word;
begin
  cnt:=0;
  for i:=1 to Size do begin
    if (exInByte(tWordsArray(Ports)[i]) AND Mask) = Patt then Inc(cnt);
  end;
  exScanPorts:=cnt;
end;

function  tCtrl.exScanNotFFPorts(var Ports; Size:word):word;
begin
  exScanNotFFPorts:=Size-exScanPorts(Ports,Size, $FF, $FF);
end;

function  tCtrl.exScanNotFFPortsX(var Ports; Size:word):word;
begin
  exScanNotFFPortsX:=Size-exScanPortsX(Ports,Size, $FF, $FF);
end;

{ * PRIVATE секция }

{$IfDef Seg16 --- DOS & Protected mode ---}

procedure Wait1msec;
{ Ожидает 1 миллисекунду событие в порте DX: (Port[DX] and BH)=BL,
заданное как BH:=маска; BL:=образец;
   Возвращает: ZF=1 - если дождалась, ZF=0 - иначе
   Использует SI:CX как счетчик }
assembler;
asm
  @Delay:

     in al,dx; and al,bh; xor al,bl { проверка события }
     je @EventOccured { выход если событие произошло }

     sub cx,1; sbb si,0; jc @ExitWait { проверка счетчика }

     cmp es:[di],ah { выход для калибровки по системному таймеру}
  je @Delay
  @ExitWait:
  @EventOccured:
end;

procedure tCtrl.CalibrateWait;
{ Калибровка процедуры Wait1msec на 1 миллисекунду }
const
  mSecondsPerTik=55; { около 55 (точно 54.945) миллисекунд в 1-м интервале
	    системного таймера(18.2 Гц)}
var Counter:longint;
begin
  if Error then Exit;
  asm
    les bx,Self

    { Установка в DX безопасного порта ввода для цикла ожидания }
    call GetPortInDX
    add dx,es:tCtrl([bx]).prData.CalibrationPortShift

    { Подготовка счетчика SI:CX циклов }
    xor cx,cx; not cx; mov si,cx; { CX:=$FFFF; SI:=$FFFF }
    { Подготовка маски и образца для бесконечного цикла }
    mov bx,$00FF
    { Установка в ES:[DI] адреса счетчика системного таймера для цикла ожидания }
    mov es,Seg0040; mov di,6Ch

    { Ожидание изменения счетчика системного таймера }
    mov ah,es:[di]
    @WhileEqual:
      cmp ah,es:[di]
    je @WhileEqual

    { Вызов цикла ожидания с выходом по изменению счетчика системного таймера
    для подсчета числа циклов за 1/55 секунды }
    mov ah,es:[di]
    call Wait1msec

    { Вычисление числа циклов }
    not cx; not si
    { Копирование счетчика в локальную переменную }
    mov word(counter),cx; mov word(counter+2),si;
  end;
  counter:=(counter+(mSecondsPerTik shr 1)) div mSecondsPerTik;
  prData.DelayCoefficient:=counter;

  { Вычисление минимального времени ожидания (мкс) }
  if prData.DelayCoefficient>0 then begin
    prData.MinDelayInterval:=(1000 + prData.DelayCoefficient) div prData.DelayCoefficient;
    if prData.MinDelayInterval<=0 then begin
      prData.MinDelayCoefficient:=(prData.DelayCoefficient+500) div 1000;
      prData.MinDelayInterval:=1;
    end else begin
      prData.MinDelayCoefficient:=1;
    end;
  end else begin
    prData.MinDelayInterval:=1000;
    prData.MinDelayCoefficient:=1;
  end;

  if (Counter<3) then begin{ проверка ограничения по быстродействию машины }
    SetErrorCode(tErrorCode(ecTooSlowMachine));
  end;
end;

{$Else --- Delphi ---- }

function tCtrl.Wait1msec;
  var c:tCounter;
begin
  c:=prTmpData.DelayCoefficient;
  repeat
    Result:=(PortsIO.InByte(Port) and MaskPatt.Mask)=MaskPatt.Patt;
    Dec(c);
  until (c<=0) or Result;
  if not Result then
    Result:=(PortsIO.InByte(Port) and MaskPatt.Mask)=MaskPatt.Patt;
end;

function tCtrl.WaitMinInterval;
  var c:tCounter;
begin
  c:=prTmpData.MinDelayCoefficient;
  repeat
    Result:=(PortsIO.InByte(Port) and MaskPatt.Mask)=MaskPatt.Patt;
    Dec(c);
  until (c<=0) or Result;
end;

procedure tCtrl.exCalibrateWait;
{ Калибровка счетчика prData.DelayCoefficient
для процедуры Wait1msec на 1 миллисекунду }
  var TickResolution:word; Time:cardinal; MaxAttemptCount:byte; MP:TMaskB;
begin
  if Error then Exit;
  if prTmpData.DelayCoefficient>0 then Exit;
  TickResolution:=GetTickCountResolution;
  if TickResolution>55 then TickResolution:=55;
  prData.CorrectCount:=TickResolution;

  TickResolution:=20*TickResolution;
  MaxAttemptCount:=16;
  prTmpData.DelayCoefficient:=$FF;
  { Подготовка маски и образца для бесконечного цикла }
  MP.PattMask:=$00FF;
  Repeat { повтор для быстрых машин }
    { Подготовка начального значения счетчика циклов }
    prTmpData.DelayCoefficient:=(prTmpData.DelayCoefficient shl 2) + 3;

    Time:=GetTickCount; { время начала цикла }
    Wait1msec(CurCalibratePort, MP);
    Time:=TimeSpentTicks(Time); { вычисление времени, проведенного в цикле }

    Dec(MaxAttemptCount);
  Until (Time>=TickResolution) or (MaxAttemptCount=0) or PortsIO.IsError;

  if PortsIO.IsError then
    SetErrorCode(tErrorCode(ecFailReadDriver));

  if  NoError then begin
    if Time<2 then begin
      SetErrorCode(Ord(ecFailCalibrateTimer));
    end else begin
      { Вычисление числа циклов на 1 миллисекунду }
      prTmpData.DelayCoefficient:=(prTmpData.DelayCoefficient+ (Time div 2)) div Time;

      { Вычисление минимального времени ожидания (мкс) }
      if prTmpData.DelayCoefficient>0 then begin
        prTmpData.MinDelayInterval:=(1000 + prTmpData.DelayCoefficient) div prTmpData.DelayCoefficient;
        if prTmpData.MinDelayInterval<=0 then begin
          prTmpData.MinDelayCoefficient:=(prTmpData.DelayCoefficient+500) div 1000;
          prTmpData.MinDelayInterval:=1;
        end else begin
          prTmpData.MinDelayCoefficient:=1;
        end;
      end else begin
        prTmpData.MinDelayInterval:=1000;
        prTmpData.MinDelayCoefficient:=1;
      end;

      { проверка ограничения по быстродействию машины }
      if (prTmpData.DelayCoefficient<2) then begin
        {$IFNDef Debug}
        SetErrorCode(Ord(ecTooSlowMachine));
        {$ELSE}
          prTmpData.DelayCoefficient:=100;
        {$EndIf}
      end;
    end;
  end else begin
    prTmpData.DelayCoefficient:=$FFF;
  end;
end;

{$EndIf}


{ * Быстрые процедуры.
подразумевают вход c: ES:BX->Self или EBX->Self }

{$IfDef Seg16 --- DOS & Protected mode ---}
procedure GetPortInDX; assembler;
asm
  mov dx,es:tCtrl([bx]).prData.BasePort
end;
{$EndIF}

function  tCtrl.MinDelayInterval_mks;
begin
  MinDelayInterval_mks:=prTmpData.MinDelayInterval;
end;

procedure tCtrl.Delay_min;
{$IfDef Seg16 --- DOS & Protected mode ---}
  var DelayCoef:longint; Port:word;
begin
  If NoError then begin { отмена исполнения при наличии ошибки }
    Time:=(Time+Pred(prData.MinDelayInterval)) div prData.MinDelayInterval;
    if time<=0 then time:=1;
    DelayCoef:=prData.MinDelayCoefficient;
    Port:=PortShift2Port(prData.CalibrationPortShift);
    asm
      les bx,Self
      { Установка в DX порта для ввода}
      mov dx,Port

      { Установка в ES:[DI] безопасного адреса для цикла ожидания }
      mov es,Seg0040; xor di,di
      mov ah,es:[di]

      { Подготовка маски и образца для цикла }
      mov bh,$00; mov bl,$FF

      { Цикл ожидания }
      @WaitLoop:
	sub word(Time),1; sbb word(Time[2]),0; jc @Exit
	mov cx,word(DelayCoef); mov si,word(DelayCoef[2])
	call Wait1msec; jz @End
      jmp @WaitLoop
      @Exit:
    end;
  end;
end;
{$Else --- Delphi ---- }
  var Port:word;
  const cMP:TMaskB=(Patt:$FF; Mask:$00);
begin
 if time=0 then Exit;
 Time:=(Time+(prTmpData.MinDelayInterval div 2)) div prTmpData.MinDelayInterval;
 if time<=0 then time:=1;
 Port:=PortShift2Port(prData.CalibrationPortShift);
 repeat
   WaitMinInterval(Port, cMP);
   Dec(Time);
 until (Time=0) or Error;
end;
{$EndIf}

END.