ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/PROG/PASCAL/T301AS.ZIP/T301_ASY.INC

Text File | 1989-01-04 | 21.8 KB | 727 lines

(* This is the primary asynchronous program.  It controls the 8250 and
   16450 and allows interrupt driven sending and receving of char-
   acters via ring buffers.  This allows for more effective background
   processing by the 8250 and/or 16450 in your system.

   Please note that 16550 support has been added to these routines
*)

Type
     { ====================================================================
       New Asynch only supports com1 and com2.  This is due to the fact
       that I have a two port serial controller card and can only test
       for my own configuration.  You should be able to add multiple ser-
       ial ports, given the comments in the source code.
       ==================================================================== }

     tComPort =  (Com1, Com2);

     { Other Baud Rates can be supported, however, I can't test them
       on my current system configuration.
     }

     tBaud = (b110, b150, b300, b600, b1200, b2400, b4800, b9600);

     { I support a number of different parity settings.  However,
       none, and even seem to be the most common.  I have not tested
       any of the other parity settings except in loop back mode.
     }

     tParity = (pSpace, pOdd, pMark, pEven, pNone);

     { All data bit settings supported by the National Semiconductor
       8250/16450/16550 UARTs are supported.
     }

     tDatabits = (d5, d6, d7, d8);

     { The National Semi series only supports two stop bit settings.
     }

     tStopbits = (s1, s2);

     tSaveVector = record     {  Saved Com interrupt vector          }
       IP: integer;
       CS: integer;
     end;

     tBufferType = array [0..MaxInt] of Byte ;

     tBuffer    = Record
                     Ring_Buffer : ^tBufferType ;
                     Buffer_Len    : Integer ;
                     Read_Ptr    : Integer ;
                     Write_Ptr   : Integer ;
                   End ;

     tregpak = record case integer of
                1: (AX, BX, CX, DX, BP, SI, DI, DS, ES, FLAGS : integer) ;
                2: (al,ah, bl,bh, cl,ch, dl,dh : byte) ;
              end;

     BigString = string[255] ;

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

                              {  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  }
     EOI    = $20 ;          { End of Interrupt command for 8259.   }
                             {  Asynch base port addresses are
                                in the ROM BIOS data area           }
     ComBaseAddr: array[Com1..Com2] of integer = ($03f8, $02f8) ;

var
     BIOSComBaseAddr: array[Com1..Com2] of integer Absolute $0040:$0000;

{
    Define a ring buffer for Asynch_Interrupt to write into
    and ReadCom to read from.
}
     Input  : tBuffer ;

     OutPut : tBuffer ;

     LSRstat,                           {  Line Status Reg at interrupt    }
     MSRstat       : byte ;             {  Modem 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     }

    { Define Equivalent Port Address Registers. }

     RBR_Port,
     THR_Port,
     IER_Port,
     FCR_Port,  { FIFO Control Register *16550 UART ONLY* }
     IIR_Port,
     LCR_Port,
     MCR_Port,
     LSR_Port,
     MSR_Port,
     SCR_Port,  { Scratch Register *16450, 16550 UARTs ONLY* }
     DLL_Port,
     DLM_Port      : integer ;

{
  These are interrupt type counters.  They are not used by the routine
  explicitly, and can probably be deleted if desired.  I like to see
  the statistics, hence I left 'em in:
}
     i0, i2, i4, i6    : integer ;
     ir, iw, ikp       : integer ;

    { Define Variables needed by Asynch_Interrupts procedure. }

     IIRreg,
     IType             : byte ;
     Temp              : integer ;
     OpenError         : boolean ;
     t16550            : boolean ;
     tUseCTS           : boolean ;

     { Define Line Status Flags }

     tCTSTimeOut,
     tDataReady,
     tOverrunError,
     tParityError,
     tFramingError,
     tBreakInterrupt,
     tTHREmpty,
     tTransmitterEmpty,
     tRCVRError         : byte ;

     { Define Modem Status Flags }

     tClearToSend,
     tDataSetReady,
     tRingIndicator,
     tDataCarrierDetect : byte ;

Procedure InstallInterrupt(IntVect: integer;
                        Var SaveVector: tSaveVector);
Var
    dosregs: tregpak ;

Begin
  inline($FA);                        {  cli        disable interrupts       }

  With dosregs Do Begin
    ds := SaveVector.CS;
    dx := SaveVector.IP;
    ah := $25 ;
    al := IntVect ;
    MsDos(dosregs);                   {  DOS function 25 - set vector        }
  End;
  inline($FB);                        {  sti        re-enable ints           }
