{$I compflgs}
{ ---------------------------------------------------------------------------
MCH - I got this from the internet.  It will work for real mode, but may
need some mods to handle dpmi.  Routines are used by the comport unit which
provides a stream-like/TdeviceStream access to the ports.  Seems to work
ok in dpmi too...

COM.DOC:

The unit COM.PAS enables [buffered] serial IO from any Turbo Pascal program using
interrupts supporting baudrates upto 115200 baud. It can address two COM
ports at the same time, where each port can be set individually. So you
could use it for baudrate conversions.

Exported procedures and functions are:

InitCom     - to initialize the port
ExitCom     - to clean-up the port
ComReceived - to check if a byte arrived and was stored in the buffer
ReadCom     - to get a byte from the buffer
ComAllowed  - to check if control lines and flow control allow output
WriteCom    - to write a byte to the port
BreakCom    - to give a break signal

At initialisation of the COM port, you can set the settings of the UART
(baudrate, data-length, parity and number of stop-bits) and select the
type of flow control (no, rts/cts or xon/xoff). Also the control lines DTR
and RTS will be raised. When hardware flow control is enabled, RTS will be
lowered when the input buffer gets full. Before writing a byte to the port,
the control lines can be checked. With hardware flow control CTS is part
of that check and should be raised. To check also for CD, the source must
be modified.

The terminal program TTY illustrates how the unit COM.TPU can be used. It
uses only one COM port at a time and it supports baudrates upto 38400
baud. The largest part of the coding consists of the user-interface and
only a minor part of the terminal emulator itself. It doesn't support any
fancy escape-sequences for screen handling, because it was more created
for debugging purposes.

	Turbo Pascal (version 4.0 or higher) unit for serial communication which
	is based on interrupt routines and includes buffering of incoming data.

	Features:

	- supports COM1 and COM2 in parallel
	- baudrates up to 115200 baud
	- RTS/CTS and XON/XOFF flow control

	Version 3.0 - May 1994

	Copyright 1994, Willem van Schaik - Oirschot - Netherlands

	--------------------------------------------------------------------------- }

	unit DosCom;

	interface

	uses Crt, Dos;

	type
		PortType	= (COM1, COM2);
		BaudType	= (B110, B150, B300, B600, B1200, B2400, B4800,
				 B9600, B19200, B38400, B57600, B115200);
		ParityType	= (None, Odd, Even, Mark, Space);
		LengthType	= (D5, D6, D7, D8);
		StopType	= (S1, S2);
		FlowType	= (No, RtsCts, XonXoff);

	procedure InitCom (PortNumber : PortType;
					 BaudRate : BaudType;
					 ParityBit : ParityType;
					 DataLength : LengthType;
					 StopBits : StopType;
					 FlowControl : FlowType);
	procedure ExitCom (PortNumber : PortType);
	function  ComReceived (PortNumber : PortType) : boolean;
  function  ReadCom (PortNumber : PortType) : char;
  function  ComAllowed (PortNumber : PortType) : boolean;
  procedure WriteCom (PortNumber : PortType; OutByte : char);
  procedure BreakCom (PortNumber : PortType);

  implementation

  type
    IntBlock = record
      IntOldIP : integer;
      IntOldCS : integer;
      IntNumber : byte;
    end;

    INS8250 = record
      DLL : integer;  { divisor latch low register (if LCR bit7 = 1) }
      DLH : integer;  { divisor latch high register (if LCR bit7 = 1) }
			THR : integer;  { transmit holding register }
      RBR : integer;  { receive holding register }
      IER : integer;  { interrupt enable register }
      LCR : integer;  { line control register }
      MCR : integer;  { modem control register }
      LSR : integer;  { line status register }
      MSR : integer;  { modem status register }
    end;

  const
    IntDS : integer = 0;
    ComPort : array [COM1..COM2] of INS8250 =
      ((DLL : $3F8 ; DLH : $3F9 ; THR : $3F8 ; RBR : $3F8 ;
        IER : $3F9 ; LCR : $3FB ; MCR : $3FC ; LSR : $3FD ; MSR : $3FE),
       (DLL : $2F8 ; DLH : $2F9 ; THR : $2F8 ; RBR : $2F8 ;
        IER : $2F9 ; LCR : $2FB ; MCR : $2FC ; LSR : $2FD ; MSR : $2FE));
    { size of the input buffer and the amount of free space to disable flow
      from the other side and to enable it again }
    ComBufferSize = 4096;
    ComFlowLower = 256;
    ComFlowUpper = 1024;

  var
    ComBuffer : array [COM1 .. COM2, 0..(ComBufferSize-1)] of byte;
    ComBufferHead, ComBufferTail : array [COM1 .. COM2] of integer;
    ComFlowControl : array [COM1 .. COM2] of FlowType;
    ComFlowHalted : array [COM1 .. COM2] of boolean;
    ComXoffReceived : array [COM1 .. COM2] of boolean;
    ComBlock : array [COM1 .. COM2] of IntBlock;

