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