End;

{ This procedure returns the line status of the UART.  The flags are
  considered on (TRUE) if they are non-zero.
}

Procedure GetLineStatus ;

begin
  LSRstat := PORT[LSR_Port] and $1E;
  tOverrunError   := LSRstat and $02 ;
  tParityError    := LSRstat and $04 ;
  tFramingError   := LSRstat and $08 ;
  tBreakInterrupt := LSRstat and $10 ;
  tRCVRError      := LSRstat and $20 ;
end ;

{ This procedure returns the modem status.  The flags are
  considered on (TRUE) if they are non-zero.
}
Procedure GetModemStatus ;

begin
  MSRstat := PORT[MSR_Port];
  tClearToSend       := MSRstat and $10 ;
  tDataSetReady      := MSRstat and $20 ;
  tRingIndicator     := MSRstat and $40 ;
  tDataCarrierDetect := MSRstat and $80 ;
end ;

{ This procedure is private to the Interrupt handler and should not be used
  for general sending of raw data to the UART.
}

Procedure SendCharacter ;

begin
with Output do
begin
  if Write_Ptr = Read_Ptr then Port[IER_Port] := Port[IER_Port] and $FD
  else
    begin
      if tUseCTS = TRUE then
        begin
          if (Port[MSR_Port] and $10) = $10 then
            begin
              PORT[THR_Port] := ORD(Ring_Buffer^[Write_Ptr]) ;
              Write_Ptr := (Write_Ptr + 1) mod Buffer_Len ;
              tCTSTimeOut := 0 ;
            end
          else
            begin
              Port[IER_Port] := Port[IER_Port] and $FD ;
              tCTSTimeOut := 1 ;
            end ;
        end
      else
        begin
          PORT[THR_Port] := ORD(Ring_Buffer^[Write_Ptr]) ;
          Write_Ptr := (Write_Ptr + 1) mod Buffer_Len ;
        end ;
    end ;
end { with }
end ;

{ This procedure is private to the Interrupt handler and should not be used
  for general receiving of raw data to the UART.
}
Procedure GetReceivedChar ;

begin
with Input do
begin
  Temp := (Write_Ptr + 1) mod Buffer_Len ;
  If (LSRstat and $9F) = 0 then                {  If Line Status is OK  }
    If Temp <> Read_Ptr then
      Begin
        Ring_Buffer^[Write_Ptr] := PORT[RBR_Port];
        Write_Ptr := Temp ;
      End
    Else LSRstat := (LSRstat or $02);
end
End;

{********************************************************************}
{                                                                    }
{       This routine gets control upon an Asynch Interrupt           }
{       We service all four interrupt types generated by the         }
{       INS8250 chip:                                                }
{                    1. Received character error or break.           }
{                    2. Received data ready.                         }
{                    3. Transmit Hold Register Empty.                }
{                    4. Modem Status Change                          }
{                                                                    }
{       In addition, circular queues are used for transmitting       }
{       and receiveing data from the COM1 port.  These queues        }
{       can optionally be turned off if buffer overflow is           }
{       detected.                                                    }
{                                                                    }
{********************************************************************}

Procedure Asynch_Interrupt;

Begin
  inline($50/$53/$51/$52/$57/$56/$06);  {  push all registers }
  inline($1E);                          {  push   ds }
  inline($2E/$8E/$1E/ourDS);            {  mov   DS,CS:ourDS }
  inline($FB) ;

{=============================================================================
  We enter a service loop to handle all interrupts at this point in the code.
  This is neccessary because the 8259 cannot handle another 8250 interrupt
  while we service the last interrupt, hence we are polling the 8250 in this
  routine until all interrupts are serviced.
 =============================================================================}

repeat
  IIRreg := PORT[IIR_Port] ;            {  Get Interrupt Identification  }
  If (IIRreg and $01) = 0 then Begin    {  If interrupt pending then }
    case (IIRreg and $06) of            {  determine cause of interrupt }

    { Received data available }

    $04: Begin
           i4 := i4 + 1 ;
           GetReceivedChar ;
         End ;

    { Received character error interrupt }

    $06: begin
           i6 := i6 + 1 ;
           GetLineStatus ;
         end ;

    { Transmit hold register empty }

    $02: begin
           i2 := i2 + 1 ;
           SendCharacter ;
         end ;

    { Modem status change }

    $00: begin
           i0 := i0 + 1 ;
           GetModemStatus ;
         end ;
    else ;
    end ; { Case }
  end ;

