Article 1094 of comp.lang.pascal:
Path: santra!tut!draken!kth!enea!mcvax!hp4nl!eurtrx!euraiv1!reino
From: reino@euraiv1.UUCP (Reino de Boer)
Newsgroups: comp.lang.pascal
Subject: Serial Unit in TP4
Keywords: Pascal, RS232
Message-ID: <797@euraiv1.UUCP>
Date: 15 Nov 88 14:17:15 GMT
Organization: Erasmus University EF/AIV,Rotterdam,Netherlands
Lines: 1237


The following unit is used at our site as the low level interface
in a program called uPnew, which interfaces to a network of Multilink Nodes.
To use it leave out the MULTILINK and UPNEW defines.

The other units needed are simple enough, although Mark Rochkind deserves
a mention for the ideas used in UNIT Console.


{$define DEBUG}
{$define MULTILINK}
{$define UPNEW}
UNIT Mserial;

{$ifdef MULTILINK}
{ Special serial handler for Multilink stand-alone nodes }
{ Version 3 firmware }
{ Only intelligent mode supported }
{ Copyright (c) 1988 by Reino de Boer/Evas/EUR }
{$endif}

INTERFACE

USES  Dos, Timer, Memory, Console, Debug;

CONST { First 2 bits for LCR }
      DataBits5   =       0;
      DataBits6   =       1;
      DataBits7   =       2;
      DataBits8   =       3;

      { Third bit for LCR }
      StopBits1   =       0;
      StopBits2   =       4; { 1.5 stop bits when 5 data bits }

      { Bits 3, 4, and 5 of LCR }
      NoParity    =       0;
      OddParity   =       8;
      EvenParity  =      24;
      Parity1     =      40;
      Parity0     =      56;

      { Bits for LSR }
      RDR         =       1; { Received Data Ready }
      OverrunErr  =       2; { New character in RBR before previous read }
      ParityErr   =       4; { Inappropriate parity in character received }
      FramingErr  =       8; { Invalid stop bit in character received }
      BreakInt    =      16; { BREAK received }
      THRempty    =      32; { THR empty }
      TSRempty    =      64; { Transmitter Shift Register empty }
      ErrorMask   =      30; { 2 OR 4 OR 8 OR 16 }

      { Other possible error values }
      NoError     =       0;
      OutOverflow =     128; { Output buffer overflow }
      InOverflow  =     256; { Input buffer overflow }
      TimeOut     =     512; { Time out for whatever is timed }
      UserInt     =    1024; { User interrupted by pressing Control-C }

      { Indices for varying data }
      COM1        =       1;
      COM2        =       2;

TYPE  { Possible "Baud rates" ( actually bits per second ) }
      BpsName     = ( Bps45_5, Bps50, Bps75, Bps110, Bps134_5, Bps150,
                    Bps300, Bps600, Bps1200, Bps1800, Bps2000,
                    Bps2400, Bps4800, Bps9600, Bps19200, Bps38400
                    );

CONST { Buffer definitions }
      BufferSize  =    4096; { Power of 2 ( for IndexMask ) }
      IndexMask   =    4095; { BufferSize - 1 }

TYPE  Buffer      = ARRAY [0..IndexMask] OF byte;

TYPE  { UART status for each serial port }
      PortData    = RECORD
                      { Identification }
                      BaseAddress : word;
                      IRQno       : byte;
                      { Interrupt configuration }
                      EnableBits  : byte;
                      { Port configuration }
                      DataBits,
                      StopBits,
                      Parity,
                      LineControl : byte;
                      Bps         : BpsName;
                      BaudDiv     : word;
                      { Error status }
                      Error       : integer;
                      { Port status }
                      THRfree     : boolean;
                      { RS232 status }
                      CTSvalue,
                      DSRvalue,
                      RIvalue,
                      DCDvalue    : byte;
                      { UART status }
                      Lstat,
                      Mstat       : byte;
                      { Buffering }
                      { Input buffer }
                      InWaiting,
                      InFront,
                      InRear      : integer;
                      InData      : Buffer;
                      { Output buffer }
                      OutWaiting,
                      OutFront,
                      OutRear     : integer;
                      OutData     : Buffer
                    END;
      PortPtr     = ^PortData;
      PortNo      = COM1..COM2;

VAR   ComPort     : ARRAY [PortNo] OF PortPtr;
      Duration,
      ByteCount   : longint;

{$ifdef MULTILINK}
{ Multilink definitions }
CONST { Highest channel number in version 3 firmware }
      MaxChannel  =      63;

      { Ring status value }
      Mended      =     $80;

      { COM port used by multilink }
      OurCom      =    COM1;

VAR   { Status per channel }
      Busy,
      Connected   : ARRAY [0..MaxChannel] OF boolean;
      { Status per node }
      RingStatus  : byte;
      NodeName    : string;
      NoKeys      : boolean;
{$endif}

PROCEDURE StartTiming;

PROCEDURE StopTiming;

PROCEDURE SelectBitRate( COM : PortNo; Br : BpsName );

PROCEDURE SelectWordLength( COM : PortNo; Len : byte );

