Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/SYSPC22.ZIP/PIBASYNC.PAS

Pascal/Delphi Source File | 1988-04-13 | 23.5 KB | 669 lines

type      regpack=record
       case integer of
         0:(ax,bx,cx,dx,bp,si,di,ds,es,flags:integer);
         1:(al,ah,bl,bh,cl,ch,dl,dh:byte)
     end;

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               *)


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;


Procedure BIOS_RS232_Init( ComPort, ComParm : Integer );


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 *);



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


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 *);


Procedure Async_Isr;


Begin   (* Async_Isr *)


  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)                  *)
(*                                                                      *)
(*                                                                      *)
(*     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 Carrier : 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 *)

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

End   (* Async_Carrier_Detect *);

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

Procedure Setterminalready ( Ready_Status : Boolean );


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 numchars: integer;

(*                                                                      *)
(*     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 *)

if Async_Buffer_Head<>Async_Buffer_Tail then
   numchars :=2 else numchars:=0;

End     (* Async_Buffer_Check *);

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

Function getchar: char;
var c:char;
(*                                                                      *)
(*     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 *)



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

         c := Async_Buffer[ Async_Buffer_Tail ];
             Async_Buffer_Tail := Async_Buffer_Tail + 1;
         If Async_Buffer_Tail > Async_Buffer_Max Then
            Async_Buffer_Tail := 0;
         INLINE( $FB );       (* STI --- Turn on interrupts *)
     Async_Buffer_Used  := Async_Buffer_Used - 1;

         getchar:=c;

End   (* Async_Receive *);


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

Procedure sendchar( C : Char );


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;

   If Counter <> 0 Then Counter := MaxInt;

   While ( Counter <> 0 ) AND
         ( ( Port[UART_LSR + Async_Base] AND $20 ) = 0 ) Do
      Counter := Counter - 1;
  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 *)


End    (* Async_Send *);




var icomoffset:integer;
FUNCTION HUNGUPON:BOOLEAN;FORWARD;





procedure hangup;
var r:regpack;
begin
setterminalready(false);
 delay (200);
end;


procedure UNINIT;
var r:regpack;
begin
Async_close;
end;


procedure setparam (comnum:byte; baud:integer; parity:boolean);
var r:regpack;
    p:byte;
    yomama:boolean;
    q:char;
    k:integer;

begin

  case comnum of
    1:icomoffset:=0;
    2:icomoffset:=-256
  end;
  if parity then begin
  q:='E';
  k:=7;
  end
  else
  begin
  q:='N';
  k:=8;
  end;
  async_init;
repeat until Async_Open (comnum,baud,q,k,1);
 setterminalready(true);
end;



procedure dontanswer;
begin
  setterminalready (false)
end;

procedure doanswer;
begin
  setterminalready (true)
end;

function waitchar:char;
begin
while (not hungupon) and (numchars<1) do;
IF NOT HUNGUPON THEN WAITCHAR:=GETCHAR;
end;