Category : Files from Magazines
Archive   : DDJ1089.ZIP
Filename : SERVELLO.LST

_Implementing Multiple Computer Communications Links_
by Mark Servello


[LISTING ONE]

Unit Serial_IO;
{************ Unit Interface Description ***************}
Interface
Type Config_rec = record { contains the configuration info }
{ for serial communication and user}
{ interface }
IRQ : Integer;
Port : Integer;
Data : Integer;
Baud : Integer;
Rate : integer; { bytes/sec }
Parity : Char;
StopBits : Integer;
DataBits : Integer;
Snow : Boolean;
Lines : Integer;
Attention: String[40];
Fore : Integer;
Back : Integer;
end;

Var Current_Cfg : Config_Rec;
Procedure Check_Receive (var ch : char);
Procedure Check_Send;
Procedure Configure( New_Cfg : Config_Rec );

{******************* Unit Implementation ******************}
Implementation
uses dos,crt; { DOS and CRT units are utilized }
Const queue_max = 3936; { queue can hold 48 lines X 82 char}

{ *********** Serial Port Constants ***********************}
COM1_data = $03f8; { COM1 Data port }
COM1_IRQ = $04; { COM1 IRQ Number}
COM2_data = $02f8; { COM2 Data port }
COM2_IRQ = $03; { COM2 IRQ Number}
ier_offset = 1; { UART IER Reg }
mcr_offset = 4; { UART Master Reg}
sts_offset = 5; { UART Status Reg}
IRQ3_Int = $0B; { IntVec for IRQ3}
IRQ4_Int = $0C; { IntVec for IRQ4}
IRQ5_Int = $0D; { IntVec for IRQ5}
IRQ6_Int = $0E; { IntVec for IRQ6}
IRQ7_Int = $0F; { IntVec for IRQ7}
PIC_CTL = $20; { Cmd for 8259 }
PIC_MASK = $21; { Mask for 8259 }
EOI = $20; { EoI command }
TBE = $20; { TBE bit }
XOFF_Char = #19; { ^S }
XON_Char = #17; { ^Q }
CR = #13;
LF = #10;

