
{ Interrupt driven communication driver and FOSSIL hookset    }
{ Hopelessly hacked up from the original very old PD versions }

Unit ProtComm;

Interface

{$IFDEF ProtEng}
  uses Crt,Dos,ProtTask;
{$ELSE}
  uses Crt,Dos;
{$ENDIF}

Const
   pVersion = '0.04';

  MaxPhysPort    = 7 ;
  BufferSize     = 8196;
  BufferMax      = 8195;

  CommInterrupt  = $14 ;
  I8088_IMR      = $21 ; { port address of the Interrupt Mask Register }

  { register offsets from base of IBM 8250 UART }
  IBM_UART_THR         = $00 ;
  IBM_UART_RBR         = $00 ;
  IBM_UART_IER         = $01 ;
  IBM_UART_IIR         = $02 ;
  IBM_UART_LCR         = $03 ;
  IBM_UART_MCR         = $04 ;
  IBM_UART_LSR         = $05 ;
  IBM_UART_MSR         = $06 ;

  PortTable      : ARRAY [0..MaxPhysPort] OF RECORD
    Base : word ;
    IRQ  : byte
    END  { PortTable record } = ( (Base : $3f8 ;  IRQ : 4),
                                  (Base : $2f8 ;  IRQ : 3),
                                  (Base : $3e8 ;  IRQ : 4),
                                  (Base : $2e8 ;  IRQ : 3),
                                  (Base : 0 ;  IRQ : 0),
                                  (Base : 0 ;  IRQ : 0),
                                  (Base : 0 ;  IRQ : 0),
                                  (Base : 0 ;  IRQ : 0) ) ;


Function  Comm_init(Baud : Longint;ThePort : Byte): Boolean;
Procedure Comm_deinit;
Procedure Comm_setbaud(newrate : Longint);
Procedure Comm_SetDirect(Newrate : Longint);
procedure Comm_setBios(newrate : longint);
Function  Comm_getbaud(ThePort : Byte): Longint;
Procedure Comm_dtr_on;
Procedure Comm_dtr_off;
Function  Comm_Tx_ready : boolean;
Function  Comm_Carrier : boolean;
Function  Comm_Rx_ready : boolean;
Function  Comm_Rx : byte;
Procedure Comm_Tx(ch : byte);
Procedure Comm_FlushOut;
Procedure Comm_ClearOut;
Procedure Comm_ClearIn;
Procedure Comm_SendBreak;
Procedure Comm_Cts_Rts(OnOff : Boolean);

Var
   CanUseFossil : Boolean;
   UsedPort     : Byte;
   UseFossil    : Boolean;

IMPLEMENTATION

uses engine2;

Var
  BIOS_Ports              : byte ;
  ExitSave                : pointer ;
  OriginalVector          : pointer ;
  IsOpen,OverFlow         : BOOLEAN ;
  Base                    : word ;       { base for open port }
  IRQ                     : byte ;       { irq  for open port }
  Buffer                  : ARRAY [0..BufferMax] OF byte ;
  BufferHead              : word ;       { Location in Buffer to put next char }
  BufferTail              : word ;       { Location in Buffer to get next char }
  BufferNewTail           : word ;
  Regs                    : registers;
  Status,RxWord                  : word;
  Old_IER,Old_IIR,Old_LCR,
  Old_MCR,Old_IMR                :byte;
  Cts_Rts_on                     : Boolean;
  CtsTimer                       : Word;

procedure Comm_setBios(newrate : longint);
var
  BaudRate    : Byte;
  Temp0       : Integer;

  begin
   Temp0 := NewRate Div 10;
   case Temp0 of
       30         : baudrate := $43;
       60         : baudrate := $63;
       120        : baudrate := $83;
       240        : baudrate := $a3;
       480        : baudrate := $c3;
       960        : baudrate := $e3;
       1920       : baudrate := $03;
       3840       : baudrate := $23;
   end;
     regs.ah := 0;
     regs.al := baudrate;
     regs.dx := usedport;
     inline($fa);
     Intr($14,regs);
     inline($fb);
end;


Procedure Comm_SetDirect(Newrate : Longint);
Var
   i,j,k        : word;
   temp       : longint;

  begin
     temp := 115200;
     Temp := temp div Newrate;
     Move(Temp,j,2);
     k := port[ibm_Uart_Lcr + base];
     port[ibm_Uart_Lcr + base] := $80;
     Port[Ibm_uart_thr + base] := lo(j);
     Port[Ibm_uart_ier + base]:= hi(j);
     Port[Ibm_Uart_Lcr + base] := $3;
  end;

