{
                         ASYNC

               Turbo Pascal Asynch Functions

These functions provide the ability to write to and read
from either Asynch adapter, asynchronously. A hardware
interrupt procedure is included to handle asynchronous or
unsolicited input. The associated functions to Open and
Close are also included.

This file must be included as part of the main Pascal program
(NOT as part of a procedure as the variables contained here
must be static).

IBM Internal Use Only.
Mike Halliday. FLYMIKE @ YKTVMZ.
}

Type tComPort =  (Com1, Com2);
     tBaud = (b110, b150, b300, b600, b1200, b2400, b4800, b9600);
     tParity = (pSpace, pOdd, pMark, pEven, pNone);
     tDatabits = (d5, d6, d7, d8);
     tStopbits = (s1, s2);

Type tSaveVector = record     {  Saved Com interrupt vector          }
       IP: integer;
       CS: integer;
     end;
Type regpak =
           record AX, BX, CX, DX, BP, SI, DI, DS, ES, FLAGS:integer end;

Const ourDS: integer = -1;    {  Will be init to contents of our DS
                                  for later use in Interrupt routine  }

                         {  Define address adders for the various
                             Async card registers.                    }
Const RBR = $00;         { xF8   Receive Buffer Register             }
      THR = $00;         { xF8   Transmitter Holding Register        }
      IER = $01;         { xF9   Interrupt Enable Register           }
      IIR = $02;         { xFA   Interrupt Identification Register   }
      LCR = $03;         { xFB   Line Control Register               }
      MCR = $04;         { xFC   Modem Control Register              }
      LSR = $05;         { xFD   Line Status Register                }
      MSR = $06;         { xFE   Modem Status Register               }
      DLL = $00;         { xF8   Divisor Latch Least Significant     }
      DLM = $01;         { xF9   Divisor Latch Most  Significant     }
                         {       ASynch Interrupt Masks              }
      imlist: array[Com1..Com2] of integer = ($EF, $F7);
                              {  ASynch hardware interrupt addresses }
      ivlist: array[Com1..Com2] of integer = ($000C, $000B);
      PICCMD = $20;           {  8259 Priority Interrupt Controller  }
      PICMSK = $21;           {  8259 Priority Interrupt Controller  }

                              {  Asynch base port addresses are
                                  in the ROM BIOS data area           }
Var   ComBaseAddr: array[Com1..Com2] of integer Absolute $0040:$0000;

{
    Define a ring buffer for Asynch_Interrupt to write into
    and ReadCom to read from.
}
Var ringbuf: array[0..255] of char;
    readptr, writptr: 0..255; {  Index which ReadCom will next read from
                                  Index which Asunch_Interrupt will next
                                  write into. If readptr=writptr then
                                  the buffer is empty.                }

Var LSRstat: byte;                     {  Line Status Reg at interrupt        }
    ComSaveVec: tSaveVector;           {  saved Async Interrupt vector        }
    ComBase :integer;                  {  Opened Com port base address        }
    ActiveComPort: tComPort;           {  Opened Com                          }
    imvalue: integer;                  {  Interrupt Mask value in use         }

Procedure SwapIntVector(IntVect: integer;
                        Var SaveVector: tSaveVector);
Var   dosregs: regpak;
Begin
  inline($FA);                          {  cli        disable interrupts       }

  With dosregs Do Begin
    ax := ($35 * 256) + IntVect;
    MsDos(dosregs);                     {  DOS function 35 - get vector        }
    ds := SaveVector.CS;
    dx := SaveVector.IP;
    SaveVector.CS := es;
    SaveVector.IP := bx;
    ax := ($25 * 256) + IntVect;
    MsDos(dosregs);                     {  DOS function 25 - set vector        }
  End;
  inline($FB);                          {  sti        re-enable ints           }
End;

{       This routine gets control upon an Asynch Interrupt           }

