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 }
{哪哪哪哪哪哪