procedure Comm_setbaud(newrate : longint);

  begin
   If UseFossil then Comm_SetBios(NewRate) else
      Comm_SetDirect(newrate);
  end;

Function Comm_getbaud( ThePort : byte) : Longint;
Var
   i,j,k      : word;
   temp       : longint;
   PortAddr   : word;

  begin
    PortAddr := PortTable[Pred(Theport)].Base ;
    k := port[ibm_Uart_Lcr + portaddr];
    port[ibm_Uart_Lcr + portaddr] := k or $80;
     i := Port[Ibm_uart_thr + portaddr];
     j := Port[Ibm_uart_ier + portaddr];
     j := j * $100;
     j := j + i;
    Port [Ibm_Uart_Lcr + portaddr] := k;
       temp := 115200;
       temp := temp div j;
     Comm_GetBaud := temp;
  end;

function Comm_Carrier : boolean;
begin
Inline
    ($B4/$03/            { Mov ah,3       }
     $8b/$16/UsedPort/   { Mov Dx,Usedport}
     $cd/$14/            { Int 14         }
     $a3/Status);        { Mov Status,Ax  }
     Comm_carrier := ((Status and $0080)<>0);
end;

PROCEDURE DisableInterrupts ;   inline( $FA {cli} ) ;
PROCEDURE EnableInterrupts ;    inline( $FB {sti} ) ;

{---------------------------------------------------------------------------}
{                      ISR - Interrupt Service Routine                      }
{---------------------------------------------------------------------------}

PROCEDURE ISR ; INTERRUPT ;
{ Interrupt Service Routine }
{ Invoked when the USART has received a byte of data from the comm line }
{ More mods by MFD 10th May 1992 for 16550's FIFO's                     }
BEGIN { ISR }
  inline(
    $FB/                                { sti                           }
    {Start:                                                             }
    { get the incoming character                                        }
    { Buffer[BufferHead] := chr(port[base + ibm_uart_rbr]);             }
    $8B/$16/Base/                       { mov dx,Base                   }
    $EC/                                { in al,dx                      }
    $8B/$1E/BufferHead/                 { mov bx,BufferHead             }
    $88/$87/Buffer/                     { mov Buffer[bx],al             }
    { BufferNewHead := succ(BufferHead);                                }
    $43/                                { inc bx                        }
    { if BufferNewHead > BufferMax then BufferNewHead := 0 ;            }
    $81/$FB/BufferMax/                  { cmp bx,BufferMax              }
    $7E/$02/                            { jle l001                      }
    $33/$DB/                            { xor bx,bx                     }
    { if BufferNewHead = BufferTail then Overflow := true               }
    {L001:                                                              }
    $3B/$1E/BufferTail/                 { cmp bx,BufferTail             }
    $75/$07/                            { jne L002                      }
    $C6/$06/Overflow/$01/               { mov overflow,1                }
    $EB/$0E/                            { jmp short L003                }
    { ELSE BEGIN                                                        }
    {   BufferHead := BufferNewHead;                                    }
    {   Async_BufferUsed := succ(Async_BufferUsed);                     }
    {   IF Async_BufferUsed > Async_MaxBufferUsed then                  }
    {     Async_MaxBufferUsed := Async_BufferUsed                       }
    {   END ;                                                           }
    {L002:                                                              }
    $89/$1E/BufferHead/                 { mov BufferHead,bx             }
    $83/$C2/$05/                        { Add dx,5                      }
    { Check FIFO - And process if more bytes.                           }
    $EC/                                { In al,dx                      }
    $24/$01/                            { And al,$01                    }
    $3C/$01/                            { cmp al,$01                    }
    $74/$CF/                            { je start:                     }
    {L003:                                                              }
    $FA/                                { cli                           }
    { issue non-specific EOI                                            }
    { port[$20] := $20 ;                                                }
    $B0/$20/                            { mov al,20h                    }
    $E6/$20                             { out 20h,al                    }
    )
  END { ISR } ;

PROCEDURE Async_Close ;

{ reset the interrupt system when USART interrupts no longer needed }


BEGIN { Async_Close }

if IsOpen then
  begin
    DisableInterrupts;
    port[I8088_IMR] := (port[I8088_IMR] or (1 shl IRQ));
    port[Base + IBM_UART_IER] := old_IER;
    EnableInterrupts ;
    port[Base + IBM_UART_MCR] := Old_Mcr;
    port[Base + IBM_UART_LCR] := Old_lcr;
    SetIntVec( IRQ + 8, OriginalVector ) ;
    IsOpen := False;
    End;
End;