PROCEDURE SelectFraming( COM : PortNo; Stop : byte );

PROCEDURE SelectParity( COM : PortNo; Par : byte );

FUNCTION AllSent( COM : PortNo ) : boolean;

PROCEDURE Poll( COM : PortNo; Sending : boolean );

PROCEDURE Send( COM : PortNo; B : byte );

FUNCTION Receive( COM : PortNo; VAR B : byte; Sending : boolean ) : boolean;

PROCEDURE Break( COM : PortNo );

PROCEDURE Install( COM : PortNo );

PROCEDURE TurnOnDTR( COM : PortNo );

PROCEDURE TurnOffDTR( COM : PortNo );

IMPLEMENTATION

{ Returns true if user pressed Control-C }
FUNCTION Interrupted : boolean;

  VAR Ch  : char;
      Spc : boolean;

  BEGIN
    {$ifndef UPNEW}
    IF( NoKeys ) THEN BEGIN
      Interrupted := false;
      exit
    END;
    {$endif}
    Interrupted := false;
    IF( keypressed ) THEN BEGIN
      ReadKbd( Ch, Spc );
      IF( NOT Spc ) THEN
        Interrupted := ( Ch = ^C )
    END
  END; { Interrupted }

CONST NotUsed     =     $00;

{ *** 8259A Progammable Interrupt Controller ( PIC ) ************************ }

CONST { PIC registers }
      IRR         = NotUsed; { Interrupt Request Register }
      ISR         =     $20; { In Service Register }
      IMR         =     $21; { Interrupt Mask Register ( R/W ) }

{ Disable all maskable interrupts }
PROCEDURE CLI;
  INLINE( $FA );

{ Enable all maskable interrupts }
PROCEDURE STI;
  INLINE( $FB );

{ Disable Interrupt Request Line IRQ }
PROCEDURE Disable( IRQ : byte );

  BEGIN
    port[IMR] := port[IMR] OR ( 1 SHL IRQ )
  END; { Disable }

{ Enable Interrupt Request Line IRQ }
PROCEDURE Enable( IRQ : byte );

  BEGIN
    port[IMR] := port[IMR] AND NOT ( 1 SHL IRQ )
  END; { Enable }

{ Send IRQ specific End Of Interrupt. INTERRUPTS OFF }
PROCEDURE SendEOI( IRQ : byte );

  BEGIN
    port[ISR] := $60 OR IRQ
  END; { SendEOI }

{ Report Interrupt level }
{ Only to be called at the start of a handler for a Maskable Interrupt }
FUNCTION RIL : byte;

  BEGIN
    { Report Interrupt Level Request }
    port[ISR] := $0B;
    { Return Interrupt level }
    RIL := port[ISR]
  END; { RIL }

{ *** 8250 Universal Asynchronous Receiver Transmitter ( UART ) ************* }

CONST { UART registers. General offsets }
      RBR         =     $00; { Receive Buffer Register when read from }
      THR         =     $00; { Transmitter Holding Register when written to }
      IER         =     $01; { Interrupt Enable Register }
      IIR         =     $02; { Interrupt Identification Register }
      LCR         =     $03; { Line Control Register }
      MCR         =     $04; { Modem Control Register }
      LSR         =     $05; { Line Status Register }
      MSR         =     $06; { Modem Status Register }

      { Bits for IER; see bits for IIR }
      RBRenable   =       1; { enable RBRfilled }
      THRenable   =       2; { enable THRemptied }
      LSRenable   =       4; { enable LSRerror }
      MSRenable   =       8; { enable MSRchange }

      { Bits for IIR }
      MSRchange   =       0;
      InActive    =       1;
      THRemptied  =       2;
      RBRfilled   =       4;
      LSRerror    =       6;

      { Bit 6 of LCR }
      SetBreak    =      64; { Bit on : send break signal }

      { Last bit of LCR }
      { see INTERFACE section for other bits }
      { If set, RBR and IER are used to communicate with the }
      { Programmable Baud Rate Generator ( PBRG ) }
      DLAB        =     128; { Divisor Latch Access Bit }

      { Bits for MCR }
      DTR         =       1; { Data Terminal Ready }
      RTS         =       2; { Request To Send }
      OUT1        =       4; { Used by Hayes international modems to }
                             { cause a power-on reset of their circuits }
      OUT2        =       8; { Controls 8250 interrupt signals }
                             { Unless OUT2 is set to 1, interrupt signals }
                             { from the UART cannot reach the rest of the PC }
      SelfTest    =      16; { Turns on UART self-test configuration }

      { Bits for MSR }
      CTSchanged  =       1; { Clear To Send }
      DSRchanged  =       2; { Data Set Ready }
      RIchanged   =       4; { Ring Indicator }
      DCDchanged  =       8; { Data Carrier Detect }
      CTSlevel    =      16;
      DSRlevel    =      32;
      RIlevel     =      64;
      DCDlevel    =     128;

      { Base Addresses }
      Base        : ARRAY [PortNo] OF integer = ( $3F8, $2F8 );

      { IRQ lines }
      IRQline     : ARRAY [PortNo] OF byte = ( 4, 3 );

      { Interrupt Numbers }
      IntrNo      : ARRAY [PortNo] OF integer = ( $0C, $0B );

