home *** CD-ROM | disk | FTP | other *** search
/ Mega CD-ROM 1 / megacd_rom_1.zip / megacd_rom_1 / MAGAZINE / DDJMAG / DDJ8910.ZIP / SERVELLO.LST < prev    next >
File List  |  1989-09-07  |  22KB  |  438 lines
  1. _Implementing Multiple Computer Communications Links_
  2. by Mark Servello
  3.  
  4.  
  5. [LISTING ONE]
  6.  
  7.           Unit Serial_IO;
  8.           {************ Unit Interface Description ***************}
  9.           Interface
  10.           Type Config_rec = record { contains the configuration info  }
  11.                                    { for serial communication and user}
  12.                                    { interface                        }
  13.                               IRQ      : Integer;
  14.                               Port     : Integer;
  15.                               Data     : Integer;
  16.                               Baud     : Integer;
  17.                               Rate     : integer;    { bytes/sec }
  18.                               Parity   : Char;
  19.                               StopBits : Integer;
  20.                               DataBits : Integer;
  21.                               Snow     : Boolean;
  22.                               Lines    : Integer;
  23.                               Attention: String[40];
  24.                               Fore     : Integer;
  25.                               Back     : Integer;
  26.                             end;
  27.           
  28.           Var  Current_Cfg      : Config_Rec;
  29.           Procedure Check_Receive (var ch : char);
  30.           Procedure Check_Send;
  31.           Procedure Configure( New_Cfg : Config_Rec );
  32.           
  33.           {******************* Unit Implementation ******************}
  34.           Implementation
  35.           uses dos,crt;           { DOS and CRT units are utilized   }
  36.           Const queue_max = 3936; { queue can hold 48 lines X 82 char}
  37.           
  38.           { *********** Serial Port Constants ***********************}
  39.                 COM1_data  = $03f8;     { COM1 Data port }
  40.                 COM1_IRQ   = $04;       { COM1 IRQ Number}
  41.                 COM2_data  = $02f8;     { COM2 Data port }
  42.                 COM2_IRQ   = $03;       { COM2 IRQ Number}
  43.                 ier_offset = 1;         { UART IER Reg   }
  44.                 mcr_offset = 4;         { UART Master Reg}
  45.                 sts_offset = 5;         { UART Status Reg}
  46.                 IRQ3_Int   = $0B;       { IntVec for IRQ3}
  47.                 IRQ4_Int   = $0C;       { IntVec for IRQ4}
  48.                 IRQ5_Int   = $0D;       { IntVec for IRQ5}
  49.                 IRQ6_Int   = $0E;       { IntVec for IRQ6}
  50.                 IRQ7_Int   = $0F;       { IntVec for IRQ7}
  51.                 PIC_CTL    = $20;       { Cmd for 8259   }
  52.                 PIC_MASK   = $21;       { Mask for 8259  }
  53.                 EOI        = $20;       { EoI command    }
  54.                 TBE        = $20;       { TBE bit        }
  55.                 XOFF_Char  = #19;       { ^S             }
  56.                 XON_Char   = #17;       { ^Q             }
  57.                 CR         = #13;
  58.                 LF         = #10;
  59.           
  60.           Type Queue_type = record
  61.                               queue      : array[1..queue_max] of byte;
  62.                               front,rear : integer;
  63.                               count      : integer;
  64.                             end;
  65.                Port_Status = (XON, XOFF);
  66.           Var  Transmit_Queue,
  67.                Receive_Queue    : Queue_Type;
  68.                Receive_Status,
  69.                Transmit_Status  : Port_Status;
  70.                Com_STS          : Integer;    { Serial Status I/O Port }
  71.                mask_value       : integer;    { Control mask word      }
  72.                old_isr          : pointer;    { storage for com port   }
  73.                                               { ISR vector in place    }
  74.           {**********************************************************}
  75.           { Serial Interrupt Service Routine - grab the char and put }
  76.           { it in the queue                                          }
  77.           {**********************************************************}
  78.           Procedure Serial_ISR; Interrupt;
  79.           var ch        : byte;      { for the incoming char         }
  80.               regs      : registers; { for using BIOS to beep bell   }
  81.               next_rear : integer;
  82.           begin
  83.             inline($FA);                   { Disable interrupts      }
  84.             ch := port[current_cfg.data];  { get character from port }
  85.             with receive_queue do
  86.               begin
  87.                 next_rear := rear + 1;
  88.                 if next_rear > queue_max then { wrap the pointer if  }
  89.                   next_rear := 1;             { necessary            }
  90.                 if next_rear <> front then
  91.                   begin                       { put char in queue    }
  92.                     rear := next_rear;
  93.                     queue[rear] := ch;
  94.                   end
  95.                 else
  96.                   begin                       { queue full,beep bell }
  97.                     regs.ax := $0E07;
  98.                     intr($10,regs);
  99.                   end;
  100.                 inc(count);                   { Inc # entries and    }
  101.                 { Check for queue getting full. Send XOFF when one   }
  102.                 { second of space left                               }
  103.           
  104.                 if count > (queue_max - current_cfg.rate) then
  105.                   begin
  106.                     Receive_status := XOFF;
  107.                     repeat until (port[com_sts] and TBE)<>0;
  108.                     port[current_cfg.data] := ord(XOFF_Char);
  109.                   end;
  110.               end;                            { END WITH             }
  111.             inline($FB);              { Enable interrupts            }
  112.             port[PIC_CTL] := EOI      { send end of interrupt to PIC }
  113.           end;                        { END PROCEDURESERIAL_ISR      }
  114.           
  115.           {**********************************************************}
  116.           { Attach Com Port Procedure - takes over interrupt vector  }
  117.           { and initializes the UART entries in the configuration    }
  118.           { table.                                                   }
  119.           {**********************************************************}
  120.           Procedure Attach_Com_Port;
  121.           var mask_value : byte;
  122.               Int_Num    : integer;
  123.           begin
  124.             Case Current_Cfg.IRQ of
  125.               3 : Int_Num := IRQ3_Int;
  126.               4 : Int_Num := IRQ4_Int;
  127.               5 : Int_Num := IRQ5_Int;
  128.               6 : Int_Num := IRQ6_Int;
  129.               7 : Int_Num := IRQ7_Int;
  130.             end;
  131.             GetIntVec(Int_Num, old_ISR);      { Save old intvec      }
  132.             SetIntVec(Int_Num, @Serial_ISR);  { point to the         }
  133.                                               { Serial_ISR procedure }
  134.             port[Current_Cfg.data+mcr_Offset] := $0B; { Set DSR/OUT2 }
  135.             port[Current_Cfg.data+ier_Offset] := $01; { enable ints  }
  136.             mask_value := port[pic_mask];             { read PIC mask}
  137.             mask_value := mask_value and              { allow ints   }
  138.                      (not (1 shl current_cfg.irq));   { on com port  }
  139.             port[pic_mask] := mask_value;             { write it back}
  140.                                                       { to PIC       }
  141.             receive_status := XON;                    { send XON to  }
  142.             repeat until (port[com_sts] and TBE)<>0;  { let other end}
  143.             port[current_cfg.data] := ord(XON_Char);  { know we're   }
  144.                                                       { here.        }
  145.             transmit_status := XON;
  146.           end;                                 { END ATTACH_COM_PORT }
  147.           
  148.           {**********************************************************}
  149.           { Release Com Port Procedure - Gives the com port interrupt}
  150.           { back to the previous holder.                             }
  151.           {**********************************************************}
  152.           Procedure Release_Com_Port;
  153.           Var Int_Num : Integer;
  154.           begin
  155.             Case Current_Cfg.IRQ of
  156.               3 : Int_Num := IRQ3_Int;
  157.               4 : Int_Num := IRQ4_Int;
  158.               5 : Int_Num := IRQ5_Int;
  159.               6 : Int_Num := IRQ6_Int;
  160.               7 : Int_Num := IRQ7_Int;
  161.             end;
  162.             mask_value := port[pic_mask];
  163.             mask_value := mask_value or (1 shl current_cfg.IRQ);
  164.             port[pic_mask] := mask_value;
  165.             SetIntVec(Int_Num, Old_ISR);  { Restore the com port int-}
  166.                                           { errupt vector            }
  167.             Receive_Status := XOFF;
  168.             Transmit_Status:= XOFF;
  169.           end;
  170.           
  171.           {**********************************************************}
  172.           { Check_Receive Procedure - This procedure checks the in-  }
  173.           { coming com port queue. If any characters are waiting,    }
  174.           { they are appended to the incoming string for program     }
  175.           { processing.                                              }
  176.           {**********************************************************}
  177.           Procedure Check_Receive (var ch : char);
  178.           begin
  179.             with receive_queue do
  180.               if front <> rear then      { Queue empty when front ptr }
  181.                                          { = rear ptr                 }
  182.                 begin
  183.                   front := front + 1;
  184.                   if front > queue_max then
  185.                     front := 1;
  186.                   ch := chr(queue[front]);
  187.                   Case ch of
  188.                        XOFF_Char         : Transmit_Status := XOFF;
  189.                        XON_Char          : Transmit_Status := XON;
  190.                   end;                    { END CASE CH               }
  191.           
  192.                   { Check queue count and send XON if receiving stop- }
  193.                   { ped and queue has 2 seconds of space free         }
  194.                   dec(count);
  195.                   if (count - (2 * current_cfg.rate)) > 0 then
  196.                     begin
  197.                       receive_status := XON;
  198.                       repeat until (port[com_sts] and TBE)<>0;
  199.                       port[current_cfg.data] := ord(XON_Char);
  200.                     end;
  201.                 end;                      { END IF FRONT <> REAR      }
  202.           end;                            { END PROC CHECK_RECEIVE    }
  203.           
  204.           {***********************************************************}
  205.           { Check_Send Procedure - This procedure handles sending     }
  206.           { chars out the COM port. If there are any characters wait- }
  207.           { ing in the send queue, they are sent one at a time.       }
  208.           {***********************************************************}
  209.           Procedure Check_Send;
  210.           Var ch   : char;
  211.               done : boolean;
  212.           Begin
  213.             done := false;
  214.             with transmit_queue do
  215.               repeat
  216.                 if (front = rear) or   { Queue empty when front ptr }
  217.                                        { = rear ptr                 }
  218.                    (Transmit_Status = XOFF) then      { Don't send  }
  219.                   done := true
  220.                 else
  221.                   begin
  222.                     if front > queue_max then
  223.                       front := 1;
  224.                     ch := chr(queue[front]);
  225.                     repeat until (port[com_sts] and TBE)<>0;
  226.                     port[current_cfg.data] := ord(ch);
  227.                   end;
  228.               until done;
  229.           End;                            { END PROCEDURE CHECK_SEND }
  230.           
  231.           Procedure Configure( New_Cfg : Config_Rec );
  232.           begin
  233.            { Routine here reads configuration file based on location }
  234.            { contained in environment string, then attaches the com  }
  235.            { port and sets communication parameters                  }
  236.           end;
  237.           begin                         { Unit Initialization        }
  238.             Configure( Current_Cfg );
  239.           end.
  240.           
  241.  
  242.  
  243.  
  244. [LISTING TWO]
  245.  
  246.  
  247.           Unit Packet_Comms;
  248.           
  249.           Interface
  250.           Const Pkt_PDP_OK    = 100;
  251.                 Pkt_Dev_hdr   = 101;
  252.                 Pkt_Dev_lst   = 102;
  253.                 Pkt_Q_hdr     = 103;
  254.                 Pkt_Q_lst     = 104;
  255.                 Pkt_PDP_Err   = 105;
  256.                 Pkt_Micro_OK  = 200;
  257.                 Pkt_Print_Sel = 201;
  258.                 Pkt_Q_Req     = 202;
  259.                 Pkt_Q_Del     = 203;
  260.                 Pkt_Q_Move    = 204;
  261.                 Pkt_Q_Hold    = 205;
  262.                 Pkt_Q_Rel     = 206;
  263.                 Pkt_Prt_Start = 207;
  264.                 Pkt_Prt_End   = 208;
  265.                 Pkt_Micro_err = 209;
  266.                 Invalid_PDP_Packet = 01;
  267.                 Invalid_Checksum   = 02;
  268.           
  269.           Type Seq_Type   = array[1..2]  of char;
  270.                Fname_Type = array[1..9]  of char;
  271.                Dname_Type = array[1..20] of char;
  272.                Packet_Rec = Record
  273.                         Data_Checksum : array[1..5] of char;
  274.                         Case Packet_Type : byte of
  275.                           Pkt_PDP_OK:    (* PDP-11 OK has no fields *)();
  276.                           Pkt_Dev_Hdr:   (Number_of_Devices : Seq_Type);
  277.                           Pkt_Dev_Lst:   (Dev_Num     : Seq_Type;
  278.                                           Dev_Name    : Dname_Type;
  279.                                           Desc        : array [1..40] of char;
  280.                                           Default     : char);
  281.                           Pkt_Q_Hdr:     (Num_Entries : Seq_Type);
  282.                           Pkt_Q_Lst:     (Q_Seq       : Seq_Type;
  283.                                           Q_Filename  : Fname_Type;
  284.                                           User        : array [1..20] of char;
  285.                                           Length      : array [1..7]  of char;
  286.                                           Date        : array [1..10] of char;
  287.                                           Time        : array [1..5]  of char);
  288.                           Pkt_PDP_Err:   (PDP_Error   : Char);
  289.                           Pkt_Micro_Ok:  (* Micro OK has no fields *)();
  290.                           Pkt_Print_Sel: (Print_Name  : Dname_Type);
  291.                           Pkt_Q_Req:     (* Request for queue list *)();
  292.                           Pkt_Q_Del:     (D_Filename  : Fname_Type;
  293.                                           Del_Flag    : Char);
  294.                           Pkt_Q_Move:    (M_Filename  : Fname_Type;
  295.                                           Position    : Seq_Type);
  296.                           Pkt_Q_Hold:    (H_Filename  : Fname_Type);
  297.                           Pkt_Q_Rel:     (R_Filename  : Fname_Type);
  298.                           Pkt_Prt_Start: (* Print file initialize *)();
  299.                           Pkt_Prt_End:   (* Print file end        *)();
  300.                           Pkt_Micro_Err: (Micro_Error : Char);
  301.                       End;
  302.           
  303.           Procedure Receive_Packet( Var Packet : Packet_Rec );
  304.           Procedure Send_Packet   ( Var Packet : Packet_Rec );
  305.           
  306.           Implementation
  307.           Uses SerialIO;
  308.           Procedure PDP_OK        ( Var Packet        : Packet_Rec;
  309.                                     Var Comp_Checksum : Integer);   forward;
  310.           Procedure Dev_Header    ( Var Packet        : Packet_Rec;
  311.                                     Var Comp_Checksum : Integer);
  312.           Procedure Dev_Desc      ( Var Packet        : Packet_Rec;
  313.                                     Var Comp_Checksum : Integer);
  314.           Procedure Q_Header      ( Var Packet        : Packet_Rec;
  315.                                     Var Comp_Checksum : Integer);
  316.           Procedure Q_Entry       ( Var Packet        : Packet_Rec;
  317.                                     Var Comp_Checksum : Integer);
  318.           Procedure PDP_Err       ( Var Packet        : Packet_Rec;
  319.                                     Var Comp_Checksum : Integer);
  320.           Procedure Micro_Ack     ( Var Packet        : Packet_Rec;
  321.                                     Var Comp_Checksum : Integer);
  322.           Procedure Print_Select  ( Var Packet        : Packet_Rec;
  323.                                     Var Comp_Checksum : Integer);
  324.           Procedure Req_Q         ( Var Packet        : Packet_Rec;
  325.                                     Var Comp_Checksum : Integer);
  326.           Procedure Del_Entry     ( Var Packet        : Packet_Rec;
  327.                                     Var Comp_Checksum : Integer);
  328.           Procedure Move_Entry    ( Var Packet        : Packet_Rec;
  329.                                     Var Comp_Checksum : Integer);
  330.           Procedure Hold_Entry    ( Var Packet        : Packet_Rec;
  331.                                     Var Comp_Checksum : Integer);
  332.           Procedure Rel_Entry     ( Var Packet        : Packet_Rec;
  333.                                     Var Comp_Checksum : Integer);
  334.           Procedure Print_Start   ( Var Packet        : Packet_Rec;
  335.                                     Var Comp_Checksum : Integer);
  336.           Procedure Print_End     ( Var Packet        : Packet_Rec;
  337.                                     Var Comp_Checksum : Integer);
  338.           Procedure Micro_Err     ( Var Packet        : Packet_Rec;
  339.                                     Var Comp_Checksum : Integer);
  340.           
  341.           Procedure Receive_Packet( Var Packet : Packet_Rec );
  342.           Var Comp_Checksum,Comm_Checksum,Count,Val_Error       : Integer;
  343.               ch              : Char;
  344.               Err_Flag        : Boolean;
  345.               Checksum_Str    : string[5];
  346.           begin
  347.             Err_Flag := False;
  348.             Repeat
  349.               comp_checksum := 0;
  350.               with packet do
  351.                 begin
  352.                   check_receive( ch );             { See if a packet's coming }
  353.                   Val(ch, packet_type, val_error);
  354.                   Case packet_type of
  355.                     Pkt_PDP_OK:  PDP_OK     ( Packet, Comp_Checksum );
  356.                     Pkt_Dev_Hdr: Dev_Header ( Packet, Comp_Checksum );
  357.                     Pkt_Dev_Lst: Dev_Desc   ( Packet, Comp_Checksum );
  358.                     Pkt_Q_Hdr:   Q_Header   ( Packet, Comp_Checksum );
  359.                     Pkt_Q_Lst:   Q_Entry    ( Packet, Comp_Checksum );
  360.                     PKT_PDP_Err: PDP_Err    ( Packet, Comp_Checksum );
  361.                   else
  362.                     begin
  363.                       packet_type := Pkt_Micro_Err;
  364.                       Micro_Error := chr(Invalid_Checksum);
  365.                       Send_Packet( Packet );
  366.                       Err_Flag := True;
  367.                     end;
  368.                   end;                              { End CASE }
  369.                   If not Err_Flag then
  370.                     begin
  371.                       For Count := 1 to 5 do
  372.                         begin
  373.                           Check_receive( ch );
  374.                           checksum_str := checksum_str + ch;
  375.                         end;
  376.                       Val(Checksum_str, comm_checksum, val_error);
  377.                       If (val_error<>0) or (Comm_Checksum<>Comp_Checksum) then
  378.                         begin
  379.                           packet_type := Pkt_Micro_Err;
  380.                           Micro_Error := chr(Invalid_Checksum);
  381.                           Send_Packet( Packet );
  382.                           Err_Flag := True;
  383.                         end
  384.                       else
  385.                         begin
  386.                           packet_type := Pkt_Micro_Ack;
  387.                           Send_Packet( Packet);
  388.                         end;                              { End Error        }
  389.                     end;                                  { End Checksum Rcv }
  390.                 end;                                      { End With Packet  }
  391.             Until not Err_Flag;
  392.           end;
  393.           
  394.           Procedure Send_Packet( Var Packet : Packet_Rec );
  395.           Var ch              : Char;
  396.               Comp_Checksum,
  397.               Count,
  398.               Val_Error       : Integer;
  399.               Err_Flag        : Boolean;
  400.               Checksum_Str    : string[5];
  401.               Temp_Packet     : Packet_Rec;
  402.           
  403.           begin
  404.             Err_Flag := False;
  405.             Repeat
  406.               comp_checksum := 0;
  407.               with packet do
  408.                 begin
  409.                   Case packet_type of
  410.                     Pkt_Micro_OK:     Micro_Ack    ( Packet, Comp_Checksum );
  411.                     Pkt_Print_Sel:    Print_Select ( Packet, Comp_Checksum );
  412.                     Pkt_Q_Req:        Req_Q        ( Packet, Comp_Checksum );
  413.                     Pkt_Q_Del:        Del_Entry    ( Packet, Comp_Checksum );
  414.                     Pkt_Q_Move:       Move_Entry   ( Packet, Comp_Checksum );
  415.                     Pkt_Q_Hold:       Hold_Entry   ( Packet, Comp_Checksum );
  416.                     Pkt_Q_Rel:        Rel_Entry    ( Packet, Comp_Checksum );
  417.                     Pkt_Prt_Start:    Print_Start  ( Packet, Comp_Checksum );
  418.                     Pkt_Prt_End:      Print_End    ( Packet, Comp_Checksum );
  419.                     Pkt_Micro_Err:    Micro_Err    ( Packet, Comp_Checksum );
  420.                   end;
  421.                   Str( Comp_Checksum, Checksum_Str );
  422.                   While (Length(Checksum_str) < 5) do
  423.                     Checksum_Str := '0' + checksum_str;
  424.                   For Count := 1 to 5 do
  425.                     check_send(checksum_str[count]);
  426.                   Receive_Packet( Temp_Packet );
  427.                   If Temp_Packet.Packet_Type <> Pkt_PDP_OK then
  428.                     Err_Flag := True;
  429.                 end;                                      { End With Packet  }
  430.             Until not Err_Flag;
  431.           end;
  432.           
  433.           {**************** Unit Initialization Main Code Block *************}
  434.           Begin
  435.           End.
  436.  
  437.  
  438.