Procedure Asynch_Interrupt;
Var dummy: array[1..8] of integer; {  Leave room for our push's      }
    MSRstat, IIRreg: byte;
Begin
{
                             BP-4   Return IP
                             BP-2   Return CS
                             BP---> Caller's BP
}
                                        {  Push regs but DON'T enable - we can't
                                  handle another interrupt now        }
  inline($50/$53/$51/$52/$57/$56/$06);
  inline($1E);                          {  push   ds       save ds, also       }
  inline($2E/$8E/$1E/ourDS);            {  mov   DS,CS:ourDS  ;Setup our DS    }

  IIRreg := PORT[ComBase + IIR];        {  Get Interrupt Identification        }
  If (IIRreg and $01) = 0 then Begin    {  If interrupt pending                }
    IIRreg := IIRreg and $06;           {  Leave bits 2 and 1 on               }
    Case IIRreg of                      {  Determine cause of interrupt (we
                                           actually only expect (and handle)
                                           the Data Available interrupt        }

      $04: Begin                        {  Received Data Available Interrupt   }
             If LSRstat = 0 then Begin  {  If Line Status is OK                }
                                        {  If there is Room in Buffer          }
               If (SUCC(writptr) mod 256) <> readptr then Begin
                                        {  Receive byte into our buffer        }
                 ringbuf[writptr] := CHR(PORT[ComBase + RBR]);
                                        {  Increment writptr                   }
                 writptr := SUCC(writptr) mod 256;
               End
                                        {  If buffer full, pretend overrun     }
               Else LSRstat := (LSRstat or $02);
             End;
           End;
      $06: LSRstat := PORT[ComBase + LSR] and $1E;
      $02: Begin End;
      $00: MSRstat := PORT[ComBase + MSR];
      Else Begin End;
    End;  {  Case  }
  End;
  PORT[PICCMD] := $20;                  {  Send End Of Interrupt to 8259       }

  inline($1F);                          {  pop    ds                           }
  inline($07/$5E/$5F/$5A/$59/$5B/$58);  {  pop rest of regs                    }
  inline($89/$EC);                      {  mov    sp,bp                        }
  inline($5D);                          {  pop    bp                           }
  inline($CF);                          {  iret       ;Return from interrupt   }
End;


{                     Open COM1 or COM2, a la Basic                  }

Procedure OpenCom(ComPort: tComPort;
                  Baud: tBaud;
                  Parity: tParity;
                  Databits: tDatabits;
                  Stopbits: tStopbits);
Const baudcode: array[b110..b9600] of integer =
                           ($417, $300, $180, $C0, $60, $30, $18, $0C);
      paritycode: array[pSpace..pNone] of byte =
                                             ($38, $08, $28, $18, $00);
      databitscode: array[d5..d8] of byte = ($00, $01, $02, $03);
      stopbitscode: array[s1..s2] of byte = ($00, $04);
Var   LCRreg: byte;

Begin
                                        {  Init the Const "ourDS" for use by
                                           the Async_Interrupt routine         }
  inline($1E);                          {  push   ds                           }
  inline($2E/$8F/$06/ourDS);            {  cs:pop ourDS                        }
                                        {  Swap Com interrupt vector           }
  With ComSaveVec Do Begin
    CS := CSEG;
    IP := OFS(Asynch_Interrupt);
  End;
  SwapIntVector(ivlist[ComPort], ComSaveVec);
  ActiveComPort := ComPort;
          inline($CD/$01);
  ComBase := ComBaseAddr[ComPort];
  LSRstat := 0;                         {  Reset LSR status          }
  imvalue := imlist[ComPort];           {  Select Interrupt Mask val }
  ComBase := ComBaseAddr[ComPort];      {  Select Input Port         }
  readptr := 0;                         {  Init buffer pointers      }
  writptr := 0;                         {  Init buffer pointers      }
  PORT[PICMSK] := PORT[PICMSK] and imvalue;  {  Enable ASynch Int    }
  PORT[IER+ComBase] := $01;             {  Enable some interrupts    }
                              { Note: OUT2, despite documentation,
                                 MUST be ON, to enable interrupts     }
  PORT[MCR+ComBase] := $0B;             {  Set RTS, DTR, OUT2        }
  LCRreg := $80;              {  Set Divisor Latch Access Bit in LCR }
  LCRreg := LCRreg or paritycode[Parity];    {  Setup Parity         }
  LCRreg := LCRreg or databitscode[Databits];{  Setup # data bits    }
  LCRreg := LCRreg or stopbitscode[Stopbits];{  Setup # stop bits    }
  PORT[LCR+ComBase] := LCRreg;     {  Set Parity, Data and Stop Bits
                                       and set DLAB                   }
  PORT[DLM+ComBase] := Hi(baudcode[Baud]);   {  Set Baud rate        }
  PORT[DLL+ComBase] := Lo(baudcode[Baud]);   {  Set Baud rate        }
  PORT[LCR+ComBase] := LCRreg and $7F;  {  Reset DLAB                }
          inline($CD/$01);
End;


{                 Close any initialized COM                          }

Procedure CloseCom;
Begin
                              {  Disable Async interrupt             }
  PORT[PICMSK] := PORT[PICMSK] or ($FF - imvalue);
  PORT[IER+ComBase] := $00;   {  Disable Data Avail interrupt        }
                              {  Restore Com interrupt vector        }
  SwapIntVector(ivlist[ActiveComPort], ComSaveVec);
End;

{
Read a stream of data from the initialized COM port. If Line
Status is not currently zero, then return immediately with
the Line Status byte. If there is no data currently in the
buffer then return stream:=null with function:=0. If there
is data in the buffer, then return all the data up to, but
not including, a CR($0D). If a CR is not found in the buffer
then loop here until one arrives.
}

Function  ReadCom(var stream: lstring): byte;{  Returned LSR, or zero}

  Function  ReadChar: char;   {  Return char, or SPIN !!!!           }
  Begin
    If readptr = writptr then
                           Repeat Begin End Until (readptr <> writptr);
    ReadChar := ringbuf[readptr];
    readptr := SUCC(readptr) mod 256;
  End;

Begin
  stream[0] := CHAR($00);          {  Init returned string to null   }
  ReadCom := LSRstat;              {  Return LSR, or zero            }
  If LSRstat = 0 then Begin
    If readptr <> writptr then Begin    {  If buffer not empty       }
      Repeat Begin                      {  Get chars from ring buffer}
                                   {  Increment returned string len  }
        stream[0] := CHAR(ORD(SUCC(stream[0])));
                                   {  Get a char from buffer, or SPIN}
        stream[ORD(stream[0])] := ReadChar;
      End
      Until (stream[ORD(stream[0])] = CHR($0D));  {  Until see a CR  }
      stream[0] := CHR(ORD(stream[0]) - 1);       {  strip the CR    }
    End;
  End;
End;

{
Write a stream of data to the initialized COM port, then
append a CR and LF.
}

Procedure WriteCom(stream: lstring);
Var LSRreg: byte;
    i: integer;
Begin
  inline($FA);                {  disable interrupts until we get all
                                  the data sent.                      }
  For i := 1 to LENGTH(stream) Do Begin
                              {  Spin until Transmitter Holding
                                  Register (THRE) is empty            }
    Repeat LSRreg := (PORT[LSR+ComBase] and $20) Until LSRreg <> 0;
    PORT[THR+ComBase] := ORD(stream[i]);     {  Output the caharacter}
  End;
  Repeat LSRreg := (PORT[LSR+ComBase] and $20) Until LSRreg <> 0;
  PORT[THR+ComBase] := $0D;   {  Output a CR                         }
  Repeat LSRreg := (PORT[LSR+ComBase] and $20) Until LSRreg <> 0;
  PORT[THR+ComBase] := $0A;   {  Output a LF                         }
  inline($FB);                {  Reenable interrupts                 }
End;