CONST { Bit rate divisor table }
      Divisor     : ARRAY [BpsName] OF word = (
                    2532, 2304, 1536, 1047, 857, 768, 384, 192,
                    96, 64, 58, 48, 24, 12, 6, 3
                    );

      { Minimum length of a BREAK signal in milliseconds }
      BreakLen    =     350; { Empirical }

      { Delay after using PBRG }
      PBRGlen     =     250; { Empirical }

      { Settle time for change in DTR or RTS }
      DTRSettle   =       2; { Empirical }
      RTSsettle   =       2; { Empirical }

      { Delay after sending, to prevent timing problems }
      BugDelay    =       1; { Empirical }

VAR   DoTiming    : boolean;
      StartTime   : longint;
      { Exception handling }
      ExitSave    : pointer;
      OldVector   : ARRAY [PortNo] OF pointer;
      Installed,
      VectorSet   : ARRAY [PortNo] OF boolean;

{$ifdef MULTILINK}
{ *** Multilink definitions ************************************************* }

CONST { Some ascii control codes with high bit on }
      DLEh        =     $90; { Prefix to command }
      EMh         =     $99; { Ring status change indicator }
      SOh         =     $8E; { Busy signal }
      SIh         =     $8F; { Free again signal }
      EOTh        =     $84; { Disconnect signal }
      ACKh        =     $86; { Acknowledge }

      HighBit     =     $80;

      { Other ascii control codes }
      ACK         =     $06; { Acknowledge }

VAR   NodeChannel : integer; { Current "receive" channel }
      EMreceived,
      DLEreceived : boolean;

      { Exception handling }
      NodeInit    : boolean;
{$endif}

{ *** Buffer primitives ***************************************************** }

PROCEDURE PutOut( COM : PortNo; B : byte );

  BEGIN
    WITH ComPort[COM]^ DO
      IF( OutWaiting >= BufferSize ) THEN
        Error := Error OR OutOverflow
      ELSE BEGIN
        OutData[OutRear] := B;
        OutRear := succ( OutRear ) AND IndexMask;
        inc( OutWaiting )
      END
  END; { PutOut }

FUNCTION GetOut( COM : PortNo; VAR B : byte ) : boolean;

  BEGIN
    WITH ComPort[COM]^ DO
      IF( OutWaiting <= 0 ) THEN
        GetOut := false
      ELSE BEGIN
        B := OutData[OutFront];
        OutFront := succ( OutFront ) AND IndexMask;
        dec( OutWaiting );
        GetOut := true
      END
  END; { GetOut }

PROCEDURE PutIn( COM : PortNo; B : byte );

  BEGIN
    WITH ComPort[COM]^ DO BEGIN
      IF( InWaiting >= BufferSize ) THEN
        Error := Error OR InOverflow
      ELSE BEGIN
        {$ifdef MULTILINK}
        { Multilink Handling }
        IF( DLEreceived ) THEN BEGIN
          DLEreceived := false;
          IF( EMreceived ) THEN BEGIN
            RingStatus := B;
            EMreceived := false
          END
          ELSE
            CASE B OF
              SOh  : BEGIN
                       Busy[NodeChannel] := true;
                       mem[$B800:0158] := ord( '*' )
                     END;
              SIh  : BEGIN
                       Busy[NodeChannel] := false;
                       mem[$B800:0158] := ord( ' ' )
                     END;
              EMh  : BEGIN
                       EMreceived := true;
                       DLEreceived := true
                     END;
              EOTh : Connected[NodeChannel] := false;
            ELSE     IF( B <= MaxChannel ) THEN
                       NodeChannel := B
            END
        END
        ELSE IF( B = DLEh ) THEN
          DLEreceived := true;
        {$endif}
        { Normal buffering }
        InData[InRear] := B;
        InRear := succ( InRear ) AND IndexMask;
        inc( InWaiting )
      END
    END
  END; { PutIn }

FUNCTION GetIn( COM : PortNo; VAR B : byte ) : boolean;

  BEGIN
    WITH ComPort[COM]^ DO BEGIN
      IF( InWaiting <= 0 ) THEN
        GetIn := false
      ELSE BEGIN
        { Disable interrupts that share this memory }
        CLI;
        B := InData[InFront];
        InFront := succ( InFront ) AND IndexMask;
        dec( InWaiting );
        { Free to be interrupted again }
        STI;
        GetIn := true
      END
    END
  END; { GetIn }

{ Send RTS signal }
PROCEDURE SendRTS( COM : PortNo );

  BEGIN
    WITH ComPort[COM]^ DO
      IF( ( port[BaseAddress + MCR] AND RTS ) = 0 ) THEN BEGIN
        port[BaseAddress + MCR] := port[BaseAddress + MCR] OR RTS;
        delay( RTSsettle )
      END
  END; { SendRTS }

