unit MainUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Spin, ComCtrls;

type
  TPassState = (psBlank, psTesting, psPass, psFail);

const
  AM_POSTSTR = WM_USER + $99;

type
  TMainForm = class(TForm)
    CheckTime: TTimer;
    ResultMemo: TMemo;
    Panel1: TPanel;
    PassFailLabel: TLabel;
    TestNewButton: TButton;
    DetectGroup: TGroupBox;
    Label1: TLabel;
    DetRefLabel: TLabel;
    Label2: TLabel;
    DetTestLabel: TLabel;
    BlurbPanel: TPanel;
    BlurbLabel: TLabel;
    Memo1: TMemo;
    RunSingleTest: TButton;
    TestNumber: TSpinEdit;
    Label3: TLabel;
    TrackBar1: TTrackBar;
    Label4: TLabel;
    ClearRefFIFO: TButton;
    ClearUutFIFO: TButton;
    TestsList: TListBox;
    RunList: TListBox;
    AddButton: TButton;
    SubButton: TButton;
    Label5: TLabel;
    Label6: TLabel;
    ClrRefHard: TButton;
    ClrUUTHard: TButton;
    CheckFifoSize: TCheckBox;
    CheckDioConfig: TCheckBox;
    CheckSlowDio: TCheckBox;
    VerboseLog: TCheckBox;
    procedure CheckTimeTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TestButtonClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure ClearRefFIFOClick(Sender: TObject);
    procedure AddButtonClick(Sender: TObject);
    procedure SubButtonClick(Sender: TObject);
    procedure ClrRefHardClick(Sender: TObject);

  protected
    procedure SetMasterPassState(NewPassState: TPassState);
    procedure AMPostStr(var Msg: TMessage); message AM_POSTSTR;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

function LogLine(Lin: String): Integer;
function StrForMHz(MHz: LongWord): String;

implementation

{$R *.DFM}

uses
  Math, AIOUSB;

const
  ERROR_DEVICE_REMOVED = 1617;

type
  TDetState = (dsNone, dsRef, dsTest, dsBoth, dsPastless);

  TTestData = record
    ReadDI, ReadMasterMHz,
    WriteDI, WriteMasterMHz: LongWord;
  end;

  TIOThread = class(TThread)
    DI: LongWord;
    bFailed, bDone: Boolean;
    //hDoneMutex: THandle;
    function IsDone: Boolean;
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  TWriteThread = class(TIOThread)
    procedure Execute; override;
  end;

  TReadThread = class(TIOThread)
    bEatFirstWord: Boolean;
    procedure Execute; override;
  end;

  TCheckFIFOWriteThread = class(TThread)
    DI: LongWord;
    bFailed: Boolean;
    FIFOPackets: Integer;
    procedure Execute; override;
  end;

var
  bTestListPrinted: Boolean = false;
  RefDI, TestDI: LongWord;
  bTestingDI, bTestingDO: Boolean;
  LastDetState: TDetState = dsPastless;
  LastPassState: TPassState = psBlank;
  TestScript: array[0..3] of TTestData = (
    (ReadMasterMHz: 01; WriteMasterMHz:  0),
    (ReadMasterMHz:  0; WriteMasterMHz: 01),
    (ReadMasterMHz: 01; WriteMasterMHz:  0),
    (ReadMasterMHz:  0; WriteMasterMHz: 01)
  );
  InBuf, OutBuf: array of Word;
  TicksPerSec: Int64;
  PostedStr: array of String;
  hPostedStrMutex: THandle;
  bDiscoRef, bDiscoTest: Boolean;

const
  RefID: LongWord = $6101D001;
//  WriteWords = 4*1024;
//  ReadWords = 1024;
  packet = 8192 div 4;
  WriteWords = 4*packet;
  ReadWords = packet;

procedure TMainForm.SetMasterPassState(NewPassState: TPassState);
begin
  if NewPassState = LastPassState then Exit;

  case NewPassState of
    psBlank: begin
      PassFailLabel.Caption := '';
      PassFailLabel.Color := clBtnFace;
      PassFailLabel.Font.Color := clBtnText;
    end;
    psTesting: begin
      PassFailLabel.Color := $FF0000;
      PassFailLabel.Font.Color := $FFFFFF;
      PassFailLabel.Caption := 'Testing...';
    end;
    psPass: begin
      PassFailLabel.Color := $00FF00;
      PassFailLabel.Font.Color := $000000;
      PassFailLabel.Caption := 'PASS';
    end;
    psFail: begin
      PassFailLabel.Color := $0000FF;
      PassFailLabel.Font.Color := $FFFFFF;
      PassFailLabel.Caption := 'FAIL';
    end;
  end;
  LastPassState := NewPassState;
end;

function GetAppVersionString: string;
var
  VerInfoSize: DWORD;
  VerInfoHandle: DWORD;
  VerInfo: Pointer;
  FixedFileInfo: PVSFixedFileInfo;
  Len: UINT;
  fn: string;
  major, minor, release, build: Word;
