home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / TPKERMIT / PACKET.PAS < prev    next >
Pascal/Delphi Source File  |  1987-03-25  |  13KB  |  288 lines
  1. (* +FILE+ PACKET.PASMSCPM *)
  2. (* ===============================================================  *)
  3. (* SENDPACKET -This procedure sends the SendData packet .           *)
  4. (*          1. The COUNT sent includes SEQ,PACKETTYPE,and CHECKSUM  *)
  5. (*             i.e. it is 3 larger than the OutCount or             *)
  6. (*               if CheckType = 2 or 3 then COUNT is 4 or 5 larger. *)
  7. (*          2. The COUNT and SEQ and CHECKSUM values are offset by  *)
  8. (*             32 decimal (20hex) to make it a printable ASCII char.*)
  9. (*          3. The CHECKSUM are calculated on the ASCII value of    *)
  10. (*             the printable characters.                            *)
  11. (*                                                                  *)
  12. (* Assumptions:                                                     *)
  13. (*       The following Global variables must be correctly set       *)
  14. (*       before calling this procedure .                            *)
  15. (*       1. OutDataCount - an integer-byte count of data characters.*)
  16. (*       2. OUTSEQ    - an integer-byte count of sequence number.   *)
  17. (*       3. OUTPACKETTYPE - an character    of type .               *)
  18. (*       4. SendData   - a character array of data to be sent.      *)
  19. (* ===============================================================  *)
  20. PROCEDURE SENDPACKET ;
  21.  VAR
  22.     I,SUM,Checkbytes : INTEGER ;
  23.     achar            : byte ;
  24.     SOHecho          : boolean ;
  25.  
  26.     BEGIN (* SENDPACKET procedure *)
  27. (*  SOHecho := Not (LocalEcho or (Series1 and  WaitXon)) ;  *)
  28.     SOHecho := Not (LocalEcho or Series1) ;
  29.     achar := 0 ;
  30.     If WaitXon then
  31.          While achar <> XON do if Readchar(achar) then
  32.                                                   else achar := xon ;
  33.     WaitXon := XonXoff ;
  34.     While RecvChar(achar) do ; (* throw away all previous incoming data *)
  35.     Delay(50);
  36.      SUM := 0 ;
  37.      CRC := 0 ;
  38.      Checkbytes := 1 ;
  39.      If (OutPacketType = ord('S')) or (OutPacketType = ord('I')) or
  40.          (InpacketType = ord('S')) or  (InpacketType = ord('I')) or
  41.          (InpacketType = ord('R')) then  (* leave Checkbytes := 1 *)
  42.                               else
  43.          If Checktype = ord('2') then Checkbytes := 2  else
  44.               If Checktype = ord('3') then Checkbytes := 3 ;
  45.  
  46.     SendChar(StartChar) ;                                       (* SOH   *)
  47.     If SOHecho then      (* wait for SOH to be echoed back *)
  48.         While achar <> StartChar do
  49.           if Not Readchar(achar) then achar:=StartChar ;
  50.     OutCount := OutDataCount + 2 + Checkbytes ;
  51.     SendChar(OutCount + $20) ;                             (* COUNT *)
  52.       SUM := SUM + OutCount + $20 ;
  53.       CRCheck(OutCount+$20) ;
  54.     SendChar(OUTSEQ+$20) ;                                 (* SEQ   *)
  55.       SUM := SUM + OUTSEQ + $20;
  56.       CRCheck(OUTSEQ+$20);
  57.     SendChar(OUTPACKETTYPE) ;                              (* TYPE  *)
  58.       SUM := SUM + ORD(OUTPACKETTYPE) ;
  59.       CRCheck(Ord(OutpacketType));
  60.  
  61.     IF OutDataCount > 0 THEN
  62.      FOR I := 1 TO OutDataCount DO
  63.          BEGIN (* Send Data *)
  64.          SendChar(SendData[I]) ;                           (* DATA   *)
  65.          SUM := SUM + SendData[I] ;
  66.          CRCheck(SendData[I]);
  67.          END ; (* Send Data *)
  68.  
  69.  
  70.     If Checkbytes = 1 then
  71.          Begin (* one Checksum *)
  72.          CHECKSUM := (SUM + (SUM AND $C0) DIV $40 ) AND $3F ;
  73.          SendChar(CHECKSUM+$20);                           (* CHECKSUM *)
  74.          End   (* one Checksum *)
  75.                      else
  76.     If Checkbytes = 2 then
  77.          Begin (* two Checksum *)
  78.          Checksum := (Sum div $40) and $3F ; (* Bit 11 - 6 *)
  79.          SendChar(Checksum+$20) ;
  80.          Checksum :=  Sum and $3F ;          (* Bit 5 - 0 *)
  81.          SendChar(Checksum+$20) ;
  82.          End  (* two Checksum *)
  83.                       else
  84.     If Checkbytes = 3 then
  85.         Begin (* CRC *)
  86.         SendChar((CRC shr 12 ) and $0F + $20) ;
  87.         SendChar((CRC shr 6  ) and $3F + $20) ;
  88.         SendChar((CRC        ) and $3F + $20) ;
  89.         End ; (* CRC *)
  90.  
  91.     SendChar(EndChar);                                     (* Cr *)
  92.     If NumPad > 0 then
  93.         For I := 1 to NumPad do SendChar(PadChar);         (* Padding *)
  94.     END ; (* SENDPACKET procedure  *)
  95.  
  96. (* ===============================================================  *)
  97. (* RECVPACKET -This Function returns TRUE if it successfully        *)
  98. (*             recieved a packet and FALSE if it had an error.      *)
  99. (*  Side Effects:                                                   *)
  100. (*       The following global variables will be set.                *)
  101. (*       1. InDataCount - an integer value of the msg char count.   *)
  102. (*       2. INSEQ - an integer value of the sequence count.         *)
  103. (*       3. TYPE  - a  character of message type (Y,N,D,F,etc)      *)
  104. (*       4. RecvData - an array of data bytes to be sent.           *)
  105. (*                                                                  *)
  106. (* ===============================================================  *)
  107. FUNCTION  RECVPACKET : BOOLEAN ;
  108.  VAR
  109.     I,SUM,RESENDS      : INTEGER ;
  110.     INCHAR,Checkbytes  : Byte ;
  111.     dummy              : Boolean ;
  112.  
  113. LABEL EXIT ;
  114.  
  115.     BEGIN (* RECVPACKET procedure *)
  116.     RECVPACKET := false ;    (* assume false until proven otherwise *)
  117.     If GotSOH then begin Inchar := StartChar; GotSOH := false; end
  118.                      else Inchar := $20 ;
  119.     While Inchar <> StartChar Do
  120.          If Readchar(Inchar) then                     (* SOH   *)
  121.                              else goto exit ;
  122.     SUM := 0 ;
  123.     CRC := 0 ;
  124.  
  125.     If not ReadChar (InCount) then goto exit ;        (* COUNT *)
  126.       SUM := SUM + InCount ;
  127.       CRCheck(InCount) ;
  128.       InCount := InCount - $20 ; (* To absolute value *)
  129.  
  130.     if not ReadChar (INSEQ) then  goto exit ;         (* SEQ   *)
  131.       SUM := SUM + INSEQ ;
  132.       CRCheck(INSEQ) ;
  133.       INSEQ := INSEQ - $20 ;
  134.  
  135.     If not ReadChar (INPACKETTYPE ) then goto exit ;  (* TYPE  *)
  136.       SUM := SUM + INPACKETTYPE ;
  137.       CRCheck(InPacketType);
  138.      Checkbytes := 1 ;
  139.      If (OutPacketType = ord('S')) or
  140.          (InpacketType = ord('S')) or
  141.          (InpacketType = ord('R')) then  (* leave Checkbytes := 1 *)
  142.                                    else
  143.          If Checktype = ord('2') then Checkbytes := 2  else
  144.               If Checktype = ord('3') then Checkbytes := 3 ;
  145.  
  146.     InDataCount := InCount - 2 - Checkbytes ;
  147.     IF InDataCount >  0 THEN
  148.      FOR I := 1 TO InDataCount  DO
  149.          BEGIN (* Recv Data *)
  150.          If ReadChar (RecvData[I]) then               (* DATA   *)
  151.               Begin (* checksum and CRC *)
  152.               SUM := SUM + RecvData[I] ;
  153.               CRCheck(RecvData[I]);
  154.               End  (* checksum and CRC *)
  155.                                    else
  156.               goto exit ;
  157.          END ; (* Revc Data *)
  158.  
  159.     RECVPACKET := True ;    (* Assume Ok until check fails *)
  160.     If Checkbytes = 1 then
  161.          Begin (* one char Checksum *)
  162.          CHECKSUM := (SUM + (SUM AND $C0) DIV $40 ) AND $3F ;
  163.          If ReadChar (INCHAR) then
  164.               IF INCHAR <> CHECKSUM+$20  THEN  RECVPACKET := FALSE ;
  165.          End  (* one char Checksum *)
  166.                       else
  167.     If Checkbytes = 2 then
  168.          Begin (* two char Checksum *)
  169.          Checksum := (Sum div $40) and $3F ;
  170.          If ReadChar(Inchar) then
  171.               If Inchar <> Checksum+$20 then RECVPACKET := false ;
  172.          Checksum := Sum and $3F ;
  173.          If ReadChar(Inchar) then
  174.               If Inchar <> Checksum+$20 then RECVPACKET := false ;
  175.          End   (* two char Checksum *)
  176.                       else
  177.     If Checkbytes = 3 then
  178.          Begin (* CRC char Checksum *)
  179.          Checksum := (CRC shr 12) and $0F ;
  180.          If ReadChar(Inchar) then
  181.           (*  If Inchar <> Checksum+$20 then
  182.                    Writeln('CRC1 ',Inchar,' ',checksum+$20);    *)
  183.               If Inchar <> Checksum+$20 then RECVPACKET := false ;
  184.          Checksum := (CRC shr 6 ) and  $3F ;
  185.          If ReadChar(Inchar) then
  186.           (*  If Inchar <> Checksum+$20 then
  187.                Writeln('CRC2 ',Inchar,' ',checksum+$20); *)
  188.               If Inchar <> Checksum+$20 then RECVPACKET := false ;
  189.          Checksum := (CRC       ) and  $3F ;
  190.          If ReadChar(Inchar) then
  191.          (*   If Inchar <> Checksum+$20 then
  192.                    Writeln('CRC3 ',Inchar,' ',checksum+$20); *)
  193.               If Inchar <> Checksum+$20 then RECVPACKET := false ;
  194.          End;  (* CRC char Checksum *)
  195.  
  196. Exit:
  197.     END ; (* RECVPACKET procedure  *)
  198.  
  199. (* ===============================================================  *)
  200. (* RESENDIT -  This procedure RESENDS the packet if it gets a nak   *)
  201. (*             It calls itself recursively upto the number of times *)
  202. (*             specified in the intial parameter list.              *)
  203. (* Side Effects - If it fails then the STATE in the message is set  *)
  204. (*                to 'A' which means ABORT .                        *)
  205. (*              - Global variable RetryCount is incremented         *)
  206. (* ===============================================================  *)
  207. PROCEDURE RESENDIT ( RETRIES : INTEGER ) ;
  208.  
  209.     BEGIN (* RESENDIT procedure *)
  210.     RetryCount := RetryCount + 1 ;
  211.     IF RETRIES > 0 THEN
  212.          BEGIN (* Try again *)
  213.          SENDPACKET ;
  214.          IF RECVPACKET THEN
  215.               IF INPACKETTYPE = ord('Y') THEN
  216.                                          ELSE
  217.               IF INPACKETTYPE = ord('N') THEN RESENDIT(RETRIES-1)
  218.                                          ELSE STATE := A
  219.                        ELSE STATE := A  ;
  220.          END   (* Try again *)
  221.                    ELSE STATE := A ;  (* Retries failed - ABORT *)
  222.     END ; (* RESENDIT procedure  *)
  223.  
  224. (* ------------------------------------------------------------ *)
  225. (*  SendPacketType - Procedure  will send a packet of the       *)
  226. (*            type specified in  the Character  parameter.      *)
  227. (*            i.e. SendPacketType('Y')  an ACK packet           *)
  228. (*                 SendPacketType('N')  an NAK packet           *)
  229. (* ------------------------------------------------------------ *)
  230.      PROCEDURE SendPacketType  (PacketType : char);
  231.          BEGIN (* SEND ACK or NAK or B or Z *)
  232.          OutDataCount := 0 ;
  233.          IF PacketType <> 'N' THEN  OUTSEQ := OUTSEQ + 1 ;
  234.          IF OUTSEQ >= 64 THEN OUTSEQ := 0;
  235.          OUTPACKETTYPE := Ord(PacketType) ;
  236.          SENDPACKET ;
  237.          END ; (* SEND ACK or NAK or B or Z *)
  238. (* ------------------------------------------------------------ *)
  239.     PROCEDURE PutInitPacket  ;
  240.          Begin (* Put Parameters into Init Packet *)
  241.          OutDataCount := 9 ;
  242.          OUTSEQ := 0 ;
  243.          (* The values  are tranformed by adding hex 20 to    *)
  244.          (* the true value, making the value a printable char *)
  245.          SendData[1] := PacketSize+ $20 ;  (* Buffsize       *)
  246.          SendData[2] := Timeout   + $20 ;  (* Time out sec   *)
  247.          SendData[3] := NumPad    + $20 ;  (* Num padchars   *)
  248.          SendData[4] := PadChar   + $20 ;  (* Pad char       *)
  249.          SendData[5] := EndChar   + $20 ;  (* EOL char       *)
  250.          SendData[6] := CntrlQuote ;      (* Quote character  *)
  251.          SendData[7] := Bit8Quote ;       (* Quote character  *)
  252.          SendData[8] := CheckType ;       (* Check Type       *)
  253.          SendData[9] := RepChar   ;       (* Repeat Character *)
  254.          IF Bit8Quote = $00 then OutDataCount := 6  (* Don't send bit8_quote *)
  255.                             else
  256.               If CheckType = $00 then OutDataCount := 7
  257.                                  else
  258.                    If RepChar = $00 then OutDataCount := 8 ;
  259.          End ; (* Put Parameters into Init Packet *)
  260. (* ------------------------------------------------------------ *)
  261.     PROCEDURE GetInitPacket ;
  262.          Begin  (* Get init parameters *)
  263.          IF InDataCount >= 1 then   PacketSize := RecvData[1]-$20 ;
  264.          IF InDataCount >= 2 then   TimeOut    := RecvData[2]-$20 ;
  265.          IF InDataCount >= 3 then   NumPad     := RecvData[3]-$20 ;
  266.          IF InDataCount >= 4 then   PadChar    := RecvData[4]-$20 ;
  267.          IF InDataCount >= 5 then   EndChar    := RecvData[5]-$20 ;
  268.          IF InDataCount >= 6 then   CntrlQuote := RecvData[6] ;
  269.          IF InDataCount >= 7 then
  270.               Begin (* Validate bit8Quote *)
  271.               Bit8Quote  := RecvData[7] ;
  272.               If RecvData[7] = ord('Y') then Bit8Quote := ord('&') ;
  273.               If Not (chr(Bit8Quote) in [']'..'?','`'..'~'])
  274.                    then Bit8Quote := 0 ;
  275.               End  (* Validate bit8Quote *)
  276.                              else   Bit8Quote  := $00 ;
  277.          IF (InDataCount >= 8) and (chr(RecvData[8]) in ['1','2','3'] )
  278.               then   CheckType  := RecvData[8]
  279.               else   CheckType  := ord('1') ;
  280.          IF InDataCount >= 9 then
  281.              If chr(RecvData[9]) in [']'..'?','`'..'~']
  282.                    then RepChar := RecvData[9]
  283.                    else RepChar := $00
  284.                              else   RepChar    := $00 ;
  285.          End ;  (* Get init parameters *)
  286. (* ------------------------------------------------------------ *)
  287.  
  288.