unit Core;

interface

uses
	WinAPI.Windows, System.Classes;

type
	TUInt8    = Byte    ; TPUInt8    = ^TUInt8   ;
	TUInt16   = Word    ; TPUInt16   = ^TUInt16  ;
	TUInt32   = LongWord; TPUInt32   = ^TUInt32  ;
	TUInt64   = UInt64  ; TPUInt64   = ^TUInt64  ;
	TUNative  = Cardinal; TPUNative  = ^TUNative ;
	TSInt8    = ShortInt; TPSInt8    = ^TSInt8   ;
	TSInt16   = SmallInt; TPSInt16   = ^TSInt16  ;
	TSInt32   = LongInt ; TPSInt32   = ^TSInt32  ;
	TSInt64   = Int64   ; TPSInt64   = ^Int64    ;
	TSNative  = Integer ; TPSNative  = ^TSNative ;
	TSingle   = Single  ; TPSingle   = ^TSingle  ;
	TDouble   = Double  ; TPDouble   = ^TDouble  ;
	TAnsiChar = AnsiChar; TPAnsiChar = ^TAnsiChar;
	TWideChar = WideChar; TPWideChar = ^TWideChar;
	UTF16String = UnicodeString;

type
	TWinErrCode = TUInt32;
	TPWinErrCode = ^TWinErrCode;
	TSerialNumber = TUInt64;
	TPSerialNumber = ^TSerialNumber;

type
	TBoardIndex = TUInt64;
const
	biAuto = TBoardIndex(0);
	biNone = TBoardIndex(-1);

type
	TChannelIndex = TUInt32;
const
	ciAll = TChannelIndex(-1);

type
	TRangeCode = TUInt32;
	TPRangeCode = ^TRangeCode;
const
	rcNoChange     = TRangeCode(-1);
	rcUnipolar10   = TRangeCode($30313055); //FourCC('U010');
	rcUnipolar5    = TRangeCode($35303055); //FourCC('U005');
	rcBipolar24    = TRangeCode($3432E142); //FourCC('B±24');
	rcBipolar20    = TRangeCode($3032E142); //FourCC('B±20');
	rcBipolar12    = TRangeCode($3231E142); //FourCC('B±12');
	rcBipolar10    = TRangeCode($3031E142); //FourCC('B±10');
	rcBipolar5     = TRangeCode($3530E142); //FourCC('B±05');
	rcBipolar2_5   = TRangeCode($BD32E142); //FourCC('B±2½');
	rcBipolar1_25  = TRangeCode($BC31E142); //FourCC('B±1¼');
	rcBipolar_625  = TRangeCode($3835E142); //FourCC('B±58');
	rcBipolar_3125  = TRangeCode($3331E142); //FourCC('B±13');
	//rcCurrent420   = TRangeCode($30323449); //FourCC('I420'); // mA
	rcRangeCode0   = TRangeCode(0);
	rcRangeCode1   = TRangeCode(1);
	rcRangeCode2   = TRangeCode(2);
	rcRangeCode3   = TRangeCode(3);
	rcRangeCode4   = TRangeCode(4);
	rcRangeCode5   = TRangeCode(5);
	rcRangeCode6   = TRangeCode(6);
	rcRangeCode7   = TRangeCode(7);

type
	TSequencerIndex = TUInt32;
const
	siFirst = TSequencerIndex(0);
	siSecond = TSequencerIndex(1);

type
	TIRQIndex = TUint32;
const
	iiOnly = TIRQIndex(0);
	//Someday cards will have more, and default param makes this trivial for now.

type
	TChunkingType = TUInt32;
const
	ctAuto = TChunkingType(0);
	ctSize = TChunkingType(1);
	ctRate = TChunkingType(2);

type
	TCallbackType = TUInt32;
const
	ctRaw = TCallbackType($776152); //FourCC('Raw'#0);
	ctCounts = TCallbackType($6E756F43); //FourCC('Coun');
	ctV = TCallbackType($746C6F56); //FourCC('Volt');
	ctNone = TCallbackType($FFFFFFFF);