until (IIRreg and $01) = 1 ;

{ Turn off 8259 and restore all registers. }

  PORT[PICCMD] := EOI;                  {  Send End Of Interrupt to 8259 }
  inline($1F);                          {  pop    ds }
  inline($07/$5E/$5F/$5A/$59/$5B/$58);  {  pop rest of regs }
  inline($8B/$E5);                      {  mov    sp,bp }
  inline($5D) ;                         {  pop    bp }
  inline($CF);                          {  iret }
End;


{ Initalize the communications port.  In this version of T301_ASY.INC,
  only one communcations port is supported at a time.  By creating two
  Asynch_Interrupt routines, or decoding which hardware interrupt gen-
  erated the call, both COM ports can be supported simultaneously.

  In the following procedure call, the parameters are as follows:

  ComPort   : An integer representing COM1 or COM2.  [1..2]

  InBuf     : Maximum Input Buffer Size [1..MaxInt]

  OutBuf    : Maximum Output Buffer Size [1..MaxInt]

  Unless you are running at 9600 baud, you can create small buffers
  of around 128 bytes and be perfectly safe from overrunning the buffers.
  At 9600 baud, you may want to create an Input Buffer of about
  1024 to 4096 bytes to handle high speed burst transmissions.  The Out-
  put Buffer is pretty immaterial.  16 to 128 bytes is really all you'll
  need for most applications, although 256 to 512 bytes will help
  marginally speed binary file transfers, IF there is little or no line
  noise.
}

Procedure InitComPort (ComPort, InBuf, OutBuf : Integer) ;

var
  IIR_Port : Integer ;
  temp_ptr : ^tBufferType ;

begin

  OpenError := FALSE ;
                                  {  Init the Const "ourDS" for use by
                                     the Async_Interrupt routine         }
  ourDS := DSEG ;
                                  {  Swap Com interrupt vector           }
  With ComSaveVec Do Begin
    CS := CSEG;
    IP := OFS(Asynch_Interrupt);
  End;

  case Comport of

    2 : ActiveComPort := Com2 ;
    1 : ActiveComPort := Com1 ;
    else begin
           OpenError := TRUE ;
           ActiveComPort := Com1 ;
         end ;
  end ;

  ComBase := BIOSComBaseAddr[ActiveComPort];  {  Select Input Port         }

  { We need to check to see if the requested COMx port exists.  If a 16550
    is active at reset, then the BIOS may not "see" the UART.  We put the code
    through some gyrations to determine what we have, and does it exist.
  }

  if (ComBase = 0) then
  begin
    IIR_Port := ComBaseAddr[ActiveComPort] + $02 ;

    if ((Port[IIR_Port] and $F0) <> 0) then
      begin
        Port[IIR_Port] := 0 ;
        ComBase := ComBaseAddr[ActiveComPort] ;
      end
    else OpenError := TRUE ;
  end ;

  InstallInterrupt(ivlist[ActiveComPort], ComSaveVec);

  with Input do
  begin
    Buffer_Len := InBuf ;
    GetMem (Temp_Ptr, Buffer_Len) ;
    Ring_Buffer := Temp_Ptr ;
  end ;

  with Output do
  begin
    Buffer_Len := OutBuf ;
    GetMem (Temp_Ptr, Buffer_Len) ;
    Ring_Buffer := Temp_Ptr ;
  end ;
end ;

{                     Open COM1 or COM2, a la Basic                  }

Procedure SetCom( Baud, Databits, Stopbits : integer ;
                  Parity : char ) ;

Const

{  Define addresses for the various Async card registers.           }

     RBR = $00;         { xF8   Receive Buffer Register             }
     THR = $00;         { xF8   Transmitter Holding Register        }
     IER = $01;         { xF9   Interrupt Enable Register           }
     FCR = $02;         { xFA   16550 FIFO Control 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     }

      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,
      errclear    : byte ;
      baudindex   : tbaud ;