{ ---------------------------------------------------------------------------
  InstallComInt

  To install an interrupt routine, first the old routine vector is read and
  stored using function 35 hex. Next the new routine is installed using
  function 25 hex.
  --------------------------------------------------------------------------- }

  procedure InstallComInt (IntNumber : byte; IntHandler : integer;
                           var Block : IntBlock);
  var
    Regs : Registers;

  begin
    IntDS := DSeg;
    Block.IntNumber := IntNumber;
    Regs.AH := $35;
    Regs.AL := IntNumber;
    MSDos (Dos.Registers(Regs));
    Block.IntOldCS := Regs.ES;
    Block.IntOldIP := Regs.BX;
    Regs.AH := $25;
    Regs.AL := IntNumber;
    Regs.DS := CSeg;
    Regs.DX := IntHandler;
    MSDos (Dos.Registers(Regs));
  end;

{ ---------------------------------------------------------------------------
  UnInstallComInt

  Uninstalling the interrupt routine is done by resetting the old interrupt
  vector using function 25.
  --------------------------------------------------------------------------- }

  procedure UnInstallComInt (var Block : IntBlock);

  var
		Regs : Registers;

  begin
    Regs.AH := $25;
    Regs.AL := Block.IntNumber;
    Regs.DS := Block.IntOldCS;
    Regs.DX := Block.IntOldIP;
    MSDos (Dos.Registers(Regs));
  end;