const
	AIOWDMClassGUID: TGUID = (D1: $E77894A2; D2: $697F; D3: $11D0; D4: ($95, $8E, $AF, $1F, $DA, $DB, $2F, $1B) );

	METHOD_BUFFERED = 0;
	FILE_READ_ACCESS = 1;
	FILE_WRITE_ACCESS = 2;
	FILE_DEVICE_KRNLDRVR = $80FF;

	IOCTL_QUERY_INFO     = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($800 shl 2) or (METHOD_BUFFERED  ) or (FILE_READ_ACCESS  shl 14));
	IOCTL_QUERY_BAR_BASE = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($801 shl 2) or (METHOD_BUFFERED  ) or (FILE_READ_ACCESS  shl 14));
	IOCTL_IRQ_WAIT_BEGIN = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($810 shl 2) or (METHOD_BUFFERED  ) or (FILE_READ_ACCESS  shl 14));
	IOCTL_IRQ_WAIT_ABORT = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($812 shl 2) or (METHOD_BUFFERED  ) or (FILE_ANY_ACCESS   shl 14));
	IOCTL_IRQ_POLL       = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($814 shl 2) or (METHOD_BUFFERED  ) or (FILE_READ_ACCESS  shl 14));
	IOCTL_SET_COS_SCHEME = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($816 shl 2) or (METHOD_BUFFERED  ) or (FILE_READ_ACCESS  shl 14));
	IOCTL_FORGET_IRP     = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($880 shl 2) or (METHOD_BUFFERED  ) or (FILE_WRITE_ACCESS shl 14));

	IOCTL_PORT_IN        = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($820 shl 2) or (METHOD_BUFFERED  ) or (FILE_READ_ACCESS  shl 14));
	IOCTL_PORT_INSTR     = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($821 shl 2) or (METHOD_BUFFERED  ) or (FILE_READ_ACCESS  shl 14));
	IOCTL_PIO_INSTR      = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($821 shl 2) or (METHOD_OUT_DIRECT) or (FILE_READ_ACCESS  shl 14));
	IOCTL_PORT_OUT       = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($822 shl 2) or (METHOD_BUFFERED  ) or (FILE_WRITE_ACCESS shl 14));
	//IOCTL_PORT_OUTSTR    = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($823 shl 2) or (METHOD_BUFFERED  ) or (FILE_WRITE_ACCESS shl 14));
	IOCTL_PIO_OUTSTR     = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($823 shl 2) or (METHOD_IN_DIRECT ) or (FILE_WRITE_ACCESS shl 14));
	IOCTL_MEM_IN         = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($824 shl 2) or (METHOD_BUFFERED  ) or (FILE_READ_ACCESS  shl 14));
	IOCTL_MEM_OUT        = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($826 shl 2) or (METHOD_BUFFERED  ) or (FILE_WRITE_ACCESS shl 14));
	IOCTL_PORTMB_OUT     = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($82A shl 2) or (METHOD_BUFFERED  ) or (FILE_WRITE_ACCESS shl 14));

	IOCTL_GET_BENCH      = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($830 shl 2) or (METHOD_BUFFERED  ) or (FILE_READ_ACCESS  shl 14));

	{
	IOCTL_DMA_RAW_START  = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($840 shl 2) or (METHOD_BUFFERED  ) or (FILE_ANY_ACCESS   shl 14));
	IOCTL_DMA_RAW_STOP   = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($841 shl 2) or (METHOD_BUFFERED  ) or (FILE_ANY_ACCESS   shl 14));
	IOCTL_DMA_RAW_READ   = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($820 shl 2) or (METHOD_OUT_DIRECT) or (FILE_READ_ACCESS  shl 14));
	IOCTL_DMA_RAW_WRITE  = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($820 shl 2) or (METHOD_IN_DIRECT ) or (FILE_WRITE_ACCESS shl 14));
	}
	IOCTL_DMA_PIONG_CONTROL = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($840 shl 2) or (METHOD_BUFFERED  ) or (FILE_WRITE_ACCESS shl 14));
	IOCTL_DMA_PIONG_READ    = LongWord((FILE_DEVICE_KRNLDRVR shl 16) or ($840 shl 2) or (METHOD_OUT_DIRECT) or (FILE_READ_ACCESS  shl 14));

	pofRelative = $01;

	ResetOffset = $00;
	IRQEnableOffset = $01;
	DACOffset = $04;
	BaseClockOffset = $0C;
	DivisorOffset = $10;
	ADCRangeOffset = $18;
	AFLevelOffset = $20;
	ADCDepthOffset = $28;
	ADCDataOffset: array[0..1] of TUInt16 = ($30, $34);
	ADCStartStopOffset = $38;
	//ADCImmediateOffset = $3A;
	IDOffset = $68;
	//ADCDataOffset: array[0..1] of TUInt32 = ($4000, $8000);
	dSequencer = $4;

	BaseADCCmd = $FCCE;
	ADCCmd_Go = $0001;
	ADCCmd_Continuous = $0020;
	ADCCmd_SingleEnded = $0800;