begin
  // Default values
  major := 0;  
  minor := 0;
  release := 0;
  build := 0;

  // The EXE filename (e.g. "C:\MyApp\Project1.exe")
  fn := Application.ExeName;

  // Get the size of the version info resource
  VerInfoSize := GetFileVersionInfoSize(PChar(fn), VerInfoHandle);
  if VerInfoSize > 0 then
  begin
    // Allocate a buffer to hold the version info
    GetMem(VerInfo, VerInfoSize);
    try
      // Retrieve the file version information
      if GetFileVersionInfo(PChar(fn), VerInfoHandle, VerInfoSize, VerInfo) then
      begin
        // Query the root block (\) for the fixed file info
        if VerQueryValue(VerInfo, '\', Pointer(FixedFileInfo), Len) then
        begin
          // Break down the 32-bit fields into 16-bit parts
          major   := HiWord(FixedFileInfo^.dwFileVersionMS);
          minor   := LoWord(FixedFileInfo^.dwFileVersionMS);
          release := HiWord(FixedFileInfo^.dwFileVersionLS);
          build   := LoWord(FixedFileInfo^.dwFileVersionLS);
        end;
      end;
    finally
      FreeMem(VerInfo);
    end;
  end;

  // Format as "Major.Minor.Release.Build"
  Result := Format('%d.%d.%d.%d', [major, minor, release, build]);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Caption := Caption + ' — v' + GetAppVersionString;

  QueryPerformanceFrequency(TicksPerSec);

  TrackBar1Change(TrackBar1);

  hPostedStrMutex := CreateMutex(nil, False, nil);

  Application.Title := Caption;

  DetectGroup.Align := alTop;
//  TestNewButton.Align := alTop;

  BlurbLabel.Caption := 'Plug in the reference board and a board to test, connect them with a 1:1 cable, and click one of the Test buttons.';

  with PassFailLabel.Font do Size := 2*Size;
  //Deal with anchor problems.
  BlurbLabel.SetBounds(8, 8, BlurbPanel.Width - 16, BlurbPanel.Height - 16);

  if RefDI = diNone then begin
    ResultMemo.Lines.Add('No reference board found.');
    SetMasterPassState(psBlank);
    Exit;
  end;
  if TestDI = diNone then begin
    ResultMemo.Lines.Add('No board under test found.');
    SetMasterPassState(psBlank);
    Exit;
  end;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  CloseHandle(hPostedStrMutex);
end;

procedure TMainForm.CheckTimeTimer(Sender: TObject);
var
  I, Mask, Status, PID: LongWord;
  ThisDetState: TDetState;
  bGotEm: Boolean;
  iTest: integer;
  DescStr: AnsiString;
begin
  if not CheckTime.Enabled then Exit;

  for I := 0 to 31 do AIOUSB_CloseDevice(I);
  Mask := GetDevices;
  RefDI := GetDeviceByEEPROMData(0, SizeOf(RefID), @RefID);

  TestDI := diNone;
  for I := 0 to 31 do
    if I <> RefDI then
      if (Mask and (1 shl I)) <> 0 then begin
        Status := QueryDeviceInfo(I, @PID, nil, nil, nil, nil);
        if Status <> ERROR_SUCCESS then Continue;
        if PID < $800C then Continue;
        if PID > $800F then Continue;

        if TestDI = diNone then begin
          bTestingDI := PID <> $800E;
          bTestingDO := PID <> $800D;
          TestDI := I;
        end
        else begin
          TestDI := diOnly;
        end;
      end
  ;

  if RefDI = diNone then begin
    //DetRefLabel.ParentColor := True;
    //DetRefLabel.ParentFont := True;
    DetRefLabel.Caption := '(not found)';
  end
  else begin
    //DetRefLabel.Color := $00FF00;
    //DetRefLabel.Font.Color := $000000;
    DetRefLabel.Caption := 'FOUND @ ' + IntToStr(RefDI);
  end;

  if TestDI = diNone then begin
    //DetTestLabel.ParentColor := True;
    //DetTestLabel.ParentFont := True;
    DetTestLabel.Caption := '(none found)';
  end
  else if TestDI = diOnly then begin
    //DetTestLabel.ParentColor := True;
    //DetTestLabel.ParentFont := True;
    DetTestLabel.Caption := '(too many found)';
  end
  else begin
    //DetTestLabel.Color := $00FF00;
    //DetTestLabel.Font.Color := $000000;
    DetTestLabel.Caption := 'FOUND @ ' + IntToStr(TestDI);
  end;



  if TestDI = diOnly then TestDI := diNone;



  bGotEm := (RefDI <> diNone) and (TestDI <> diNone);
  TestNewButton.Enabled := bGotEm;

  if RefDI = diNone then begin
    if TestDI = diNone then
      ThisDetState := dsNone
    else
      ThisDetState := dsTest
    ;
  end
  else begin
    if TestDI = diNone then
      ThisDetState := dsRef
    else
      ThisDetState := dsBoth
    ;
  end;
  if ThisDetState <> LastDetState then begin
    LastDetState := ThisDetState;

    SetMasterPassState(psBlank);
  end;

  if not bTestListPrinted then
  begin
    bTestListPrinted := true;
    //if ThisDetState = dsBoth then
    begin
      for iTest := 0 to High(TestScript) do with TestScript[iTest] do
      begin
        if (iTest and 2) = 0 then begin
          TestScript[iTest].ReadDI := RefDI;
          TestScript[iTest].WriteDI := TestDI;
          DescStr := 'Test '+IntToStr(iTest)+' => Test board' + StrForMHz(TestScript[iTest].WriteMasterMHz) + ' writing to reference board' + StrForMHz(TestScript[iTest].ReadMasterMHz) + '.';
        end
        else begin
          TestScript[iTest].ReadDI := TestDI;
          TestScript[iTest].WriteDI := RefDI;
          DescStr := 'Test '+IntToStr(iTest)+' => Reference board' + StrForMHz(TestScript[iTest].WriteMasterMHz) + ' writing to test board' + StrForMHz(TestScript[iTest].ReadMasterMHz) + '.';
        end;

        LogLine(DescStr);
      end;
    end;
    LogLine('Streaming Size: ' + IntToStr(WriteWords) + ' words');
  end;
end;

function CalcDIORaw(I: Integer): LongWord;
begin
  if I < $100 then
    Result := $01010101 * I
  else if I < $120 then
    Result := not ($FFFFFFFF shl (I - $120))
  else if I < $140 then
    Result := $FFFFFFFF shl (I - $120)
  else //Not supposed to happen, just don't fuck up if it does.
    Result := I
  ;
end;

function LogLine(Lin: String): Integer;
begin
  Result := MainForm.ResultMemo.Lines.Add(Lin);
end;

procedure PostLine(Lin: String);
var
  I: Integer;

begin
  WaitForSingleObject(hPostedStrMutex, INFINITE);
  I := Length(PostedStr);
  SetLength(PostedStr, I+1);
  PostedStr[I] := Lin;
  ReleaseMutex(hPostedStrMutex);
  PostMessage(MainForm.Handle, AM_POSTSTR, 0, 0);
end;

procedure TMainForm.AMPostStr(var Msg: TMessage);
var
  I: Integer;

begin
  WaitForSingleObject(hPostedStrMutex, INFINITE);
    for I := 0 to High(PostedStr) do
      LogLine(PostedStr[I])
    ;
    SetLength(PostedStr, 0);
  ReleaseMutex(hPostedStrMutex);
end;

procedure DoReport(ReportLine: Integer; bFailed: Boolean);
var
  ReportStr: String;

begin
  if bFailed then
    ReportStr := 'FAIL'
  else
    ReportStr := 'PASS'
  ;
  with MainForm.ResultMemo do Lines[ReportLine] := Lines[ReportLine] + ReportStr;
end;

function BoardName(DI: LongWord): String;
begin
  if DI = RefDI then
    Result := 'REFERENCE board'
  else
    Result := 'board under test'
  ;
end;

procedure NoteDisconnect(DI: LongWord);
begin
  if DI = RefDI then
    bDiscoRef := True
  else
    bDiscoTest := True
  ;
end;


function CheckAIOStatus(Status: LongWord; const OperationDesc: String; DI: LongWord; out bDisconnected: Boolean): Boolean;
begin
  bDisconnected := False;
  // If ERROR_SUCCESS (0), then no error, return False
  Result := (Status <> ERROR_SUCCESS);

  if Result then
  begin
    // An error happened; log it
    LogLine(Format('Error %d while %s on %s.',
      [Status, OperationDesc, BoardName(DI)]));

    // Check if the device was removed
    if Status = ERROR_DEVICE_REMOVED then
    begin
      bDisconnected := True;
      LogLine(Format('Disconnected during %s on %s.', [OperationDesc, BoardName(DI)]));      
      NoteDisconnect(DI);
    end;
  end
  else
  begin
    // LogLine(Format('Success %s on %s.', [OperationDesc, BoardName(DI)]));
  end;
end;

function TryDIOConfig(DI: LongWord; OutMask: Byte; DIOData: Longword; TriMask: Byte; var bDisconnected: Boolean): Boolean;
var
  Status: LongWord;
begin
  Status := DIO_ConfigureEx(DI, @OutMask, @DIOData, @TriMask);
  Result := CheckAIOStatus(Status, Format('configuring DIO (OutMask=%x, TriMask=%x)', [OutMask, TriMask]), DI, bDisconnected);
end;

function TryDIOWriteAll(DI: LongWord; DIOData: LongWord; var bDisconnected: Boolean): Boolean;
var
  Status: LongWord;
begin
  Status := DIO_WriteAll(DI, @DIOData);
  Result := CheckAIOStatus(Status, 'writing DIO', DI, bDisconnected);
end;

function TryDIOReadAll(DI: LongWord; var DIOData: LongWord; var bDisconnected: Boolean): Boolean;
var
  Status: LongWord;
begin
  DIOData := 0;
  Status := DIO_ReadAll(DI, @DIOData);
  Result := CheckAIOStatus(Status, 'reading DIO', DI, bDisconnected);
end;



function TryDIOStreamOpen(DI: LongWord; bIsRead: Boolean; var bDisconnected: Boolean): Boolean;
var
  Status: LongWord;

begin
  Status := DIO_StreamOpen(DI, bIsRead);
  Result := CheckAIOStatus(Status, 'opening stream on', DI, bDisconnected);
end;

function TryClearFIFO(DI: LongWord; var bDisconnected: Boolean): Boolean;
var
  Status: LongWord;
begin
  Status := AIOUSB_ClearFIFO(DI, 0);
  Result := CheckAIOStatus(Status, 'clearing FIFO on', DI, bDisconnected);
end;


function ExpectedFIFOBytes(DI: LongWord): Integer;
var
  PID: LongWord;

begin
  QueryDeviceInfo(DI, @PID, nil, nil, nil, nil);
  if PID = $800C then
    Result := 128*1024
  else
    Result := 8*1024
  ;
end;

procedure CheckFIFOSizes(ReadDI, WriteDI: LongWord);
const
  EPBuffers = 8;
  OtherEPBufferBytes = 512 * (EPBuffers - 1);

var
  LastFIFOPackets, TotFIFOBytes, RefFIFOBytes, TestFIFOBytes, ExpectedTestFIFOBytes: Integer;
  CheckFIFOWriteThread: TCheckFIFOWriteThread;
  BytesTransferred: LongWord;
  InBuf: array of Word;
  Hz,slaveHz:double;
  bdisc:boolean;
begin
  Hz:=2000000;
  slaveHz := 0;
  DIO_StreamSetClocks(WriteDI, Hz, Hz);
  DIO_StreamSetClocks(ReadDI, slaveHz, slaveHz);

    LogLine('Checking FIFO sizes...');
  //Tristate while setting direction, so it's safe for the control lines.
  TryDIOConfig( RefDI, $8, $FFFFFFFF, $FF, bdisc);
  TryDIOConfig(TestDI, $4, $FFFFFFFF, $FF, bdisc);
  DIO_StreamOpen(ReadDI, True);
  DIO_StreamClose(ReadDI);
  DIO_StreamOpen(WriteDI, False);
  TryDIOConfig( RefDI, $8, $FFFFFFFF, $0, bdisc);
  TryDIOConfig(TestDI, $4, $FFFFFFFF, $0, bdisc);
  //Launch thread to write, with no read, until it locks up.
  CheckFIFOWriteThread := TCheckFIFOWriteThread.Create(True);
  CheckFIFOWriteThread.DI := WriteDI;
  CheckFIFOWriteThread.Resume;
  //Wait for it to lock up.
  LastFIFOPackets := 0;
  repeat
    Sleep(1); //Should be more than enough for the thread to transfer one packet.
    if CheckFIFOWriteThread.FIFOPackets = LastFIFOPackets then Break;

    LastFIFOPackets := CheckFIFOWriteThread.FIFOPackets;
  until False;
  TotFIFOBytes := 512 * CheckFIFOWriteThread.FIFOPackets;
  //Tell the thread to not write any more, and then read out data so it can release.
  CheckFIFOWriteThread.Terminate;
  DIO_StreamOpen(ReadDI, True);
  SetLength(InBuf, 256);
  DIO_StreamFrame(ReadDI, Length(InBuf), @InBuf[0], BytesTransferred);
  LastFIFOPackets := 1;
  Sleep(1); //Make sure the thread has time to report its last packet.
  repeat
    DIO_StreamFrame(ReadDI, Length(InBuf), @InBuf[0], BytesTransferred);
    Inc(LastFIFOPackets);
  until LastFIFOPackets = CheckFIFOWriteThread.FIFOPackets;
  DIO_StreamClose(ReadDI);
  DIO_StreamClose(WriteDI);
  //Clean up worker thread.
  FreeAndNil(CheckFIFOWriteThread);

  //Calc and report.
  RefFIFOBytes := ExpectedFIFOBytes(RefDI);
  TestFIFOBytes := TotFIFOBytes - RefFIFOBytes - OtherEPBufferBytes;
  ExpectedTestFIFOBytes := ExpectedFIFOBytes(TestDI);

  if TestFIFOBytes = ExpectedTestFIFOBytes then begin
    LogLine('FIFO sizes match.');
    Exit;
  end;

  LogLine('Warning:');
  LogLine('FIFO size mismatch detected!');
  LogLine('Reference board FIFO: ' + IntToStr(RefFIFOBytes div 1024) + 'kB');
  LogLine('Bytes assumed held in other EP buffers: ' + FloatToStr(OtherEPBufferBytes / 1024) + 'kB');
  LogLine('Board under test FIFO: ' + FloatToStr(TestFIFOBytes / 1024) + 'kB measured, expected ' + IntToStr(ExpectedTestFIFOBytes div 1024) + 'kB from PID.');
  LogLine('Board under test may need to be re-KeyMastered!');
end;

function StrForMHz(MHz: LongWord): String;
begin
  if MHz = 0 then
    Result := ''
  else
    Result := ' (' + IntToStr(MHz) + 'MHz clock source)'
  ;
end;

function DoTest(bOldBoard, bRunSingleTest: Boolean): TPassState;
var
  Status: LongWord;
  StuckHigh, StuckLow,
  DIORaw, SlowDIOIn, SlowDIOOut: LongWord;
  bFailed, bThisFailed, bOptimistic: Boolean;
  DoneCode, Mismatches: Integer;
  ReadHz, WriteHz: Double;
  WriteThread: TWriteThread;
  ReadThread: TReadThread;
  Naui, StartTime, ElapsedTime, TestDur: Int64;
  ReportLine, ThisReportLine: Integer;
  DescStr: String;
  bFastSafeIsDI: Boolean;

  procedure NoWorky;
  begin
    LogLine('This isn''t going to work.');
    DoReport(ReportLine, True);
    Result := psFail;
  end;

  procedure ItDisconnected;
  begin
    LogLine('');
    LogLine('DISCONNECTION:');
    if bDiscoRef then LogLine('Reference board disconnected.');
    if bDiscoTest then LogLine('Board under test disconnected.');
    LogLine('Aborting test.');
    Result := psFail;
  end;

  procedure CheckAndReportSlowMismatch(DIData, DOData: LongWord);
  begin
    if DIData <> DOData then begin
      bFailed := True;

      if Mismatches = 0 then
        LogLine('Mismatch: ' + IntToHex(DIData, 8) + ' XOR ' + IntToHex(DOData, 8) + ' = ' + IntToHex(DIData xor DOData, 8))
      else if Mismatches = 1 then
        LogLine('More mismatches...')
      ;
      Inc(Mismatches);

      StuckHigh := StuckHigh or (DIData and not DOData);
      StuckLow  := StuckLow  or (DOData and not DIData);
    end;
  end;

  procedure ReportStucks;
  var
    MoreComplexErrors: LongWord;

  begin
    MoreComplexErrors := StuckHigh and StuckLow;
    StuckHigh := StuckHigh and not MoreComplexErrors;
    StuckLow  := StuckLow  and not MoreComplexErrors;
    if StuckHigh <> 0 then LogLine('Bits that may be stuck high: ' + IntToHex(StuckHigh, 8));
    if StuckLow  <> 0 then LogLine('Bits that may be stuck low: '  + IntToHex(StuckLow , 8));
    if MoreComplexErrors <> 0 then PostLine('Bits with more complex errors: '  + IntToHex(MoreComplexErrors, 4));
    StuckHigh := 0;
    StuckLow  := 0;
  end;

  procedure doATest(iTest: integer);
    var
      iWord, iDevice: integer;
      bdisc:boolean;
  begin
    MainForm.Memo1.Lines.Add(#13#10'-------- Test '+IntToStr(iTest)+ ' --------');
    with TestScript[iTest] do begin
      if ReadMasterMHz <> 0 then ReadMasterMhz := MainForm.trackBar1.position;
      if WriteMasterMHz <> 0 then WriteMasterMHz := MainForm.trackBar1.position;

      if WriteDI = RefDI then begin
        if not bTestingDI then Exit;
        DescStr := #13#10'Test '+IntToStr(iTest)+' => Reference board' + StrForMHz(WriteMasterMHz) + ' writing to test board' + StrForMHz(ReadMasterMHz) + '.';
      end
      else begin
        if not bTestingDO then Exit;
        DescStr := #13#10'Test '+IntToStr(iTest)+' => Test board' + StrForMHz(WriteMasterMHz) + ' writing to reference board' + StrForMHz(ReadMasterMHz) + '.';
      end;
      //DescStr := DescStr + FloatToStr(Max(ReadMasterMHz, WriteMasterMHz)) + ' MHz, ';
      //if ReadMasterMHz <> 0 then DescStr := DescStr + 'In master: ' else DescStr := DescStr + 'Out master: ';
      ThisReportLine := LogLine(DescStr);
      bThisFailed := False;
      bOptimistic := True;

      TryDIOConfig( RefDI, $4, $FFFFFFFF, $FF, bdisc);
      TryDIOConfig(TestDI, $8, $FFFFFFFF, $FF, bdisc);
      if TryDIOStreamOpen(WriteDI, False, bdisc) then bThisFailed := True;
      if TryDIOStreamOpen(ReadDI, True, bdisc) then bThisFailed := True;
      TryDIOConfig( RefDI, $4, $FFFFFFFF, $0, bdisc);
      TryDIOConfig(TestDI, $8, $FFFFFFFF, $0, bdisc);

      ReadHz := 0;
      WriteHz := 1024*1024*WriteMasterMHz;
      Status := DIO_StreamSetClocks(WriteDI, ReadHz, WriteHz);
      if Status <> ERROR_SUCCESS then begin
        LogLine('Error ' + IntToStr(Status) + ' setting clocks on ' + BoardName(WriteDI) + '.');
        bThisFailed := True;
      end;
      ReadHz := 1024*1024*ReadMasterMHz;
      WriteHz := 0;
      Status := DIO_StreamSetClocks(ReadDI, ReadHz, WriteHz);
      if Status <> ERROR_SUCCESS then begin
        LogLine('Error ' + IntToStr(Status) + ' setting clocks on ' + BoardName(ReadDI) + '.');
        bThisFailed := True;
      end;

      if TryDIOConfig( RefDI, $4, $FFFFFFFF, $1, bdisc) then bThisFailed := True;
      if TryDIOConfig(TestDI, $8, $FFFFFFFF, $1, bdisc) then bThisFailed := True;



{
      OutBuf[0] := (WriteDI shl 4) or ReadDI;
      OutBuf[1] := (OutBuf[0] shl 4) or 1;
      for iWord := 2 to WriteWords - 1 do
        OutBuf[iWord] := OutBuf[1] * iWord
      ;
}
{
      OutBuf[0] := (WriteDI shl 4) or ReadDI;
      OutBuf[1] := (OutBuf[0] shl 4) or 1;
      for iWord := 2 to WriteWords - 1 do
        OutBuf[iWord] := iWord * $123;
      ;
}

{
      for iWord := 0 to WriteWords - 1 do
        OutBuf[iWord] := iWord*7;
      ;
}
      for iWord := 0 to WriteWords-1 do
      begin
        OutBuf[iWord] := not (1 shl (iWord mod 16));
      end;


      WriteThread := TWriteThread.Create;
      WriteThread.DI := WriteDI;
      ReadThread := TReadThread.Create;
      ReadThread.DI := ReadDI;
      ReadThread.bEatFirstWord := bOldBoard;// and (iTest = 0);
      ReadThread.Resume;
      Sleep(1);
      WriteThread.Resume;
      QueryPerformanceCounter(StartTime);
      TestDur := 32*TicksPerSec;
      repeat
        Sleep(1);
        Application.ProcessMessages;

        QueryPerformanceCounter(Naui);
        ElapsedTime := Naui - StartTime;
        if bOptimistic and (ElapsedTime > 4*TicksPerSec) then begin
          LogLine(#9'If this doesn''t lock up, the test may need to be re-run...');
          bOptimistic := False;
        end;
      until (WriteThread.IsDone and ReadThread.IsDone) or (ElapsedTime > TestDur);

      if TryDIOConfig( RefDI, $4, $FFFFFFFF, $FF, bdisc) then bThisFailed := True;
      if TryDIOConfig(TestDI, $8, $FFFFFFFF, $FF, bdisc) then bThisFailed := True;

      Application.ProcessMessages;

      DoneCode := 0;
      if WriteThread.IsDone then Inc(DoneCode, 1);
      if ReadThread.IsDone then Inc(DoneCode, 2);
      if DoneCode = 3 then begin
        if WriteThread.bFailed or ReadThread.bFailed then bThisFailed := True;
        WriteThread.Free;
        ReadThread.Free;
      end
      else begin
        case DoneCode of
          0: LogLine('Both DIO threads locked up.');
          1: begin LogLine('DIO read thread locked up on ' + BoardName(ReadDI) + '.'); ReadThread.Terminate; WriteThread.Free; end;
          2: begin LogLine('DIO write thread locked up on ' + BoardName(WriteDI) + '.'); WriteThread.Terminate; ReadThread.Free; end;
        end;
        LogLine('');
        LogLine('PLEASE UNPLUG. The test can''t continue.');
        LogLine('');
        LogLine('If this happens too many times, you''ll also need to close and rerun this test, or it''ll crash/lock up/etc.');
        DoReport(ThisReportLine, True);
        DoReport(ReportLine, True);
        Result := psFail;
        for iDevice := 0 to 31 do AIOUSB_CloseDevice(iDevice);
        Exit;
      end;

      DoReport(ThisReportLine, bThisFailed);
      if bThisFailed then bFailed := True;
    end;//with

  end;

// DoTests BEGIN -------------------------------------------------------

  var
    iTest: integer;
    testNum:integer;
    bdisc:boolean;
begin
  Result := psTesting;

  bDiscoRef := False;
  bDiscoTest := False;
  if Mainform.CheckDioConfig.checked then begin
    ReportLine := LogLine('Basic Config: ');

    bFailed := False;
    if TryDIOConfig(RefDI, $8, $FFFFFFFF, $FF, bdisc) then begin
      NoWorky;
      Exit;
    end;
    if TryDIOConfig(TestDI, $4, $FFFFFFFF, $FF, bdisc) then begin
      NoWorky;
      Exit;
    end;
    if bFailed then Result := psFail;
  end;


  //Put the fast ports into opposite directions, so it's safe for the control lines.
  //Set it for writing from ref to test, unless the board under test is a DO, then do the opposite.
  bFastSafeIsDI := bTestingDI;
  if TryDIOStreamOpen(RefDI, not bFastSafeIsDI, bdisc) then begin
    NoWorky;
    Exit;
  end;
  Status := DIO_StreamClose(RefDI);
  if Status <> ERROR_SUCCESS then begin
    LogLine('Error ' + IntToStr(Status) + ' closing stream on REFERENCE board.');
    NoWorky;
    Exit;
  end;

  if TryDIOStreamOpen(TestDI, bFastSafeIsDI, bdisc) then begin
    NoWorky;
    Exit;
  end;
  Status := DIO_StreamClose(TestDI);
  if Status <> ERROR_SUCCESS then begin
    LogLine('Error ' + IntToStr(Status) + ' closing stream on board under test.');
    NoWorky;
    Exit;
  end;
  LogLine('');


  if Mainform.CheckSlowDio.checked then begin
      LogLine('Slow DIO:');

      ReportLine := LogLine('Write ABC, Read D: ');
      bFailed := False;
      if TryDIOConfig(TestDI, $7, $FFFFFFFF, $0, bdisc) then bFailed := True;
      if TryDIOConfig( RefDI, $8, $FFFFFFFF, $0, bdisc) then bFailed := True;
      if bFailed then Result := psFail;

      Mismatches := 0;
      StuckHigh := 0;
      StuckLow := 0;
      for iTest := 0 to $13F do begin
        DIORaw := CalcDIORaw(iTest);
        if TryDIOWriteAll(TestDI, DIORaw    , bdisc) then bFailed := True;
        if TryDIOWriteAll(RefDI , DIORaw    , bdisc) then bFailed := True;
        if  TryDIOReadAll(TestDI, SlowDIOOut, bdisc) then bFailed := True;
        if  TryDIOReadAll(RefDI , SlowDIOIn , bdisc) then bFailed := True;
        CheckAndReportSlowMismatch(
          (SlowDIOIn  and $00FFFFFF) or (SlowDIOOut and $FF000000)
        ,
          (SlowDIOOut and $00FFFFFF) or (SlowDIOIn  and $FF000000)
        );

        if bDiscoRef or bDiscoTest then begin
          ItDisconnected;
          DoReport(ReportLine, True);
          Exit;
        end;
      end;

      if TryDIOConfig( RefDI, $4, $FFFFFFFF, $FF, bdisc) then bFailed := True;
      if TryDIOConfig(TestDI, $8, $FFFFFFFF, $FF, bdisc) then bFailed := True;
      DoReport(ReportLine, bFailed);
      if bFailed then Result := psFail;
      ReportStucks;



      ReportLine := LogLine('Write D, Read ABC: ');
      bFailed := False;
      if TryDIOConfig(TestDI, $8, $FFFFFFFF, $0, bdisc) then bFailed := True;
      if TryDIOConfig( RefDI, $7, $FFFFFFFF, $0, bdisc) then bFailed := True;
      if bFailed then Result := psFail;

      Mismatches := 0;
      StuckHigh := 0;
      StuckLow := 0;
      for iTest := 0 to $13F do begin
        DIORaw := CalcDIORaw(iTest);
        if TryDIOWriteAll(RefDI , DIORaw    , bdisc) then bFailed := True;
        if TryDIOWriteAll(TestDI, DIORaw    , bdisc) then bFailed := True;
        if  TryDIOReadAll(RefDI , SlowDIOOut, bdisc) then bFailed := True;
        if  TryDIOReadAll(TestDI, SlowDIOIn , bdisc) then bFailed := True;
        CheckAndReportSlowMismatch(
          (SlowDIOIn  and $00FFFFFF) or (SlowDIOOut and $FF000000)
        ,
          (SlowDIOOut and $00FFFFFF) or (SlowDIOIn  and $FF000000)
        );

        if bDiscoRef or bDiscoTest then begin
          ItDisconnected;
          DoReport(ReportLine, True);
          Exit;
        end;
      end;

      if TryDIOConfig( RefDI, $4, $FFFFFFFF, $FF, bdisc) then bFailed := True;
      if TryDIOConfig(TestDI, $8, $FFFFFFFF, $FF, bdisc) then bFailed := True;
      DoReport(ReportLine, bFailed);
      if bFailed then Result := psFail;
      ReportStucks;
  end;// check slow DIO



  if Result = psFail then begin
    LogLine('Skipping fast DIO because of previous failures.');
    Exit;
  end;

  LogLine('');
  ReportLine := LogLine('Fast DIO: ');
  {//Looks like clearing the FIFO makes the boards go crazy.
  bFailed := False;
  if not TryClearFIFO(RefDI) then bFailed := True;
  if not TryClearFIFO(TestDI) then bFailed := True;
  if bFailed then Result := psFail;
  }

  bFailed := False;
  if bRunSingleTest = true then
    doATest(MainForm.TestNumber.Value)
  else
    for iTest := 0 to MainForm.RunList.Items.Count-1 do begin
      testNum := StrToInt(MainForm.RunList.Items[iTest][6]); // asdf
      MainForm.Memo1.Lines.Add('Running Test '+IntToStr(testNum)+'.');
      doATest(testNum);
    end; // for
  DoReport(ReportLine, bFailed);
  if bFailed then
    MainForm.Memo1.Lines.Add('Failed')
  else
    MainForm.Memo1.Lines.Add('Passed');


  if bFailed then Result := psFail;

  if Result = psTesting then Result := psPass;
end;

procedure TMainForm.TestButtonClick(Sender: TObject);
var
  OverallResult: TPassState;

  ReportLine,
  iTest: Integer;
  bSingleTest: Boolean;
  bdisc:boolean;
begin
  bSingleTest := Sender = RunSingleTest;


  ResultMemo.Lines.Clear;

  if RefDI = diNone then begin
    ResultMemo.Lines.Add('No reference board found.');
    SetMasterPassState(psBlank);
    Exit;
  end;
  if TestDI = diNone then begin
    ResultMemo.Lines.Add('No board under test found.');
    SetMasterPassState(psBlank);
    Exit;
  end;

  SetMasterPassState(psTesting);
  CheckTime.Enabled := False;
  Application.ProcessMessages;

  SetLength(OutBuf, WriteWords);
  SetLength(InBuf, 4*ReadWords);

  for iTest := 0 to High(TestScript) do
    if (iTest and 2) = 0 then begin
      TestScript[iTest].ReadDI := RefDI;
      TestScript[iTest].WriteDI := TestDI;
    end
    else begin
      TestScript[iTest].ReadDI := TestDI;
      TestScript[iTest].WriteDI := RefDI;
    end
  ;

  ReportLine := LogLine('Overall: ');
  LogLine('');

  OverallResult := DoTest(false , bSingleTest);
  LogLine('');


  if checkFifoSize.checked then begin
    if bTestingDO then begin
      CheckFIFOSizes(RefDI, TestDI)
    end else begin
      CheckFIFOSizes(TestDI, RefDI)
    end;
  end;

  if CheckDioConfig.checked then begin
    if TryDIOConfig( RefDI, $8, $FFFFFFFF, $FF, bdisc) then OverallResult := psFail;
    if TryDIOConfig(TestDI, $4, $FFFFFFFF, $FF, bdisc) then OverallResult := psFail;
  end;

  SetLength(OutBuf, 0);
  SetLength(InBuf, 0);

  if OverallResult = psPass then begin
    SetMasterPassState(psPass);
    DoReport(ReportLine, False);
  end
  else begin
    SetMasterPassState(psFail);
    DoReport(ReportLine, True);
  end;
  LogLine('');

  CheckTime.Enabled := True;

end;

{ TWriteThread }

procedure TWriteThread.Execute;
var
  Status, BytesTransferred: LongWord;

begin
  Status := DIO_StreamFrame(DI, WriteWords, @OutBuf[0], BytesTransferred);
  if Status <> ERROR_SUCCESS then begin
    PostLine('  Error ' + IntToStr(Status) + ' writing frame to ' + BoardName(DI) + '.');
    bFailed := True;
  end else
  begin
    PostLine('    Successfully wrote '+intToStr(BytesTransferred)+' to ' +BoardName(DI) + '.');
  end;
  DIO_StreamClose(DI);
  bDone := True;
end;

{ TReadThread }

procedure TReadThread.Execute;
var
  Status, FramePointsLeft, BytesTransferred,
  StuckHigh, StuckLow, MoreComplexErrors: LongWord;
  Mismatches,
  iReadFrame, iWord: Integer;
  msg: Ansistring;

begin
  Mismatches := 0;
  StuckHigh := 0;
  StuckLow := 0;

  for iReadFrame := 0 to 3 do begin
    PostLine('  for iReadFrame := 0 to 3 do begin: loop= '+IntToStr(iReadFrame));
    if Terminated then Break;

    FramePointsLeft := ReadWords;
    repeat
      Status := DIO_StreamFrame(DI, FramePointsLeft, @InBuf[iReadFrame*ReadWords + ReadWords - Integer(FramePointsLeft)], BytesTransferred);
      if Terminated then Break;
      if Status <> ERROR_SUCCESS then begin
        bFailed := True;

        PostLine('  Error ' + IntToStr(Status) + ' reading frame from ' + BoardName(DI) + '.');
        Break;
      end
      else begin
        PostLine('    StreamFrame read '+IntToStr(BytesTransferred)+' from '+BoardName(DI));
        Msg := '    StreamFrame read '+IntToStr(BytesTransferred)+' from '+BoardName(DI)+#13#10;
      end;
      if BytesTransferred = 2*FramePointsLeft then begin PostLine('    All expected data read, breaking out of repeat.'); Break; end;

      Dec(FramePointsLeft, BytesTransferred div 2);
      PostLine('    Bytes Remaining to transfer: '+IntToStr(FramePointsLeft));
    until False;

    if Terminated then Break;
    if Status <> ERROR_SUCCESS then Continue;
//    PostLine('    Logging received packet data while');
//    PostLine('    Beginning check for mismatch/stuck bits');

    for iWord := iReadFrame*ReadWords to iReadFrame*ReadWords + ReadWords - 1 do begin
      if MainForm.VerboseLog.checked then
        msg := msg + ('@' + IntToHex(iWord, 4) + ' got ' +IntToHex(InBuf[iWord], 4) + ' expected ' + IntToHex(outBuf[iWord], 4) );
      if InBuf[iWord] <> OutBuf[iWord] then begin
        if not MainForm.VerboseLog.checked then
          msg := msg + ('@' + IntToHex(iWord, 4) + ' got ' +IntToHex(InBuf[iWord], 4) + ' expected ' + IntToHex(outBuf[iWord], 4) );
        bFailed := True;
        msg := msg + ' --- fail';
        StuckHigh := StuckHigh or (InBuf[iWord] and not OutBuf[iWord]);
        StuckLow  := StuckLow  or (OutBuf[iWord] and not InBuf[iWord]);

        if Terminated then Break;

        if Mismatches < 20 then
          PostLine(#9'Mismatch @ ' + IntToHex(iWord, 1) + ': ' + IntToHex(InBuf[iWord], 4) + ' <> ' + IntToHex(OutBuf[iWord], 4))
        else if Mismatches = 20 then
          PostLine(#9'More mismatches...')
        ;
        Inc(Mismatches);
        msg := msg+#13#10;
      end;
      if MainForm.VerboseLog.Checked then
        msg := msg+#13#10;
    end;
    if (Mismatches > 0)  OR MainForm.VerboseLog.Checked then MainForm.Memo1.Lines.Add(msg);

  end;

  DIO_StreamClose(DI);
  if not Terminated then begin
    MoreComplexErrors := StuckHigh and StuckLow;
    StuckHigh := StuckHigh and not MoreComplexErrors;
    StuckLow  := StuckLow  and not MoreComplexErrors;
    if StuckHigh <> 0 then PostLine(#9'Bits that may be stuck high: ' + IntToHex(StuckHigh, 4));
    if StuckLow  <> 0 then PostLine(#9'Bits that may be stuck low: '  + IntToHex(StuckLow , 4));
    if MoreComplexErrors <> 0 then PostLine(#9'Bits with more complex errors: '  + IntToHex(MoreComplexErrors, 4));
  end;
  bDone := True;
end;

{ TIOThread }

constructor TIOThread.Create;
begin
  inherited Create(True);

  //hDoneMutex := CreateMutex(nil, False, nil);
end;

destructor TIOThread.Destroy;
begin
  //CloseHandle(hDoneMutex);

  inherited;
end;

function TIOThread.IsDone: Boolean;
begin
  if not bDone then WaitForSingleObject(Handle, 1);

  Result := bDone;
end;

{ TCheckFIFOWriteThread }

procedure TCheckFIFOWriteThread.Execute;
var
  Status, BytesTransferred: LongWord;
  OutBuf: array of Word;

begin
  bFailed := False;
  FIFOPackets := 0;
  SetLength(OutBuf, 256);
  FillChar(OutBuf[0], Length(OutBuf)*SizeOf(OutBuf[0]), 0);

  repeat
    Status := DIO_StreamFrame(DI, Length(OutBuf), @OutBuf[0], BytesTransferred);
    if Status <> ERROR_SUCCESS then begin
      PostLine('Error ' + IntToStr(Status) + ' writing frame to ' + BoardName(DI) + '.');
      bFailed := True;
      Break;
    end;
    Inc(FIFOPackets);
  until Terminated;
end;


procedure TMainForm.TrackBar1Change(Sender: TObject);
  var
    iTest : integer;
begin
  label4.Caption := IntToStr((Sender as TTrackBar).Position)+' MHz';
  for iTest := 0 to high(TestScript) do with TestScript[iTest] do begin
      if ReadMasterMHz <> 0 then ReadMasterMhz := MainForm.trackBar1.position;
      if WriteMasterMHz <> 0 then WriteMasterMHz := MainForm.trackBar1.position;
  end;
  ResultMemo.Clear;
  bTestListPrinted := false;
end;

procedure TMainForm.ClearRefFIFOClick(Sender: TObject);
begin
  if Sender = ClearRefFIFO then begin
    if RefDI < 32 then begin
      Memo1.Lines.Add('Clearing Reference Board ('+IntToStr(RefDI)+') FIFO');
      AIOUSB_ClearFIFO(RefDI, 1)
    end
  end else begin
    if TestDI < 32 then begin
      Memo1.Lines.Add('Clearing Board Under Test ('+IntToStr(TestDI)+') FIFO');
      AIOUSB_ClearFIFO(TestDI, 1);
    end;
  end;
end;

procedure TMainForm.AddButtonClick(Sender: TObject);
begin
  if TestsList.ItemIndex <> -1 then begin
    RunList.Items.Add(TestsList.Items[TestsList.ItemIndex]);
    TestsList.Items.Delete(TestsList.ItemIndex);
    if TestsList.Items.Count > 0 then
      TestsList.ItemIndex := 0;
  end;
end;

procedure TMainForm.SubButtonClick(Sender: TObject);
begin

  if RunList.ItemIndex <> -1 then begin
    TestsList.Items.Add(RunList.Items[RunList.ItemIndex]);
    RunList.Items.Delete(RunList.ItemIndex);
    if RunList.Items.Count > 0 then
      RunList.ItemIndex := 0;
  end;
end;

procedure TMainForm.ClrRefHardClick(Sender: TObject);
begin
  if Sender = ClrRefHard then begin
    if RefDI < 32 then begin
      Memo1.Lines.Add('Clearing Reference Board ('+IntToStr(RefDI)+') FIFO HARD');
      AIOUSB_ClearFIFO(RefDI, 0)
    end
  end else begin
    if TestDI < 32 then begin
      Memo1.Lines.Add('Clearing Board Under Test ('+IntToStr(TestDI)+') FIFO HARD');
      AIOUSB_ClearFIFO(TestDI, 0);
    end;
  end;
end;

end.