Function init_fossil(Baud : longint;ThePort : Byte): Boolean;

begin
     usedPort := ThePort - 1;
     regs.ah := $4;
     regs.dx := usedport;
     inline($fa);
     intr($14,regs);
     inline($fb);
     if regs.ax <> $1954 then Init_fossil := False
        Else
          begin
            Init_Fossil := true;
            UseFossil := True;
            Comm_SetBaud(Baud);
          end;
end;

Function Async_Open(Baud : Longint; LogicalPortNum: byte): boolean;

VAR
    i,oldIIR : byte ;
    Fifos,Portthere  : Boolean;

BEGIN { Async_Open }
  IF NOT IsOpen THEN
    BEGIN
      BufferHead       := 0 ;
      BufferTail       := 0 ;
      Overflow         := FALSE;
      UsedPort   := PRED(LogicalPortNum);
      fifos := false;
      IsOpen := false;
     If PortTable[UsedPort].Base <> 0 then
       BEGIN
          Base := PortTable[usedPort].Base ;
          IRQ  := PortTable[usedPort].IRQ ;
          Old_ier := port[Base + IBM_UART_IER];
          Old_Mcr := port[Base + IBM_UART_MCR];
          Old_Lcr := port[Base + IBM_UART_LCR];
          Port[Base + Ibm_Uart_Lcr] := $75;
          PortThere := (Port[Base + Ibm_Uart_Lcr] = $75);
          Port[Base + Ibm_Uart_Lcr] := $3;
          If PortThere Then
             begin
                Comm_SetDirect(Baud);
                port[IBM_UART_MCR + Base] := $0b; { Turn on RTS/DTR     }
                OldIIR := Port[base+Ibm_Uart_IIR];
                Port[base + Ibm_Uart_IIR] := 1;            {check for Fifos!}
                Fifos := (port[base + Ibm_uart_IIR] And $c0 = $c0);
                If Not Fifos then Port[base + Ibm_Uart_IIR] := OldIIR;
                GetIntVec(IRQ + 8,OriginalVector);
                SetIntVec(IRQ + 8,@ISR);
                DisableInterrupts ; { --- ENTER CRITICAL REGION -------------------- }
                port[I8088_IMR] := (port[I8088_IMR] and ((1 shl IRQ) xor $FF)) ;
                port[IBM_UART_IER + Base] := $01; { enable data ready interrupt }
                EnableInterrupts ;  { --- EXIT CRITICAL REGION --------------------- }
                IsOpen := TRUE
             end;
       END;
    END;
   Async_Open := IsOpen
  END { Async_Open } ;


{$F+}
PROCEDURE TerminateUnit ; {$F-}

BEGIN { TerminateUnit }
  Async_Close ;
  ExitProc := ExitSave
  END { TerminateUnit } ;

Function Comm_init(Baud : Longint;ThePort : Byte): Boolean;

 begin
  UseFossil := False;
  If
    not IsOpen
  then
    begin
      if
        ((canusefossil) and (Init_Fossil(baud,ThePort)))
      then
        begin
          usefossil:=true;
          Comm_Init := True;
          IsOpen := True;
          Base := PortTable[usedPort].Base ;
        end
      else
        Begin
          If
            Async_Open(Baud,ThePort)
          then
            Begin
              Comm_Init := true;
              IsOpen := True;
            End
          else
            Comm_Init := False;
        End;
    End; {if not isopen}
End;

Function Comm_Rx_ready : boolean;
Var
  AHigh : Byte;
  b:boolean;
 Begin
     if UseFossil Then
       Begin
        Inline
        ($B4/$03/            { Mov ah,3 }
         $8b/$16/UsedPort/   { Mov Dx,[Usedport]}
         $cd/$14/            { Int 14}
         $a3/Status);        { Mov [Status],Al   }
         b := ((Status and $100) <> 0);
       end
     Else
       b := (Bufferhead <> BufferTail);
  comm_rx_ready:=b;
 End;

Procedure Comm_deinit;
   begin
     If IsOpen then
        Begin
           If UseFossil then
           Begin
             regs.ah := $5;
             regs.dx := usedport;
             inline($fa);
             intr($14,regs);
             inline($fb);
           end
           else Async_Close;
           IsOpen := False;
        end;
   End;

Function Comm_Rx: byte;
 Begin
       If UseFossil then
        Begin
             Inline
             ($B4/$02/            { Mov ah,3 }
              $8b/$16/UsedPort/   { Mov Dx,[Usedport]}
              $cd/$14/            { Int 14}
              $a3/RXWord);        { Mov [Status],Al   }
              Comm_Rx := lo(RXWord);
         end
          else
         Begin
               Comm_Rx         := Buffer[BufferTail] ;
               BufferTail := (SUCC( BufferTail ) MOD BufferSize) ;
         end;
 end;

