reino@euraiv1.UUCP (Reino de Boer) (11/15/88)
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]