{ Return true if DTR is off }
FUNCTION DTRoff( COM : PortNo ) : boolean;

  BEGIN
    WITH ComPort[COM]^ DO
      DTRoff := ( ( port[BaseAddress + MCR] AND DTR ) = 0 )
  END; { DTRoff }

{ Tell DCE that DTE is ready }
PROCEDURE TurnOnDTR( COM : PortNo );

  BEGIN
    WITH ComPort[COM]^ DO
      port[BaseAddress + MCR] := port[BaseAddress + MCR] OR DTR;
    delay( DTRsettle )
  END; { TurnOnDTR }

{ Tell DCE that DTE is not ready }
PROCEDURE TurnOffDTR( COM : PortNo );

  BEGIN
    WITH ComPort[COM]^ DO
      port[BaseAddress + MCR] := port[BaseAddress + MCR] AND NOT DTR;
    delay( DTRsettle )
  END; { TurnOffDTR }

{ Establish equipment readiness status }
{ TurnOnDTR, SendRTS, and keep OUT2 on }
PROCEDURE Establish( COM : PortNo );

  BEGIN
    WITH ComPort[COM]^ DO
      port[BaseAddress + MCR] := DTR OR RTS OR OUT2
  END; { Establish }

{ Set default values }
PROCEDURE InitComPortData( COM : PortNo );

  BEGIN
    ComPort[COM] := Malloc( sizeof( PortData ) );
    IF( ComPort[COM] = NIL ) THEN
      Fatal( 'Out of memory' );
    WITH ComPort[COM]^ DO BEGIN
      BaseAddress := Base[COM];
      IRQno       := IRQline[COM];
      { Enable all interrupt types }
      EnableBits  := RBRenable OR THRenable OR LSRenable OR MSRenable;
      DataBits    := DataBits8;
      StopBits    := StopBits1;
      Parity      := NoParity;
      LineControl := DataBits OR StopBits OR Parity;
      Bps         := Bps9600;
      BaudDiv     := Divisor[Bps];
      Error       := NoError;
      { The following should be re-initialized because they are volatile }
      Lstat       := 0;
      Mstat       := 0;
      THRfree     := false;
      CTSvalue    := 0;
      DSRvalue    := 0;
      RIvalue     := 0;
      DCDvalue    := 0;
      { Queue initialization }
      InWaiting   := 0;
      InFront     := 0;
      InRear      := 0;
      OutWaiting  := 0;
      OutFront    := 0;
      OutRear     := 0
    END
  END; { InitComPortData }

{ Select bit rate by programming the PBRG }
PROCEDURE SelectBitRate( COM : PortNo; Br : BpsName );

  BEGIN
    WITH ComPort[COM]^ DO BEGIN
      { Update port data }
      Bps := Br;
      BaudDiv := Divisor[Br];
      { Set Divisor Latch Access Bit }
      port[BaseAddress + LCR] := LineControl OR DLAB;
      { Bit rate divisor to PBRG }
      portw[BaseAddress + RBR] := BaudDiv;
      { Give port some time to settle }
      delay( PBRGlen );
      { Reset function of RBR }
      port[BaseAddress + LCR] := LineControl
    END
  END; { SelectBitRate }

{ Set word length in Line Control Register }
PROCEDURE SelectWordLength( COM : PortNo; Len : byte );

  BEGIN
    WITH ComPort[COM]^ DO BEGIN
      { Update port data }
      DataBits := Len;
      LineControl := ( LineControl AND ( NOT DataBits8 ) ) OR DataBits;
      { Set relevant bits }
      port[BaseAddress + LCR] := LineControl
    END
  END; { SelectWordLength }

{ Set stopbits in Line Control Register }
PROCEDURE SelectFraming( COM : PortNo; Stop : byte );

  BEGIN
    WITH ComPort[COM]^ DO BEGIN
      { Update port data }
      StopBits := Stop;
      LineControl := ( LineControl AND ( NOT StopBits2 ) ) OR StopBits;
      { Set relevant bits }
      port[BaseAddress + LCR] := LineControl
    END
  END; { SelectFraming }

{ Set parity in Line Control Register }
PROCEDURE SelectParity( COM : PortNo; Par : byte );

  BEGIN
    WITH ComPort[COM]^ DO BEGIN
      { Update port data }
      Parity := Par;
      LineControl := ( LineControl AND ( NOT Parity0 ) ) OR Parity;
      { Set relevant bits }
      port[BaseAddress + LCR] := LineControl
    END
  END; { SelectParity }