Function Comm_Tx_ready : boolean;

Var
    ctxr,cd, Cts,Thr   : boolean;
    St1           : byte;
begin
 If useFossil then
   begin
   Inline
    ($B4/$03/            { Mov ah,3       }
     $8b/$16/UsedPort/   { Mov Dx,Usedport}
     $cd/$14/            { Int 14         }
     $a3/Status);        { Mov Status,Ax  }
     Thr := (Status and $2000) <> 0;
     Cd := (Status and $0080) <> 0;
     Ctxr := Thr or (not cd);
   End
 Else
   Begin
       Thr := ((port [IBM_UART_LSR + Base] and $20) <> 0);
       St1 := port[ibm_uart_msr +base];
       Cts := (st1 and $10 = $10);
       Cd  := (st1 and $80 = $80);
       If Cts_Rts_On and Cd then
         Ctxr := THR and Cts
       else
         Ctxr := Thr;
   end;
  comm_tx_ready:=ctxr;
end;

Procedure Comm_Tx(ch : byte);

 Begin

{$IFDEF ProtEng}
{    While not Comm_Tx_Ready do
      GiveAwayTime;}
{$ELSE}
{   Repeat
   until Comm_Tx_ready;}
{$ENDIF}
    If UseFossil then
       Begin
           regs.ah := $01;
           regs.al := ch;
           regs.dx := usedport;
           inline($fa);
           intr($14,regs);
           inline($fb);
       End
    else
     port[IBM_uart_thr + base] := ch;
 end;

Procedure Comm_FlushOut;
 Begin
   If Usefossil then
    begin
        regs.Ah := $8;
        Regs.dx := usedport;
        inline($fa);
        Intr($14,regs);
        inline($fb);
    end;
 end;


Procedure Comm_ClearOut;
  Begin
   If UseFossil Then
      Begin
         Regs.Ah := $9;
         Regs.Dx := usedport;
         inline($fa);
         Intr($14,regs);
         inline($fb);
      End;
  end;

Procedure Comm_ClearIn;
  Begin
   If UseFossil then
    Begin
      Regs.Ah := $0a;
      Regs.Dx := usedport;
      inline($fa);
      Intr($14,Regs);
      inline($fb);
    end
   else
    Begin
      BufferHead := 0;
      BufferTail := 0;
      OverFlow   := False;
    End;
  End;

Procedure Comm_SendBreak;

Var
   I,j : Byte;
 Begin
   If UseFossil then
     Begin
      Regs.AX := $1a01;
      Regs.Dx := UsedPort;
      inline($fa);
      Intr($14,regs);
      inline($fb);
      Delay(100);
      Regs.Ax := $1a00;
      Regs.Dx := UsedPort;
      inline($fa);
      Intr($14,regs);
      inline($fb);
     end
   else
     Begin
      I := port[IBM_UART_LCR + Base];
      J := i;
      I := I And $7f;
      I := I or $40;
      Port[IBM_UART_LCR + Base] := I;
      delay(100);
      port[IBM_UART_LCR + Base] := j;
     End;
  End;

Procedure Comm_dtr_on;

Var    i      : Byte;

begin
     If UseFossil then
      Begin
        regs.ah := $06;
        regs.al := $01;
        regs.dx := usedport;
        inline($fa);
        intr($14,regs);
        inline($fb);
      end
     else
      Port [IBM_UART_MCR + Base] := $0b;
End;

Procedure Comm_dtr_off;
Var
   I     : Byte;

begin
   if UseFossil then
     begin
        regs.ah := $06;
        regs.al := $00;
        regs.dx := Usedport;
        inline($fa);
        intr($14,regs);
        inline($fb);
     end
    else
     Port[IBM_Uart_MCR + Base] := $0a;
end;

Procedure Comm_Cts_Rts(OnOff : Boolean);

begin
  if UseFossil then
    begin
     Regs.dx := USedPort;
     If OnOff then regs.al := 2 else Regs.al := 0;
     Regs.ah := $0f;
     inline($fa);
     Intr($14,regs);
     inline($fb);
    end
  else
    Cts_Rts_On := OnOff;
end;


BEGIN { InitializeUnit }
  ExitSave := ExitProc ;
  ExitProc := @TerminateUnit ;
  IsOpen   := FALSE ;
  Overflow := FALSE ;
  CanUseFossil := True;
  Cts_rts_on := True;
  Bios_Ports := 4;
end.


