Power-Programmierung/CD1.mdf/pascal/library/dos/communic/yasync.pas

Pascal/Delphi Source File | 1987-12-21 | 39.8 KB | 1,081 lines

{$R-,S-,I-,D+,T+,F-,V+,B-,N-,L+ }
Unit YAsync; { Version 1.4 }
{
  "Yet another" set of Async routines.  This unit supports concurrent
  use of one to four 8250 Asynchronous communications ports with transmit and
  receive buffer interrupt support and flexible handshaking options at the
  interrupt level.  Upon program termination, all open ports are closed
  and interrupt vectors returned to their former values.

  Copyright 1987 by Edwin Floyd [76067,747]
                    4210 Pickering Dr.
                    Columbus, GA 31907
                    (404) 563 - 9915

  All rights reserved; non-commercial use Ok.

  Update History

  1.0 10-12-87 E. Floyd, Initial implementation and testing complete
  1.1 11-22-87 E. Floyd, Added handshaking options, changed name to YAsync
  1.2 11-29-87 E. Floyd, Separated handshaking options, changed irpt handler
  1.3 12-19-87 E. Floyd, Removed polling support, changed buffer spec.
  1.4 12-21-87 E. Floyd, Documented for upload to C'Serv, added buflen funcs
}
Interface

Uses Dos, Crt;

Const
  YasyncVersion = 14; { Current version * 10 }
  MaxPorts = 4;       { Maximum number of ports supported }
  DefaultBufferSize = 2048; { Default size of receive & transmit buffers }
  BaudRateDividend : LongInt = 115200; { Used to compute baud rate divisor }
  TimeoutMilliseconds : LongInt = 1000; { Retry Send until timeout ms }
  BreakMiliseconds : Word = 300; { Duration of break signal }

  { These constants define the bits for the Line Status Register }
  LSRRcvReady = $01;  { Received data ready }
  LSROverrun  = $02;  { OverRun error }
  LSRParity   = $04;  { Parity error }
  LSRFrame    = $08;  { Framing error }
  LSRBreak    = $10;  { Break detected }
  LSRXhReady  = $20;  { Transmit hold register empty }
  LSRXsReady  = $40;  { Transmit shift register empty }
  LSRTimeout  = $80;  { Time out (software implemented) }

  { These constants define the bits for the Modem Status Register }
  MSRctsDelta = $01;  { Clear To Send changed }
  MSRdsrDelta = $02;  { DataSet Ready changed }
  MSRriDelta  = $04;  { Ring Indicate changed }
  MSRcdDelta  = $08;  { Carrier Detect changed }
  MSRcts      = $10;  { Clear To Send }
  MSRdsr      = $20;  { DataSet Ready }
  MSRri       = $40;  { Ring Indicate }
  MSRcd       = $80;  { Carrier Detect }