Begin

  OpenError := FALSE ;            {  Default no error on open.           }
                                  {  Init the Const "ourDS" for use by
                                     the Async_Interrupt routine         }
  imvalue := imlist[ActiveComPort] ;      {  Select Interrupt Mask val }

  Input.Read_Ptr   := 0 ;                 {  Init buffer pointers      }
  Input.Write_Ptr  := 0 ;
  OutPut.Read_Ptr  := 0 ;
  OutPut.Write_Ptr := 0 ;

  RBR_Port := RBR + ComBase ;
  THR_Port := THR + ComBase ;
  IER_POrt := IER + ComBase ;
  IIR_Port := IIR + ComBase ;
  LCR_Port := LCR + ComBase ;
  MCR_Port := MCR + ComBase ;
  LSR_Port := LSR + ComBase ;
  MSR_Port := MSR + ComBase ;
  DLL_Port := DLL + ComBase ;
  DLM_Port := DLM + ComBase ;

  {
     Reset any pending error conditions and turn off DLAB.
  }
  Port[LCR_Port] := Port[LCR_Port] and $7F ;
  errclear := PORT[LSR_Port] ;
  errclear := PORT[RBR_Port] ;
  errclear := PORT[MSR_Port] ;
  {
          Set Baud Rate Divisor Registers and the Line Control Register
  }
  LCRreg := $80;               {  Set Divisor Latch Access Bit in LCR }

  case Parity of
   'S' : LCRreg := LCRreg or paritycode[pSpace] ;
   'O' : LCRreg := LCRreg or paritycode[pOdd]   ;
   'M' : LCRreg := LCRreg or paritycode[pMark]  ;
   'E' : LCRreg := LCRreg or paritycode[pEven]  ;
   'N' : LCRreg := LCRreg or paritycode[pNone]  ;
   else LCRreg  := LCRreg or paritycode[pNone]   ;
  end ; { case }

  case databits of
    5 : LCRreg := LCRreg or databitscode[d5] ;
    6 : LCRreg := LCRreg or databitscode[d6] ;
    7 : LCRreg := LCRreg or databitscode[d7] ;
    8 : LCRreg := LCRreg or databitscode[d8] ;
    else LCRreg := LCRreg or databitscode[d8] ;
  end ; { case }

  case stopbits of
    1 : LCRreg := LCRreg or stopbitscode[s1] ;
    2 : LCRreg := LCRreg or stopbitscode[s2] ;
    else LCRreg := LCRreg or stopbitscode[s1] ;
  end ; { case }

  baudindex := b1200 ;
  if baud = 110 then baudindex := b110 ;
  if baud = 150 then baudindex := b150 ;
  if baud = 300 then baudindex := b300 ;
  if baud = 600 then baudindex := b600 ;
  if baud = 1200 then baudindex := b1200 ;
  if baud = 2400 then baudindex := b2400 ;
  if baud = 4800 then baudindex := b4800 ;
  if baud = 9600 then baudindex := b9600 ;

  inline ($FA) ;
  PORT[LCR_Port] := LCRreg;                  {  Set Parity, Data and Stop Bits
                                             and set DLAB                     }
  PORT[DLM_Port] := Hi(baudcode[Baudindex]); {  Set Baud rate                 }
  PORT[DLL_Port] := Lo(baudcode[Baudindex]); {  Set Baud rate                 }
  PORT[LCR_Port] := LCRreg and $7F ;         {  Reset DLAB                    }

  PORT[PICMSK] := PORT[PICMSK] and imvalue;  {  Enable ASynch Int             }

  { Note: OUT2, despite documentation,  MUST be ON, to enable interrupts      }

  PORT[MCR_Port] := $0F;                     {  Set RTS, DTR, OUT1, OUT2      }
  PORT[IER_Port] := $0D ;                    {  Enable some interrupts        }
  inline ($FB) ;
  {
    Let's determine if a 16550 INS UART is installed.
  }

  t16550 := FALSE ;
  Port[FCR_Port] := $01 ;
  if (Port[IIR_Port] and $C0) <> $00 then
    begin
      Port[FCR_Port] := $00 ;
      t16550 := TRUE ;
      Port[FCR_Port] := $C1 ;
    end ;

  PORT[PICCMD] := EOI ;
  tUseCTS := FALSE ;
  GetLineStatus ;
  GetModemStatus ;
  i0 := 0 ;
  i2 := 0 ;
  i4 := 0 ;
  i6 := 0 ;
  iw := 0 ;
  ir := 0 ;
  ikp := 0 ;
End;


{                 Close any initialized COM                                 }

Procedure CloseCom;
Begin
    inline ($FA) ;
    PORT[IER_Port] := 0 ;   {  Disable Data Avail interrupt        }
    Port[MCR_Port] := 0 ;
                            {  Disable Async interrupt             }
    PORT[PICMSK] := PORT[PICMSK] or ($FF - imvalue);
    inline ($FB) ;
    if t16550 = TRUE then PORT[FCR_Port] := $00 ;