Type Queue_type = record
queue : array[1..queue_max] of byte;
front,rear : integer;
count : integer;
end;
Port_Status = (XON, XOFF);
Var Transmit_Queue,
Receive_Queue : Queue_Type;
Receive_Status,
Transmit_Status : Port_Status;
Com_STS : Integer; { Serial Status I/O Port }
mask_value : integer; { Control mask word }
old_isr : pointer; { storage for com port }
{ ISR vector in place }
{**********************************************************}
{ Serial Interrupt Service Routine - grab the char and put }
{ it in the queue }
{**********************************************************}
Procedure Serial_ISR; Interrupt;
var ch : byte; { for the incoming char }
regs : registers; { for using BIOS to beep bell }
next_rear : integer;
begin
inline($FA); { Disable interrupts }
ch := port[current_cfg.data]; { get character from port }
with receive_queue do
begin
next_rear := rear + 1;
if next_rear > queue_max then { wrap the pointer if }
next_rear := 1; { necessary }
if next_rear <> front then
begin { put char in queue }
rear := next_rear;
queue[rear] := ch;
end
else
begin { queue full,beep bell }
regs.ax := $0E07;
intr($10,regs);
end;
inc(count); { Inc # entries and }
{ Check for queue getting full. Send XOFF when one }
{ second of space left }

if count > (queue_max - current_cfg.rate) then
begin
Receive_status := XOFF;
repeat until (port[com_sts] and TBE)<>0;
port[current_cfg.data] := ord(XOFF_Char);
end;
end; { END WITH }
inline($FB); { Enable interrupts }
port[PIC_CTL] := EOI { send end of interrupt to PIC }
end; { END PROCEDURESERIAL_ISR }

{**********************************************************}
{ Attach Com Port Procedure - takes over interrupt vector }
{ and initializes the UART entries in the configuration }
{ table. }
{**********************************************************}
Procedure Attach_Com_Port;
var mask_value : byte;
Int_Num : integer;
begin
Case Current_Cfg.IRQ of
3 : Int_Num := IRQ3_Int;
4 : Int_Num := IRQ4_Int;
5 : Int_Num := IRQ5_Int;
6 : Int_Num := IRQ6_Int;
7 : Int_Num := IRQ7_Int;
end;
GetIntVec(Int_Num, old_ISR); { Save old intvec }
SetIntVec(Int_Num, @Serial_ISR); { point to the }
{ Serial_ISR procedure }
port[Current_Cfg.data+mcr_Offset] := $0B; { Set DSR/OUT2 }
port[Current_Cfg.data+ier_Offset] := $01; { enable ints }
mask_value := port[pic_mask]; { read PIC mask}
mask_value := mask_value and { allow ints }
(not (1 shl current_cfg.irq)); { on com port }
port[pic_mask] := mask_value; { write it back}
{ to PIC }
receive_status := XON; { send XON to }
repeat until (port[com_sts] and TBE)<>0; { let other end}
port[current_cfg.data] := ord(XON_Char); { know we're }
{ here. }
transmit_status := XON;
end; { END ATTACH_COM_PORT }

{**********************************************************}
{ Release Com Port Procedure - Gives the com port interrupt}
{ back to the previous holder. }
{**********************************************************}
Procedure Release_Com_Port;
Var Int_Num : Integer;
begin
Case Current_Cfg.IRQ of
3 : Int_Num := IRQ3_Int;
4 : Int_Num := IRQ4_Int;
5 : Int_Num := IRQ5_Int;
6 : Int_Num := IRQ6_Int;
7 : Int_Num := IRQ7_Int;
end;
mask_value := port[pic_mask];
mask_value := mask_value or (1 shl current_cfg.IRQ);
port[pic_mask] := mask_value;
SetIntVec(Int_Num, Old_ISR); { Restore the com port int-}
{ errupt vector }
Receive_Status := XOFF;
Transmit_Status:= XOFF;
end;

{**********************************************************}
{ Check_Receive Procedure - This procedure checks the in- }
{ coming com port queue. If any characters are waiting, }
{ they are appended to the incoming string for program }
{ processing. }
{**********************************************************}
Procedure Check_Receive (var ch : char);
begin
with receive_queue do
if front <> rear then { Queue empty when front ptr }
{ = rear ptr }
begin
front := front + 1;
if front > queue_max then
front := 1;
ch := chr(queue[front]);
Case ch of
XOFF_Char : Transmit_Status := XOFF;
XON_Char : Transmit_Status := XON;
end; { END CASE CH }

{ Check queue count and send XON if receiving stop- }
{ ped and queue has 2 seconds of space free }
dec(count);
if (count - (2 * current_cfg.rate)) > 0 then
begin
receive_status := XON;
repeat until (port[com_sts] and TBE)<>0;
port[current_cfg.data] := ord(XON_Char);
end;
end; { END IF FRONT <> REAR }
end; { END PROC CHECK_RECEIVE }

{***********************************************************}
{ Check_Send Procedure - This procedure handles sending }
{ chars out the COM port. If there are any characters wait- }
{ ing in the send queue, they are sent one at a time. }
{***********************************************************}
Procedure Check_Send;
Var ch : char;
done : boolean;
Begin
done := false;
with transmit_queue do
repeat
if (front = rear) or { Queue empty when front ptr }
{ = rear ptr }
(Transmit_Status = XOFF) then { Don't send }
done := true
else
begin
if front > queue_max then
front := 1;
ch := chr(queue[front]);
repeat until (port[com_sts] and TBE)<>0;
port[current_cfg.data] := ord(ch);
end;
until done;
End; { END PROCEDURE CHECK_SEND }

Procedure Configure( New_Cfg : Config_Rec );
begin
{ Routine here reads configuration file based on location }
{ contained in environment string, then attaches the com }
{ port and sets communication parameters }
end;
begin { Unit Initialization }
Configure( Current_Cfg );
end.




[LISTING TWO]


Unit Packet_Comms;

Interface
Const Pkt_PDP_OK = 100;
Pkt_Dev_hdr = 101;
Pkt_Dev_lst = 102;
Pkt_Q_hdr = 103;
Pkt_Q_lst = 104;
Pkt_PDP_Err = 105;
Pkt_Micro_OK = 200;
Pkt_Print_Sel = 201;
Pkt_Q_Req = 202;
Pkt_Q_Del = 203;
Pkt_Q_Move = 204;
Pkt_Q_Hold = 205;
Pkt_Q_Rel = 206;
Pkt_Prt_Start = 207;
Pkt_Prt_End = 208;
Pkt_Micro_err = 209;
Invalid_PDP_Packet = 01;
Invalid_Checksum = 02;

Type Seq_Type = array[1..2] of char;
Fname_Type = array[1..9] of char;
Dname_Type = array[1..20] of char;
Packet_Rec = Record
Data_Checksum : array[1..5] of char;
Case Packet_Type : byte of
Pkt_PDP_OK: (* PDP-11 OK has no fields *)();
Pkt_Dev_Hdr: (Number_of_Devices : Seq_Type);
Pkt_Dev_Lst: (Dev_Num : Seq_Type;
Dev_Name : Dname_Type;
Desc : array [1..40] of char;
Default : char);
Pkt_Q_Hdr: (Num_Entries : Seq_Type);
Pkt_Q_Lst: (Q_Seq : Seq_Type;
Q_Filename : Fname_Type;
User : array [1..20] of char;
Length : array [1..7] of char;
Date : array [1..10] of char;
Time : array [1..5] of char);
Pkt_PDP_Err: (PDP_Error : Char);
Pkt_Micro_Ok: (* Micro OK has no fields *)();
Pkt_Print_Sel: (Print_Name : Dname_Type);
Pkt_Q_Req: (* Request for queue list *)();
Pkt_Q_Del: (D_Filename : Fname_Type;
Del_Flag : Char);
Pkt_Q_Move: (M_Filename : Fname_Type;
Position : Seq_Type);
Pkt_Q_Hold: (H_Filename : Fname_Type);
Pkt_Q_Rel: (R_Filename : Fname_Type);
Pkt_Prt_Start: (* Print file initialize *)();
Pkt_Prt_End: (* Print file end *)();
Pkt_Micro_Err: (Micro_Error : Char);
End;

Procedure Receive_Packet( Var Packet : Packet_Rec );
Procedure Send_Packet ( Var Packet : Packet_Rec );

Implementation
Uses SerialIO;
Procedure PDP_OK ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer); forward;
Procedure Dev_Header ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure Dev_Desc ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure Q_Header ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure Q_Entry ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure PDP_Err ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure Micro_Ack ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure Print_Select ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure Req_Q ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure Del_Entry ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure Move_Entry ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure Hold_Entry ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure Rel_Entry ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure Print_Start ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure Print_End ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);
Procedure Micro_Err ( Var Packet : Packet_Rec;
Var Comp_Checksum : Integer);

Procedure Receive_Packet( Var Packet : Packet_Rec );
Var Comp_Checksum,Comm_Checksum,Count,Val_Error : Integer;
ch : Char;
Err_Flag : Boolean;
Checksum_Str : string[5];
begin
Err_Flag := False;
Repeat
comp_checksum := 0;
with packet do
begin
check_receive( ch ); { See if a packet's coming }
Val(ch, packet_type, val_error);
Case packet_type of
Pkt_PDP_OK: PDP_OK ( Packet, Comp_Checksum );
Pkt_Dev_Hdr: Dev_Header ( Packet, Comp_Checksum );
Pkt_Dev_Lst: Dev_Desc ( Packet, Comp_Checksum );
Pkt_Q_Hdr: Q_Header ( Packet, Comp_Checksum );
Pkt_Q_Lst: Q_Entry ( Packet, Comp_Checksum );
PKT_PDP_Err: PDP_Err ( Packet, Comp_Checksum );
else
begin
packet_type := Pkt_Micro_Err;
Micro_Error := chr(Invalid_Checksum);
Send_Packet( Packet );
Err_Flag := True;
end;
end; { End CASE }
If not Err_Flag then
begin
For Count := 1 to 5 do
begin
Check_receive( ch );
checksum_str := checksum_str + ch;
end;
Val(Checksum_str, comm_checksum, val_error);
If (val_error<>0) or (Comm_Checksum<>Comp_Checksum) then
begin
packet_type := Pkt_Micro_Err;
Micro_Error := chr(Invalid_Checksum);
Send_Packet( Packet );
Err_Flag := True;
end
else
begin
packet_type := Pkt_Micro_Ack;
Send_Packet( Packet);
end; { End Error }
end; { End Checksum Rcv }
end; { End With Packet }
Until not Err_Flag;
end;

Procedure Send_Packet( Var Packet : Packet_Rec );
Var ch : Char;
Comp_Checksum,
Count,
Val_Error : Integer;
Err_Flag : Boolean;
Checksum_Str : string[5];
Temp_Packet : Packet_Rec;

begin
Err_Flag := False;
Repeat
comp_checksum := 0;
with packet do
begin
Case packet_type of
Pkt_Micro_OK: Micro_Ack ( Packet, Comp_Checksum );
Pkt_Print_Sel: Print_Select ( Packet, Comp_Checksum );
Pkt_Q_Req: Req_Q ( Packet, Comp_Checksum );
Pkt_Q_Del: Del_Entry ( Packet, Comp_Checksum );
Pkt_Q_Move: Move_Entry ( Packet, Comp_Checksum );
Pkt_Q_Hold: Hold_Entry ( Packet, Comp_Checksum );
Pkt_Q_Rel: Rel_Entry ( Packet, Comp_Checksum );
Pkt_Prt_Start: Print_Start ( Packet, Comp_Checksum );
Pkt_Prt_End: Print_End ( Packet, Comp_Checksum );
Pkt_Micro_Err: Micro_Err ( Packet, Comp_Checksum );
end;
Str( Comp_Checksum, Checksum_Str );
While (Length(Checksum_str) < 5) do
Checksum_Str := '0' + checksum_str;
For Count := 1 to 5 do
check_send(checksum_str[count]);
Receive_Packet( Temp_Packet );
If Temp_Packet.Packet_Type <> Pkt_PDP_OK then
Err_Flag := True;
end; { End With Packet }
Until not Err_Flag;
end;

{**************** Unit Initialization Main Code Block *************}
Begin
End.