|
|
unit Serial;interface
function ConDetect:Boolean;
function ConCommand(Command:Byte):boolean;
function ConSetBaud(BaudRate:Integer):boolean;
function ConSetChannel(Channel:Integer):boolean;
function ConSetGain(Gain:Integer):boolean;
function ConWriteDAC(DAC_Code:Integer):boolean;
function ConStart(TimerVal:Integer;Points:Integer):boolean;
procedure ConSetRWMode(RWMode:Byte);
procedure ConSetRAMAddr(RAMAddr:Integer);
function ConWriteRAM(RAMData:Integer):boolean;
procedure ConSetSyncMode(SDelay:Integer;SLevel:Integer;
SChannel:Byte;SMode:Byte);procedure DevDataWrite(Data:Byte);
procedure DevAddrWrite(Addr:Byte);
procedure DevReset;
function DevDataReady:Boolean;
function DevDataImRead:Byte;
function DevDataRead:Byte;
procedure DevClearBuff;procedure SerPortInit(SPortN:Integer;InitFifo:Boolean;SBaud:Integer);
function SerGetFifo(SPortN:Integer):Byte;
procedure SerSetFifo(SPortN:Integer;Value:Byte);
function SerGetIntEn(SPortN:Integer):Byte;
procedure SerSetIntEn(SPortN:Integer;Value:Byte);
function SerGetLCnt(SPortN:Integer):Byte;
procedure SerSetLCnt(SPortN:Integer;Value:Byte);
function SerGetMCnt(SPortN:Integer):Byte;
procedure SerSetMCnt(SPortN:Integer;Value:Byte);
procedure SerSetDlab(SPortN:Integer;State:Boolean);
procedure SerSetBaudRate(SPortN:Integer;SBaud:Integer);
function SerDataReady(SPortN:Integer):Boolean;
function SerDataImRead(SPortN:Integer):Byte;
function SerDataRead(SPortN:Integer):Byte;
function SerTrEmpty(SPortN:Integer):Boolean;
procedure SerDataWrite(SPortN:Integer;Value:Byte);
procedure SerClearBuff(SPortN:Integer);const
Xtal=22118400; {Controller Xtal Frequency}
{Params}
Buff_Cmd=0;
CmdStart=1;
CmdReadRAM=2;
CmdWriteRAM=3;
CmdWriteDAC=4;
CmdSetChG=5;
CmdSetBaud=6;
RplDataReady=7;
CmdDACTestOn=8;
CmdDACTestOff=9;
CmdRAMTest=10;
Buff_Echo=1;
Buff_RaaL=2;
Buff_RaaH=3;
Buff_RadL=4;
Buff_RadH=5;
Buff_TmrL=6;
Buff_TmrH=7;
Buff_PtsL=8;
Buff_PtsH=9;
Buff_DelL=10;
Buff_DelH=11;
Buff_Chan=12;
Buff_Gain=13;
Buff_DacL=14;
Buff_DacH=15;
Buff_SynL=16;
Buff_SynH=17;
Buff_SyCh=18;
Buff_SyMd=19;
SyMdEnable=1;
SyMdExtern=2;
SyMdRise=4;
SyMdDelayed=8;
Buff_RwMd=20;
RwMdAutoOff=0;
RwMdAutoByte=1;
RwMdAutoWord=3;
RwMdAutoB16=5;
RwMdAutoArray=7;
RwMdIncDecEn=8;
RwMdInc=$10;
Buff_Baud=21;
BaudClk=Xtal div 64;Rd =$80; {Device Read Mode}
UART_Data =0; // Receiver Buffer, Transmit Holding Register
UART_IntEn=1; // Interrupt Enable Register
ERBFI =$01; // Received Data Available
ETBEI =$02; // Transmitter Holding Register Empty
ELSI =$04; // Receiver Line Status
EDSSI =$08; // Modem Status
UART_IntId=2; // Interrupt Ident Register
F50A =$c0; // 16550A FIFO mode
F50 =$80; // 16550 FIFO mode
FOFF =$00; // FIFO off
FI1 =$00; // Interrupt On 1 Byte In FIFO
FI4 =$40; // Interrupt On 4 Bytes In FIFO
FI8 =$80; // Interrupt On 8 Bytes In FIFO
FI14 =$c0; // Interrupt On 14 Bytes In FIFO
DMAEN =$08; // DMA Enable
RESTF =$04; // Reset Transmitter FIFO Counter
RESRT =$02; // Reset Receiver FIFO Counter
FIFO =$01; // Receive And Transmit FIFO Enable
IIP =$01; // Inverted Interrupt Pending (0=int)
IID =$06; // Interrupt ID
RLSI =$06; // Receiver Line Status
RDAI =$04; // Received Data Available
THREI =$02; // Transmitter Holding Register Empty
MSI =$00; // Modem Status
UART_LCnt =3; // Line Control Register
WLS0 =$01; // Word Length Select Bit 0
WLS1 =$02; // Word Length Select Bit 1
W5B =$00; // 5 Bit Words
W6B =$01; // 6 Bit Words
W7B =$02; // 7 Bit Words
W8B =$03; // 8 Bit Words
S1B =$00; // 1 Stop Bits (1.5 for 5 bit words)
S2B =$04; // 2 Stop Bits
PEN =$08; // Parity Enable
PSB =$30; // Parity Select bits
EPS =$10; // Even Parity Select
SPR =$20; // Stick Parity
SB =$40; // Set Break
DLAB =$80; // Divisor Latch Access Bit
UART_MCnt =4; // Modem Control Register
DTR =$01; // Data Terminal Ready
RTS =$02; // Request To Send
OUT1 =$04; // Output Line 1
OUT2 =$08; // Output Line 2
DLOOP =$10; // Diagnostic Loopback
UART_LStat=5; // Line Status Register
DR =$01; // Data Ready
OER =$02; // Overrun Error
PER =$04; // Parity Error
FER =$08; // Framing Error
BI =$10; // Break Indicated
THRE =$20; // Transmitter Holding Register Empty
TSRE =$40; // Transmitter Shift Register Empty
FIFOE =$80; // FIFO Error
LERR =$0e; // Line Error
UART_MStat=6; // Modem Status Register
DCTS =$01; // Delta Clear to Send
DDSR =$02; // Delta Data Set Ready
TERI =$04; // Trailing Edge Ring Indicator
DDCD =$08; // Delta Receive Line Signal Detect
CTS =$10; // Clear To Send
DSR =$20; // Data Set ready
RI =$40; // Ring Indicator
DCD =$80; // Receive Line Signal Detect
UART_DivL =0; // LSB Baud Rate Divisor
UART_DivH =1; // MSB Baud Rate Divisorimplementation
uses Windows, Dialogs, Sysutils, Controls;
const
{Ports Bases}
COM1_Base=$3f8;
COM2_Base=$2f8;RdTimeOut=100; {mS}
type
EPortError=class(exception);var
UART_Base: Word;
ErrEn: Boolean;function SerBase(SPortN:Integer):Integer;
begin
Case SPortN of
1: SerBase:=COM1_Base;
2: SerBase:=COM2_Base;
else
begin
SerBase:=COM2_Base;
MessageBeep(MB_IconError);
MessageDlg('Invalid serial port number. ',mtError,[mbOK],0);
end;
end;
end;function ReadPort(Addr:Word):Byte;
var A:Word;D:Byte;
begin
A:=Addr;
asm
mov dx,A
in al,dx
mov D,al
end;
ReadPort:=D;
end;procedure WritePort(Addr:Word;Data:Byte);
var A:Word;D:Byte;
begin
A:=Addr; D:=Data;
asm
mov dx,A
mov al,D
out dx,al
end;
end;function SerGetFifo(SPortN:Integer):Byte;
begin
SerGetFifo:=ReadPort(SerBase(SPortN)+UART_IntId);
end;procedure SerSetFifo(SPortN:Integer;Value:Byte);
begin
WritePort(SerBase(SPortN)+UART_IntId,Value);
end;function SerGetIntEn(SPortN:Integer):Byte;
begin
SerGetIntEn:=ReadPort(SerBase(SPortN)+UART_IntEn);
end;procedure SerSetIntEn(SPortN:Integer;Value:Byte);
begin
WritePort(SerBase(SPortN)+UART_IntEn,Value);
end;function SerGetLCnt(SPortN:Integer):Byte;
begin
SerGetLCnt:=ReadPort(SerBase(SPortN)+UART_LCnt);
end;procedure SerSetLCnt(SPortN:Integer;Value:Byte);
begin
WritePort(SerBase(SPortN)+UART_LCnt,Value);
end;function SerGetMCnt(SPortN:Integer):Byte;
begin
SerGetMCnt:=ReadPort(SerBase(SPortN)+UART_MCnt);
end;procedure SerSetMCnt(SPortN:Integer;Value:Byte);
begin
WritePort(SerBase(SPortN)+UART_MCnt,Value);
end;procedure SerSetDlab(SPortN:Integer;State:Boolean);
var LCnt:Byte;
begin
LCnt:=SerGetLCnt(SPortN);
if State
then LCnt:=LCnt or DLAB
else LCnt:=LCnt and (not DLAB);
SerSetLCnt(SPortN,LCnt);
end;procedure SerSetBaudRate(SPortN:Integer;SBaud:Integer);
var DivVal:Byte;
begin
DivVal:=round(115200/SBaud);
SerSetDlab(SPortN,True);
WritePort(SerBase(SPortN)+UART_DivL,DivVal);
WritePort(SerBase(SPortN)+UART_DivH,0);
SerSetDlab(SPortN,False);
end;function SerDataReady(SPortN:Integer):Boolean;
begin
if (ReadPort(SerBase(SPortN)+UART_LStat) and DR)=0
then SerDataReady:=False
else SerDataReady:=True;
end;function SerDataImRead(SPortN:Integer):Byte;
begin
SerDataImRead:=ReadPort(SerBase(SPortN)+UART_Data);
end;function SerDataRead(SPortN:Integer):Byte;
var TmOv: DWord; Tov: Boolean;
begin
TmOv:=GetTickCount+RdTimeOut;
repeat Tov:=(GetTickCount>=TmOv)
until SerDataReady(SPortN) or Tov;
SerDataRead:=0;
if not Tov then
SerDataRead:=ReadPort(SerBase(SPortN)+UART_Data)
else if ErrEn then raise EPortError.Create('Serial Port Error');
end;function SerTrEmpty(SPortN:Integer):Boolean;
begin
if ((not ReadPort(SerBase(SPortN)+UART_LStat))
and (THRE+TSRE))=0
then SerTrEmpty:=True
else SerTrEmpty:=False;
end;procedure SerDataWrite(SPortN:Integer;Value:Byte);
begin
repeat until SerTrEmpty(SPortN);
WritePort(SerBase(SPortN)+UART_Data,Value);
end;procedure SerClearBuff(SPortN:Integer);
begin
while SerDataReady(SPortN) do
ReadPort(SerBase(SPortN)+UART_Data);
end;procedure SerPortInit(SPortN:Integer;InitFifo:Boolean;SBaud:Integer);
begin
ErrEn:=true;
if InitFifo then
begin
SerSetFifo(SPortN,FIFO+RESRT+RESTF);
SerSetFifo(SPortN,FIFO);
if (SerGetFifo(SPortN) and F50A)<>F50A then
begin
SerSetFifo(SPortN,FOFF);
MessageDlg('UART FIFO not present.',mtInformation,[mbOK],0);
end;
end;
UART_Base:=SerBase(SPortN);
SerSetBaudRate(SPortN,SBaud);
SerSetLCnt(SPortN,SPR+PEN+W8B);
SerSetIntEn(SPortN,0);
SerSetMCnt(SPortN,OUT2+RTS);
end;// Device Access Section
function DevDataReady:Boolean;
begin
if (ReadPort(UART_Base+UART_LStat) and DR)=0
then DevDataReady:=False
else DevDataReady:=True;
end;function DevDataImRead:Byte;
begin
DevDataImRead:=ReadPort(UART_Base+UART_Data)
end;function DevDataRead:Byte;
var TmOv: Dword; Tov: Boolean;
begin
TmOv:=GetTickCount+RdTimeOut;
repeat Tov:=(GetTickCount>=TmOv)
until DevDataReady or Tov;
DevDataRead:=0;
if not Tov then
DevDataRead:=ReadPort(UART_Base+UART_Data)
else if ErrEn then raise EPortError.Create('Serial Port Error');
end;procedure DevClearBuff;
begin
while DevDataReady do
ReadPort(UART_Base+UART_Data);
end;procedure DevDataWrite(Data:Byte);
begin
repeat until ((not ReadPort(UART_Base+UART_LStat))
and (THRE+TSRE))=0;
WritePort(UART_Base+UART_LCnt,SPR+PEN+EPS+W8B);
WritePort(UART_Base+UART_Data,Data);
end;procedure DevAddrWrite(Addr:Byte);
begin
repeat until ((not ReadPort(UART_Base+UART_LStat))
and (THRE+TSRE))=0;
WritePort(UART_Base+UART_LCnt,SPR+PEN+W8B);
WritePort(UART_Base+UART_Data,Addr and $9f);
end;procedure DevReset;
begin
repeat until ((not ReadPort(UART_Base+UART_LStat))
and (THRE+TSRE))=0;
WritePort(UART_Base+UART_LCnt,SPR+PEN+W8B);
WritePort(UART_Base+UART_Data,$40);
end;// Hi Level Commands
function ConCommand(Command:Byte):boolean;
begin
DevClearBuff;
DevAddrWrite(Buff_Cmd);
DevDataWrite(Command);
Result:=true;
try
if DevDataRead<>Command then if ErrEn then
if MessageDlg('Device returns an invalid value.',
mtError,[mbRetry,mbCancel],0)=mrRetry
then ConCommand(Command)
else Result:=false;
except
if MessageDlg('Device is not responding.',
mtError,[mbRetry,mbCancel],0)=mrRetry
then ConCommand(Command)
else Result:=false;
end;
end;function ConDetect:Boolean;
var Res1,Res2: Boolean; b:byte;
begin
Res1:=true; Res2:=true;
DevClearBuff;
DevAddrWrite(Buff_Echo);
DevDataWrite($55);
DevAddrWrite(Buff_Echo+Rd);
try begin b:=DevDataRead;
if b<>$55 then Res1:=false; end;
except
Res1:=false;
end;
DevDataWrite($aa);
DevAddrWrite(Buff_Echo+Rd);
try
if DevDataRead<>$aa then Res2:=false;
except
Res2:=false;
end;
ErrEn:=Res1 and Res2;
Result:=ErrEn;
end;function ConSetBaud(BaudRate:Integer):boolean;
begin
DevAddrWrite(Buff_Baud);
DevDataWrite($100-round(BaudClk/BaudRate));
Result:=ConCommand(CmdSetBaud);
end;function ConSetChannel(Channel:Integer):boolean;
begin
DevAddrWrite(Buff_Chan);
DevDataWrite(Channel);
Result:=ConCommand(CmdSetChG);
end;function ConSetGain(Gain:Integer):boolean;
begin
DevAddrWrite(Buff_Gain);
DevDataWrite(Gain);
Result:=ConCommand(CmdSetChG);
end;function ConWriteDAC(DAC_Code:Integer):boolean;
begin
DevAddrWrite(Buff_DacL);
DevDataWrite(DAC_Code and $ff);
DevAddrWrite(Buff_DacH);
DevDataWrite((DAC_Code shr 8) and $0f);
Result:=ConCommand(CmdWriteDAC);
end;function ConStart(TimerVal:Integer;Points:Integer):boolean;
begin
DevAddrWrite(Buff_TmrL);
DevDataWrite(TimerVal and $ff);
DevAddrWrite(Buff_TmrH);
DevDataWrite((TimerVal shr 8) and $ff);DevAddrWrite(Buff_PtsL);
DevDataWrite(Points and $ff);
DevAddrWrite(Buff_PtsH);
DevDataWrite((Points shr 8) and $3f);Result:=ConCommand(CmdStart);
end;procedure ConSetSyncMode(SDelay:Integer;SLevel:Integer;
SChannel:Byte;SMode:Byte);
begin
DevAddrWrite(Buff_DelL);
DevDataWrite(SDelay and $ff);
DevAddrWrite(Buff_DelH);
DevDataWrite((SDelay shr 8) and $ff);DevAddrWrite(Buff_SynL);
DevDataWrite(SLevel and $ff);
DevAddrWrite(Buff_SynH);
DevDataWrite((SLevel shr 8) and $ff);DevAddrWrite(Buff_SyCh);
DevDataWrite(SChannel);DevAddrWrite(Buff_SyMd);
DevDataWrite(SMode);
end;procedure ConSetRWMode(RWMode:Byte);
begin
DevAddrWrite(Buff_RwMd);
DevDataWrite(RWMode);
end;procedure ConSetRAMAddr(RAMAddr:Integer);
begin
DevAddrWrite(Buff_RaaL);
DevDataWrite(RAMAddr and $ff);
DevAddrWrite(Buff_RaaH);
DevDataWrite((RAMAddr shr 8) and $3f);
end;function ConWriteRAM(RAMData:Integer):boolean;
begin
DevAddrWrite(Buff_RadL);
DevDataWrite(RAMData and $ff);
DevAddrWrite(Buff_RadH);
DevDataWrite((RAMData shr 8) and $ff);
Result:=ConCommand(CmdWriteRAM);
end;end.
E-mail: 
info@telesys.ru