End;

Procedure Break ;

var
    LCRreg,
    DropDTR   : byte ;

begin
    LCRreg := Port[LCR_Port] or $40 ;
    Port[LCR_Port] := LCRreg ;
    Delay (600) ;
    LCRreg := Port[LCR_Port] xor $40 ;
    Port[LCR_Port] := LCRreg ;
end ;

Procedure Purge ;

{ Purpose : Purge all circular queues. }

begin
    Input.Read_Ptr   := 0;                  {  Init buffer pointers      }
    Input.Write_Ptr  := 0;
    OutPut.Read_Ptr  := 0 ;
    OutPut.Write_Ptr := 0 ;

{ Reset 8250 Interrupt Enable Registers. }

  Port [IER_Port] := Port [IER_Port] and $0D ;
  if t16550 = TRUE then PORT[FCR_Port] := PORT[FCR_Port] or $06 ;
end ;

Function  ReadChar : char ;

{
  This routine is intended to function as an AUX or USR logical character
  input device driver.  Usage is AuxInPtr := ofs(Readchar) followed by
  the actual read operation read(AUX, var).
}

Begin
  with Input do
  begin
    ir := ir + 1 ;
    if Read_Ptr = Write_Ptr then ReadChar := chr(0)
    else begin
        ReadChar := CHAR(Ring_Buffer^[Read_Ptr]) ;
        inline ($FA) ;
        Read_Ptr := (Read_Ptr + 1) mod Buffer_Len ;
        inline ($FB) ;
    end ;
  end
End;

Function RS232ChrAvailable : boolean ;

{
  This routine should be checked before reading a character from the RS232
  port, otherwise garbage will be returned and the buffer count messed up.
}

begin
  with Input do
  begin
   If Read_Ptr = Write_Ptr then RS232ChrAvailable := FALSE
      else RS232ChrAvailable := TRUE ;
  end
end ;

Procedure WriteChar (ch:char) ;

{
  This is the corresponding AuxOutPtr routine for use with write (aux, var).
}

begin
  iw := iw + 1;
  with Output do
  begin
    Ring_Buffer^[Read_Ptr] := ORD(ch) ;
    Read_Ptr := (Read_Ptr + 1) mod Buffer_Len ;
  end ; { with }
  Port [IER_Port] := Port [IER_Port] or $02 ;
end ;

Procedure WriteBlock (var Block; size: integer) ;

{
  This routine fills the OutPut.Ring_Buffer^, and then enables THRE interrupt.
}

Label
    reload ;

type
    Block_Ovly = array [1..MaxInt] of Byte ;

Var
    Dummy_Block: Block_Ovly absolute Block ;
    Dummy_Block_Count: Integer ;

begin

  Dummy_Block_Count := 1 ;

  with Output do
  begin
    reload:

    while ((((Read_Ptr + 1) mod Buffer_Len) <> Write_Ptr) and
           (Dummy_Block_Count <= size))
    begin
         Ring_Buffer^[Read_Ptr] := Dummy_Block[Dummy_Block_Count] ;
         Read_Ptr := (Read_Ptr + 1) mod Buffer_Len ;
         Dummy_Block_Count := Dummy_Block_Count + 1
    end
  end ; { with }
    Port [IER_Port] := Port [IER_Port] or $02 ;
    if (Dummy_Block_Count < size) THEN goto reload ;
end ;

Procedure WriteString (var Block: BigString ) ;

{
  This routine fills the OutPut.Ring_Buffer^, and then enables THRE interrupt.
}

Label reload ;

Var
    Dummy_Block_Count: Integer ;

begin
    Dummy_Block_Count := 1 ;

  with Output do
  begin
    reload:

    while ((((Read_Ptr + 1) mod Buffer_Len) <> Write_Ptr) and
           (Dummy_Block_Count <= Length(Block)))
    begin
         Ring_Buffer^[Read_Ptr] := ORD(Block[Dummy_Block_Count]) ;
         Read_Ptr := (Read_Ptr + 1) mod Buffer_Len ;
         Dummy_Block_Count := Dummy_Block_Count + 1
     end ;
  end ;
     Port [IER_Port] := Port [IER_Port] or $02 ;
     if (Dummy_Block_Count < Length(Block)) THEN goto reload ;
end ;

Procedure UseCTS ;

begin
  tUseCTS := TRUE ;
  tCTSTimeOut := 0 ;
end ;