{ Asynchronous interrupt handler }
PROCEDURE ComHandler; INTERRUPT;

  VAR COM          : PortNo;
      Id,
      DataByte     : byte;

  BEGIN
    { Find out which port interrupted }
    IF( ( RIL AND ( 1 SHL IRQline[COM1] ) ) <> 0 ) THEN
      COM := COM1
    ELSE
      COM := COM2;
    WITH ComPort[COM]^ DO BEGIN
      { Find out type of interrupt }
      Id := port[BaseAddress + IIR];
      { Enable all other interrupts }
      STI;
      CASE Id OF
        MSRchange  : BEGIN
                       Mstat := port[BaseAddress + MSR];
                       IF( ( Mstat AND CTSchanged ) <> 0 ) THEN
                         IF( ( Mstat AND CTSlevel ) <> 0 ) THEN
                           CTSvalue := 1
                         ELSE
                           CTSvalue := 0;
                       IF( ( Mstat AND DSRchanged ) <> 0 ) THEN
                         IF( ( Mstat AND DSRlevel ) <> 0 ) THEN
                           DSRvalue := 1
                         ELSE
                           DSRvalue := 0;
                       {$ifndef UPNEW}
                       IF( ( Mstat AND RIchanged ) <> 0 ) THEN
                         IF( ( Mstat AND RIlevel ) <> 0 ) THEN
                           RIvalue := 1
                         ELSE
                           RIvalue := 0;
                       IF( ( Mstat AND DCDchanged ) <> 0 ) THEN
                         IF( ( Mstat AND DCDlevel ) <> 0 ) THEN
                           DCDvalue := 1
                         ELSE
                           DCDvalue := 0;
                       {$endif}
                       { Take the opportunity to maybe update THRfree }
                       Lstat := port[BaseAddress + LSR];
                       IF( ( Lstat AND THRempty ) <> 0 ) THEN
                         THRfree := true
                     END;
        THRemptied : BEGIN
                       THRfree := true;
                       Lstat := port[BaseAddress + LSR]
                     END;
        RBRfilled  : BEGIN
                       DataByte := port[BaseAddress + RBR];
                       Lstat := port[BaseAddress + LSR];
                       PutIn( COM, DataByte )
                     END;
        LSRerror   : BEGIN
                       Lstat := port[BaseAddress + LSR];
                       Error := Error OR ( Lstat AND ErrorMask );
                       { Take the opportunity to maybe update THRfree }
                       IF( ( Lstat AND THRempty ) <> 0 ) THEN
                         THRfree := true
                     END
      ELSE           BEGIN { Inactive, but take the opportunity }
                       Mstat := port[BaseAddress + MSR];
                       IF( ( Mstat AND CTSchanged ) <> 0 ) THEN
                         IF( ( Mstat AND CTSlevel ) <> 0 ) THEN
                           CTSvalue := 1
                         ELSE
                           CTSvalue := 0;
                       IF( ( Mstat AND DSRchanged ) <> 0 ) THEN
                         IF( ( Mstat AND DSRlevel ) <> 0 ) THEN
                           DSRvalue := 1
                         ELSE
                           DSRvalue := 0;
                       {$ifndef UPNEW}
                       IF( ( Mstat AND RIchanged ) <> 0 ) THEN
                         IF( ( Mstat AND RIlevel ) <> 0 ) THEN
                           RIvalue := 1
                         ELSE
                           RIvalue := 0;
                       IF( ( Mstat AND DCDchanged ) <> 0 ) THEN
                         IF( ( Mstat AND DCDlevel ) <> 0 ) THEN
                           DCDvalue := 1
                         ELSE
                           DCDvalue := 0;
                       {$endif}
                       { Take the opportunity to maybe update THRfree }
                       Lstat := port[BaseAddress + LSR];
                       IF( ( Lstat AND THRempty ) <> 0 ) THEN
                         THRfree := true
                     END
      END;
      { Disable all maskable interrupts }
      CLI;
      { Send specific End Of Interrupt }
      SendEOI( IRQno )
    END
  END; { ComHandler }

{ Try to send a byte to COM }
{ RS-232-C protocol for transmitting data :
    Turn on DTR                   | Static condition
    Modem signals DSR             | Static condition
    Send RTS signal to ask for permission
    Modem signals CTS when clear to send
    Send character when THR is empty }
FUNCTION OutByte( COM : PortNo; B : byte ) : boolean;

  CONST Period = 1; { maybe one second ? }

  VAR   Start  : longint;
        S      : string[3];

  BEGIN
    {$ifdef MULTILINK}
    { Some multilink handling here }
    IF( RingStatus <> Mended ) THEN BEGIN
      str( RingStatus, S );
      Message( 'Ring Break At ' + S );
      REPEAT
        IF( Interrupted ) THEN
          Fatal( 'User interrupt' )
      UNTIL( RingStatus = Mended );
      ClearMessage
    END;
    { End of special multilink handling }
    {$endif}
    WITH ComPort[COM]^ DO BEGIN
      Establish( COM );
      REPEAT
        IF( DSRvalue = 0 ) THEN BEGIN
          { Wait for DSR to come up }
          Start := ClockTicks;
          REPEAT
          UNTIL( DSRvalue = 1 ) OR ( TimedOut( Start, Period ) );
          IF( DSRvalue = 0 ) THEN BEGIN
            OutByte := false;
            Error := Error OR TimeOut;
            exit
          END
        END;
        IF( CTSvalue = 0 ) THEN BEGIN
          { Wait for CTS to come up }
          Start := ClockTicks;
          REPEAT
          UNTIL( CTSvalue = 1 ) OR ( TimedOut( Start, Period ) );
          IF( CTSvalue = 0 ) THEN BEGIN
            OutByte := false;
            Error := Error OR TimeOut;
            exit
          END
        END;
        IF( NOT THRfree ) THEN BEGIN
          { Wait for THR to become empty }
          Start := ClockTicks;
          REPEAT
          UNTIL( THRfree ) OR ( TimedOut( Start, Period ) );
          IF( NOT THRfree ) THEN BEGIN
            OutByte := false;
            Error := Error OR TimeOut;
            exit
          END
        END
      UNTIL( DSRvalue = 1 ) AND ( CTSvalue = 1 ) AND ( THRfree );
      port[BaseAddress + THR] := B;
      { Update THRfree, which is shared by the interrupt handler }
      THRfree := false;
      {$ifdef UPNEW}
      delay( BugDelay );
      {$endif}

      {$ifdef DEBUG}
      IF( Debugging ) THEN
        DebugOut( B );
      {$endif}

      OutByte := true
    END
  END; { OutByte }