type
	TPortOp = packed record
		Addr: TUInt16;
		Flags: TUInt8;
		Size: TUInt8;
		Data32: TUInt32;
	end;
	TPPortOp = ^TPortOp;

	TCardInfo = packed record
		DeviceID: LongWord;
		BaseAddress: Word;
		Reserved: Word;
	end;
	TPCardInfo = ^TCardInfo;

	TBasalThread = class(TThread)
	public
		constructor Create; virtual;
	end;

	TOS = (osDunno, osWin95, osWin98, osNT, osNT5, osNTVistaCore);

	TImmediateMode = (imUnknown, imNative16, imNative32, imEmulated);

	TRegisterMap = (rmUnknown, rmAIO, rmADIO, rmHMAIO);

	TDeviceData = record
		SymbolicLink: UTF16String;
		hDevice: THandle;
		DeviceID: TUInt32;
		BaseClock: TUInt32;
		LastDACRanges: array[0..3] of TRangeCode;
		ImmediateMode: TImmediateMode;
		RegisterMap: TRegisterMap;
		hThreadingMutex: THandle;
		SequencerAcq: array[0..1] of record
			ChunkingType: TChunkingType;
			ChunkingScalar: TUInt32;
			CallbackType: TCallbackType;
			pCallback: Pointer;
			bInCallback: Boolean;
			hThreadingMutex: THandle;
			AcquireThread: TThread;
		end;
		{$IFDEF DEBUG}
			DebugMask: TUInt32;
			LogFil: TFileStream;
		{$ENDIF}
	end;

const
	DACCt = 4;
	ADCChCt = 8;

type
	TInstantLambda = reference to procedure ();

var
	OS: TOS;
	Dev: array of TDeviceData;

function CloseAndInvalidateHandle(var H: THandle): LongBool;
{$IFDEF DEBUG}
	function AnsiMessageBox(Text, Caption: AnsiString; uType: UINT): Integer;
{$ENDIF}

procedure WithThreadingMutexHeld(iBoard: TBoardIndex; DoWhat: TInstantLambda);
procedure WithSeqThreadingMutexHeld(iBoard: TBoardIndex; iSequencer: TSequencerIndex; DoWhat: TInstantLambda);
procedure WithAllThreadingMutexesHeld(iBoard: TBoardIndex; DoWhat: TInstantLambda);

function ValidateBoardIndex(iBoard: TBoardIndex): TUInt32;
function DoDeviceIoControl(hDevice: THandle; IOCTLCode: DWORD; pInBuffer: Pointer; InBufferSize: DWORD; pOutBuffer: Pointer; OutBufferSize: DWORD; pBytesReturned: PDWORD = nil; pOverlapped: POverlapped = nil): TWinErrCode;



implementation

function CloseAndInvalidateHandle(var H: THandle): LongBool;
begin
	if H = INVALID_HANDLE_VALUE then Exit(True);
	Result := CloseHandle(H);
	H := INVALID_HANDLE_VALUE;
end;

{$IFDEF DEBUG}
	function AnsiMessageBox(Text, Caption: AnsiString; uType: UINT): Integer;
	begin
		Result := MessageBoxA(0, PAnsiChar(Text), PAnsiChar(Caption), uType);
		Text := '';
		Caption := '';
	end;
{$ENDIF}



