serial string driver
As writing a serial driver seems to be a problem, the following code is a sample
string driver.
{
StrDrv - uart driver 16550
----------------------------------------------------
It is optimized for a 16550 UART in the PC, but
should work also with a 8250 UART. - not yet tested
Just below IMPLEMENTATION there is <$DEFINE U16550>,
which enables codegeneration for the 16550, which is
strongly recommended.
There is a VAR Is16550 locally to this unit, that is
set at PROC UARTInit, it reflects the UART detected.
The detection is off when conditionally disabled.
----------------------------------------------------
It is set for COM1, IRQ4, 8bit, 1stop, no parity
----------------------------------------------------
Furthermore it supports RTS/CTS handshake ,
that the other side may stop the PC from sending.
It then activates the CTS-line(-12V).
Upon a trailing edge (-12V to +12V), the Driver resumes
transmitting. The levels are assumed after the drivers,
that means on the cable.
----------------------------------------------------
Benchmarks : on a 386/16MHz
At 9600 full speed tx and rx : ( shorted )
real mode :5% CPU time
protected mode :8% CPU time
----------------------------------------------------
The interface is PROC PutBuffer,GetBuffer, which
assumes a STRING.
The string is as follows:
[0]:stringlength
Note:
MMUDRV.InitDrv; < only once >
rep
MMUDRV.PutBuffer(@p);
Wait(RxSema);
MMUDRV.GetBuffer(q); < either >
end rep
q: reply conforms the above structure
----------------------------------------------------
----------------------------------------------------
New from mmudrv2.pas :
Tx is timed, this reduces interrupts, as the tx is
always on. further the txsema is not required anymore.
Now putbuffer includes a timed wait until the new message
fits into the buffer. This allows the senders to fill
the buffer, where the tx has maximum performance, as
the txirq then moves 16 bytes at a time.
The txbuffer has 256 bytes
----------------------------------------------------
Created :27/sept/93
Last Update :6/feb/96
Is updated version of :mmudriv.pas,mmudrv2.pas,mmudrv.pas
----------------------------------------------------
TestFile is :DRVTEST.PAS
----------------------------------------------------
}
UNIT StrDrv;
INTERFACE
USES RTKernel,OPString;
TYPE StrPtr=^STRING;
PROCEDURE InitDrv(baud:LONGINT;Fifosize:BYTE);
PROCEDURE PutBuffer(p:StrPtr); { p is @String }
PROCEDURE GetBuffer(VAR p:STRING); { p is a string }
FUNCTION IsLineOpen:BOOLEAN;
{ the rest is for debug }
PROCEDURE WriteTx;
PROCEDURE WriteRx;
PROCEDURE WriteCStr(p:StrPtr); { write string passed to/from driver }
PROCEDURE WriteUARTState;
VAR
RxSema1 :RTKernel.Semaphore;
IMPLEMENTATION
{===========================================================}
{ The following defines are disabled by a dot : .$DEFINE }
{$DEFINE U16550 } { enables 16550 UART }
{-------------------------------------------------------}
CONST
{ UARTAdress for COM1 }
RBR1=$3F8;THR1=$3F8;IER1=$3F9;IIR1=$3FA;FCR1=$3FA;LCR1=$3FB;
MCR1=$3FC;LSR1=$3FD;MSR1=$3FE;DLL1=$3F8;DLM1=$3F9;
{ UARTAdress for COM2 }
RBR2=$2F8;THR2=$2F8;IER2=$2F9;IIR2=$2FA;FCR2=$2FA;LCR2=$2FB;
MCR2=$2FC;LSR2=$2FD;MSR2=$2FE;DLL2=$2F8;DLM2=$2F9;
CONST
RxBufferSize=256; { must be, as byte wraps }
TxBufferSize=256; { must be, as byte wraps }
{ TxDepth=16; } { nr of bytes being filled at TxIRQ <=16 }
VAR
ExitSave :POINTER;
RxBuffer1 :ARRAY[0..RxBufferSize-1]OF BYTE;
ErrorBuffer1:ARRAY[0..RxBufferSize-1]OF BYTE;
RxWrite1,RxRead1,RxFree1 :BYTE;
TxBuffer1 :ARRAY[0..TxBufferSize-1]OF BYTE;
TxWrite1,TxRead1,TxFree1 :BYTE;
TxOnIRQ1,TxStop1,RxStop1 :BOOLEAN; { set during message }
Is16550 :BOOLEAN;
TxDepth:BYTE; { nr of bytes being filled at TxIRQ <=16 }
{컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�}
PROCEDURE EnableInterrupts; INLINE($FB);
PROCEDURE DisableInterrupts; INLINE($FA);
{$F+}
{袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴�}
{$F+,S-,R-} { far, not stack chk, no range chk }
PROCEDURE UARTHandler1;INTERRUPT;
VAR td,iirc,msrc :BYTE;
BEGIN
iirc:=Port[IIR1] AND $0F; { get interrupt source }
Port[MCR1]:=Port[MCR1] AND $07; { switch interrupts of UART off }
msrc:=Port[MSR1]; { get modem status reg }
CASE IIRC OF
{컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴}
$06: { line IRQ }
BEGIN
td:=port[LSR1]AND $71; { accept only OV,PA,FR,FI }
ErrorBuffer1[RxWrite1]:=td;
END;
{컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴}
{ Note :for a 16550 UART, the FIFO is emptied.
}
$04,$0C: { rx data avail IRQ }
BEGIN
{$IFDEF U16550}
WHILE ((port[LSR1] AND $01)<>0) DO { read 16550 FIFO }
BEGIN
{$ENDIF}
td:=port[RBR1];
RxBuffer1[RxWrite1]:=td;
Inc(RxWrite1);
Dec(RxFree1);
IF (RxFree1<16) THEN RxStop1:=TRUE ELSE RxStop1:=FALSE;
{$IFDEF U16550}
END; { while data }
{$ENDIF}
IF RxStop1 THEN
port[MCR1]:=port[MCR1] and $FC; { DTR/RTS low }
{ ELSE
port[MCR1]:=port[MCR1] or $03;} { DTR/RTS high }
END;
{컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴}
{ as long as the txbuffer is not empty, another byte is put to the
transmitter. The 16550 UART is fed with up to 16 bytes.
should the CTS signal stop, nothing is done
}
$02: { tx empty IRQ }
BEGIN
IF (TxRead1=TxWrite1) THEN TxOnIRQ1:=FALSE { last byte sent }
ELSE { TxRead<>TxWrite }
BEGIN
TxOnIRQ1:=TRUE;
IF (((msrc AND $10)=0)) THEN TxStop1:=TRUE; { cts signals stop }
IF (not TxStop1) THEN
BEGIN
{$IFDEF U16550}
td:=0;
REPEAT
{$ENDIF}
inc(td);
Port[THR1]:=TxBuffer1[TxRead1];
Inc(TxRead1); Inc(TxFree1);
{$IFDEF U16550}
UNTIL (Not Is16550)OR(TxRead1=TxWrite1)OR(td=TxDepth);
{$ENDIF}
END;
END; { txonirq and not stop }
END; { txempty }
{컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴}
{ The CTS stops transmitting (TxStop:=TRUE). When the CTS disappears
the transmitter resumes action
}
$00: { modem status IRQ }
BEGIN
IF (((msrc and $11)=$01)) THEN { cts signals stop }
BEGIN
TxStop1:=TRUE;
END
ELSE
BEGIN
IF (((msrc AND $11)=$11)) THEN { cts signals ready again }
BEGIN
TxStop1:=FALSE;
IF (TxRead1<>TxWrite1) THEN
BEGIN
TxOnIRQ1:=TRUE;
IF ((Port[LSR1] and $20)<>0) THEN { THR1e empty }
BEGIN
{$IFDEF U16550}
td:=0;
REPEAT
{$ENDIF}
inc(td);
Port[THR1]:=TxBuffer1[TxRead1];
Inc(TxRead1); Inc(TxFree1); { includes wrap }
{$IFDEF U16550}
UNTIL (Not Is16550)OR(TxRead1=TxWrite1)OR(td=TxDepth);
{$ENDIF}
END;
END; { txread<>txwrite }
END; { cts signal }
END;
END; { modem line }
{컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴}
ELSE {b:=iirc};
END; { case }
RTKernel.EndOfInterrupt;
Port[MCR1]:=Port[MCR1] OR $08; { switch interrupts of UART on again }
END; { proc UARTHandler }
{袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴�}
PROCEDURE IRQInit;
VAR i :WORD;
BEGIN
FOR i:=0 TO RxBufferSize-1 DO RxBuffer1[i]:=0;
FOR i:=0 TO TxBufferSize-1 DO TxBuffer1[i]:=0;
FOR i:=0 TO RxBufferSize-1 DO ErrorBuffer1[i]:=0;
TxWrite1:=0;TxRead1:=0;
RxFree1:=RxBufferSize-16;
TxFree1:=TxBufferSize-4;
TxOnIRQ1:=FALSE;
TxStop1:=FALSE; { tx stops on CTS }
RxStop1:=FALSE; { signal stop on DTR }
RxRead1:=0;RxWrite1:=0;
END; { proc IRQInit }
{袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴�}
PROCEDURE PICInit;
BEGIN
SetIRQHandler(4,@UARTHandler1);
IRQTopPriority(4,8);
EnableIRQ(4);
END;
{袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴�}
PROCEDURE PICDone;
BEGIN
DisableIRQ(4);
END; { proc PICDone }
{袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴�}
{ initializes 16550 or 16450 or 8250 UART }
PROCEDURE UARTInit(baud:WORD;Fifosize:BYTE);
VAR Bd :WORD;
Tb :BYTE;
BEGIN
Port[IER1]:=$00; { no interrupts }
Port[LCR1]:=$80;
CASE baud OF
115 :BEGIN Port[DLL1]:=1; Port[DLM1]:=0; END;
56000:BEGIN Port[DLL1]:=2; Port[DLM1]:=0; END;
38400:BEGIN Port[DLL1]:=3; Port[DLM1]:=0; END;
19200:BEGIN Port[DLL1]:=6; Port[DLM1]:=0; END;
9600 :BEGIN Port[DLL1]:=12; Port[DLM1]:=0; END;
4800 :BEGIN Port[DLL1]:=24; Port[DLM1]:=0; END;
2400 :BEGIN Port[DLL1]:=48; Port[DLM1]:=0; END;
1200 :BEGIN Port[DLL1]:=96; Port[DLM1]:=0; END;
600 :BEGIN Port[DLL1]:=lo(192); Port[DLM1]:=hi(192); END;
300 :BEGIN Port[DLL1]:=lo(384); Port[DLM1]:=hi(384); END;
150 :BEGIN Port[DLL1]:=lo(768); Port[DLM1]:=hi(768); END;
110 :BEGIN Port[DLL1]:=lo(1047);Port[DLM1]:=hi(1047); END;
75 :BEGIN Port[DLL1]:=lo(1536);Port[DLM1]:=hi(1536); END;
50 :BEGIN Port[DLL1]:=lo(2304);Port[DLM1]:=hi(2304); END;
ELSE BEGIN Port[DLL1]:=96;Port[DLM1]:=0; END; { 1200 }
END;
Port[LCR1]:=$03; { 8 bit 1 stop no parity }
{$IFDEF U16550}
CASE Fifosize OF { set FIFO incl clear }
1 :Port[FCR1]:=$07;
4 :Port[FCR1]:=$47;
8 :Port[FCR1]:=$87;
14 :Port[FCR1]:=$C7;
ELSE Port[FCR1]:=$47;
END;
TxDepth:=FifoSize;
{$ENDIF}
TB:=Port[RBR1]; { empty receiver }
TB:=Port[MSR1]; { clear MSR irq }
TB:=Port[LSR1]; { clear LSR IRQ }
TB:=Port[IIR1]; { clear THR1 irq }
Port[MCR1]:=$0C; { RTS off,DTR off, out1+2 on }
Port[IER1]:=$0F; { enable Rx, Tx ,line and modemstatus irq }
{$IFDEF U16550}
Is16550:=((Port[IIR1] AND $C0)=$C0); { detect 16550 }
{$ELSE}
Is16550:=FALSE;
{$ENDIF}
END; { proc UARTInit }
{袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴�}
PROCEDURE UARTDone;
VAR tb :BYTE;
BEGIN
Port[MCR1]:=0;
PORT[IER1]:=0;{ disable interrupts }
TB:=Port[RBR1];
{$IFDEF U16550}
Port[FCR1]:=0;
{$ENDIF}
END; { proc UARTDone }
{袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴�}
FUNCTION IsLineOpen:BOOLEAN;
VAR b:BYTE;
BEGIN
b:=Port[MSR1];
IsLineOpen:=(((Port[MSR1] AND $10)=$10));
END;
{袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴�}
{컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�
GetBuffer this is the usual accessproc to the Rxbuffer
it copies the Ringbuffer to the specified region
컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴�}
PROCEDURE GetBuffer(VAR p:STRING);
VAR XStart,XEnd,XSize,ASize,BSize:BYTE;
BEGIN
XStart:=RxRead1;XEnd:=RxWrite1;
IF (XEnd>XStart) THEN
BEGIN
XSize:=XEnd-XStart;
Move(RxBuffer1[XStart],p[1],XSize);
END
ELSE
BEGIN
XSize:=RxBufferSize-XStart+XEnd;
ASize:=RxBufferSize-XStart;
Move(RxBuffer1[XStart],p[1],ASize);
BSize:=XSize-ASize;
Move(RxBuffer1[0],p[ASize+1],BSize);
END;
Inc(RxRead1,XSize);
Inc(RxFree1,XSize);
IF (RxFree1>16)AND RXStop1 THEN
BEGIN
RxStop1:=FALSE;
port[MCR1]:=port[MCR1] or $03; { DTR/RTS high }
END;
p[0]:=chr(XSize);
END; { proc GetBuffer }
{袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴袴�}
PROCEDURE PutBuffer(p:StrPtr);
VAR s,t:BYTE;
d:WORD;
BEGIN
s:=ord(p^[0]); { length of block }
WHILE (s>TxFree1) DO { packet too big to fit into buffer }
BEGIN
RTKERNEL.Delay(1);
IF (Not TxStop1) THEN { transmission enabled }
BEGIN
IF ((Port[LSR1]AND $20)<>0)THEN { thre empty }
BEGIN
TxOnIRQ1:=TRUE;
Port[THR1]:=TxBuffer1[TxRead1];
Inc(TxRead1); Inc(TxFree1); { includes wrap }
END;
END;
END;
d:=TxBufferSize-TxWrite1; { space to the end of the buffer }
IF (d>=s) THEN { it fits }
BEGIN
move(p^[1],TxBuffer1[TxWrite1],s);
inc(TxWrite1,s);
END
ELSE { it doesn't fit }
BEGIN
move(p^[1],TxBuffer1[TxWrite1],d);
TxWrite1:=0;
move(p^[d+1],TxBuffer1[0],s-d);
TxWrite1:=s-d;
END;
Dec(TxFree1,s);
{ block is now in buffer }
IF (Not TxStop1)AND(not TxOnIRQ1) THEN { cts is false }
BEGIN
IF ((Port[LSR1]AND $20)<>0)THEN { thre empty }
BEGIN
Port[THR1]:=TxBuffer1[TxRead1];
Inc(TxRead1); Inc(TxFree1); { includes wrap }
END;
END;
TxOnIRQ1:=TRUE;
END;
{-------------------------------------------------------}
PROCEDURE InitDrv(baud:LONGINT;Fifosize:BYTE);
BEGIN
IRQInit;
UARTInit(baud,Fifosize);
PICInit;
Port[MCR1]:=$0F; { RTS on,DTR on, out1+2 on }
{$IFDEF U16550}
IF (not IS16550) THEN
BEGIN
Writeln('WARNING : There is no 16550 UART on COM1');
Writeln(' Due to continous 9600, it reduces CPU load');
Writeln(' by buffering. The program may not work properly');
RTKernel.Delay(100);
END;
{$ENDIF}
END; { const NetworkDriver.Init }
{-------------------------------------------------------}
PROCEDURE WriteTx;
VAR i,j:WORD;
BEGIN
WriteLn('w: ',OPSTRING.hexw(txwrite1),' r: ',OPSTRING.hexw(txread1));
i:=0;
REPEAT
j:=0;
REPEAT
inc(j);
Write(OPSTRING.HexB(TxBuffer1[i]),' ');
inc(i);
UNTIL (j=16) or (i=TxBufferSize);
Writeln;
UNTIL (i=TxBufferSize);
Writeln;
END;
PROCEDURE WriteRx;
VAR i,j:WORD;
BEGIN
WriteLn('w: ',OPSTRING.hexw(Rxwrite1),' r: ',hexw(rxread1));
i:=0;
REPEAT
j:=0;
REPEAT
inc(j);
Write(OPSTRING.HexB(RxBuffer1[i]),' ');
inc(i);
UNTIL (j=16) or (i=RxBufferSize);
Writeln;
UNTIL (i=RxBufferSize);
Writeln;
END;
PROCEDURE WriteCStr(p:StrPtr);
VAR i :BYTE;
BEGIN
FOR i:=1 TO length(p^) DO Write(hexb(ord(p^[i])));
END;
PROCEDURE WriteUARTState;
BEGIN
Writeln;
Write('RBR1',hexb(port[RBR1]),' ');
Write('IER1',hexb(port[IER1]),' ');
Write('IIR1',hexb(port[IIR1]),' ');
Write('LCR1',hexb(port[LCR1]),' ');
Write('MCR1',hexb(port[MCR1]),' ');
Write('LSR1',hexb(port[LSR1]),' ');
Write('MSR1',hexb(port[MSR1]),' ');
END;
{-------------------------------------------------------}
{$F+,S-}
PROCEDURE MyExitProc;
BEGIN
ExitProc:=ExitSave;
Uartdone;
PICdone;
END;
{-------------------------------------------------------}
BEGIN { autoinit of this unit}
ExitSave:=ExitProc;
ExitProc:=@MyExitProc;
InitSemaphore(RxSema1,Counting,0,'Rxsema');
END. { unit }
home
last updated: 21.nov.99
Copyright (99,2000) Ing.Büro R.Tschaggelar