{ Try to send as many bytes as possible }
PROCEDURE OutBytes( COM : PortNo );

  VAR B    : byte;
      Junk : boolean;

  BEGIN
    WITH ComPort[COM]^ DO
      WHILE( OutWaiting > 0 ) DO BEGIN
        IF( Interrupted ) THEN BEGIN
          Error := Error OR UserInt;
          exit
        END;
        B := OutData[OutFront]; { Peek ahead }
        IF( OutByte( COM, B ) ) THEN
          { No data lost: update buffer }
          Junk := GetOut( COM, B )
        ELSE
          exit
      END
  END; { OutBytes }

{ Report serial interface errors only }
PROCEDURE ReportErrors( COM : PortNo );

  BEGIN
    WITH ComPort[COM]^ DO
      IF( ( Error AND pred( TimeOut ) ) = 0 ) THEN { Do not report here }
        exit
      ELSE BEGIN { Fatal error }
        Vselect( output );
        IF( ( Error AND OverrunErr ) <> 0 ) THEN
          writeln( 'Overrun error' );
        IF( ( Error AND ParityErr ) <> 0 ) THEN
          writeln( 'Parity error' );
        IF( ( Error AND FramingErr ) <> 0 ) THEN
          writeln( 'Framing error' );
        IF( ( Error AND BreakInt ) <> 0 ) THEN
          writeln( 'BREAK received' );
        IF( ( Error AND OutOverflow ) <> 0 ) THEN
          writeln( 'Output buffer overflow' );
        IF( ( Error AND InOverflow ) <> 0 ) THEN
          writeln( 'Input buffer overflow' );
        { Call exception handler }
        halt
      END
  END; { ReportErrors }

{ Return true if no more output waiting }
FUNCTION AllSent( COM : PortNo ) : boolean;

  BEGIN
    WITH ComPort[COM]^ DO
      AllSent := ( OutWaiting <= 0 )
  END; { AllSent }

{ Poll port: error handling, output and preparing input }
PROCEDURE Poll( COM : PortNo; Sending : boolean );

  BEGIN
    { ** Error handling ** }
    ReportErrors( COM );
    { ** Output         ** }
    IF( Sending ) THEN
      OutBytes( COM );
    { ** Input          ** }
    { Do the handshaking necessary to allow reception of characters }
    IF( Interrupted ) THEN
      Fatal( 'User interrupt' );
    TurnOnDTR( COM )
  END; { Poll }

{ Send byte B to port COM }
PROCEDURE Send( COM : PortNo; B : byte );

  BEGIN
    IF( DoTiming ) THEN
      inc( ByteCount );
    { Buffer first, to relieve higher levels from checking burden }
    PutOut( COM, B );
    { Now try to send it }
    Poll( COM, true )
  END; { Send }

{ Try to receive a byte from the input buffer }
FUNCTION Receive( COM : PortNo; VAR B : byte; Sending : boolean ) : boolean;

  CONST Period = 3; { Maybe should be OneSecond ? }

  VAR   Start  : longint;

  BEGIN
    Poll( COM, Sending );
    Start := ClockTicks;
    WITH ComPort[COM]^ DO BEGIN
      REPEAT
        IF( GetIn( COM, B ) ) THEN BEGIN { Success }
          Receive := true;

          {$ifdef DEBUG}
          IF( Debugging ) THEN
            DebugIn( B );
          {$endif}

          exit
        END
      UNTIL( TimedOut( Start, Period ) );
      { Failed }
      Error := Error OR TimeOut;
      Poll( COM, Sending );
      Receive := false
    END
  END; { Receive }

{ Collect and dispose of garbage after BREAK }
PROCEDURE DisposeGarbage( COM : PortNo );

  VAR Junk : byte;

  BEGIN
    REPEAT
    UNTIL( NOT Receive( COM, Junk, true ) );
    { Reset time out error set by Receive }
    WITH ComPort[COM]^ DO
      Error := Error AND ( NOT TimeOut )
  END; { DisposeGarbage }