procedure WithThreadingMutexHeld(iBoard: TBoardIndex; DoWhat: TInstantLambda);
var
	oThreadPriority: Integer;

begin
	oThreadPriority := GetThreadPriority(GetCurrentThread);
	if oThreadPriority <> THREAD_PRIORITY_TIME_CRITICAL then SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
	WaitForSingleObject(Dev[iBoard].hThreadingMutex, INFINITE);
	try
		DoWhat;
	finally
		ReleaseMutex(Dev[iBoard].hThreadingMutex);
		if oThreadPriority <> THREAD_PRIORITY_TIME_CRITICAL then SetThreadPriority(GetCurrentThread, oThreadPriority);
	end;
end;

procedure WithSeqThreadingMutexHeld(iBoard: TBoardIndex; iSequencer: TSequencerIndex; DoWhat: TInstantLambda);
var
	oThreadPriority: Integer;

begin
	oThreadPriority := GetThreadPriority(GetCurrentThread);
	if oThreadPriority <> THREAD_PRIORITY_TIME_CRITICAL then SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
	WaitForSingleObject(Dev[iBoard].SequencerAcq[iSequencer].hThreadingMutex, INFINITE);
	try
		DoWhat;
	finally
		ReleaseMutex(Dev[iBoard].SequencerAcq[iSequencer].hThreadingMutex);
		if oThreadPriority <> THREAD_PRIORITY_TIME_CRITICAL then SetThreadPriority(GetCurrentThread, oThreadPriority);
	end;
end;

procedure WithAllThreadingMutexesHeld(iBoard: TBoardIndex; DoWhat: TInstantLambda);
var
	oThreadPriority: Integer;
	iSequencer: TSequencerIndex;

begin
	oThreadPriority := GetThreadPriority(GetCurrentThread);
	if oThreadPriority <> THREAD_PRIORITY_TIME_CRITICAL then SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
	WaitForSingleObject(Dev[iBoard].hThreadingMutex, INFINITE);
	try
		for iSequencer := 0 to High(Dev[iBoard].SequencerAcq) do
			WaitForSingleObject(Dev[iBoard].SequencerAcq[iSequencer].hThreadingMutex, INFINITE)
		;
		try
			DoWhat;
		finally
			for iSequencer := 0 to High(Dev[iBoard].SequencerAcq) do
				ReleaseMutex(Dev[iBoard].SequencerAcq[iSequencer].hThreadingMutex)
			;
		end;
	finally
		ReleaseMutex(Dev[iBoard].hThreadingMutex);
		SetThreadPriority(GetCurrentThread, oThreadPriority);
	end;
end;



function ValidateBoardIndex(iBoard: TBoardIndex): TWinErrCode;
begin
	try
		if (iBoard < 0) or (iBoard >= Length(Dev)) then begin
			Result := ERROR_INVALID_INDEX;
		end
		else begin
			Result := ERROR_SUCCESS;
		end;
		SetLastError(Result);
	except
		Result := ERROR_INTERNAL_ERROR;
	end;
end;

function DoDeviceIoControl(hDevice: THandle; IOCTLCode: DWORD; pInBuffer: Pointer; InBufferSize: DWORD; pOutBuffer: Pointer; OutBufferSize: DWORD; pBytesReturned: PDWORD; pOverlapped: POverlapped): TWinErrCode;
var
	DummyBytes: TUInt32;

begin
	try
		if pBytesReturned = nil then pBytesReturned := @DummyBytes;

		if DeviceIoControl(hDevice, IOCTLCode, pInBuffer, InBufferSize, pOutBuffer, OutBufferSize, pBytesReturned^, pOverlapped) then begin
			Result := ERROR_SUCCESS;
			SetLastError(Result);
		end
		else begin
			Result := GetLastError;
			if Result = ERROR_SUCCESS then begin
				Result := ERROR_GEN_FAILURE;
				SetLastError(Result);
			end;
		end;
	except
		Result := ERROR_INTERNAL_ERROR;
	end;
end;

{ TBasalThread }

constructor TBasalThread.Create;
begin
	inherited Create(True);
end;

end.
