(*----------------------------------------------------------------------*)
(*         PIBASYNC.PAS   --- Asynchronous I/O for Turbo Pascal         *)
(*----------------------------------------------------------------------*)
(*                                                                      *)
(*  Author:  Philip R. Burns                                            *)
(*  Date:    January, 1985                                              *)
(*  Version: 1.0                                                        *)
(*  Systems: For MS-DOS on IBM PCs and close compatibles only.          *)
(*           Note:  I have checked these on Zenith 151s under           *)
(*                  MSDOS 2.1 and IBM PCs under PCDOS 2.0.              *)
(*                                                                      *)
(*  History: Some of these routines are based upon ones written by:     *)
(*                                                                      *)
(*              Alan Bishop                                             *)
(*              C. J. Dunford                                           *)
(*              Michael Quinlan                                         *)
(*                                                                      *)
(*           I have cleaned up these other authors' code, fixed some    *)
(*           bugs, and added many new features.                         *)
(*                                                                      *)
(*           Suggestions for improvements or corrections are welcome.   *)
(*           Please leave messages on Gene Plantz's BBS (312) 882 4145  *)
(*           or Ron Fox's BBS (312) 940 6496.                           *)
(*                                                                      *)
(*           If you use this code in your own programs, please be nice  *)
(*           and give all of us credit.                                 *)
(*                                                                      *)
(*----------------------------------------------------------------------*)
(*                                                                      *)
(*  Routines:                                                           *)
(*                                                                      *)
(*     Async_Init             ---    Performs initialization.           *)
(*     Async_Open             ---    Sets up COM port                   *)
(*     Async_Close            ---    Closes down COM port               *)
(*     Async_Carrier_Detect   ---    Checks for modem carrier detect    *)
(*     Async_Carrier_Drop     ---    Checks for modem carrier drop      *)
(*     Async_Buffer_Check     ---    Checks if character in COM buffer  *)
(*     Async_Term_Ready       ---    Toggles terminal ready status      *)
(*     Async_Receive          ---    Reads character from COM buffer    *)
(*     Async_Receive_With_Timeout                                       *)
(*                            ---    Receives char. with timeout check  *)
(*     Async_Send             ---    Transmits char over COM port       *)
(*     Async_Send_String      ---    Sends string over COM port         *)
(*     Async_Send_String_With_Delays                                    *)
(*                            ---    Sends string with timed delays     *)
(*     Async_Send_Break       ---    Sends break (attention) signal     *)
(*     Async_Percentage_Used  ---    Returns percentage com buffer used *)
(*     Async_Purge_Buffer     ---    Purges receive buffer              *)
(*                                                                      *)
(*----------------------------------------------------------------------*)
(*                                                                      *)
(*----------------------------------------------------------------------*)


(*----------------------------------------------------------------------*)
(*                                                                      *)
(*                  COMMUNICATIONS HARDWARE ADDRESSES                   *)
(*                                                                      *)
(*        These are specific to IBM PCs and close compatibles.          *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

Const

   UART_THR = $00;       (* offset from base of UART Registers for IBM PC *)
   UART_RBR = $00;
   UART_IER = $01;
   UART_IIR = $02;
   UART_LCR = $03;
   UART_MCR = $04;
   UART_LSR = $05;
   UART_MSR = $06;

   I8088_IMR = $21;      (* port address of the Interrupt Mask Register *)

   COM1_Base = $03F8;    (* port addresses for the UART *)
   COM2_Base = $02F8;

   COM1_Irq = 4;         (* Interrupt line for the UART *)
   COM2_Irq = 3;

Const

   Async_DSeg_Save : Integer = 0;  (* Save DS reg in Code Segment for *)
                                   (* interrupt routine               *)

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*                   COMMUNICATIONS BUFFER VARIABLES                    *)
(*                                                                      *)
(*     The Communications Buffer is implemented as a circular (ring)    *)
(*     buffer, or double-ended queue.  The asynchronous I/O routines    *)
(*     enter characters in the buffer as they are received.  Higher-    *)
(*     level routines may extract characters from the buffer.           *)
(*                                                                      *)
(*     Note that this buffer is used for input only;  output is done    *)
(*     on a character-by-character basis.                               *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

Const

   Async_Buffer_Max    = 8191;       (* Size of Communications Buffer   *)
   Async_Loops_Per_Sec = 6500;       (* Loops per second -- 4.77 clock  *)
   TimeOut             = 256;        (* TimeOut value                   *)

Var
                                     (* Communications Buffer Itself *)

   Async_Buffer          : Array[0..Async_Buffer_Max] of Char;

   Async_Open_Flag       : Boolean;  (* true if Open but no Close         *)
   Async_Port            : Integer;  (* current Open port number (1 or 2) *)
   Async_Base            : Integer;  (* base for current open port        *)
   Async_Irq             : Integer;  (* irq for current open port         *)

   Async_Buffer_Overflow : Boolean;  (* True if buffer overflow has happened *)
   Async_Buffer_Used     : Integer;
   Async_MaxBufferUsed   : Integer;

                                     (* Async_Buffer empty if Head = Tail    *)
   Async_Buffer_Head    : Integer;   (* Loc in Async_Buffer to put next char *)
   Async_Buffer_Tail    : Integer;   (* Loc in Async_Buffer to get next char *)
   Async_Buffer_NewTail : Integer;

(*----------------------------------------------------------------------*)
(*                BIOS_RS232_Init --- Initialize UART                   *)
(*----------------------------------------------------------------------*)

Procedure BIOS_RS232_Init( ComPort, ComParm : Integer );

(*                                                                      *)
(*     Procedure:  BIOS_RS232_Init                                      *)
(*                                                                      *)
(*     Purpose:    Issues interrupt $14 to initialize the UART          *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        BIOS_RS232_Init( ComPort, ComParm : Integer );                *)
(*                                                                      *)
(*           ComPort  --- Communications Port Number (1 or 2)           *)
(*           ComParm  --- Communications Parameter Word                 *)
(*                                                                      *)
(*      Calls:   INTR   (to perform BIOS interrupt $14)                 *)
(*                                                                      *)

Var
   Regs: RegPack;

Begin   (* BIOS_RS232_Init *)

   With Regs Do
      Begin
         Ax := ComParm AND $00FF;  (* AH=0; AL=ComParm   *)
         Dx := ComPort;            (* Port number to use *)
         INTR($14, Regs);
      End;

End    (* BIOS_RS232_Init *);


(*----------------------------------------------------------------------*)
(*             DOS_Set_Intrpt --- Call DOS to set interrupt vector      *)
(*----------------------------------------------------------------------*)

Procedure DOS_Set_Intrpt( v, s, o : Integer );

(*                                                                      *)
(*     Procedure:  DOS_Set_Intrpt                                       *)
(*                                                                      *)
(*     Purpose:    Calls DOS to set interrupt vector                    *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        DOS_Set_Intrpt( v, s, o : Integer );                          *)
(*                                                                      *)
(*           v --- interrupt vector number to set                       *)
(*           s --- segment address of interrupt routine                 *)
(*           o --- offset address of interrupt routine                  *)
(*                                                                      *)
(*      Calls:   MSDOS   (to set interrupt)                             *)
(*                                                                      *)

Var
   Regs : Regpack;

Begin   (* DOS_Set_Intrpt *)

   With Regs Do
      Begin
         Ax := $2500 + ( v AND $00FF );
         Ds := s;
         Dx := o;
         MsDos( Regs );
      End;

End    (* DOS_Set_Intrpt *);

(*----------------------------------------------------------------------*)
(*               Async_Isr --- Interrupt Service Routine                *)
(*----------------------------------------------------------------------*)

Procedure Async_Isr;

(*                                                                      *)
(*     Procedure:  Async_Isr                                            *)
(*                                                                      *)
(*     Purpose:    Invoked when UART has received character from        *)
(*                 communications line  (asynchronous)                  *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Isr;                                                    *)
(*                                                                      *)
(*           --- Called asyncronously only!!!!!!                        *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*        This is Michael Quinlan's version of the interrupt handler.   *)
(*                                                                      *)

Begin   (* Async_Isr *)

  (*  NOTE: on entry, Turbo Pascal has already PUSHed BP and SP  *)

  Inline(
      (* save all registers used *)
    $50/                           (* PUSH AX *)
    $53/                           (* PUSH BX *)
    $52/                           (* PUSH DX *)
    $1E/                           (* PUSH DS *) 
    $FB/                           (* STI *)
      (* set up the DS register to point to Turbo Pascal's data segment *)
    $2E/$FF/$36/Async_Dseg_Save/   (* PUSH CS:Async_Dseg_Save *)
    $1F/                           (* POP DS *)
      (* get the incomming character *) 
      (* Async_Buffer[Async_Buffer_Head] := Chr(Port[UART_RBR + Async_Base]); *) 
    $8B/$16/Async_Base/            (* MOV DX,Async_Base *) 
    $EC/                           (* IN AL,DX *)
    $8B/$1E/Async_Buffer_Head/     (* MOV BX,Async_Buffer_Head *) 
    $88/$87/Async_Buffer/          (* MOV Async_Buffer[BX],AL *)
      (* Async_Buffer_NewHead := Async_Buffer_Head + 1; *)
    $43/                           (* INC BX *)
      (* if Async_Buffer_NewHead > Async_Buffer_Max then
          Async_Buffer_NewHead := 0; *)
    $81/$FB/Async_Buffer_Max/      (* CMP BX,Async_Buffer_Max *)
    $7E/$02/                       (* JLE L001 *) 
    $33/$DB/                       (* XOR BX,BX *)
      (* if Async_Buffer_NewHead = Async_Buffer_Tail then
          Async_Buffer_Overflow := TRUE
        else *)
(*L001:*)
    $3B/$1E/Async_Buffer_Tail/     (* CMP BX,Async_Buffer_Tail *)
    $75/$08/                       (* JNE L002 *) 
    $C6/$06/Async_Buffer_Overflow/$01/ (* MOV Async_Buffer_Overflow,1 *)
    $90/                           (* NOP generated by assembler for some reason *)
    $EB/$16/                       (* JMP SHORT L003 *)
      (* begin
          Async_Buffer_Head := Async_Buffer_NewHead; 
          Async_Buffer_Used := Async_Buffer_Used + 1; 
          if Async_Buffer_Used > Async_MaxBufferUsed then 
            Async_MaxBufferUsed := Async_Buffer_Used
        end; *) 
(*L002:*)
    $89/$1E/Async_Buffer_Head/     (* MOV Async_Buffer_Head,BX *)
    $FF/$06/Async_Buffer_Used/     (* INC Async_Buffer_Used *)
    $8B/$1E/Async_Buffer_Used/     (* MOV BX,Async_Buffer_Used *)
    $3B/$1E/Async_MaxBufferUsed/   (* CMP BX,Async_MaxBufferUsed *)
    $7E/$04/                       (* JLE L003 *)
    $89/$1E/Async_MaxBufferUsed/   (* MOV Async_MaxBufferUsed,BX *) 
(*L003:*)
      (* disable interrupts *)
    $FA/                           (* CLI *)
      (* Port[$20] := $20; *)  (* use non-specific EOI *)
    $B0/$20/                       (* MOV AL,20h *)
    $E6/$20/                       (* OUT 20h,AL *)
      (* restore the registers then use IRET to return *)
      (* the last two POPs are required because Turbo Pascal PUSHes these regs
        before we get control.  The manual doesn't say so, but that is what
        really happens *)
    $1F/                           (* POP DS *)
    $5A/                           (* POP DX *)
    $5B/                           (* POP BX *)
    $58/                           (* POP AX *)
    $5C/                           (* POP SP *)
    $5D/                           (* POP BP *)
    $CF)                           (* IRET *)

End    (* Async_Isr *);

(*----------------------------------------------------------------------*)
(*               Async_Init --- Initialize Asynchronous Variables       *)
(*----------------------------------------------------------------------*)

Procedure Async_Init;

(*                                                                      *)
(*     Procedure:  Async_Init                                           *)
(*                                                                      *)
(*     Purpose:    Initializes variables                                *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Init;                                                   *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)

Begin   (* Async_Init *)

  Async_DSeg_Save       := DSeg;
  Async_Open_Flag       := FALSE;
  Async_Buffer_Overflow := FALSE;
  Async_Buffer_Used     := 0;
  Async_MaxBufferUsed   := 0;

End     (* Async_Init *);

(*----------------------------------------------------------------------*)
(*               Async_Close --- Close down communications interrupts   *)
(*----------------------------------------------------------------------*)

Procedure Async_Close;

(*                                                                      *)
(*     Procedure:  Async_Close                                          *)
(*                                                                      *)
(*     Purpose:    Resets interrupt system when UART interrupts         *)
(*                 are no longer needed.                                *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Close;                                                  *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)

Var
   i : Integer;
   m : Integer;

Begin  (* Async_Close *)

   If Async_Open_Flag Then
      Begin

                     (* disable the IRQ on the 8259 *)

         Inline($FA);                 (* disable interrupts *)

         i := Port[I8088_IMR];        (* get the interrupt mask register *)
         m := 1 shl Async_Irq;        (* set mask to turn off interrupt  *)
         Port[I8088_IMR] := i or m;

                     (* disable the 8250 data ready interrupt *)

         Port[UART_IER + Async_Base] := 0;

                     (* disable OUT2 on the 8250 *)

         Port[UART_MCR + Async_Base] := 0;

         Inline($FB);                 (* enable interrupts *)

                     (* re-initialize our data areas so we know *)
                     (* the port is closed                      *)

         Async_Open_Flag := FALSE;

      End;

End    (* Async_Close *);

(*----------------------------------------------------------------------*)
(*               Async_Open --- Open communications port                *)
(*----------------------------------------------------------------------*)

Function Async_Open( ComPort       : Integer;
                     BaudRate      : Integer;
                     Parity        : Char;
                     WordSize      : Integer;
                     StopBits      : Integer  ) : Boolean;

(*                                                                      *)
(*     Function:   Async_Open                                           *)
(*                                                                      *)
(*     Purpose:    Opens communications port                            *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Flag := Async_Open( ComPort       : Integer;                  *)
(*                            BaudRate      : Integer;                  *)
(*                            Parity        : Char;                     *)
(*                            WordSize      : Integer;                  *)
(*                            StopBits      : Integer) : Boolean;       *)
(*                                                                      *)
(*           ComPort  --- which port (1 or 2)                           *)
(*           BaudRate --- Baud rate (110 to 9600)                       *)
(*           Parity   --- "E" for even, "O" for odd, "N" for none       *)
(*           WordSize --- Bits per character  (5 through 8)             *)
(*           StopBits --- How many stop bits  (1 or 2)                  *)
(*                                                                      *)
(*           Flag returned TRUE if port initialized successfully;       *)
(*           Flag returned FALSE if any errors.                         *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        BIOS_RS232_Init --- initialize RS232 port                     *)
(*        DOS_Set_Intrpt  --- set address of RS232 interrupt routine    *)
(*                                                                      *)

Const   (* Baud Rate Constants *)

   Async_Num_Bauds = 8;

   Async_Baud_Table : Array [1..Async_Num_Bauds] Of Record
                                                       Baud, Bits : Integer;
                                                    End

                    = ( ( Baud: 110;  Bits: $00 ),
                        ( Baud: 150;  Bits: $20 ),
                        ( Baud: 300;  Bits: $40 ),
                        ( Baud: 600;  Bits: $60 ),
                        ( Baud: 1200; Bits: $80 ),
                        ( Baud: 2400; Bits: $A0 ),
                        ( Baud: 4800; Bits: $C0 ),
                        ( Baud: 9600; Bits: $E0 ) );

Var
   ComParm : Integer;
   i       : Integer;
   m       : Integer;

Begin  (* Async_Open *)

                             (* If port open, close it down first. *)

   If Async_Open_Flag Then Async_Close;

                             (* Choose communications port *)
   If ComPort = 2 Then
      Begin
         Async_Port := 2;
         Async_Base := COM2_Base;
         Async_Irq  := COM2_Irq;
      End
   Else
      Begin
         Async_Port := 1;  (* default to COM1 *)
         Async_Base := COM1_Base;
         Async_Irq  := COM1_Irq;
      End;

   If (Port[UART_IIR + Async_Base] and $00F8) <> 0 Then
      Async_Open := FALSE    (* Serial port not installed *)
   Else
      Begin   (* Open the port *)

                   (* Set buffer pointers *)

         Async_Buffer_Head     := 0;
         Async_Buffer_Tail     := 0;
         Async_Buffer_Overflow := FALSE;

            (*---------------------------------------------------*)
            (*    Build the ComParm for RS232_Init               *)
            (*    See Technical Reference Manual for description *)
            (*---------------------------------------------------*)

                   (* Set up the bits for the baud rate *)

         If BaudRate > 9600 Then
            BaudRate := 9600
         Else If BaudRate <= 0 Then
            BaudRate := 300;

         i := 0;

         Repeat
            i := i + 1
         Until ( ( i >= Async_Num_Bauds ) OR
                 ( BaudRate = Async_Baud_Table[i].Baud ) );

         ComParm := Async_Baud_Table[i].Bits;

                   (* Choose Parity *)

         If Parity In ['E', 'e'] Then
            ComParm := ComParm or $0018
         Else If Parity In ['O', 'o'] Then
            ComParm := ComParm or $0008;

                   (* Choose number of data bits *)

         WordSize := WordSize - 5;

         If ( WordSize < 0 ) OR ( WordSize > 3 ) Then
            WordSize := 3;

         ComParm := ComParm OR WordSize;

                   (* Choose stop bits *)

         If StopBits = 2 Then
            ComParm := ComParm OR $0004;  (* default is 1 stop bit *)

                   (* use the BIOS COM port initialization routine *)

         BIOS_RS232_Init( Async_Port - 1 , ComParm );

         DOS_Set_Intrpt( Async_Irq + 8 , CSeg , Ofs( Async_Isr ) );

                   (* Read the RBR and reset any pending error conditions. *)
                   (* First turn off the Divisor Access Latch Bit to allow *)
                   (* access to RBR, etc.                                  *)

         Inline($FA);  (* disable interrupts *)

         Port[UART_LCR + Async_Base] := Port[UART_LCR + Async_Base] and $7F;

                   (* Read the Line Status Register to reset any errors *)
                   (* it indicates                                      *)

         i := Port[UART_LSR + Async_Base];

                   (* Read the Receiver Buffer Register in case it *)
                   (* contains a character                         *)

         i := Port[UART_RBR + Async_Base];

                   (* enable the irq on the 8259 controller *)

         i := Port[I8088_IMR];  (* get the interrupt mask register *)
         m := (1 shl Async_Irq) xor $00FF;

         Port[I8088_IMR] := i and m;

                   (* enable the data ready interrupt on the 8250 *)

         Port[UART_IER + Async_Base] := $01;

                   (* enable OUT2 on 8250 *)

         i := Port[UART_MCR + Async_Base];
         Port[UART_MCR + Async_Base] := i or $08;


         Inline($FB); (* enable interrupts *)

         Async_Open := TRUE

    End;

End   (* Async_Open *);

(*----------------------------------------------------------------------*)
(*      Async_Carrier_Detect --- Check for modem carrier detect         *)
(*----------------------------------------------------------------------*)

Function Async_Carrier_Detect : Boolean;

(*                                                                      *)
(*     Function:   Async_Carrier_Detect                                 *)
(*                                                                      *)
(*     Purpose:    Looks for modem carrier detect                       *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Flag := Async_Carrier_Detect : Boolean;                       *)
(*                                                                      *)
(*           Flag is set TRUE if carrier detected, else FALSE.          *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)

Begin (* Async_Carrier_Detect *)

   Async_Carrier_Detect := ODD( Port[ UART_MSR + Async_Base ] SHR 7 );

End   (* Async_Carrier_Detect *);

(*----------------------------------------------------------------------*)
(*      Async_Carrier_Drop --- Check for modem carrier drop/timeout     *)
(*----------------------------------------------------------------------*)

Function Async_Carrier_Drop : Boolean;

(*                                                                      *)
(*     Function:   Async_Carrier_Drop                                   *)
(*                                                                      *)
(*     Purpose:    Looks for modem carrier drop/timeout                 *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Flag := Async_Carrier_Drop : Boolean;                         *)
(*                                                                      *)
(*           Flag is set TRUE if carrier dropped, else FALSE.           *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)

Begin (* Async_Carrier_Drop *)

   Async_Carrier_Drop := NOT ODD( Port[ UART_MSR + Async_Base ] SHR 7 );

End   (* Async_Carrier_Drop *);

(*----------------------------------------------------------------------*)
(*      Async_Term_Ready --- Set terminal ready status                  *)
(*----------------------------------------------------------------------*)

Procedure Async_Term_Ready( Ready_Status : Boolean );

(*                                                                      *)
(*     Procedure:  Async_Term_Ready                                     *)
(*                                                                      *)
(*     Purpose:    Sets terminal ready status                           *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Term_Ready( Ready_Status : Boolean );                   *)
(*                                                                      *)
(*           Ready_Status --- Set TRUE to set terminal ready on,        *)
(*                            Set FALSE to set terminal ready off.      *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)

Var
   Mcr_Value: Byte;

Begin (* Async_Term_Ready *)

   Mcr_Value := Port[ UART_MCR + Async_Base ];

   If ODD( Mcr_Value ) Then Mcr_Value := Mcr_Value - 1;

   If Ready_Status Then Mcr_Value := Mcr_Value + 1;

   Port[ UART_MCR + Async_Base ] := Mcr_Value;

End   (* Async_Term_Ready *);

(*----------------------------------------------------------------------*)
(*          Async_Buffer_Check --- Check if character in buffer         *)
(*----------------------------------------------------------------------*)

Function Async_Buffer_Check : Boolean;

(*                                                                      *)
(*     Function:   Async_Buffer_Check                                   *)
(*                                                                      *)
(*     Purpose:    Check if character in buffer                         *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Flag := Async_Buffer_Check : Boolean;                         *)
(*                                                                      *)
(*           Flag returned TRUE if character received in buffer,        *)
(*           Flag returned FALSE if no character received.              *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*       This routine only checks if a character has been received      *)
(*       and thus can be read; it does NOT return the character.        *)
(*       Use Async_Receive to read the character.                       *)
(*                                                                      *)

Begin   (* Async_Buffer_Check *)

   Async_Buffer_Check := ( Async_Buffer_Head <> Async_Buffer_Tail );

End     (* Async_Buffer_Check *);

(*----------------------------------------------------------------------*)
(*          Async_Receive --- Return character from buffer              *)
(*----------------------------------------------------------------------*)

Function Async_Receive( Var C : Char ) : Boolean;

(*                                                                      *)
(*     Function:   Async_Receive                                        *)
(*                                                                      *)
(*     Purpose:    Retrieve character (if any) from buffer              *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Flag := Async_Receive( Var C: Char ) : Boolean;               *)
(*                                                                      *)
(*           C --- character (if any) retrieved from buffer;            *)
(*                 set to CHR(0) if no character available.             *)
(*                                                                      *)
(*           Flag returned TRUE if character retrieved from buffer,     *)
(*           Flag returned FALSE if no character retrieved.             *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)

Begin   (* Async_Receive *)

   If Async_Buffer_Head = Async_Buffer_Tail Then
      Begin (* No character to retrieve *)

         Async_Receive := FALSE;
         C             := CHR( 0 );

      End   (* No character available   *)

   Else
      Begin (* Character available *)

                   (* Turn off interrupts *)

         INLINE( $FA );       (* CLI --- Turn off interrupts *)

                   (* Get character from buffer *)

         C := Async_Buffer[ Async_Buffer_Tail ];

                   (* Increment buffer pointer.   If past *)
                   (* end of buffer, reset to beginning.  *)

         Async_Buffer_Tail := Async_Buffer_Tail + 1;

         If Async_Buffer_Tail > Async_Buffer_Max Then
            Async_Buffer_Tail := 0;

                   (* Decrement buffer use count *)

         Async_Buffer_Used  := Async_Buffer_Used - 1;

                   (* Turn on interrupts *)

         INLINE( $FB );       (* STI --- Turn on interrupts *)

                   (* Indicate character successfully retrieved *)

         Async_Receive := TRUE;

      End   (* Character available *);

End   (* Async_Receive *);

(*----------------------------------------------------------------------*)
(*   Async_Receive_With_TimeOut --- Return char. from buffer with delay *)
(*----------------------------------------------------------------------*)

Procedure Async_Receive_With_Timeout( Secs : Integer; Var C : Integer );

(*                                                                      *)
(*     Procedure:  Async_Receive_With_Delay                            *)
(*                                                                      *)
(*     Purpose:    Retrieve character as integer from buffer,           *)
(*                 or return TimeOut if specified delay period          *)
(*                 expires.                                             *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Receive_With_Timeout( Secs: Integer; Var C: Integer );  *)
(*                                                                      *)
(*           Secs ---  Timeout period in seconds                        *)
(*           C     --- ORD(character) (if any) retrieved from buffer;   *)
(*                     set to TimeOut if no character found before      *)
(*                     delay period expires.                            *)
(*                                                                      *)
(*     Calls:  Async_Receive                                            *)
(*                                                                      *)
(*     WATCH OUT!  THIS ROUTINE RETURNS AN INTEGER, NOT A CHARACTER!!!  *)
(*                                                                      *)
(*     Note:  This routine uses a CPU loop to do timing.  The value of  *)
(*            the constant used is suitable for 4.77 MHz CPUs.  If your *)
(*            CPU is faster or slower, you will need to adjust the      *)
(*            value of ASYNC_LOOPS_PER_SEC.                             *)
(*                                                                      *)

Var
   Isecs        : Integer;
   Jsecs        : Integer;
   I            : Integer;
   J            : Integer;
   Char_Waiting : Boolean;
   Ch           : Char;

Begin (* Async_Receive_With_Timeout *)

   I     := Maxint DIV Async_Loops_Per_Sec;
   Isecs := ( Secs + I - 1 ) DIV I;
   Jsecs := ( Secs - Isecs * ( I - 1 ) ) * Async_Loops_Per_Sec;
   Isecs := Isecs + 1;

   Repeat
      J := Jsecs;
      Repeat
         J            := J - 1;
         Char_Waiting := ( Async_Buffer_Head <> Async_Buffer_Tail );
      Until( ( J = 0 ) OR ( Char_Waiting ) );
      Isecs  := Isecs - 1;
   Until( ( Isecs = 0 ) OR ( Char_Waiting ) );

   If ( NOT Char_Waiting) Then
      C := TimeOut
   Else
      Begin
         Char_Waiting := Async_Receive( Ch );
         C := ORD( Ch );
      End;

End   (* Async_Receive_With_Timeout *);

(*----------------------------------------------------------------------*)
(*          Async_Send --- Send character over communications port      *)
(*----------------------------------------------------------------------*)

Procedure Async_Send( C : Char );

(*                                                                      *)
(*     Procedure:  Async_Send                                           *)
(*                                                                      *)
(*     Purpose:    Sends character out over communications port         *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Send( C : Char );                                       *)
(*                                                                      *)
(*           C --- Character to send                                    *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)

Var
   i       : Integer;
   m       : Integer;
   Counter : Integer;

Begin   (* Async_Send *)

                   (* Turn on OUT2, DTR, and RTS *)

   Port[UART_MCR + Async_Base] := $0B;

                   (* Wait for CTS using Busy Wait *)

   Counter := MaxInt;

   While ( Counter <> 0 ) AND
         ( ( Port[UART_MSR + Async_Base] AND $10 ) = 0 ) Do
      Counter := Counter - 1;

                   (* Wait for Transmit Hold Register Empty (THRE) *)

   If Counter <> 0 Then Counter := MaxInt;

   While ( Counter <> 0 ) AND
         ( ( Port[UART_LSR + Async_Base] AND $20 ) = 0 ) Do
      Counter := Counter - 1;

                   (* Send the character if port clear *)

  If Counter <> 0 Then
     Begin  (* Send the Character *)

        Inline($FA); (* CLI --- disable interrupts *)

        Port[UART_THR + Async_Base] := Ord(C);

        Inline($FB); (* STI --- enable interrupts *)

     End    (* Send the Character *)

  Else  (* Timed Out *)
     Writeln('<<<TIMEOUT>>>');

End    (* Async_Send *);

(*----------------------------------------------------------------------*)
(*          Async_Send_Break --- Send break (attention) signal          *)
(*----------------------------------------------------------------------*)

Procedure Async_Send_Break;

(*                                                                      *)
(*     Procedure:  Async_Send_Break                                     *)
(*                                                                      *)
(*     Purpose:    Sends break signal over communications port          *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Send_Break;                                             *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)

Var
   Old_Lcr   : Byte;
   Break_Lcr : Byte;

Begin (* Async_Send_Break *)

   Old_Lcr   := Port[ UART_LCR + Async_Base ];
   Break_Lcr := Old_Lcr;

   If Break_Lcr >  127 Then Break_Lcr := Break_Lcr - 128;
   If Break_Lcr <=  63 Then Break_Lcr := Break_Lcr +  64;

   Port[ UART_LCR + Async_Base ] := Break_Lcr;

   Delay( 400 );

   Port[ UART_LCR + Async_Base ] := Old_Lcr;

End   (* Async_Send_Break *);

(*----------------------------------------------------------------------*)
(*     Async_Send_String --- Send string over communications port       *)
(*----------------------------------------------------------------------*)

Procedure Async_Send_String( S : AnyStr );

(*                                                                      *)
(*     Procedure:  Async_Send_String                                    *)
(*                                                                      *)
(*     Purpose:    Sends string out over communications port            *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Send_String( S : AnyStr );                              *)
(*                                                                      *)
(*           S --- String to send                                       *)
(*                                                                      *)
(*     Calls:  Async_Send                                               *)
(*                                                                      *)

Var
   i : Integer;

Begin  (* Async_Send_String *)

  For i := 1 To LENGTH( S ) Do
     Async_Send( S[i] )

End    (* Async_Send_String *);

(*----------------------------------------------------------------------*)
(*     Async_Send_String_With_Delays --- Send string with timed delays  *)
(*----------------------------------------------------------------------*)

Procedure Async_Send_String_With_Delays( S          : AnyStr;
                                         Char_Delay : Integer;
                                         EOS_Delay  : Integer  );

(*                                                                      *)
(*     Procedure:  Async_Send_String_With_Delays                        *)
(*                                                                      *)
(*     Purpose:    Sends string out over communications port with       *)
(*                 specified delays for each character and at the       *)
(*                 end of the string.                                   *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Send_String_With_Delays( S          : AnyStr ;          *)
(*                                       Char_Delay : Integer;          *)
(*                                       EOS_Delay  : Integer );        *)
(*                                                                      *)
(*           S          --- String to send                              *)
(*           Char_Delay --- Number of milliseconds to delay after       *)
(*                          sending each character                      *)
(*           EOS_Delay  --- Number of milleseconds to delay after       *)
(*                          sending last character in string            *)
(*                                                                      *)
(*     Calls:  Async_Send                                               *)
(*             Async_Send_String                                        *)
(*             Length                                                   *)
(*             Delay                                                    *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*        This routine is useful when writing routines to perform       *)
(*        non-protocol uploads.  Many computer systems require delays   *)
(*        between receipt of characters for correct processing.  The    *)
(*        delay for end-of-string usually applies when the string       *)
(*        represents an entire line of a file.                          *)
(*                                                                      *)
(*        If delays are not required, Async_Send_String is faster.      *)
(*        This routine will call Async_Send_String is no character      *)
(*        delay is to be done.                                          *)
(*                                                                      *)

Var
   I : Integer;

Begin  (* Async_Send_String_With_Delays *)

   If Char_Delay <= 0 Then
      Async_Send_String( S )
   Else
      For I := 1 To LENGTH( S ) Do
         Begin
            Async_Send( S[I] );
            Delay( Char_Delay );
         End;

   If EOS_Delay > 0 Then Delay( EOS_Delay );

End    (* Async_Send_String_With_Delays *);

(*----------------------------------------------------------------------*)
(*      Async_Percentage_Used --- Report Percentage Buffer Filled       *)
(*----------------------------------------------------------------------*)

Function Async_Percentage_Used : Real;

(*                                                                      *)
(*     Function:   Async_Percent_Used                                   *)
(*                                                                      *)
(*     Purpose:    Reports percentage of com buffer currently filled    *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Percentage := Async_Percentage_Used : Real;                   *)
(*                                                                      *)
(*           Percentage gets how much of buffer is filled;              *)
(*           value goes from 0.0 (empty) to 1.0 (totally full).         *)
(*                                                                      *)
(*     Calls:  None                                                     *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*       This routine is helpful when incorporating handshaking into    *)
(*       a communications program.  For example, assume that the host   *)
(*       computer uses the XON/XOFF (DC1/DC3) protocol.  Then the       *)
(*       PC program should issue an XOFF  to the host when the value    *)
(*       returned by Async_Percentage_Used > .75 or so.  When the       *)
(*       utilization percentage drops below .25 or so, the PC program   *)
(*       should transmit an XON.                                        *)
(*                                                                      *)

Begin (* Async_Percentage_Used *)

   Async_Percentage_Used := Async_Buffer_Used / ( Async_Buffer_Max + 1 );

End   (* Async_Percentage_Used *);

(*----------------------------------------------------------------------*)
(*     Async_Purge_Buffer --- Purge communications input buffer         *)
(*----------------------------------------------------------------------*)

Procedure Async_Purge_Buffer;

(*                                                                      *)
(*     Procedure:  Async_Purge_Buffer                                   *)
(*                                                                      *)
(*     Purpose:    Purges communications input buffer                   *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Async_Purge_Buffer;                                           *)
(*                                                                      *)
(*     Calls:  Async_Receive                                            *)
(*                                                                      *)

Var
   C: Char;

Begin  (* Async_Purge_Buffer *)

   Repeat
      Delay( 35 );
   Until ( NOT Async_Receive( C ) );

End    (* Async_Purge_Buffer *);