{ ---------------------------------------------------------------------------
  Com1IntHandler

  This routine is installed as the interrupt routine by InstallComInt, which
  in its turn is called by InitCom at initialisation of the unit.

  When a byte arrives at the COM-port, first action is to get the byte from
  the UART register and store it the buffer. Next the buffer pointer is
  increased. Depending on flow control being enabled or not, it is checked if
  the free space has become less then ComFlowLower and if that is the case the
  other party (the DCE) is signalled to stop transmitting data.

  When the type of flow control specified at calling InitCom is RtsCts (this
  is hardware flow control), the RTS bit of the MCR register is lowered. If
  flow control is XonXoff (software flow control), an XOFF character (13 hex)
  is send to the other party by calling WriteCom.

  Finally the routine must be ended with a CLI instruction and the interrupt
  flags must be cleared.
  --------------------------------------------------------------------------- }

  procedure Com1IntHandler (Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP : word);
  interrupt;

  begin
    ComBuffer[COM1, ComBufferHead[COM1]] := Port[ComPort[COM1].RBR];
		if ComFlowControl[COM1] = No then
    begin
      ComBufferHead[COM1] := (ComBufferHead[COM1] + 1) mod ComBufferSize;
    end
    else { when flow control increase buffer pointer later }
    begin
      { check for incoming XON/XOFF }
      if ComFlowControl[COM1] = XonXoff then
      begin
        if ComBuffer[COM1, ComBufferHead[COM1]] = $11 then { XON }
          ComXoffReceived[COM1] := false
        else if ComBuffer[COM1, ComBufferHead[COM1]] = $13 then { XOFF }
          ComXoffReceived[COM1] := true;
      end;
      ComBufferHead[COM1] := (ComBufferHead[COM1] + 1) mod ComBufferSize;
      { check if outgoing must be temporized }
      if not ComFlowHalted[COM1] then
        if (ComBufferHead[COM1] >= ComBufferTail[COM1]) and
  	(ComBufferTail[COM1] - ComBufferHead[COM1] + ComBufferSize < ComFlowLower) or
  	(ComBufferHead[COM1] < ComBufferTail[COM1]) and
  	(ComBufferTail[COM1] - ComBufferHead[COM1] < ComFlowLower) then
        begin { buffer gets too full }
  	if ComFlowControl[COM1] = RtsCts then
  	  Port[ComPort[COM1].MCR] := Port[ComPort[COM1].MCR] and $FD { lower RTS }
  	else if ComFlowControl[COM1] = XonXoff then
  	  WriteCom (COM1, #$13); { send XOFF }
  	ComFlowHalted[COM1] := true;
        end;
    end;
    inline ($FA);                         { CLI }
    Port[$20] := $20;                     { clear interrupt flag }
  end;

{ ---------------------------------------------------------------------------
  Com2IntHandler

	This routine is identical to Com1IntHandler, only for COM2.
  --------------------------------------------------------------------------- }

  procedure Com2IntHandler (Flags, CS, IP, AX, BX, CX, DX, SI, DI, DS, ES, BP : word);
  interrupt;

  begin
    ComBuffer[COM2, ComBufferHead[COM2]] := Port[ComPort[COM2].RBR];
    if ComFlowControl[COM2] = No then
    begin
      ComBufferHead[COM2] := (ComBufferHead[COM2] + 1) mod ComBufferSize;
    end
    else { when flow control increase buffer pointer later }
    begin
      { check for incoming XON/XOFF }
      if ComFlowControl[COM2] = XonXoff then
      begin
        if ComBuffer[COM2, ComBufferHead[COM2]] = $11 then { XON }
          ComXoffReceived[COM2] := false
        else if ComBuffer[COM2, ComBufferHead[COM2]] = $13 then { XOFF }
          ComXoffReceived[COM2] := true;
      end;
      ComBufferHead[COM2] := (ComBufferHead[COM2] + 1) mod ComBufferSize;
      { check if outgoing must be temporized }
      if not ComFlowHalted[COM2] then
        if (ComBufferHead[COM2] >= ComBufferTail[COM2]) and
  	(ComBufferTail[COM2] - ComBufferHead[COM2] + ComBufferSize < ComFlowLower) or
  	(ComBufferHead[COM2] < ComBufferTail[COM2]) and
  	(ComBufferTail[COM2] - ComBufferHead[COM2] < ComFlowLower) then
        begin { buffer gets too full }
  	if ComFlowControl[COM2] = RtsCts then
  	  Port[ComPort[COM2].MCR] := Port[ComPort[COM2].MCR] and $FD { lower RTS }
  	else if ComFlowControl[COM2] = XonXoff then
  	  WriteCom (COM2, #$13); { send XOFF }
  	ComFlowHalted[COM2] := true;
        end;
		end;
    inline ($FA);                         { CLI }
    Port[$20] := $20;                     { clear interrupt flag }
  end;

{ ---------------------------------------------------------------------------
  InitCom;

  For each of the COM ports that will be used, this routine must be called
  to initialize the UART and to install the interrrupt routine. The first
  five parameters define the serial protocol (baudrate B150..B11500, parity
  None..Space, length D5..D8 and number of stop bits S1 or S2). The last
  parameter specifies the type of flow control, with allowed values No,
  RtsCts and XonXoff.

  The control signals DTR and RTS of the COM port (plus the OUT2 signal, which
  is used by some internal modems) are raised to signal the other end of the
  line that the port is ready to receive data.
  --------------------------------------------------------------------------- }

  procedure InitCom; { (PortNumber : PortType;
  		        BaudRate : BaudType;
                        ParityBit : ParityType;
  		        DataLength : LengthType;
  		        StopBits : StopType;
  		        FlowControl : FlowType); }
  const
    BaudReg : array [B110 .. B115200] of word =
      ($0417, $0300, $0180, $00C0, $0060, $0030,
       $0018, $000C, $0006, $0003, $0002, $0001);
    ParityReg : array [None..Space] of byte =
      ($00, $08, $18, $28, $38);
    LengthReg : array [D5 .. D8] of byte =
      ($00, $01, $02, $03);
    StopReg : array [S1 .. S2] of byte =
      ($00, $04);

  var
    Regs : Registers;

  begin
    { enable the interrupt (IRQ4 resp. IRQ3) for the specified COM port, by
      resetting the bits in the Interrupt Mask Register of the 8259 interrupt
      controller }
    if PortNumber = COM1 then
    begin
      InstallComInt($0C, Ofs(Com1IntHandler), ComBlock[COM1]);
      Port[$21] := Port[$21] and $EF
    end
    else if PortNumber = COM2 then
    begin
      InstallComInt($0B, Ofs(Com2IntHandler), ComBlock[COM2]);
      Port[$21] := Port[$21] and $F7
    end;

    Port[ComPort[PortNumber].LCR] := $80; { switch to write latch reg }
    Port[ComPort[PortNumber].DLH] := Hi (BaudReg [BaudRate]);
    Port[ComPort[PortNumber].DLL] := Lo (BaudReg [BaudRate]);
    Port[ComPort[PortNumber].LCR] := $00 or
  				   ParityReg [ParityBit] or
  				   LengthReg [DataLength] or
  				   StopReg [StopBits];
    Port[ComPort[PortNumber].IER] := $01; { enable interrupts }
    Port[ComPort[PortNumber].MCR] := $01 or { raise DTR }
  			           $02 or { raise RTS }
  				   $08;   { raise OUT2 }
    ComBufferHead[PortNumber] := 0;
    ComBufferTail[PortNumber] := 0;
    ComFlowControl[PortNumber] := FlowControl;
    ComFlowHalted[PortNumber] := false;
    ComXoffReceived[PortNumber] := false;
  end;

{ ---------------------------------------------------------------------------
  ExitCom;

  This routine must be called for each COM port in use, to remove the
  interrupt routine and to reset the control lines.
  --------------------------------------------------------------------------- }

  procedure ExitCom; { (PortNumber : PortType) }

  var
    Regs : Registers;

  begin
    { disable the interrupt (IRQ4 resp. IRQ3) for the specified COM port, by
      setting the bits in the Interrupt Mask Register of the 8259 interrupt
      controller }
    if PortNumber = COM1 then
      Port[$21] := Port[$21] or $10
    else if PortNumber = COM2 then
      Port[$21] := Port[$21] or $08;

    Port[ComPort[PortNumber].LCR] := Port[ComPort[PortNumber].LCR] and $7F;
    Port[ComPort[PortNumber].IER] := 0; { disable interrupts }
    Port[ComPort[PortNumber].MCR] := 0; { lower DTR, RTS and OUT2 }
    UnInstallComInt(ComBlock[PortNumber]);
  end;

{ ---------------------------------------------------------------------------
  ComReceived;

  When the head and tail pointer (for writing resp. reading bytes) are not
  pointing to the same byte in the buffer, a byte has arrived from the UART
  and was stored in the buffer by the interrupt routine.
  --------------------------------------------------------------------------- }

	function ComReceived; { (PortNumber : PortType) : boolean; }

  begin
    ComReceived := ComBufferHead[PortNumber] <> ComBufferTail[PortNumber];
  end;

{ ---------------------------------------------------------------------------
  ReadCom;

  Calling this function will wait for a byte in the buffer (if there is not
  yet one present) and then return it. The tail buffer pointer is increased
  and if flow from the other side was stopped, a check is made if the free
  space has again become more then ComFlowUpper. In that situation, depending
  on the type of flow control, either the RTS line is raised or and XON byte
  (11 hex) is send to the other party.
  --------------------------------------------------------------------------- }

  function ReadCom; { (PortNumber : PortType) : char; }

  begin
    while ComBufferHead[PortNumber] = ComBufferTail[PortNumber] do Delay(10);
    ReadCom := char(ComBuffer[PortNumber, ComBufferTail[PortNumber]]);
    ComBufferTail[PortNumber] := (ComBufferTail[PortNumber] + 1) mod ComBufferSize;
    if (ComFlowControl[PortNumber] <> No) and ComFlowHalted[PortNumber] then
      if (ComBufferHead[PortNumber] >= ComBufferTail[PortNumber]) and
        (ComBufferTail[PortNumber] - ComBufferHead[PortNumber] + ComBufferSize > ComFlowUpper) or
        (ComBufferHead[PortNumber] < ComBufferTail[PortNumber]) and
        (ComBufferTail[PortNumber] - ComBufferHead[PortNumber] > ComFlowUpper) then
      begin { buffer has emptied enough }
        if ComFlowControl[PortNumber] = RtsCts then
  	Port[ComPort[PortNumber].MCR] := Port[ComPort[PortNumber].MCR] or $02 { raise RTS }
        else if ComFlowControl[PortNumber] = XonXoff then
  	WriteCom (PortNumber, #$11); { send XON }
        ComFlowHalted[PortNumber] := false;
      end;
  end;

{ ---------------------------------------------------------------------------
  ComAllowed;

  With this function it is possible to check if writing data to the COM port
  is allowed. When there is no flow control no check is made on any control
  line and the result will always be true. When hardware type flow control is
  enabled, DSR (and CD) and CTS must be high. In case of software flow
  control DSR must be high and a check is made if an XOFF byte was received.
  --------------------------------------------------------------------------- }

  function  ComAllowed; { (PortNumber : PortType) : boolean; }

  begin
    ComAllowed := true;
    if (ComFlowControl[PortNumber] = RtsCts) then
    begin
      { replace in next line both $30 with $B0 for checking on CD, DSR and CTS }
      if ((Port[ComPort[PortNumber].MSR] and $30) <> $30) then { no DSR or CTS }
        ComAllowed := false;
    end
    else if (ComFlowControl[PortNumber] = XonXoff) then
    begin
      { replace in next line both $20 with $A0 for checking on CD and DSR }
      if ((Port[ComPort[PortNumber].MSR] and $20) <> $20) or { no DSR }
         (ComXoffReceived[PortNumber]) then { XOFF received }
        ComAllowed := false;
    end
  end;

{ ---------------------------------------------------------------------------
  WriteCom;

  This routine is to write a byte to the COM port. However, when necessary
  this will be delayed until the previous output byte is out the the UART.
  --------------------------------------------------------------------------- }

  procedure WriteCom; { (PortNumber : PortType; OutByte : char); }

  begin
    while ((Port[ComPort[PortNumber].LSR] and $20) <> $20) do  { TD empty }
      Delay(1);
    Port[ComPort[PortNumber].THR] := byte(OutByte);
  end;

{ ---------------------------------------------------------------------------
  BreakCom;

  With this routine the TD line can be lowered for 200 msec, which is a so-
  called break signal.
  --------------------------------------------------------------------------- }

  procedure BreakCom; { (PortNumber : PortType); }

  begin
    Port[ComPort[PortNumber].LCR] := Port[ComPort[PortNumber].LCR] or $40;
    Delay (200);  { 0.2 seconds }
    Port[ComPort[PortNumber].LCR] := Port[ComPort[PortNumber].LCR] and $BF;
  end;

  end.

{ ---------------------------------------------------------------------------
  end of COM.PAS
  --------------------------------------------------------------------------- }