Type
  AsyncBuffer = Array[0..32767] Of Byte;
  {
    Note, AsyncBuffer is for the buffer pointer declarations below.  The actual
    buffer size is specified in Async_Control.
  }
  Async_Control = Record
  {
    This record contains control information used to manage the activity of
    a port.  Certain fields may be altered before calling OpenPort.  These
    are marked with an "*" in the comments.  For instance...

      With AsyncPort[2] Do Begin
        ReceiveSize := 10000;
        TransmitSize := 8000;
        WaitForXon := True;
        XoHand := True;
        XoTransparent := False;
      End;
      OpenPort(2, 9600, 7, 1, 'E');

    ...sets buffer sizes and Xon/Xoff handshaking for COM2 and opens COM2 at
    9600 bps, 7 bits, 1 stop bit, even parity.  Fields not marked with "*"
    in comments are used internally by YAsync; do not alter these fields.
    Do not alter any fields while a port is open.
  }
    PortOpen : Boolean;       { True if port is currently open }
    VectorIndex : Byte;       { Index to interrupt vector save area }

    IrqNumber : Byte;         { *IRQ number }
    IntNumber : Byte;         { *Interrupt number }
    BasePort : Word;          { *Base I/O port for UART }
    {
      The IRQ, Interrupt and base port numbers are set to default values during
      initialization.  The defaults (see implementation Const's for details)
      should be appropriate for most systems, but they may be reset if
      necessary before calling OpenPort.
    }
    LineStatus : Byte;        { Line status register for ErrorRoutine,
                                  Decode with LSRxxx constants above }
    ModemStatus : Byte;       { Modem status register for ModemRoutine,
                                  Decode with MSRxxx constants above }
    UserData : Word;          { This field is unused by YAsync routines }

    WaitForXon : Boolean;     { *Inhibit transmit between Xoff and Xon }
    WaitForCts : Boolean;     { *Inhibit transmit if not Cts }
    WaitForDsr : Boolean;     { *Inhibit transmit if not Dsr }
    WaitForCd  : Boolean;     { *Inhibit transmit if not Cd }
    XoHand : Boolean;         { *Handshake receive buffer with Xon/Xoff }
    RtsHand : Boolean;        { *Handshake receive buffer with Rts }
    DtrHand : Boolean;        { *Handshake receive buffer with Cts }
    XoTransparent : Boolean;  { *Pass Xon/Xoff through to data stream }
    {
      If XoTransparent is False, Xon and Xoff characters are not placed in
      the receive buffer (they will still have their handshaking effect if
      WaitForXon is True).  The defaults are:
        WaitForXon = False
        WaitForCts = False
        WaitForDsr = False
        WaitForCd = False
        XoHand = False
        RtsHand = True
        DtrHand = False
        XoTransparent = True
    }
    TransmitEnabled : Boolean;{ If False, transmit is inhibited }
    SenderEnabled : Boolean;  { Handshake signal was sent to sender }
    AwaitingXon : Boolean;    { True if waiting for Xon }
    AwaitingCts : Boolean;    { True if waiting for Cts }
    AwaitingDsr : Boolean;    { True if waiting for Dsr }
    AwaitingCd  : Boolean;    { True if waiting for Cd }
    AwaitingCh  : Boolean;    { True if waiting for character to transmit }
    StreamInsert : Byte;      { Character to be forced into output stream }

    ErrorRoutine : Pointer;   { *Pointer to routine for line status interrupt }
    ModemRoutine : Pointer;   { *Pointer to routine for modem status intrpt }
    {
      These routines must be declared as Far-calls ($F+) at the global level
      with a one-Word value parameter, the port number.  Do NOT declare
      them as "Interrupt" type procedures.  These routines, though not
      "Interrupt" type routines, are called from the interrupt service routine,
      therefore they should follow the same rules as an ISR - no DOS services,
      reentrant, etc.  ErrorRoutine should examine LineStatus to determine the
      cause of the error; ModemRoutine should examine ModemStatus.
    }
    ReceiveBuffer : ^AsyncBuffer;  { *Receive buffer }
    ReceiveSize : Word;            { *0..32767 }
    ReceiveHead : Word;
    ReceiveTail : Word;
    TransmitBuffer : ^AsyncBuffer; { *Transmit buffer }
    TransmitSize : Word;           { *0..32767 }
    TransmitHead : Word;
    TransmitTail : Word;
    ReleaseReceive : Boolean; { YAsync obtained receive buffer, must release }
    ReleaseTransmit : Boolean;{ Ditto, transmit buffer }
    {
      Buffers are allocated from the heap if the corresponding pointer is Nil
      when OpenPort is called.  You may allocate a buffer yourself and place
      its address in ReceiveBuffer or TransmitBuffer, and its size in
      ReceiveSize or TransmitSize.  Alternatively, you may change the size of
      the automatically allocated buffer by changing ReceiveSize or
      TransmitSize before calling OpenPort.
    }
  End;

  SetOfChar = Set of Char; { Used by LineReadPort below }

Var
  AsyncPort: Array[1..MaxPorts] Of Async_Control;
  PortOpenError : Byte;  { Error code from open routine..
                           0 Normal, open successful
                           1 Port number out of range (1..4)
                           2 Baud rate out of range (50..115200)
                           3 Word length out of range (5..8)
                           4 Stop bits out of range (1..2)
                           5 Invalid parity (N,E,O,1,0)
                           6 Buffer size invalid (2..32767)
                           7 Insufficient heap space for buffers
                           8 UART not responding
                           9 Program bug - should never happen
                         }

Function OpenPort(ComPort : Word;     { Com port number, 1..4 }
                  BaudRate : LongInt; { BPS, 50..115200 }
                  WordLength : Word;  { 5..8 bits }
                  StopBits : Word;    { 1..2 stop bits }
                  Parity : Char      { N,E,O,1,0 }
                  ) : Boolean;        { Return True if open successful }
{ Prepare port for communications.  Baud rate may be any number from
  50..115200; the actual steady-state baud rate that can be maintained without
  overruns depends on the cpu speed in response to interrupts.  A 4.77 Mhz,
  8088 XT can handle up to about 10000.  If WordLength is 5 and StopBits is 2,
  the actual stop bits used will be 1.5.  If OpenPort fails, it returns False
  and places an error code in PortOpenError above. }

Procedure ClosePort(ComPort : Word);
{ Close async port, reset interrupts and release buffers.  If buffered output
  is in progress, ClosePort will wait for its completion.  ClosePort turns
  off the DTR and RTS modem control signals. }

Procedure ClearTransmitBuffer(ComPort : Word);
{ Discard all unsent characters in the transmit buffer. }

Procedure ClearReceiveBuffer(ComPort : Word);
{ Discard all unread characters in the receive buffer. }

Function ReceiveBufferUsed(ComPort : Word) : Word;
{ Returns the number of receive buffer bytes in use }

Function TransmitBufferUsed(ComPort : Word) : Word;
{ Returns the number of transmit buffer bytes in use }

Function SendPort(ComPort : Word; Ch : Char ) : Boolean;
{ Send a character (or place it in transmit buffer).  Return True if
  successful.  This rouine will wait up to TimeoutMilliseconds for buffer
  space to become available. }

Function BlockSendPort(ComPort : Word; Var Block; BlkLen : Word) : Word;
{ Move a block of characters to the buffer and return the number of characters
  inserted in buffer.  This function does not wait for buffer space to become
  available - it always returns immediately. }

Function BlockSendPortWait(ComPort : Word; Var Block; BlkLen : Word) : Word;
{ Send a block of characters; return the number of characters sent.  This
  function will wait TimeoutMilliseconds between characters sent if not enough
  buffer space is available.  As soon as the remainder of the message will
  fit in the buffer, this routine returns (maybe immediately if the entire
  message fits). Otherwise, if TimeoutMilliseconds elapses without a single
  character being transmitted (may happen if handshaking is asserted), this
  routine signals a timeout error and returns the number of bytes
  successfully loaded into the buffer. }

Function PortReady(ComPort : Word) : Boolean;
{ Returns True if a character is waiting in the receive buffer or RBR. }

Function ReadPort(ComPort : Word; Var Ch) : Boolean;
{ Returns received character from buffer, returns False if none ready. }

Function BlockReadPort(ComPort : Word; Var Block; BlkLen : Word) : Word;
{ Read a block of characters from the port and return number of characters
  read.  This function does not wait for characters to appear in the buffer;
  it transfers any characters which might be present, up to BlkLen, and returns
  the number of characters transferred.}

Function BlockReadPortDelim(ComPort : Word; Var Block; BlkLen : Word;
  Delim : SetOfChar) : Word;
{ Read a block of characters from the port and return number of characters
  read.  This function reads characters from the port until either: 1. BlkLen
  characters have been read; 2. A character appearing in Delim has been read
  (The Delim character appears in the buffer and is included in the count); or
  3. TimeoutMilliseconds has elapsed since the last character received
  (LSRTimeout bit set in LineStatus and ErrorRoutine called if present). }

Procedure SendBreak(ComPort : Word);
{ Send break signal for BreakMiliseconds.  If buffered output is in progress,
  SendBreak will wait for its completion before sending the break signal. }

Procedure SetDTR(ComPort : Word; Dtr : Boolean);
{ Set DTR on/off - WARNING: When DtrHand is True, DTR is turned off
  by the interrupt handler when the receive buffer exceeds 75% full, and
  turned back on by ReadPort when the receive buffer falls below 50% full.
  Use of this procedure may interfere with automatic DTR handshaking. }

Procedure SetRTS(ComPort : Word; Rts : Boolean);
{ Set RTS on/off - WARNING: This signal is also controlled by the state of the
  receive buffer when RtsHand is True.  Use of this procedure may interfere
  with automatic RTS handshaking.}

Procedure SetLoop(ComPort : Word; Loop : Boolean);
{ Set LoopBack on/off - WARNING: Setting LoopBack on disables interrupts
  from the 8250 UART! (It apparently disconnects OUT2 from the PC bus.) }

Implementation

Const
  { These are the offsets from BasePort of the 8250 control registers }
  DLL = 0; { Divisor Latch Least-significant-byte (LCR bit $80 on) }
  DLM = 1; { Divisor Latch Most-significant-byte (LCR bit $80 on) }
  RBR = 0; { Receiver Buffer Register (read) }
  THR = 0; { Transmitter Holding Register (write) }
  IER = 1; { Interrupt Enable Register }
  IIR = 2; { Interrupt Identification Register (read only) }
  LCR = 3; { Line Control Register }
  MCR = 4; { Modem Control Register }
  LSR = 5; { Line Status Register }
  MSR = 6; { Modem Status Register }

  { These constants define the bits for the Modem Control Register }
  MCRloop     = $10; { Loopback mode }
  MCRout2     = $08; { Out2, must be on for interrupts }
  MCRout1     = $04; { Out1 ? }
  MCRrts      = $02; { Request to send }
  MCRdtr      = $01; { Data terminal ready }

  { These are the default base ports, IRQs and interrupts }
  BasePorts : Array[1..MaxPorts] Of Word = ($03F8,$02F8,$03E8,$02E8);
  IRQs : Array[1..MaxPorts] Of Byte = (4,3,4,3);
  Interrupts : Array[1..MaxPorts] Of Byte = (12,11,12,11);

  XOn  = 17; {^Q, DC1, XOn }
  XOff = 19; {^S, DC3, XOff }

Type
  VectorType = Record
    UseCount : Byte;  { Number of ports using this interrupt vector }
    IntrptNo : Byte;  { Interrupt number for this vector }
    Vector : Pointer; { Old value of vector }
    NextPort : Word;  { Next port to process }
    PortList : Array[0..MaxPorts] Of Word; { Open ports using this vector }
  End;

Var
  FormerExitProc : Pointer; { Save area for ExitProc pointer }
  VectorSave : Array[1..MaxPorts] Of VectorType;

Procedure CallFar(ComPort : Word; proc : Pointer);
{ Call proc, reentrant far call, works even when @proc is in a record.
  Far proc may only be declared globally. }
InLine($5B/          { pop bx   ; save @proc in cx:bx }
       $59/          { pop cx }
       $0E/          { push cs  ; set up return address }
       $E8/$00/$00/  { call $ }
       $58/          { pop ax }
       $05/$08/$00/  { add ax,8 }
       $50/          { push ax }
       $51/          { push cx  ; restore @proc to stack }
       $53/          { push bx }
       $CB);         { retf     ; go to proc }

Procedure DisableInterrupts;
{ Disable 80x86/8 interrupts }
Inline($FA);

Procedure EnableInterrupts;
{ Enable 80x86/8 interrupts }
Inline($FB);

Function ReceiveBufferUsed(ComPort : Word) : Word;
{ Return number of receive buffer bytes used }
Begin { ReceiveBufferUsed }
  With AsyncPort[ComPort] Do Begin
    DisableInterrupts;
    If ReceiveHead < ReceiveTail Then
      ReceiveBufferUsed := (ReceiveSize-ReceiveTail)+ReceiveHead
    Else ReceiveBufferUsed := ReceiveHead-ReceiveTail;
    EnableInterrupts;
  End;
End;  { ReceiveBufferUsed }

Function TransmitBufferUsed(ComPort : Word) : Word;
{ Return number of transmit buffer bytes used }
Begin { TransmitBufferUsed }
  With AsyncPort[ComPort] Do Begin
    DisableInterrupts;
    If TransmitHead < TransmitTail Then
      TransmitBufferUsed := (TransmitSize-TransmitTail)+TransmitHead
    Else TransmitBufferUsed := TransmitHead-TransmitTail;
    EnableInterrupts;
  End;
End;  { TransmitBufferUsed }

Procedure SetDTR(ComPort : Word; Dtr : Boolean);
{ Set DTR on/off }
Begin { SetDTR }
  With AsyncPort[ComPort] Do Begin
    If Dtr Then
      Port[BasePort+MCR] := Port[BasePort+MCR] Or MCRdtr
    Else
      Port[BasePort+MCR] := Port[BasePort+MCR] And Not MCRdtr;
  End;
End;  { SetDTR }

Procedure SetRTS(ComPort : Word; Rts : Boolean);
{ Set RTS on/off }
Begin { SetRTS }
  With AsyncPort[ComPort] Do Begin
    If Rts Then
      Port[BasePort+MCR] := Port[BasePort+MCR] Or MCRrts
    Else
      Port[BasePort+MCR] := Port[BasePort+MCR] And Not MCRrts;
  End;
End;  { SetRTS }

Procedure EnableTransmit(ComPort : Word);
{ Enable buffered transmit, restart interrupt if necessary }
Begin { EnableTransmit }
  With AsyncPort[ComPort] Do Begin
    TransmitEnabled := True;
    DisableInterrupts;
    If (TransmitHead <> TransmitTail) And AwaitingCh Then Begin
      Port[BasePort+THR] := TransmitBuffer^[TransmitTail];
      TransmitTail := Succ(TransmitTail);
      If TransmitTail = TransmitSize Then TransmitTail := 0;
    End;
    EnableInterrupts;
  End;
End;  { EnableTransmit }

Procedure EnableSender(ComPort : Word);
{ Enable sender via handshaking signal }
Begin { EnableSender }
  With AsyncPort[ComPort] Do Begin
    If Not SenderEnabled Then Begin
      If XoHand Then Begin
        DisableInterrupts;
        If AwaitingCh Then Port[BasePort+THR] := XOn
        Else StreamInsert := XOn;
        EnableInterrupts;
      End;
      If DtrHand Then SetDtr(ComPort, True);
      If RtsHand Then SetRts(ComPort, True);
      SenderEnabled := True;
    End;
  End;
End;  { EnableSender }

Procedure DisableSender(ComPort : Word);
{ Disable sender via handshaking signal }
Begin { DisableSender }
  With AsyncPort[ComPort] Do Begin
    If SenderEnabled Then Begin
      If XoHand Then Begin
        DisableInterrupts;
        If AwaitingCh Then Port[BasePort+THR] := XOff
        Else StreamInsert := XOff;
        EnableInterrupts;
      End;
      If DtrHand Then SetDtr(ComPort, False);
      If RtsHand Then SetRts(ComPort, False);
      SenderEnabled := False;
    End;
  End;
End;  { DisableSender }

Procedure ClearTransmitBuffer(ComPort : Word);
{ Discard all unsent characters in the transmit buffer. }
Begin { ClearTransmitBuffer }
  With AsyncPort[ComPort] Do Begin
    DisableInterrupts;
    TransmitHead := 0;
    TransmitTail := 0;
    EnableInterrupts;
  End;
End;  { ClearTransmitBuffer }

Procedure ClearReceiveBuffer(ComPort : Word);
{ Discard all unsent characters in the receive buffer. }
Begin { ClearReceiveBuffer }
  With AsyncPort[ComPort] Do Begin
    DisableInterrupts;
    ReceiveHead := 0;
    ReceiveTail := 0;
    EnableInterrupts;
    EnableSender(ComPort);
  End;
End;  { ClearReceiveBuffer }

Procedure AsyncISR(VectorNo : Word);
{ General Interrupt Handler (called by specific interrupt procs below) }
Var
  i, Next, ComPort : Word;
  work : Byte;
  done : Boolean;
Begin { AsyncISR }
  EnableInterrupts;
  With VectorSave[VectorNo] Do Begin
    Inc(NextPort);
    If NextPort > UseCount then NextPort := 1;
    i := NextPort;
    Repeat
      ComPort := PortList[i];
      With AsyncPort[ComPort] Do Begin
        done := False;
        Repeat
          Case Port[BasePort+IIR] Of
            $06 : Begin { Received character error or break }
              LineStatus := Port[BasePort+LSR];
              If (LineStatus And LSRBreak) <> 0 Then Begin
                LineStatus := LineStatus And Not LSRFrame;
                work := Port[BasePort+RBR];
              End;
              If ErrorRoutine <> Nil Then CallFar(ComPort, ErrorRoutine);
            End;
            $04 : Begin { Received data ready }
              work := Port[BasePort+RBR];
              If XoTransparent Or ((work <> XOff) And (work <> XOn)) Then Begin
                next := Succ(ReceiveHead);
                If next = ReceiveSize Then next := 0;
                If next = ReceiveTail Then Begin
                  LineStatus := LSROverrun;
                  If ErrorRoutine <> Nil Then CallFar(ComPort, ErrorRoutine);
                End Else Begin
                  ReceiveBuffer^[ReceiveHead] := work;
                  ReceiveHead := next;
                End;
                If (XoHand Or RtsHand Or DtrHand) And SenderEnabled Then Begin
                  If ReceiveHead < ReceiveTail Then
                    next := (ReceiveSize-ReceiveTail)+ReceiveHead
                  Else next := ReceiveHead-ReceiveTail;
                  If next > (ReceiveSize - (ReceiveSize Shr 2)) Then
                    DisableSender(ComPort);
                End;
              End;
              If WaitForXon Then Begin
                Case work Of
                  XOff : Begin
                    TransmitEnabled := False;
                    AwaitingXon := True;
                  End;
                  XOn : Begin
                    AwaitingXon := False;
                    If Not (AwaitingCts Or AwaitingDsr Or AwaitingCd) Then
                      EnableTransmit(ComPort);
                  End;
                End;
              End;
            End;
            $02 : Begin { Transmit holding register empty }
              If StreamInsert > 0 Then Begin
                Port[BasePort+THR] := StreamInsert;
                StreamInsert := 0;
              End Else If (TransmitHead <> TransmitTail) And TransmitEnabled
              Then Begin
                Port[BasePort+THR] := TransmitBuffer^[TransmitTail];
                Inc(TransmitTail);
                If TransmitTail = TransmitSize Then TransmitTail := 0;
              End Else AwaitingCh := True;
            End;
            $00 : Begin { Modem status change }
              ModemStatus := Port[BasePort+MSR];
              AwaitingCts := WaitForCts And ((ModemStatus And MSRcts) = 0);
              AwaitingDsr := WaitForDsr And ((ModemStatus And MSRdsr) = 0);
              AwaitingCd := WaitForCd And ((ModemStatus And MSRcd) = 0);
              If (AwaitingCts Or AwaitingDsr Or AwaitingCd Or AwaitingXon)
                Then TransmitEnabled := False
                Else If Not TransmitEnabled Then EnableTransmit(ComPort);
              If ModemRoutine <> Nil Then CallFar(ComPort, ModemRoutine);
            End;
            Else done := True;
          End;
        Until done;
      End;
      Inc(i);
      If i > UseCount Then i := 1;
    Until i = NextPort;
  End;
  DisableInterrupts;
  Port[$20] := $20; { Non-specific EOI to 8259 }
End;  { AsyncISR }

{ One of these should exist for each element of VectorSave above. }
{ These are are the actual interrupt routines referenced in OpenPort below }
Procedure AsyncISR1; Interrupt; Begin AsyncISR(1); End;
Procedure AsyncISR2; Interrupt; Begin AsyncISR(2); End;
Procedure AsyncISR3; Interrupt; Begin AsyncISR(3); End;
Procedure AsyncISR4; Interrupt; Begin AsyncISR(4); End;

Procedure ClosePort(ComPort : Word);
{ Release async port }
Var
  Timer : LongInt;
  i, LastTail : Word;
Begin { ClosePort }
  With AsyncPort[ComPort] Do Begin
    If PortOpen Then Begin
      { Allow transmit buffer to empty }
      Timer := TimeoutMilliseconds;
      LastTail := TransmitTail;
      While (TransmitHead <> TransmitTail) And (Timer > 0) Do Begin
        Dec(Timer);
        Delay(1);
        If LastTail <> TransmitTail Then Begin
          LastTail := TransmitTail;
          Timer := TimeoutMilliseconds;
        End;
      End;
      If Timer = 0 Then Begin
        LineStatus := LSRTimeout;
        If ErrorRoutine <> Nil Then CallFar(ComPort, ErrorRoutine);
      End;

      Port[BasePort+IER] := 0; { Disable 8250 interrupts }
      Port[BasePort+MCR] := 0; { All modem signals off }
      With VectorSave[VectorIndex] Do Begin
        i := 0;
        Repeat Inc(i) Until (i >= UseCount) Or (PortList[i] = ComPort);
        PortList[i] := PortList[UseCount];
        Dec(UseCount);
        If UseCount = 0 Then Begin { No more ports using this irq }
          Port[$21] := Port[$21] Or (1 Shl IrqNumber);
          SetIntVec(IntrptNo, Vector);
        End;
      End;
      { Free buffers }
      If ReleaseReceive Then Begin
        FreeMem(ReceiveBuffer, ReceiveSize);
        ReceiveBuffer := Nil;
      End;
      If ReleaseTransmit Then Begin
        FreeMem(TransmitBuffer, TransmitSize);
        TransmitBuffer := Nil;
      End;
      PortOpen := False;
    End;
  End;
End;  { ClosePort }

Function OpenPort(ComPort : Word;     { Com port number, 1..4 }
                  BaudRate : LongInt; { BPS, 50..115200 }
                  WordLength : Word;  { 5..8 bits }
                  StopBits : Word;    { 1..2 stop bits }
                  Parity : Char       { N,E,O,1,0 }
                  ) : Boolean;        { Return True if open successful }
{ Prepare port for communications }
Var
  BaudDivisor : Word;
  Work, FreeSave : Byte;
Begin { OpenPort }
  If (ComPort < 1) Or (ComPort > MaxPorts) Then PortOpenError := 1
  Else With AsyncPort[ComPort] Do Begin
    If PortOpen Then ClosePort(ComPort) Else Begin { Precautionary... }
      Port[BasePort+IER] := 0; { disable 8250 interrupts }
      Port[BasePort+MCR] := 0; { all modem control signals off }
    End;
    PortOpenError := 0;
    Parity := UpCase(Parity);

    If (BaudRate < 50) Or (BaudRate > 115200) Then PortOpenError := 2
    Else If (WordLength < 5) Or (WordLength > 8) Then PortOpenError := 3
    Else If (StopBits < 1) Or (StopBits > 2) Then PortOpenError := 4
    Else If Not (Parity In ['N','E','O','1','0']) Then PortOpenError := 5
    Else If (ReceiveSize < 2 ) Or (ReceiveSize > 32767)
         Or (TransmitSize < 2) Or (TransmitSize > 32767)
    Then PortOpenError := 6 Else Begin
      ReleaseReceive := False;
      ReleaseTransmit := False;
      If ReceiveBuffer = Nil Then Begin
        If MaxAvail < ReceiveSize Then PortOpenError := 7 Else Begin
          GetMem(ReceiveBuffer, ReceiveSize);
          ReleaseReceive := True;
        End;
      End;
      If TransmitBuffer = Nil Then Begin
        If MaxAvail < TransmitSize Then PortOpenError := 7 Else
          ReleaseTransmit := True;
      End;
      If ReleaseReceive Then Begin
        FreeMem(ReceiveBuffer, ReceiveSize);
        ReceiveBuffer := Nil;
      End;
    End;

    If (PortOpenError = 0) And ((Port[BasePort+IIR] And $F8) <> 0) Then
      PortOpenError := 8;

    If PortOpenError = 0 Then Begin
      { Get buffers }
      If ReceiveBuffer = Nil Then GetMem(ReceiveBuffer, ReceiveSize);
      ReceiveHead := 0;
      ReceiveTail := 0;
      If TransmitBuffer = Nil Then GetMem(TransmitBuffer, TransmitSize);
      TransmitHead := 0;
      TransmitTail := 0;

      { Set baud rate }
      BaudDivisor := BaudRateDividend Div BaudRate;
      Port[BasePort+LCR] := $80;
      Port[BasePort+DLM] := Hi(BaudDivisor);
      Port[BasePort+DLL] := Lo(BaudDivisor);

      { Set Word Length, Stop Bits, Parity }
      Work := WordLength - 5;
      If StopBits = 2 Then Work := Work Or $04;
      Case Parity Of
        'N' : ;
        'O' : Work := Work Or $08;
        'E' : Work := Work Or $18;
        '1' : Work := Work Or $28;
        '0' : Work := Work Or $38;
      End;
      Port[BasePort+LCR] := Work;

      { Read registers to reset pending conditions }
      LineStatus := Port[BasePort+LSR];
      ModemStatus := Port[BasePort+MSR];
      Work := Port[BasePort+RBR];

      AwaitingXon := False;
      AwaitingCh := True;
      SenderEnabled := True;

      { Set interrupts }
      FreeSave := 0;
      VectorIndex := 1;
      While (VectorIndex <= MaxPorts)
      And
      (
        (VectorSave[VectorIndex].UseCount = 0)
        Or
        (VectorSave[VectorIndex].IntrptNo <> IntNumber)
      ) Do Begin
        If (FreeSave = 0) And (VectorSave[VectorIndex].UseCount = 0) Then
          FreeSave := VectorIndex;
        Inc(VectorIndex);
      End;
      If VectorIndex <= MaxPorts Then With VectorSave[VectorIndex] Do Begin
        DisableInterrupts;
        Inc(UseCount);
        PortList[UseCount] := ComPort;
      End
      Else If FreeSave = 0 Then PortOpenError := 9 { This should never happen }
      Else With VectorSave[FreeSave] Do Begin { Save old vector }
        VectorIndex := FreeSave;
        UseCount := 1;
        PortList[1] := ComPort;
        IntrptNo := IntNumber;
        GetIntVec(IntrptNo, Vector);
        Case VectorIndex Of
          1 : SetIntVec(IntrptNo, @AsyncISR1);
          2 : SetIntVec(IntrptNo, @AsyncISR2);
          3 : SetIntVec(IntrptNo, @AsyncISR3);
          4 : SetIntVec(IntrptNo, @AsyncISR4);
          Else PortOpenError := 9; { This shouldn't happen }
        End;
        Port[$21] := Port[$21] And Not (1 Shl IrqNumber);
      End;
      PortOpen := True;
      Port[BasePort+MCR] := MCRout2+MCRrts+MCRdtr;
      Port[BasePort+IER] := $0F; { Enable 8250 interrupts }
      EnableInterrupts;
      AwaitingCts := WaitForCts And ((ModemStatus And MSRcts) = 0);
      AwaitingDsr := WaitForDsr And ((ModemStatus And MSRdsr) = 0);
      AwaitingCd := WaitForCd And ((ModemStatus And MSRcd) = 0);
      TransmitEnabled := Not (AwaitingCts Or AwaitingDsr Or AwaitingCd);
    End;
    OpenPort := PortOpen And (PortOpenError = 0);
  End;
End;  { OpenPort }

Function SendPort(ComPort : Word; Ch : Char ) : Boolean;
{ Send a character (or place in transmit buffer).  Return true if successful }
Var
  Timer : LongInt;
  next : Word;
Begin { SendPort }
  With AsyncPort[ComPort] Do Begin
    SendPort := False;
    Timer := TimeoutMilliseconds;
    next := Succ(TransmitHead);
    If next = TransmitSize Then next := 0;
    While (next = TransmitTail) And (Timer > 0) Do Begin
      Delay(1);
      Dec(Timer);
    End;
    If Timer > 0 Then Begin
      DisableInterrupts;
      If TransmitEnabled And AwaitingCh Then Begin
        Port[BasePort+THR] := Ord(Ch);
        AwaitingCh := False;
      End Else Begin
        TransmitBuffer^[TransmitHead] := Ord(Ch);
        TransmitHead := next;
      End;
      EnableInterrupts;
      SendPort := True;
    End Else Begin
      LineStatus := LSRTimeout;
      If ErrorRoutine <> Nil Then CallFar(ComPort, ErrorRoutine);
    End;
  End;
End;  { SendPort }

Function BlockSendPort(ComPort : Word; Var Block; BlkLen : Word) : Word;
{ Move a block of characters to the buffer; returns number of characters
  inserted in buffer.  This function does not wait for buffer space to become
  available - it always returns immediately. }
Var
  next, first, second, len : Word;
  blk : AsyncBuffer Absolute Block;
Begin { BlockSendPort }
  With AsyncPort[ComPort] Do Begin
    BlockSendPort := 0;
    If BlkLen > 0 Then Begin
      DisableInterrupts;
      If TransmitTail > TransmitHead Then Begin
        first := TransmitTail - TransmitHead - 1;
        second := 0;
      End Else Begin
        first := TransmitSize - TransmitHead;
        second := TransmitTail;
        If TransmitTail = 0 Then Dec(first) Else Dec(second);
      End;
      EnableInterrupts;
      len := BlkLen;
      next := TransmitHead;
      If first > 0 Then Begin
        If first > len Then first := len;
        Move(Blk, TransmitBuffer^[TransmitHead], first);
        len := len - first;
        next := TransmitHead + first;
        If next >= TransmitSize Then next := 0;
      End;
      If (len > 0) And (second > 0) Then Begin
        If second > len Then second := len;
        Move(Blk[first], TransmitBuffer^, second);
        len := len - second;
        next := second;
      End;
      TransmitHead := next;
      BlockSendPort := BlkLen - len;
      If TransmitEnabled Then Begin { JumpStart the interrupt }
        DisableInterrupts;
        If AwaitingCh And (TransmitHead <> TransmitTail) Then Begin
          Port[BasePort+THR] := TransmitBuffer^[TransmitTail];
          TransmitTail := Succ(TransmitTail);
          If TransmitTail = TransmitSize Then TransmitTail := 0;
          AwaitingCh := False;
        End;
        EnableInterrupts;
      End;
    End;
  End;
End;  { BlockSendPort }

Function BlockSendPortWait(ComPort : Word; Var Block; BlkLen : Word) : Word;
{ Send a block of characters; return the number of characters sent.  This
  function will wait TimeoutMilliseconds between characters sent if not enough
  buffer space is available. }
Var
  Blk : AsyncBuffer Absolute Block;
  i, j : Word;
  Timer : LongInt;
Begin { BlockSendPortWait }
  With AsyncPort[ComPort] Do Begin
    BlockSendPortWait := 0;
    Timer := TimeoutMilliseconds;
    i := 0;
    While (BlkLen > 0) And (Timer > 0) Do Begin
      j := BlockSendPort(ComPort, Blk[i], BlkLen);
      If j > 0 Then Begin
        i := i + j;
        BlkLen := BlkLen - j;
        Timer := TimeoutMilliseconds;
      End Else Begin
        Dec(Timer);
        Delay(1);
      End;
    End;
    If Timer = 0 Then Begin
      LineStatus := LSRTimeout;
      If ErrorRoutine <> Nil Then CallFar(ComPort, ErrorRoutine);
    End;
  End;
End;  { BlockSendPortWait }

Function PortReady(ComPort : Word) : Boolean;
{ Returns True if character waiting in receive buffer or RBR }
Begin { PortReady }
  With AsyncPort[ComPort] Do Begin
    PortReady := ReceiveHead <> ReceiveTail;
  End;
End;  { PortReady }

Function ReadPort(ComPort : Word; Var Ch) : Boolean;
{ Returns received character from buffer }
Var
  bufused : Word;
  Rch : Byte Absolute Ch;
Begin { ReadPort }
  With AsyncPort[ComPort] Do Begin
    If ReceiveHead = ReceiveTail Then ReadPort := False Else Begin
      Rch := ReceiveBuffer^[ReceiveTail];
      DisableInterrupts;
      Inc(ReceiveTail);
      If ReceiveTail = ReceiveSize Then ReceiveTail := 0;
      EnableInterrupts;
      ReadPort := True;
    End;
    If Not SenderEnabled And (XoHand Or RtsHand Or DtrHand) Then Begin
      DisableInterrupts;
      If ReceiveHead < ReceiveTail Then
        bufused := (ReceiveSize-ReceiveTail)+ReceiveHead
      Else bufused := ReceiveHead-ReceiveTail;
      EnableInterrupts;
      If bufused < (ReceiveSize Shr 1) Then EnableSender(ComPort);
    End;
  End;
End;  { ReadPort }

Function BlockReadPort(ComPort : Word; Var Block; BlkLen : Word) : Word;
{ Read a block of characters from the port and return number of characters
  read.  This function does not wait for characters to appear in the buffer;
  it transfers any characters which might be present, up to BlkLen, and returns
  the number transferred.}
Var
  Blk : AsyncBuffer Absolute Block;
  first, second, len, bufused, i : Word;
Begin { BlockReadPort }
  With AsyncPort[ComPort] Do Begin
    DisableInterrupts;
    If ReceiveHead < ReceiveTail Then Begin
      first := ReceiveSize - ReceiveTail;
      second := ReceiveHead;
    End Else Begin
      first := ReceiveHead - ReceiveTail;
      second := 0;
    End;
    EnableInterrupts;
    i := 0;
    len := first;
    If len > BlkLen Then len := BlkLen;
    If len > 0 Then Begin
      Move(ReceiveBuffer^[ReceiveTail], Blk, len);
      BlkLen := BlkLen - len;
      i := i + len;
      DisableInterrupts;
      ReceiveTail := ReceiveTail + len;
      If ReceiveTail = ReceiveSize Then ReceiveTail := 0;
      EnableInterrupts;
    End;
    If BlkLen > 0 Then Begin
      len := second;
      If len > BlkLen Then len := BlkLen;
      If len > 0 Then Begin
        Move(ReceiveBuffer^, Blk[i], len);
        i := i + len;
        DisableInterrupts;
        ReceiveTail := ReceiveTail + len;
        EnableInterrupts;
      End;
    End;
    BlockReadPort := i;
    If Not SenderEnabled And (XoHand Or RtsHand Or DtrHand) Then Begin
      DisableInterrupts;
      If ReceiveHead < ReceiveTail Then
        bufused := (ReceiveSize-ReceiveTail)+ReceiveHead
      Else bufused := ReceiveHead-ReceiveTail;
      EnableInterrupts;
      If bufused < (ReceiveSize Shr 1) Then EnableSender(ComPort);
    End;
  End;
End;  { BlockReadPort }

Function BlockReadPortDelim(ComPort : Word; Var Block; BlkLen : Word;
  Delim : SetOfChar) : Word;
{ Read a block of characters from the port and return number of characters
  read.  This function reads characters from the port until either: 1. BlkLen
  characters have been read; 2. A character appearing in Delim has been read
  (The Delim character appears in the buffer and is included in the count); or
  3. TimeoutMilliseconds has elapsed since the last character received
  (LSRTimeout bit set in LineStatus and ErrorRoutine called if present). }
Var
  Blk : AsyncBuffer Absolute Block;
  Timer : LongInt;
  i : Word;
  ch : Byte;
Begin { BlockReadPortDelim }
  With AsyncPort[ComPort] Do Begin
    i := 0;
    Timer := TimeoutMilliseconds;
    If BlkLen > 0 Then Repeat
      If ReadPort(ComPort, ch) Then Begin
        Blk[i] := Ch;
        Inc(i);
        Timer := TimeoutMilliseconds;
      End Else Begin
        Dec(Timer);
        Delay(1);
      End;
    Until (i >= BlkLen) Or (Timer = 0) Or (Chr(ch) In Delim);
    If Timer = 0 Then Begin
      LineStatus := LSRTimeout;
      If ErrorRoutine <> Nil Then CallFar(ComPort, ErrorRoutine);
    End;
  End;
End;  { BlockReadPortDelim }

Procedure SetLoop(ComPort : Word; Loop : Boolean);
{ Set LoopBack on/off }
Begin { SetLoop }
  With AsyncPort[ComPort] Do Begin
    If Loop Then
      Port[BasePort+MCR] := Port[BasePort+MCR] Or MCRloop
    Else
      Port[BasePort+MCR] := Port[BasePort+MCR] And Not MCRloop;
  End;
End;  { SetLoop }

Procedure SendBreak(ComPort : Word);
{ Send break signal }
Var
  Timer : LongInt;
  LastTail : Word;
Begin { SendBreak }
  With AsyncPort[ComPort] Do Begin
    If TransmitSize > 0 Then Begin { Allow transmit buffer to empty }
      Timer := TimeoutMilliseconds;
      LastTail := TransmitTail;
      While (TransmitHead <> TransmitTail) And (Timer > 0) Do Begin
        Dec(Timer);
        Delay(1);
        If LastTail <> TransmitTail Then Begin
          LastTail := TransmitTail;
          Timer := TimeoutMilliseconds;
        End;
      End;
      If Timer = 0 Then Begin
        LineStatus := LSRTimeout;
        If ErrorRoutine <> Nil Then CallFar(ComPort, ErrorRoutine);
      End;
    End;
    Port[BasePort+LCR] := Port[BasePort+LCR] Or $40; { Turn on break }
    Delay(BreakMiliseconds);
    Port[BasePort+LCR] := Port[BasePort+LCR] And $BF; { Turn off break }
  End;
End;  { SendBreak }

{$F+} Procedure AsyncExit; {$F-}
{ Exit procedure, close ports }
Var
  i : Word;
Begin { AsyncExit }
  For i := 1 To MaxPorts Do ClosePort(i);
  ExitProc := FormerExitProc;
End;  { AsyncExit }

Procedure InitializeAsync;
{ Initialize data areas and install exit proc }
Var
  i : Word;
Begin { InitializeAsync }
  For i := 1 To MaxPorts Do Begin
    With AsyncPort[i] Do Begin
      PortOpen := False;
      IrqNumber := IRQs[i];
      IntNumber := Interrupts[i];
      VectorIndex := 0;
      BasePort := BasePorts[i];
      LineStatus := 0;
      ModemStatus := 0;
      UserData := 0;
      WaitForXon := False;
      WaitForCts := False;
      WaitForDsr := False;
      WaitForCd := False;
      RtsHand := True;
      DtrHand := False;
      XoHand := False;
      XoTransparent := True;
      TransmitEnabled := True;
      AwaitingXon := False;
      AwaitingCts := False;
      AwaitingDsr := False;
      AwaitingCd := False;
      AwaitingCh := True;
      SenderEnabled := True;
      StreamInsert := 0;
      ErrorRoutine := Nil;
      ModemRoutine := Nil;
      ReceiveBuffer := Nil;
      ReceiveSize := DefaultBufferSize;
      ReceiveHead := 0;
      ReceiveTail := 0;
      TransmitBuffer := Nil;
      TransmitSize := DefaultBufferSize;
      TransmitHead := 0;
      TransmitTail := 0;
      ReleaseReceive := True;
      ReleaseTransmit := True;
    End;
    With VectorSave[i] Do Begin
      UseCount := 0;
      IntrptNo := 0;
      Vector := Nil;
      NextPort := 1;
    End;
  End;
  PortOpenError := 0;
  FormerExitProc := ExitProc;
  ExitProc := @AsyncExit;
End;  { InitializeAsync }

Begin { Initialization }
  InitializeAsync;
End.  { Unit }