{ Send break signal to modem }
PROCEDURE Break( COM : PortNo );

  BEGIN
    WITH ComPort[COM]^ DO BEGIN
      { Set break bit }
      port[BaseAddress + LCR] := LineControl OR SetBreak;
      { Keep break bit high }
      delay( BreakLen );
      { reset break bit }
      port[BaseAddress + LCR] := LineControl;
      { Waste some cycles }
      delay( 100 );
      DisposeGarbage( COM )
    END
  END; { Break }

{ Reset UART }
PROCEDURE ResetChip( COM : PortNo );

  VAR Junk : byte;

  BEGIN
    WITH ComPort[COM]^ DO BEGIN
      { Dump all waiting input }
      WHILE( ( port[BaseAddress + LSR] AND RDR ) <> 0 ) DO
        Junk := port[BaseAddress + RBR];
      CLI;
      { Allow none of the interrupt types }
      port[BaseAddress + IER] := 0;
      { Tell modem we're not ready }
      port[BaseAddress + MCR] :=
        port[BaseAddress + MCR] AND NOT ( OUT2 OR DTR OR RTS );
      { Disable all interrupts for this port }
      Disable( IRQno );
      STI
    END
  END; { ResetChip }

{ Deinstall a previously installed port }
PROCEDURE DeInstall( COM : PortNo );

  BEGIN
    Installed[COM] := false;
    ResetChip( COM )
  END; { DeInstall }

{ Install interrupt handling for port COM }
PROCEDURE Install( COM : PortNo );

  CONST Period       = OneSecond;

  VAR   Start        : longint;

  BEGIN
    WITH ComPort[COM]^ DO BEGIN
      { Initialize volatile data per existing signals }
      Mstat := port[BaseAddress + MSR];
      IF( ( Mstat AND CTSlevel ) <> 0 ) THEN
        CTSvalue := 1
      ELSE
        CTSvalue := 0;
      IF( ( Mstat AND DSRlevel ) <> 0 ) THEN
        DSRvalue := 1
      ELSE
        DSRvalue := 0;
      IF( ( Mstat AND RIlevel ) <> 0 ) THEN
        RIvalue := 1
      ELSE
        RIvalue := 0;
      IF( ( Mstat AND DCDlevel ) <> 0 ) THEN
        DCDvalue := 1
      ELSE
        DCDvalue := 0;
      Lstat := port[BaseAddress + LSR];
      THRfree := ( ( Lstat AND THRempty ) <> 0 );
      { Get old vector handler }
      IF( NOT VectorSet[COM] ) THEN BEGIN
        getintvec( IntrNo[COM], OldVector[COM] );
        VectorSet[COM] := true
      END;
      { Set our interrupt handler }
      setintvec( IntrNo[COM], @ComHandler );
      ResetChip( COM );
      CLI;
      Establish( COM );
      { Enable interrupts for this port }
      Enable( IRQno );
      { Enable all wanted interrupt types }
      port[BaseAddress + IER] := EnableBits;
      { Just to be sure }
      SendEOI( IRQno );
      STI;
      { Set Bit rate and other characteristics }
      port[BaseAddress + LCR] := DLAB;
      portw[BaseAddress + RBR] := BaudDiv;
      port[BaseAddress + LCR] := LineControl;
      { Waste some cycles }
      delay( PBRGlen );

      Installed[COM] := true;

      { Wait for port to react }
      Start := ClockTicks;
      WHILE( CTSvalue = 0 ) DO BEGIN
        IF( TimedOut( Start, Period ) ) THEN
          Fatal( 'No modem connected..( Time out CTS )' );
      END
    END
  END; { Install }

PROCEDURE StartTiming;

  BEGIN
    StartTime := ClockTicks;
    ByteCount := 0;
    DoTiming := true;
  END; { StartTiming }

PROCEDURE StopTiming;

  BEGIN
    DoTiming := false;
    Duration := ClockTicks - StartTime
  END; { StopTiming }

{$ifdef MULTILINK}
{ *** Multilink handling **************************************************** }

PROCEDURE DoString( S : string );

  VAR I : integer;

  BEGIN
    FOR I := 1 TO length( S ) DO BEGIN
      Send( OurCom, ord( S[I] ) );
      IF( ComPort[OurCom]^.Error <> NoError ) THEN
        exit
    END
  END; { DoString }

{ Initialize Multilink Node to intelligent mode }
PROCEDURE InitNode;

  CONST MaxTries = 10;

  VAR   Tries    : integer;
        B        : byte;
        Options  : string;

  BEGIN
    Tries := 0;
    REPEAT
      { Reset errors from last try }
      WITH ComPort[OurCom]^ DO
        Error := Error AND NOT ( TimeOut OR UserInt );
      inc( Tries );
      { Send BREAK <space> INIT to node }
      Break( OurCom );
      DoString( ' INIT'^M );
      DisposeGarbage( OurCom );
      { Waste some cycles }
      delay( 200 );
      { Select channel 0 by sending a BREAK }
      Break( OurCom );
      { Set Intelligent mode, no Xon/Xoff }
      DoString( 'SINX'^M );
      { Select channel 0 }
      Break( OurCom );
      { Ask for options }
      DoString( 'O'^M );
      Options := '';
      REPEAT
        IF( Receive( OurCom, B, true ) ) THEN
          Options := Options + chr( B )
        ELSE IF( ( ComPort[OurCom]^.Error AND UserInt ) <> 0 ) THEN
          Fatal( 'User interrupt' )
      UNTIL( B = ACK ) OR ( ComPort[OurCom]^.Error <> NoError )
      { If we have an error here, it is a Timeout error }
    UNTIL( ( ComPort[OurCom]^.Error = NoError )
      AND ( pos( ' INV', Options ) > 0 ) ) { Ok, I know, but it works }
      OR ( Tries > MaxTries );
    IF( Tries > MaxTries ) THEN
      Fatal( 'Node initialization failed' );
    NodeInit := true
  END; { InitNode }

{ Read real 2-byte nodename from RAM in node }
PROCEDURE ReadNodeName;

  CONST Digits : string[16] = '0123456789ABCDEF';

  VAR   B      : byte;
        I      : integer;
        Temp   : ARRAY [1..50] OF byte; { 50 is large enough }

  PROCEDURE CheckError;

    BEGIN
      WITH ComPort[OurCom]^ DO
        IF( Error <> NoError ) THEN
          IF( ( Error AND UserInt ) <> 0 ) THEN
            Fatal( 'User interrupt' )
          ELSE
            Fatal( 'Failed to read node name' )
    END; { CheckError }

  { Decode returned data }
  FUNCTION Character( I, J : integer ) : char;

    BEGIN
      Character := chr(
        16 * pred( pos( chr( Temp[I] ), Digits ) ) +
        pred( pos( chr( Temp[J] ), Digits ) ) )
    END; { Character }

  BEGIN
    { Select channel 0 }
    Send( OurCom, DLEh );
    Send( OurCom, 0 );
    { Request RAM reading }
    DoString( 'R 0050'^M );
    CheckError;
    { Make sure we sent all }
    REPEAT
      Poll( OurCom, true )
    UNTIL( AllSent( OurCom ) );
    I := 0;
    REPEAT
      IF( Receive( OurCom, B, true ) ) THEN BEGIN
        inc( I );
        Temp[I] := B
      END
    UNTIL( ComPort[OurCom]^.Error <> NoError ) OR ( ( B OR HighBit ) = ACKh );
    CheckError;
    NodeName := Character( 4, 5 ) + Character( 7, 8 )
  END; { ReadNodeName }

{ General multlink initialization }
PROCEDURE InitMultilink;

  VAR Chan : integer;

  BEGIN
    { Init status variables }
    FOR Chan := 0 TO MaxChannel DO BEGIN
      Busy[Chan] := false;
      Connected[Chan] := false
    END;
    NodeChannel := 0;
    EMreceived := false;
    DLEreceived := false;
    RingStatus := Mended;
    { Install handler for COM }
    Install( OurCom );
    { Initialize node to a predetermined state }
    InitNode;
    { Get real node name }
    ReadNodeName;
    { Re-initialize node }
    InitNode
  END; { InitMultilink }
{$endif}

{$F+}
{ Exception handler }
PROCEDURE ExitUnit;

  VAR COM : PortNo;

  BEGIN
    {$ifdef MULTILINK}
    IF( NodeInit ) THEN BEGIN { Multilink cleaning up }
      NodeInit := false;
      { Select channel 0 }
      Send( OurCom, DLEh );
      Send( OurCom, 0 );
      { Request RAM reading }
      DoString( 'n' + NodeName + ^M );
      REPEAT
        Poll( OurCom, true )
      UNTIL( AllSent( OurCom ) );
      Break( OurCom );
      DoString( ' INIT'^M );
      Break( OurCom )
    END;
    {$endif}
    FOR COM := COM1 TO COM2 DO BEGIN
      IF( Installed[COM] ) THEN
        DeInstall( COM );
      IF( VectorSet[COM] ) THEN BEGIN
        VectorSet[COM] := false;
        setintvec( IntrNo[COM], OldVector[COM] )
      END;
      Free( ComPort[COM] )
    END;
    exitproc := ExitSave
  END; { ExitUnit }
{$F-}

PROCEDURE InitExceptionHandling;

  VAR COM : PortNo;

  BEGIN
    FOR COM := COM1 TO COM2 DO BEGIN
      VectorSet[COM] := false;
      Installed[COM] := false
    END;
    {$ifdef MULTILINK}
    NodeInit := false;
    {$endif}
    ExitSave := exitproc;
    exitproc := @ExitUnit
  END; { InitExceptionHandling }

{ Overall initialization }
PROCEDURE InitUnit;

  VAR COM : PortNo;

  BEGIN
    NoKeys := false;
    DoTiming := false;
    InitExceptionHandling;
    FOR COM := COM1 TO COM2 DO
      InitComPortData( COM );
    {$ifdef MULTILINK}
    InitMultilink
    {$endif}
  END; { InitUnit }

BEGIN
  InitUnit
END.
-- 
Reino de Boer
Erasmus Universiteit Rotterdam The Netherlands.
Vakgroep AIV 
reino@euraiv1.uucp  [All hail Discordia]


