Power-Programmierung/CD1.mdf/pascal/library/dos/communic/async4_2/async4.pas

Pascal/Delphi Source File | 1987-11-14 | 33.9 KB | 1,082 lines

{ Async4: Combined IBM, DG/1 serial interrupt handler unit  4.0b, 11 Nov 87 }
{****************************************************************************

                                 Async4 Unit

               Async4 Communication Routines by Michael Quinlan
                Extended for use with DG1 by N. Arley Dealey
                Customized for ZAPCIS use by N. Arley Dealey
         Converted to Turbo Pascal version 4 unit by N. Arley Dealey

                                     ----

NOTES:
  1.  This is a quick and dirty adaptation of a quick and dirty hack of
      Michael Quinlan's original work... don't expect beauty.  It does,
      however, seem to work well enough within its basic design limitations.
      The adaptation is also incomplete.  DTR control is not implemented for
      the IBM machine type, Async_Change and Async_GetParam are not
      implemented for the DG1 and nothing at all is implemented for the T2K.
  2.  This combined version extracts a few penalties in size and overhead.
      The execution overhead is not generally a problem except in the
      procedure Async_Send.  Eventually xmit ISRs should be installed and
      Async_Send should just put the char into a buffer and insure that the
      transmitter interrupt is enabled.  This would avoid the character by
      character overhead currently experienced.
  3.  I'm rather disturbed by Async_Open and Async_Close installing/removing
      the interrupt handler.  The installation really should be done in
      Async_Init and a companion procedure Async_Quit should be added to
      perform the removal and other clean-up activities but I'm going to leave
      it as is for now.  (nad  15 Jun 86)
  4.  An Async_Flush procedure should probably also be added.
  5.  LogicalPortNum values start at 1 and parallel the logical comm device
      names (eg, LogicalPortNum 1 corresponds to the COM1: device).


Revision History
----------------
14 Nov 87  4.1a  nad  Async_AvailPorts replaced with Async_AvailablePorts
                      to allow non-seqential ports
11 Nov 87  4.0b  nad  Finally woke up & eliminated need for special TAP ver
10 Nov 87  4.0b  nad  Added Async_GetParams
09 Nov 87  3.0a  ---  *** Uploaded to CompuServe BorPro forum DL2 ***********
           3.0a  nad  Removed second param to Async_MapBpsRate
           2.0a  nad  Fixed bps rate error, added: aBpsRate, Async_MapBpsRate
           1.2a  nad  Uses DelayTick & DelaySecond now instead of Delay
           1.1b  nad  Fixed bogus Divisor in Async_Change
           1.1a  nad  Async_Buffer_Check renamed to Async_Get_Char for TapCIS
           1.0a  nad  Reincorporated Async_Change from TapCIS sources
           0.0a  nad  Exceedingly crude conversion to version 4 unit
---------------- OLD (include file version) REVISION HISTORY ----------------
           4.1b  nad  Brute force hack to insure line is dropped on close
           4.1a  nad  DTR control reinstated (conditionally)
           4.0b  nad  _async_IsOpen changed to "typed constant"
           4.0a  nad  Support for WRITE[LN]( Usr ... )
           3.1b  nad  Back to single overlay -- double actually _cost_ space!
           3.1a  nad  Double overlay version
           3.0b  nad  squashed initialization bug in IBM_Async_Open
                      experimental (rom call) Async_Send
           3.0a  nad  Overlayed & reconsolidated version
           2.0a  nad  Split into Async.0 and Async.1
           1.0c  nad  AsyncDG1_SetDTR removed for space considerations
           1.0b  nad  SetMachineInfo added, param removed from Async_Init
           1.0a  nad  First combined version, new param to Async_Init
           0.2b  nad  Saves & restores int vector (as it should have all along)
           0.2a  nad  Various changes & extensions for ZapCIS compatibility
           0.1a  nad  Added AsyncDG1_SetDTR procedure
16 Apr 86  0.0a  nad  First cut at conversion to work with DG/1
{===========================================================================}

{---  Conditionals ---------------------------------------------------------}
{ The following conditionals may be set to control compilation as specified }
{ DEFINE Test           }{ Enables various trace reports                    }
{ DEFINE ForceDG1       }{ Forces machine type to DG1 for testing purposes  }
{ DEFINE DTR_Control    }{ Adds procedure to set/clear DTR                  }
{---------------------------------------------------------------------------}

{$B-} { Short circuit boolean evaluation }
{$I-} { I/O checking    OFF   }
{$R-} { Range checking  OFF   }
{$S-} { Stack checking  OFF   }
{$V-} { Var-str check   OFF   }

UNIT Async4 ;

INTERFACE

USES
  Timers,
  Dos ;


CONST
  UnitVersion           = '4.0b' ;
  UnitVerDate           = '11 Nov 87' ;
  MaxPort               = 8 ;


TYPE
  aComputerType         = (IBM, DG1, T2K) ;
  aSharedPort           = (ExtPort, IntModem) ;
  aParitySetting        = (NoParity, OddParity, EvenParity) ;
  aBpsRate              = (bps110,  bps150,  bps300,  bps600,
                           bps1200, bps2400, bps4800, bps9600) ;
  aSetOfPorts           = SET OF 1..MaxPort ;

{$IFDEF Test}
  VAR
    Async_BufferUsed    : word ;
    Async_MaxBufferUsed : word ;
  {$ENDIF}


FUNCTION Async_DefinePort
  (     LogicalPortNum  : byte ;
        Base            : word ;
        IRQ             : byte )
  : BOOLEAN ;


FUNCTION Async_Open
  (     LogicalPortNum  : byte ;
        Rate            : aBpsRate ;
        Parity          : aParitySetting ;
        WordSize        : byte ;
        StopBits        : byte )
  : BOOLEAN ;
  { Sets up interrupt vector, initializes the com port for processing, sets }
  { pointers to the buffer.  Returns false if com port not installed.       }

PROCEDURE Async_Close ;
  { Turn off the com port interrupts & restores original vector.  }

PROCEDURE Async_Change
  (     Rate            : aBpsRate ;
        Parity          : aParitySetting ;
        WordSize        : byte  ;
        StopBits        : byte  ) ;
  { Change current comm parameters }

PROCEDURE Async_GetParams
  ( VAR Rate            : aBpsRate ;
    VAR Parity          : aParitySetting ;
    VAR WordSize        : byte  ;
    VAR StopBits        : byte  ) ;
  { Get values of current comm parameters }

FUNCTION Async_MapBpsRate
  (     Rate    : word )
  : aBpsRate ;

FUNCTION Async_PortName
  (     LogicalPortNum : byte )
  : string ;
  { Returns name of specified port. }

PROCEDURE Async_AvailablePorts
  ( VAR CurrentPorts : aSetOfPorts ) ;
  { Returns currently available comm ports. }

FUNCTION ASync_ComputerType
  : aComputerType ;
  { Returns type of computer program is executing on. }

FUNCTION Async_BufferOverflow
  : BOOLEAN ;
  { Returns true if input buffer has overflowed, otherwise false. }

FUNCTION Async_Buffer_Check
  ( VAR c : CHAR )
  : BOOLEAN ;
  { If a character is available, returns true and moves the character from  }
  { the buffer to the parameter.  Otherwise, returns false and parameter is }
  { undefined.                                                                }

PROCEDURE Async_Send
  (     c : CHAR ) ;
  { Transmits the character. }

PROCEDURE Async_Send_String
  (     s : string ) ;
  { Calls Async_Send to send each character of S, then sends <CR>. }

{$IFDEF Dtr_Control}
  PROCEDURE Async_SetDTR
    (     LogicalPortNum : byte ;
          DTR_True       : BOOLEAN ) ;
  {$ENDIF}

IMPLEMENTATION {============================================================}

CONST
  MaxPhysPort    = 7 ;
  BufferSize     = 4096 ;
  BufferMax      = 4095 ;

  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 ;

   { register offsets from base of DG/1 82C51A USART }
  DG1_USART_Data       = $00 ;
  DG1_USART_Status     = $01 ;
  DG1_USART_Control    = $01 ;

  { misc }
  DG1_CommOnCmd        = $8000 ;
  DG1_CommOffCmd       = $8100 ;
  DG1_Success          = $0000 ;
  DG1_Failure          = $8000 ;


VAR
  ExitSave       : pointer ;
  OriginalVector : pointer ;
  IsOpen         : BOOLEAN ;
  ComputerType   : aComputerType ;
  Overflow       : BOOLEAN ;
  PortsAvail     : aSetOfPorts ;
  PhysicalPort   : byte ;       { currently open PHYSICAL port number }
  { PhysicalPort is necessary because, although the mapping of logical to }
  { physical port numbers is a straightforward arithmetic function on IBM }
  { machines, the mapping is not straightforward on the DG/1 where both   }
  { logical port number 2 and logical port number 3 share a physical port }
  Base           : word ;       { base for open port }
  IRQ            : byte ;       { irq  for open port }

  Buffer         : ARRAY [0..BufferMax] OF CHAR ;
  BufferHead     : word ;       { Location in Buffer to put next char }
  BufferTail     : word ;       { Location in Buffer to get next char }
  BufferNewTail  : word ;

  DG1_IntOrExt   : aSharedPort ;

const { why, oh why, does Turbo _still_ insist on callings these constants? }
  PortTable      : ARRAY [0..MaxPhysPort] OF RECORD
    Base : word ;
    IRQ  : byte
    END  { PortTable record } = ( (Base : 0 ;  IRQ : 0),
                                  (Base : 0 ;  IRQ : 0),
                                  (Base : 0 ;  IRQ : 0),
                                  (Base : 0 ;  IRQ : 0),
                                  (Base : 0 ;  IRQ : 0),
                                  (Base : 0 ;  IRQ : 0),
                                  (Base : 0 ;  IRQ : 0),
                                  (Base : 0 ;  IRQ : 0) ) ;


{---------------------------------------------------------------------------}
{                    M A C R O     D E F I N I T I O N S                    }
{---------------------------------------------------------------------------}

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


{$IFDEF Test}
  {$I Hex.inc}
  {$ENDIF}


{---------------------------------------------------------------------------}
{                     L O C A L     P R O C E D U R E S                     }
{---------------------------------------------------------------------------}


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

PROCEDURE ISR ; INTERRUPT ;
{ Interrupt Service Routine }
{ Invoked when the USART has received a byte of data from the comm line }
{ re-written 9/10/84 in machine language ; original source left as comments }

BEGIN { ISR }
  inline(
    $FB/                                { STI }

    { get the incoming character }
    { Buffer[BufferHead] := CHR( port[Base + DG1_USART_Data] ) ; }
    $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/$08/                            { JNE L002 }
    $C6/$06/Overflow/$01/               { MOV Overflow,1 }
    $90/                                { NOP generated by assembler for some reason }
    $EB/$16/                            { 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 }
    {$IFDEF Test}
      $FF/$06/Async_BufferUsed/         { INC Async_BufferUsed }
      $8B/$1E/Async_BufferUsed/         { MOV BX,Async_BufferUsed }
      $3B/$1E/Async_MaxBufferUsed/      { CMP BX,Async_MaxBufferUsed }
      $7E/$04/                          { JLE L003 }
      $89/$1E/Async_MaxBufferUsed/      { MOV Async_MaxBufferUsed,BX }
      {$ENDIF}
    {L003:}

    { disable interrupts } {?????????????????????}
    $FA/                                { CLI }

    { issue non-specific EOI }
    { port[$20] := $20 ;                                                }
    $B0/$20/                            { MOV AL,20h }
    $E6/$20                             { OUT 20h,AL }
    )
  END { ISR } ;


PROCEDURE DG1_Send
  (     c : CHAR ) ;

{ DG/1 character output procedure for USR device driver }

VAR
  Counter : word ;

BEGIN { DG1_Send }
  { wait for DSR & TxRdy }
  Counter := MAXINT ;
  WHILE (Counter <> 0) and ((port[Base + DG1_USART_Status] and $81) <> $81) DO
    dec( Counter ) ;
  { send the char IFF dsr & txrdy are true }
  IF Counter <> 0 THEN BEGIN { send the character }
    DisableInterrupts ; { critical region? why? }
    port[Base + DG1_USART_Control] := $37 ; { err reset, rxe, dtr, rts, txe }
    port[Base + DG1_USART_Data]    := ORD( c ) ;
    port[Base + DG1_USART_Control] := $36 ; { err reset, rxe, dtr, rts }
    EnableInterrupts    { critical region? why? }
    END
  END { DG1_Send } ;


PROCEDURE IBM_Send
  (     c : CHAR ) ;

{ IBM character output procedure for USR device driver }

VAR
  Counter : word ;

BEGIN { IBM_Send }
  port[IBM_UART_MCR + Base] := $0B ; { turn on OUT2, DTR, and RTS }
  Counter := MAXINT ;
  WHILE (Counter <> 0) AND ((port[IBM_UART_MSR + Base] AND $10) = 0) DO
    dec( Counter ) ;
  IF Counter <> 0 THEN
    Counter := MAXINT ;
  WHILE (Counter <> 0) AND ((port[IBM_UART_LSR + Base] AND $20) = 0) DO
    dec( Counter ) ;
  DisableInterrupts ;
  port[IBM_UART_THR + Base] := ORD( c ) ;
  EnableInterrupts
  END { IBM_Send } ;


PROCEDURE DG1_DisablePort
  (     PhysicalPortNum  : byte ;
        Which            : aSharedPort ) ;

{ Power down line drivers for desired port }

VAR
  Regs : Registers ;

BEGIN { DG1_DisablePort }
  WITH Regs DO BEGIN
    ax := DG1_CommOffCmd ;
    cx := ORD( Which ) ;
    dx := PhysicalPortNum ;
    intr( CommInterrupt, Regs )
    END
  END { DG1_DisablePort } ;


FUNCTION DG1_EnablePort
  (     PhysicalPortNum  : byte ;
        Which            : aSharedPort )
  : BOOLEAN ;

{ Power up line drivers for desired port and check for presence }

VAR
  Regs : Registers ;

BEGIN { DG1_EnablePort }
  IF (PhysicalPortNum = 0) AND (Which = ExtPort) THEN
    DG1_DisablePort( PhysicalPortNum, IntModem ) ; { make sure internal is off }
  DG1_EnablePort := FALSE ; { assume the worst }
  WITH Regs DO BEGIN
    ax := DG1_CommOnCmd ;
    cx := ORD( Which ) ;
    dx := PhysicalPortNum ;
    intr( CommInterrupt, Regs ) ;
    IF ax = DG1_Success THEN
      DG1_EnablePort := TRUE
    ELSE
      DG1_DisablePort( PhysicalPortNum, Which ) { make sure it is all off }
    END
  END { DG1_EnablePort } ;


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

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


PROCEDURE InitializeUnit ;

{ initialize variables }

CONST
  NumPortsMask       = $0E00 ;
  NumPortsShift      = 9 ;

VAR
  j                  : byte ;
  BIOS_Ports         : byte ;
  BIOS_PortBaseTable : ARRAY [0..3] OF word absolute $0040:$0000 ;
  BIOS_EquipFlag     : word                 absolute $0040:$0010 ;

  FUNCTION DetermineMachineType
    : aComputerType ;

  { Determine which machine we are currently running on }

  CONST
    ROM_Seg      = $F000 ;
    ROM_MaxIndex = $7FFF ;
    SearchStart  = $2000 ;
    SearchEnd    = $27FF ;

  TYPE
    SearchState  = (Searching, Checking, Found, NotFound) ;

  VAR
    ROM          : ARRAY [0..ROM_MaxIndex] OF CHAR absolute ROM_Seg:$0000 ;
    State        : SearchState ;
    Index        : word ;
    k            : byte ;
    ID_Var       : string[11] ;

  BEGIN { DetermineMachineType }
    {$IFDEF ForceDG1}
      DetermineMachineType := DG1
    {$ELSE}
      ID_Var := 'GENERAL/One' ;
      Index  := SearchStart;
      State  := Searching ;
      REPEAT
        IF ROM[Index] = ID_Var[1] THEN BEGIN
          k     := 1 ;
          State := Checking ;
          WHILE State = Checking DO BEGIN
            inc( k ) ;
            inc( Index ) ;
            IF ROM[Index] <> ID_Var[k] THEN
              State := Searching
            ELSE IF k = length( ID_Var ) THEN
              State := Found
            END { while }
          END ; { if }
        inc( Index ) ;
        IF Index > SearchEnd THEN
          State := NotFound
        UNTIL State IN [Found, NotFound] ;
      IF State = Found THEN
        DetermineMachineType := DG1
      ELSE
        DetermineMachineType := IBM
      {$ENDIF}
    END { DetermineMachineType } ;

BEGIN { InitializeUnit }
  ExitSave := ExitProc ;
  ExitProc := @TerminateUnit ;
  IsOpen   := FALSE ;
  Overflow := FALSE ;
  {$IFDEF Test}
    Async_BufferUsed      := 0 ;
    Async_MaxBufferUsed   := 0 ;
    {$ENDIF}
  BIOS_Ports := ((BIOS_EquipFlag and NumPortsMask) shr NumPortsShift) ;
  FOR j := 0 TO PRED( BIOS_Ports ) DO WITH PortTable[j] DO BEGIN
    Base := BIOS_PortBaseTable[j] ;
    IRQ  := SUCC( hi(Base) ) ;
    PortsAvail := PortsAvail + [SUCC(j)]
    END ; { for }
  IF DetermineMachineType = IBM THEN BEGIN
    ComputerType := IBM ;
    END
  ELSE { machinetype = DG1 } BEGIN
    ComputerType := DG1 ;
    { Note: This really needs to check for presence of internal modem but  }
    {       for right now we'll just assume it is installed & hard code it }
    PortsAvail   := PortsAvail + [3] ;
    PortTable[3] := PortTable[1] { HACK! }
    END
  END { InitializeUnit } ;


{---------------------------------------------------------------------------}
{                  E X P O R T E D     P R O C E D U R E S                  }
{---------------------------------------------------------------------------}


FUNCTION Async_DefinePort
  (     LogicalPortNum : byte ;
        Base           : word ;
        IRQ            : byte )
  : BOOLEAN ;

VAR
  PhysPortNum : byte ;

BEGIN { Async_DefinePort }
  PhysPortNum := PRED( LogicalPortNum ) ;
  IF (PhysPortNum IN [0..MaxPhysPort]) THEN BEGIN
    PortTable[PhysPortNum].Base := Base ;
    PortTable[PhysPortNum].IRQ  := IRQ ;
    PortsAvail := PortsAvail + [LogicalPortNum] ;
    Async_DefinePort := TRUE
    END
  ELSE
    Async_DefinePort := FALSE
  END { Async_DefinePort } ;


{$IFDEF DTR_Control}
  PROCEDURE Async_SetDTR
    (     LogicalPortNum : byte ;
          DTR_True       : BOOLEAN ) ;

  VAR
    Regs : Registers ;

  BEGIN { Async_SetDTR }
    IF Async_CurrentMachine = DG1 THEN WITH Regs DO BEGIN
      IF DTR_True THEN
        ax := $8200
      ELSE
        ax := $8300 ;
      dx := PRED( LogicalPortNum ) ;
      intr( CommInterrupt, Regs )
      END
    ELSE { Async_CurrentMachine = IBM } BEGIN
      {*** NOT IMPLEMENTED YET ***}
      END
    END { Async_SetDTR } ;
  {$ENDIF}


FUNCTION Async_Buffer_Check
  ( VAR c : CHAR )
  : BOOLEAN ;

{ see if a character has been received ; return it if yes }

BEGIN { Async_Buffer_Check/Async_Get_Char }
  IF BufferHead = BufferTail THEN
    Async_Buffer_Check := FALSE
  ELSE BEGIN
    c          := Buffer[BufferTail] ;
    BufferTail := (SUCC( BufferTail ) MOD BufferSize) ;
    {$IFDEF Test}
      dec( Async_BufferUsed ) ;
      {$ENDIF}
    Async_Buffer_Check := TRUE
    END
  END { Async_Buffer_Check/Async_Get_Char } ;


PROCEDURE Async_Send
  (     c : CHAR ) ;

{ transmit a character }

BEGIN { Async_Send }
  CASE ComputerType OF
    DG1 : DG1_Send( c ) ;
    IBM : IBM_Send( c ) ;
    T2K : begin writeln( '*** Async Error ***' ) ; halt end
    END { case }
  END { Async_Send } ;


PROCEDURE Async_Send_String
  (     s : string ) ;

{ transmit a string }

VAR
  i : byte ;

BEGIN { Async_Send_String }
  FOR i := 1 to length( s ) DO
    Async_Send( s[i] )
  END ; { Async_Send_String }


FUNCTION Async_MapBpsRate
  (     Rate    : word )
  : aBpsRate ;

BEGIN { Async_MapBpsRate }
  IF Rate <= 110 THEN
    Async_MapBpsRate := bps110
  ELSE IF Rate <= 150  THEN
    Async_MapBpsRate := bps150
  ELSE IF Rate <= 300  THEN
    Async_MapBpsRate := bps300
  ELSE IF Rate <= 600  THEN
    Async_MapBpsRate := bps600
  ELSE IF Rate <= 1200 THEN
    Async_MapBpsRate := bps1200
  ELSE IF Rate <= 2400 THEN
    Async_MapBpsRate := bps2400
  ELSE IF Rate <= 4800 THEN
    Async_MapBpsRate := bps4800
  ELSE
    Async_MapBpsRate := bps9600
  END { Async_MapBpsRate } ;


FUNCTION Async_PortName
  (     LogicalPortNum : byte )
  : string ;

{ Returns name of specified port. }

VAR
  s : string[1] ;

BEGIN { Async_PortName }
  CASE ComputerType OF
    DG1 : BEGIN
      CASE LogicalPortNum OF
        1 : Async_PortName := 'External' ;
        2 : Async_PortName := 'Com2:   ' ;
        3 : Async_PortName := 'Internal'
        END { case }
      END ;
    IBM : BEGIN
      str( LogicalPortNum, s ) ;
      Async_PortName := concat( 'COM', s, ':' )
      END ;
    T2K : begin writeln( '*** Async Error ***' ) ; halt end
    END { case }
  END { Async_PortName } ;


PROCEDURE Async_AvailablePorts
  ( VAR CurrentPorts : aSetOfPorts ) ;

BEGIN { Async_AvailablePorts }
  CurrentPorts := PortsAvail
  END { Async_AvailablePorts } ;


FUNCTION ASync_ComputerType
  : aComputerType ;

BEGIN { Async_ComputerType }
  Async_ComputerType := ComputerType
  END { Async_ComputerType } ;


FUNCTION Async_BufferOverflow
  : BOOLEAN ;

BEGIN { Async_BufferOverflow }
  Async_BufferOverflow := Overflow
  END { Async_BufferOverflow } ;


PROCEDURE Async_Close ;

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

  {$IFDEF Test}
    procedure reportstatus
      (     header : boolean ) ;
    var
      mask : byte ;
      j    : byte ;
    begin
      if header then
        writeln( '*** DSR    BrkDet FrmErr OvrRun ParErr TxEmp  RxRdy  TxRdy ' ) ;
      write( '*** ' ) ;
      mask := $80 ;
      for j := 7 downto 0 do begin
        if ((port[Base + DG1_USART_Status] and mask) = 0) then
          write( 'false  ' )
        else
          write( 'TRUE   ' ) ;
        mask := mask shr 1
        end ;
      writeln
      end ;
    {$ENDIF}

BEGIN { Async_Close }
  {$IFDEF Test}
    WRITELN( '*** Async_Close' ) ;
    {$ENDIF}
  IF IsOpen THEN BEGIN
    { disable the IRQ on the 8259 }
    { --- ENTER CRITICAL AREA (?) ------------------------------------------ }
    DisableInterrupts ;
    port[I8088_IMR] := (port[I8088_IMR] or (1 shl IRQ)) ;
    EnableInterrupts ;
    { --- EXIT CRITICAL AREA (?) ------------------------------------------- }
    { shut down the UART/USART }
    CASE ComputerType OF
      DG1 : BEGIN
        {$IFDEF Test}
          reportstatus( true ) ;
          {$ENDIF}
        { Check whether we're using the internal modem or something connected }
        { to the external port and act accordingly.  We have to do this       }
        { because of DG's brain-damaged decision that the internal modem      }
        { should default to autoanswering (!) and do it on the very _first_   }
        { ring (!!!) plus the fact that dropping DTR on the internal causes   }
        { all the modem registers to be reset to their default values.  A pox }
        { on DG's house for this travesty.                             -nacd  }
        IF DG1_IntOrExt = ExtPort THEN { err reset & disable everything }
          port[Base + DG1_USART_Control] := $10
        ELSE { send onhook command then deal with usart } BEGIN
          DelaySeconds( 1 ) ;
          Async_Send( '+' ) ;  Async_Send( '+' ) ;  Async_Send( '+' ) ;
          DelaySeconds( 1 ) ;
          Async_Send_String( 'ATH' ) ;
          DelayTicks( 6 ) ;
          {err reset, rx & tx disabled, RTS false but leave DTR true }
          port[Base + DG1_USART_Control] := $12
          END ;
        DelayTicks( 2 ) ;
        {$IFDEF Test}
          reportstatus( false ) ;
          {$ENDIF}
        DG1_DisablePort( PhysicalPort, DG1_IntOrExt )
        END ; { dg1 }
      IBM : BEGIN
        port[Base + IBM_UART_IER] := 0 ;
        port[Base + IBM_UART_MCR] := 0
        END ; { ibm }
      T2K : BEGIN
        writeln( '*** Async Error ***' ) ; halt
        END
      END ; { case }
    SetIntVec( IRQ + 8, OriginalVector ) ;
    IsOpen := FALSE
    END
  END { Async_Close } ;


FUNCTION Async_Open
  (     LogicalPortNum     : byte ;
        Rate               : aBpsRate ;
        Parity             : aParitySetting ;
        WordSize           : byte ;
        StopBits           : byte )
  : BOOLEAN ;

{ open a communications port }

  PROCEDURE BIOS_RS232_Init
    (     ThePort : byte ;
          ComParm : word ) ;

  { Issue Interrupt $14 to initialize the UART/USART }
  { See the IBM PC Technical Reference Manual for the format of ComParm }
  { Valid for both IBM and DG1 }

  VAR
    Regs : Registers ;

  BEGIN { BIOS_RS232_Init }
    WITH Regs DO BEGIN
      ah := $00 ;
      al := ComParm ;
      dx := ThePort ;
      intr( CommInterrupt, Regs )
      END
    END { BIOS_RS232_Init } ;

  PROCEDURE BuildComParm
    (     Rate      : aBpsRate ;
          Parity    : aParitySetting ;
          WordSize  : byte ;
          StopBits  : byte ;
      VAR ComParm   : word ) ;

  { Build the ComParm for RS232_Init }
  { See DG/1 Programmer's Reference Manual for description }

  CONST
    RateTable : ARRAY [aBpsRate] OF byte
      = ( $00, $20, $40, $60, $80, $A0, $C0, $E0 ) ;

  VAR
    i : byte ;

  BEGIN { BuildComParm }
    ComParm := RateTable[Rate] ;

    CASE Parity OF
      NoParity   : ComParm := (ComParm or $0000) ;
      OddParity  : ComParm := (ComParm or $0008) ;
      EvenParity : ComParm := (ComParm or $0018)
      END ; { case }

    IF WordSize = 7 THEN
      ComParm := (ComParm or $0002)
    ELSE
      ComParm := (ComParm or $0003) ;   { default to 8 data bits }

    IF StopBits = 2 THEN
      ComParm := (ComParm or $0004)
    ELSE
      ComParm := (ComParm or $0000)    { default to 1 stop bit }
    END { BuildComParm } ;

  PROCEDURE CommonInit
    (     PhysicalPort : byte ;
          Rate         : aBpsRate ;
          Parity       : aParitySetting ;
          WordSize     : byte ;
          StopBits     : byte ) ;

  VAR
    ComParm   : word ; { YUCK! TP3 won't pack multiple fields in a word }

  BEGIN { CommonInit }
    Base := PortTable[PhysicalPort].Base ;
    IRQ  := PortTable[PhysicalPort].IRQ ;

    { Build the ComParm for RS232_Init }
    BuildComParm( Rate, Parity, WordSize, StopBits, ComParm ) ;

    { use the BIOS com port initialization routine to save code }
    BIOS_RS232_Init( PhysicalPort, ComParm ) ;

    GetIntVec( IRQ + 8, OriginalVector ) ;
    SetIntVec( IRQ + 8, @ISR )
    END { CommonInit } ;

  FUNCTION DG1_Open
    (     LogicalPortNum  : byte ;
          Rate            : aBpsRate ;
          Parity          : aParitySetting ;
          WordSize        : byte ;
          StopBits        : byte )
    : BOOLEAN ;

  VAR
    i : byte ;

  BEGIN { DG1_Open }
    CASE LogicalPortNum of
      1 : BEGIN PhysicalPort := 0 ;  DG1_IntOrExt := ExtPort  END ;
      2 : BEGIN PhysicalPort := 1 ;  DG1_IntOrExt := ExtPort  END ;
      3 : BEGIN PhysicalPort := 0 ;  DG1_IntOrExt := IntModem END ;
      ELSE BEGIN
        DG1_Open := FALSE ;
        exit
        END
      END ; { case }
    IF DG1_EnablePort( PhysicalPort, DG1_IntOrExt ) THEN BEGIN
      CommonInit( PhysicalPort, Rate, Parity, WordSize, StopBits ) ;
      DisableInterrupts ; { --- ENTER CRITICAL REGION ---------------------- }
      { since we issued an interrupt $14 to initialize the 8251 we }
      { can safely assume that it is now awaiting Control commands }
      { reset any errors, enable RxRdy, assert DTR & RTS }
      port[Base + DG1_USART_Control] := $26 ;

      { read and discard any chars which may be in the buffers }
      i := port[Base + DG1_USART_Data] ;
      i := port[Base + DG1_USART_Data] ;

      { enable the irq on the 8259 controller }
      port[I8088_IMR] := (port[I8088_IMR] and ((1 shl IRQ) xor $FF)) ;
      EnableInterrupts ; { --- EXIT CRITICAL REGION ------------------------ }
      DG1_Open := TRUE
      END
    ELSE
      DG1_Open := FALSE
    END ; { DG1_Open }

  FUNCTION IBM_Open
    (     LogicalPortNum  : byte ;
          Rate            : aBpsRate ;
          Parity          : aParitySetting ;
          WordSize        : byte ;
          StopBits        : byte )
    : BOOLEAN ;

  VAR
    i : byte ;

  BEGIN { IBM_Open }
    PhysicalPort   := PRED( LogicalPortNum ) ;
    IF PortTable[PhysicalPort].Base = 0 THEN
      IBM_Open := FALSE
    ELSE BEGIN
      CommonInit( PhysicalPort, Rate, Parity, WordSize, StopBits ) ;
      IF (port[IBM_UART_IIR + Base] and $00F8) <> 0 THEN
        IBM_Open := FALSE
      ELSE BEGIN
        DisableInterrupts ; { --- ENTER CRITICAL REGION -------------------- }
        port[IBM_UART_LCR + Base] :=
          port[IBM_UART_LCR + Base] and $7F ;
        i := port[IBM_UART_LSR + Base] ;
        i := port[IBM_UART_RBR + Base] ;
        port[I8088_IMR] := (port[I8088_IMR] and ((1 shl IRQ) xor $FF)) ;
        port[IBM_UART_IER + Base] := $01 ; { enable data ready interrupt }
        port[IBM_UART_MCR + Base] := (port[IBM_UART_MCR + Base] or $08) ;
        EnableInterrupts ;  { --- EXIT CRITICAL REGION --------------------- }
        IBM_Open := TRUE
        END
      END
    END { IBM_Open } ;

BEGIN { Async_Open }
  IF NOT IsOpen THEN BEGIN
    BufferHead       := 0 ;
    BufferTail       := 0 ;
    Overflow         := FALSE ;
    {$IFDEF Test}
      Async_BufferUsed := 0 ;
      {$ENDIF}
    CASE ComputerType OF
      DG1 :
        IsOpen := DG1_Open( LogicalPortNum, Rate, Parity, WordSize, StopBits ) ;
      IBM :
        IsOpen := IBM_Open( LogicalPortNum, Rate, Parity, WordSize, StopBits ) ;
      T2K :
        IsOpen := FALSE
      END ; { case }
    Async_Open := IsOpen
    END
  END { Async_Open } ;


PROCEDURE Async_Change
  (     Rate          : aBpsRate ;
        Parity        : aParitySetting ;
        WordSize      : byte  ;
        StopBits      : byte  ) ;
  { Change current comm parameters }

VAR
  Divisor           : word ;
  LCR               : byte ;
  const
  DivisorTable      : ARRAY [aBpsRate] OF word
    = ( $0417, $0300, $0180, $00C0, $0060, $0030, $0018, $000C ) ;


BEGIN { Async_Change }

  Divisor := DivisorTable[Rate] ;

  CASE Parity OF
    NoParity   : LCR := $00 ;
    OddParity  : LCR := $08 ;
    EvenParity : LCR := $18
    END { case } ;

  CASE WordSize OF
    5 :  LCR := (LCR or $00) ;
    6 :  LCR := (LCR or $01) ;
    7 :  LCR := (LCR or $02) ;
    8 :  LCR := (LCR or $03) ;
    else LCR := (LCR or $02)    { default - 7 data bits }
    END { case } ;

  CASE StopBits OF
    1 :  LCR := (LCR or $00) ;
    2 :  LCR := (LCR or $04) ;
    else LCR := (LCR or $00)    { default - 1 stop bit }
    END { case } ;

  {$IFDEF Test}
    writeln( '*** Async_Change ***' ) ;
    writeln( '  new LCR     : $', hex(lcr,2) ) ;
    writeln( '  new Divisor : $', hex(divisor,4) ) ;
    {$ENDIF}
  DisableInterrupts ; { --- ENTER CRITICAL REGION -------------------------- }
  port[ IBM_UART_LCR + Base] := (port[IBM_UART_LCR + Base] or $80) ;
  portw[               Base] := Divisor ;
  port[ IBM_UART_LCR + Base] := LCR ;
  EnableInterrupts    { --- EXIT CRITICAL AREA  ---------------------------- }
  END { Async_Change } ;


PROCEDURE Async_GetParams
  ( VAR Rate          : aBpsRate ;
    VAR Parity        : aParitySetting ;
    VAR WordSize      : byte  ;
    VAR StopBits      : byte  ) ;
  { Get current values of comm parameters }

VAR
  Divisor           : word ;
  LCR               : byte ;

BEGIN { Async_GetParams }
  IF ComputerType = IBM THEN BEGIN
    DisableInterrupts ; { --- ENTER CRITICAL REGION -------------------------- }
    LCR := port[IBM_UART_LCR + Base] ;
    port[IBM_UART_LCR + Base] := (port[IBM_UART_LCR + Base] or  $80) ;
    Divisor := portw[Base] ;
    port[IBM_UART_LCR + Base] := (port[IBM_UART_LCR + Base] and $7F) ;
    EnableInterrupts ;  { --- EXIT CRITICAL AREA  ---------------------------- }
    WordSize := ( LCR and $03) + 5 ;
    StopBits := ((LCR and $04) shr 2) + 1 ;
    CASE ((LCR and $18) shr 3) OF
      0, 2 : Parity := NoParity ;
      1    : Parity := OddParity ;
      3    : Parity := EvenParity
      END ; { case }
    IF Divisor = $000C THEN
      Rate := bps9600
    ELSE IF Divisor = $0018 THEN
      Rate := bps4800
    ELSE IF Divisor = $0030 THEN
      Rate := bps2400
    ELSE IF Divisor = $0060 THEN
      Rate := bps1200
    ELSE IF Divisor = $00C0 THEN
      Rate := bps600
    ELSE IF Divisor = $0180 THEN
      Rate := bps300
    ELSE IF Divisor = $0300 THEN
      Rate := bps150
    ELSE { Divisor had better = $0417 }
      Rate := bps110
    END { IBM }
  ELSE BEGIN
    WRITELN( '*** Critical Error: Async_GetParam not implemented ***' ) ;
    halt
    END
  END { Async_GetParams } ;


BEGIN { Async4 unit body }
  InitializeUnit
  END { Async4 unit body }.