Topspeed_JPI/TS-V3/SRC/KERMIT.LST

Listing:

    1  (* Release 3.10 *)
    2  (*-------------------------------------------------------------------------*
    3  *                                                                          *
    4  *  KERMIT.MOD - COMMS Toolkit KERMIT file protocol                         *
    5  *                                                                          *
    6  *  COPYRIGHT (C) 1988..1992 Clarion Software Corporation.                  *
    7  *  All Rights Reserved                                                     *
    8  *                                                                          *
    9  *--------------------------------------------------------------------------*)
   10  
   11  IMPLEMENTATION MODULE Kermit;
   12    IMPORT ComSetup,Filenames,FIO,FTSupport,Lib,RS232,SPRINTF,Str;
   13  
   14    CONST
   15      TooMany             = "Too many retries";
*****                            ^ not supported yet
   16      UserAbort           = "User Abort";
*****                            ^ not supported yet
   17      FileOpened          = "File Opened";
*****                            ^ not supported yet
   18      FileClosed          = "File Closed";
*****                            ^ not supported yet
   19      EndSession          = "Session Ends";
*****                            ^ not supported yet
   20      XParams             = "Exchanging Params";
*****                            ^ not supported yet
   21      OK                  = 0;
   22      SOH                 = 1;
   23      CHKLNTH             = 1;
   24      YES                 = ORD("Y");
*****                            ^ undeclared identifier
*****                                   ^ not supported yet
   25      NO                  = ORD("N");
*****                            ^ undeclared identifier
*****                                   ^ not supported yet
   26      MAXTRIES            = 5;
   27      MAXPACK             = 512;        (* My maximum extended-length packet size *)
   28      MAXWINDO            = 6;          (* My window size                         *)
   29      (* Kermit Packet Types *)
   30      DATA                = 100H+ORD('D');
*****                                 ^ undeclared identifier
*****                                        ^ not supported yet
   31      ACK                 = 100H+ORD('Y');
*****                                 ^ undeclared identifier
*****                                        ^ not supported yet
   32      NAK                 = 100H+ORD('N');
*****                                 ^ undeclared identifier
*****                                        ^ not supported yet
   33      SENDINIT            = 100H+ORD('S');
*****                                 ^ undeclared identifier
*****                                        ^ not supported yet
   34      ENDSESS             = 100H+ORD('B');
*****                                 ^ undeclared identifier
*****                                        ^ not supported yet
   35      FILEHDR             = 100H+ORD('F');
*****                                 ^ undeclared identifier
*****                                        ^ not supported yet
   36      EOFILE              = 100H+ORD('Z');
*****                                 ^ undeclared identifier
*****                                        ^ not supported yet
   37      ERROR               = 100H+ORD('E');
*****                                 ^ undeclared identifier
*****                                        ^ not supported yet
   38      QRSRVD              = 100H+ORD('Q');
*****                                 ^ undeclared identifier
*****                                        ^ not supported yet
   39      TIMEOUT             = 100H+ORD('T');
*****                                 ^ undeclared identifier
*****                                        ^ not supported yet
   40      ATTR                = 100H+ORD('A');
*****                                 ^ undeclared identifier
*****                                        ^ not supported yet
   41      (* flags = Bit Numbers for Capability mask *)
   42      XLPKTS              = 1;  (* True if extended length packets are supported *)
   43      WINDOWS             = 2;  (* True if sliding windows are supported         *)
   44      ATTPKTS             = 3;  (* True if attribute packets are supported       *)
   45  
   46    TYPE
   47      DefaultRec          = RECORD
   48                              MaxL       : CARDINAL; (* The max length packet to send        *)
   49                              Time       : CARDINAL; (* The timeout while waiting for a pkt  *)
   50                              NPad       : CARDINAL; (* The number of pad characters to send *)
   51                              PadC       : CARDINAL; (* The pad character to use             *)
   52                              Eoln       : CARDINAL; (* The end of line character to use     *)
   53                              QCtl       : CARDINAL; (* The char to use as Ctrl-Quote        *)
   54                              QBin       : CARDINAL; (* The char used for 8th bit quoting    *)
   55                              Chkt       : CARDINAL; (* The frame check type to use          *)
   56                              Rept       : CARDINAL; (* The char used for repeat encoding    *)
   57                              Capa       : BITSET;   (* Remote's capability mask             *)
*****                                           ^ undeclared identifier
   58                              WSiz       : CARDINAL; (* Window Size                          *)
   59                              XLen       : CARDINAL; (* Extended Packet Length               *)
   60                            END;
*****                            ^ not supported yet
   61      Buffer              = ARRAY[0..MAXPACK-1] OF CHAR;
*****                                             ^ not supported yet
*****                                                   ^ not supported yet
   62      TableEntry          = RECORD
   63                              PacketNo   : CARDINAL; (* seq no of this packet      *)
   64                              Acked      : BOOLEAN;  (* true if this entry is ok   *)
   65                              Sent       : CARDINAL; (* number of times this pkt sent *)
   66                              Data       : Buffer;   (* the actual packet contents *)
   67                              Lenth      : CARDINAL; (* Bytes of data in this pkt  *)
   68                              FilePos    : LONGCARD; (* the new file pointer       *)
*****                                           ^ undeclared identifier
   69                            END;
*****                            ^ not supported yet
   70  
   71    VAR
   72      Tries               : CARDINAL;    (* Number of attempts to send/receive    *)
   73      SeqNo               : CARDINAL;    (* The sequence number I use/expect next *)
   74      WindowSize          : CARDINAL;    (* The current window size               *)
   75      SizeToSend          : CARDINAL;    (* Maximum size packet I can send        *)
   76      Default             : DefaultRec;  (* Settings for various protocol options *)
*****                            ^ not supported yet
   77      f                   : FIO.File;    (* The file being sent/received          *)
*****                                ^ not supported yet
   78  
   79  (*...............................................*)
   80  
   81    PROCEDURE InitVars;
   82      BEGIN
   83        FTSupport.Errors:=0;
*****        ^ not supported yet
*****                  ^ not supported yet
   84        FTSupport.LastMessage:='';
*****        ^ not supported yet
*****                  ^ not supported yet
   85        FTSupport.XferMode := 'CHK';
*****        ^ not supported yet
*****                  ^ not supported yet
*****                              ^ not supported yet
   86        FTSupport.Transferred:=0;
*****        ^ not supported yet
*****                  ^ not supported yet
   87        FTSupport.Aborted := FALSE;
*****        ^ not supported yet
*****                  ^ not supported yet
   88        FTSupport.SizeInBytes:=0;
*****        ^ not supported yet
*****                  ^ not supported yet
   89        WindowSize := MAXWINDO;
   90      END InitVars;
*****          ^ not supported yet
   91  
   92  (*...............................................*)
   93  
   94    PROCEDURE Min(a,b:CARDINAL):CARDINAL;
   95      BEGIN
   96        IF a<b THEN
   97          RETURN(a);
   98        ELSE
   99          RETURN(b);
  100        END;
  101      END Min;
*****          ^ not supported yet
  102  
  103  (*...............................................*)
  104  
  105    PROCEDURE Max(a,b:CARDINAL):CARDINAL;
  106      BEGIN
  107         IF a>b THEN
  108           RETURN(a);
  109         ELSE
  110           RETURN(b);
  111         END;
  112      END Max;
*****          ^ not supported yet
  113  
  114  (*...............................................*)
  115  
  116    PROCEDURE ToChar(x:CARDINAL):CARDINAL;
  117      BEGIN
  118        RETURN x+20H;
  119      END ToChar;
*****          ^ not supported yet
  120  
  121  (*...............................................*)
  122  
  123    PROCEDURE UnChar(x:CARDINAL):CARDINAL;
  124      BEGIN
  125        RETURN x-20H;
  126      END UnChar;
*****          ^ not supported yet
  127  
  128  (*...............................................*)
  129  
  130    PROCEDURE Ctrl(x:CARDINAL):CARDINAL;
  131      BEGIN
  132        RETURN CARDINAL(BITSET(x) / BITSET(40H));
*****                        ^ undeclared identifier
*****                                ^ not supported yet
*****                                    ^ undeclared identifier
*****                                              ^ not supported yet
  133      END Ctrl;
*****          ^ not supported yet
  134  
  135  (*...............................................*)
  136  
  137    PROCEDURE Receive(TLimit:CARDINAL):CARDINAL;
  138      VAR
  139        c                 : CHAR;
  140      BEGIN
  141        LOOP
  142          IF RS232.SerialRead(c,TLimit*10) THEN
*****             ^ not supported yet
*****                   ^ not supported yet
*****                                         ^ not supported yet
  143            IF (ORD(c)=SOH) OR (c>=' ') THEN
*****                ^ undeclared identifier
*****                     ^ not supported yet
  144              RETURN ORD(c);
*****                     ^ undeclared identifier
*****                          ^ not supported yet
  145            END;
  146          ELSE
  147            RETURN TIMEOUT;
  148          END;
  149        END;
  150      END Receive;
*****          ^ not supported yet
  151  
  152  (*...............................................*)
  153  
  154    PROCEDURE Msg(s:ARRAY OF CHAR);
*****                             ^ not supported yet
  155      VAR
  156        Lnth              : CARDINAL;
  157      BEGIN
  158        Lnth := Str.Length(s);
*****                ^ not supported yet
*****                    ^ not supported yet
*****                           ^ not supported yet
  159        Lib.Move(ADR(s),ADR(FTSupport.LastMessage),Lnth);
*****        ^ not supported yet
*****            ^ not supported yet
*****                 ^ undeclared identifier
*****                     ^ not supported yet
*****                        ^ undeclared identifier
*****                            ^ not supported yet
*****                                      ^ not supported yet
*****                                                       ^ not supported yet
  160        FTSupport.LastMessage[Lnth] := 0C;
*****        ^ not supported yet
*****                  ^ not supported yet
*****                                  ^ not supported yet
  161        FTSupport.UpdateStatus;
*****        ^ not supported yet
*****                  ^ not supported yet
  162      END Msg;
*****          ^ not supported yet
  163  
  164  (*...............................................*)
  165  
  166    PROCEDURE Error(s:ARRAY OF CHAR);
*****                               ^ not supported yet
  167      BEGIN
  168        INC(FTSupport.Errors);
*****        ^ undeclared identifier
*****            ^ not supported yet
*****                      ^ not supported yet
  169        Msg(s);
*****        ^ not supported yet
*****            ^ not supported yet
  170      END Error;
*****          ^ not supported yet
  171  
  172  (*...............................................*)
  173  
  174    PROCEDURE SendPacket(tipe,SeqNo,DataLnth:CARDINAL);
  175      VAR
  176        i,p,CheckSum      : CARDINAL;
  177        Buff              : ARRAY[0..MAXPACK+15] OF CHAR;
*****                                             ^ not supported yet
*****                                                    ^ not supported yet
  178        Extended          : BOOLEAN;
  179  
  180  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  181  
  182      PROCEDURE sPutChar(c:CARDINAL);
  183        BEGIN
  184          Buff[p] := CHR(c);
*****          ^ not supported yet
*****                ^ not supported yet
*****                     ^ undeclared identifier
*****                          ^ not supported yet
  185          CheckSum := (CheckSum+c) MOD 100H;
  186          INC(p);
*****          ^ undeclared identifier
*****               ^ not supported yet
  187        END sPutChar;
*****            ^ not supported yet
  188  
  189  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  190  
  191      BEGIN (* SendPacket *)
  192        i:=0;
  193        p:=1;
  194        CheckSum:=0;
  195        WITH Default DO
*****             ^ not supported yet
  196          Extended := (XLPKTS IN Capa) AND (DataLnth>MaxL-(2+CHKLNTH));
*****                                 ^ not supported yet
*****                                                     ^ not supported yet
  197        END;
*****        ^ not supported yet
  198        Buff[0]:=CHR(SOH);
*****        ^ not supported yet
*****              ^ not supported yet
*****                 ^ undeclared identifier
*****                        ^ not supported yet
  199        IF Extended THEN
  200          sPutChar(ToChar(0))
*****          ^ not supported yet
*****                   ^ not supported yet
*****                           ^ not supported yet
  201        ELSE
  202          sPutChar(ToChar(DataLnth+2+CHKLNTH))
*****          ^ not supported yet
*****                   ^ not supported yet
*****                                            ^ not supported yet
  203        END;
  204        sPutChar(ToChar(SeqNo));
*****        ^ not supported yet
*****                 ^ not supported yet
*****                             ^ not supported yet
  205        sPutChar(tipe-100H);
*****        ^ not supported yet
*****                          ^ not supported yet
  206        IF Extended THEN
  207          sPutChar(ToChar((DataLnth+CHKLNTH) DIV 95));
*****          ^ not supported yet
*****                   ^ not supported yet
*****                                                   ^ not supported yet
  208          sPutChar(ToChar((DataLnth+CHKLNTH) MOD 95));
*****          ^ not supported yet
*****                   ^ not supported yet
*****                                                   ^ not supported yet
  209          sPutChar(ToChar((CheckSum+(CheckSum>>6)) MOD 64));
*****          ^ not supported yet
*****                   ^ not supported yet
*****                                                         ^ not supported yet
  210        END;
  211        WHILE i<DataLnth DO sPutChar(ORD(FTSupport.FBuff[i]));
*****                            ^ not supported yet
*****                                     ^ undeclared identifier
*****                                         ^ not supported yet
*****                                                   ^ not supported yet
*****                                                          ^ not supported yet
  212          INC(i)
*****          ^ undeclared identifier
*****               ^ not supported yet
  213        END;
  214        Buff[p] := CHR(ToChar((CheckSum+(CheckSum>>6)) MOD 64));
*****        ^ not supported yet
*****              ^ not supported yet
*****                   ^ undeclared identifier
*****                       ^ not supported yet
*****                                                             ^ not supported yet
  215        Buff[p+1] := CHR(Default.Eoln);
*****        ^ not supported yet
*****                ^ not supported yet
*****                     ^ undeclared identifier
*****                         ^ not supported yet
*****                                 ^ not supported yet
  216        RS232.SerialWrite(Buff,p+2);
*****        ^ not supported yet
*****              ^ not supported yet
*****                          ^ not supported yet
*****                                  ^ not supported yet
  217      END SendPacket;
*****          ^ not supported yet
  218  
  219  (*...............................................*)
  220  
  221    (* Read a packet and return the packet type. *)
  222    PROCEDURE ReadPacket(VAR SeqNo,Lnth:CARDINAL; SkipSOH:BOOLEAN):CARDINAL;
  223      CONST
  224        BadChecksum       = "Bad Checksum";
*****                            ^ not supported yet
  225      TYPE
  226        RdStates          = (Mark,Len,Seq,Type,LenX1,LenX2,HChk,Data,Check,Err);
  227      VAR
  228        Extended          : BOOLEAN;
  229        Timeout,rslt,
  230        PacketType,Cnt,
  231        HCheck,CheckSum   : CARDINAL;
  232        RdState           : RdStates;
*****                            ^ not supported yet
  233      BEGIN
  234        RdState:=Mark;
*****        ^ not supported yet
*****                 ^ not supported yet
  235        Timeout:=Default.Time;
*****                 ^ not supported yet
*****                         ^ not supported yet
  236        Timeout := Max(Timeout,10);
*****                   ^ not supported yet
*****                                 ^ not supported yet
  237        LOOP
  238          IF SkipSOH THEN
  239            rslt:=SOH;
  240          ELSE
  241            rslt:=Receive(Timeout);
*****                  ^ not supported yet
*****                                 ^ not supported yet
  242          END;
  243          IF rslt = TIMEOUT THEN
  244            Error("Timeout");
*****            ^ not supported yet
*****                  ^ not supported yet
  245            RETURN TIMEOUT;
  246          ELSIF rslt = SOH THEN
  247            SkipSOH:=FALSE;
  248            RdState:=Len;
*****            ^ not supported yet
*****                     ^ not supported yet
  249            CheckSum:=0;
  250            Cnt:=0;
  251            Extended:=FALSE;
  252          ELSE
  253            IF RdState # Check THEN
*****               ^ not supported yet
*****                         ^ not supported yet
  254              CheckSum := CARDINAL(BITSET(CheckSum+rslt)*BITSET(0FFH));
*****                                   ^ undeclared identifier
*****                                                       ^ not supported yet
*****                                                         ^ undeclared identifier
*****                                                                    ^ not supported yet
  255            END;
  256            CASE RdState OF
*****                 ^ not supported yet
  257              Mark        : (* do nothing, as SOH should have been trapped above *)|
*****              ^ not supported yet
  258              Len         : Lnth:=UnChar(rslt);
*****              ^ not supported yet
*****                                  ^ not supported yet
*****                                             ^ not supported yet
  259                            Extended:=(Lnth=0);
  260                            IF NOT Extended THEN
  261                              DEC(Lnth,2+CHKLNTH);
*****                              ^ undeclared identifier
*****                                                ^ not supported yet
  262                            END;
  263                            RdState:=Seq;                                   |
*****                            ^ not supported yet
*****                                     ^ not supported yet
  264              Seq         : SeqNo:=UnChar(rslt);
*****              ^ not supported yet
*****                                   ^ not supported yet
*****                                              ^ not supported yet
  265                            RdState:=Type;                                  |
*****                            ^ not supported yet
*****                                     ^ not supported yet
  266              Type        : PacketType := 100H+rslt;
*****              ^ not supported yet
  267                            IF Extended THEN
  268                              RdState := LenX1
*****                              ^ not supported yet
*****                                         ^ not supported yet
  269                            ELSIF Lnth>0 THEN
  270                              RdState:=Data
*****                              ^ not supported yet
*****                                       ^ not supported yet
  271                            ELSE
  272                              RdState:=Check
*****                              ^ not supported yet
*****                                       ^ not supported yet
  273                            END;                                            |
  274              LenX1       : Lnth:=UnChar(rslt);
*****              ^ not supported yet
*****                                  ^ not supported yet
*****                                             ^ not supported yet
  275                            RdState:=LenX2;                                 |
*****                            ^ not supported yet
*****                                     ^ not supported yet
  276              LenX2       : Lnth := (Lnth*95+UnChar(rslt)) - CHKLNTH;
*****              ^ not supported yet
*****                                             ^ not supported yet
*****                                                        ^ not supported yet
  277                            HCheck:=CheckSum;
  278                            RdState := HChk;                                |
*****                            ^ not supported yet
*****                                       ^ not supported yet
  279              HChk        : IF rslt=ToChar((HCheck+(HCheck>>6)) MOD 64) THEN
*****              ^ not supported yet
*****                                    ^ not supported yet
*****                                                                      ^ not supported yet
  280                              IF Lnth>0 THEN
  281                                RdState:=Data;
*****                                ^ not supported yet
*****                                         ^ not supported yet
  282                              ELSE
  283                                RdState:=Check;
*****                                ^ not supported yet
*****                                         ^ not supported yet
  284                              END;
  285                           ELSE
  286                              Error(BadChecksum);
*****                              ^ not supported yet
*****                                    ^ not supported yet
  287                              RETURN TIMEOUT;
  288                           END;                                             |
  289              Data        : FTSupport.FBuff[Cnt] := CHR(rslt);
*****              ^ not supported yet
*****                            ^ not supported yet
*****                                      ^ not supported yet
*****                                               ^ not supported yet
*****                                                    ^ undeclared identifier
*****                                                            ^ not supported yet
  290                            INC(Cnt);
*****                            ^ undeclared identifier
*****                                   ^ not supported yet
  291                            IF Cnt=Lnth THEN
  292                              RdState:=Check;
*****                              ^ not supported yet
*****                                       ^ not supported yet
  293                            END;                                            |
  294              Check       : IF rslt=ToChar((CheckSum+(CheckSum>>6)) MOD 64) THEN
*****              ^ not supported yet
*****                                    ^ not supported yet
*****                                                                          ^ not supported yet
  295                              IF PacketType=ERROR THEN
  296                                Msg("Error Packet received");
*****                                ^ not supported yet
*****                                    ^ not supported yet
  297                              END;
  298                              RETURN PacketType;
  299                            ELSE
  300                              Error(BadChecksum); RETURN TIMEOUT;
*****                              ^ not supported yet
*****                                    ^ not supported yet
  301                            END;                                            |
  302              Err         : (* purge modem buffer *);
*****              ^ not supported yet
  303            END;
  304          END;
  305        END;
  306      END ReadPacket;
*****          ^ not supported yet
  307  
  308  (*...............................................*)
  309  
  310    PROCEDURE NxtPktNo(SeqNo:CARDINAL):CARDINAL;
  311      BEGIN
  312        RETURN CARDINAL(BITSET(SeqNo+1) * BITSET(3FH));
*****                        ^ undeclared identifier
*****                                      ^ not supported yet
*****                                          ^ undeclared identifier
*****                                                    ^ not supported yet
  313      END NxtPktNo;
*****          ^ not supported yet
  314  
  315  (*...............................................*)
  316  
  317    PROCEDURE SendInitParms(tipe:CARDINAL);
  318      VAR
  319        MyCapas           : BITSET;
*****                            ^ undeclared identifier
  320      BEGIN
  321        (* This line says that I can use attribute and extended length packets *)
  322        MyCapas := {WINDOWS,XLPKTS,ATTPKTS};
*****        ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
*****                                   ^ not supported yet
  323        WITH Default DO
*****             ^ not supported yet
  324          WindowSize := Min(MAXWINDO,WSiz);
*****                        ^ not supported yet
*****                                     ^ not supported yet
  325          FTSupport.FBuff[ 0] := CHR(ToChar(MaxL));
*****          ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
*****                                 ^ undeclared identifier
*****                                     ^ not supported yet
*****                                            ^ not supported yet
  326          FTSupport.FBuff[ 1] := CHR(ToChar(Time));
*****          ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
*****                                 ^ undeclared identifier
*****                                     ^ not supported yet
*****                                            ^ not supported yet
  327          FTSupport.FBuff[ 2] := CHR(ToChar(0));
*****          ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
*****                                 ^ undeclared identifier
*****                                     ^ not supported yet
*****                                             ^ not supported yet
  328          FTSupport.FBuff[ 3] := CHR(Ctrl(0));
*****          ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
*****                                 ^ undeclared identifier
*****                                     ^ not supported yet
*****                                           ^ not supported yet
  329          FTSupport.FBuff[ 4] := CHR(ToChar(Eoln));
*****          ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
*****                                 ^ undeclared identifier
*****                                     ^ not supported yet
*****                                            ^ not supported yet
  330          FTSupport.FBuff[ 5] := CHR(QCtl);
*****          ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
*****                                 ^ undeclared identifier
*****                                     ^ not supported yet
  331          FTSupport.FBuff[ 6] := 'Y';
*****          ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
  332          FTSupport.FBuff[ 7] := '1';
*****          ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
  333          FTSupport.FBuff[ 8] := CHR(Rept);
*****          ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
*****                                 ^ undeclared identifier
*****                                     ^ not supported yet
  334          FTSupport.FBuff[ 9] := CHR(ToChar(CARDINAL(MyCapas)));
*****          ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
*****                                 ^ undeclared identifier
*****                                     ^ not supported yet
*****                                                     ^ not supported yet
  335          FTSupport.FBuff[10] := CHR(ToChar(WindowSize));     (* Window Size *)
*****          ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
*****                                 ^ undeclared identifier
*****                                     ^ not supported yet
*****                                                      ^ not supported yet
  336          FTSupport.FBuff[11] := CHR(ToChar(MAXPACK DIV 95)); (* pkt lnth - High bits *)
*****          ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
*****                                 ^ undeclared identifier
*****                                     ^ not supported yet
*****                                                          ^ not supported yet
  337          FTSupport.FBuff[12] := CHR(ToChar(MAXPACK MOD 95)); (* pkt lnth - Low bits *)
*****          ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
*****                                 ^ undeclared identifier
*****                                     ^ not supported yet
*****                                                          ^ not supported yet
  338        END;
*****        ^ not supported yet
  339        SendPacket(tipe,SeqNo,13);
*****        ^ not supported yet
*****                                ^ not supported yet
  340      END SendInitParms;
*****          ^ not supported yet
  341  
  342  (*...............................................*)
  343  
  344    PROCEDURE GetInitParams():CARDINAL;
  345      TYPE
  346        InitStates        = (maxl,time,npad,padc,eol,qctl,qbin,chkt,rept,capas,capas2,windo,maxlx1,maxlx2,done);
  347      VAR
  348        rslt,p,c,Seq,Lnth : CARDINAL;
  349        temp              : BITSET;
*****                            ^ undeclared identifier
  350        State             : InitStates;
*****                            ^ not supported yet
  351      BEGIN
  352        IF Tries=MAXTRIES THEN
  353          Error(TooMany);
*****          ^ not supported yet
*****                ^ not supported yet
  354          RETURN(ERROR);
  355        END;
  356        INC(Tries);
*****        ^ undeclared identifier
*****                 ^ not supported yet
  357        rslt := ReadPacket(Seq,Lnth,FALSE);
*****                ^ not supported yet
*****                                         ^ not supported yet
  358        IF (rslt # SENDINIT) AND (rslt # ACK) THEN
  359          RETURN(rslt);
  360        END;
  361        (* Set defaults *)
  362        WITH Default DO
*****             ^ not supported yet
  363          Capa:={};
*****          ^ not supported yet
*****                 ^ not supported yet
  364          p:=0;
  365          State:=maxl;
*****          ^ not supported yet
*****                 ^ not supported yet
  366          LOOP
  367            IF p<Lnth THEN
  368              c:=ORD(FTSupport.FBuff[p]);
*****                 ^ undeclared identifier
*****                     ^ not supported yet
*****                               ^ not supported yet
*****                                      ^ not supported yet
  369              INC(p)
*****              ^ undeclared identifier
*****                   ^ not supported yet
  370            ELSE
  371              c:=0;
  372            END;
  373            CASE State OF
*****                 ^ not supported yet
  374              maxl        : MaxL:=UnChar(c);
*****              ^ not supported yet
*****                            ^ not supported yet
*****                                  ^ not supported yet
*****                                          ^ not supported yet
  375                            State:=time;                                    |
*****                            ^ not supported yet
*****                                   ^ not supported yet
  376              time        : Time:=UnChar(c);
*****              ^ not supported yet
*****                            ^ not supported yet
*****                                  ^ not supported yet
*****                                          ^ not supported yet
  377                            State:=npad;                                    |
*****                            ^ not supported yet
*****                                   ^ not supported yet
  378              npad        : NPad:=UnChar(c);
*****              ^ not supported yet
*****                            ^ not supported yet
*****                                  ^ not supported yet
*****                                          ^ not supported yet
  379                            IF NPad=0 THEN
*****                               ^ not supported yet
  380                              INC(p);
*****                              ^ undeclared identifier
*****                                   ^ not supported yet
  381                              State:=eol;
*****                              ^ not supported yet
*****                                     ^ not supported yet
  382                            ELSE
  383                              State:=padc;
*****                              ^ not supported yet
*****                                     ^ not supported yet
  384                            END;                                            |
  385              padc        : PadC:=Ctrl(c);
*****              ^ not supported yet
*****                            ^ not supported yet
*****                                  ^ not supported yet
*****                                        ^ not supported yet
  386                            State:=eol;                                     |
*****                            ^ not supported yet
*****                                   ^ not supported yet
  387              eol         : Eoln:=UnChar(c);
*****              ^ not supported yet
*****                            ^ not supported yet
*****                                  ^ not supported yet
*****                                          ^ not supported yet
  388                            State:=qctl;                                    |
*****                            ^ not supported yet
*****                                   ^ not supported yet
  389              qctl        : QCtl:=c;
*****              ^ not supported yet
*****                            ^ not supported yet
*****                                  ^ incompatible assignment
  390                            State:=qbin;                                    |
*****                            ^ not supported yet
*****                                   ^ not supported yet
  391               (* optional features *)
  392              qbin        : IF (c=YES) OR (c=NO) THEN
*****              ^ not supported yet
  393                              QBin:=0;
*****                              ^ not supported yet
*****                                    ^ incompatible assignment
  394                            ELSE
  395                              QBin:=c;
*****                              ^ not supported yet
*****                                    ^ incompatible assignment
  396                            END;
  397                            State:=chkt;                                    |
*****                            ^ not supported yet
*****                                   ^ not supported yet
  398              chkt        : (* Ignore frame check type for the moment *)
*****              ^ not supported yet
  399                            State := rept;                                  |
*****                            ^ not supported yet
*****                                     ^ not supported yet
  400              rept        : IF c=32 THEN
*****              ^ not supported yet
  401                              Rept:=0;
*****                              ^ not supported yet
*****                                    ^ incompatible assignment
  402                            ELSE
  403                              Rept:=c;
*****                              ^ not supported yet
*****                                    ^ incompatible assignment
  404                            END;
  405                            State:=capas;                                   |
*****                            ^ not supported yet
*****                                   ^ not supported yet
  406              capas       : IF c<32 THEN
*****              ^ not supported yet
  407                              Capa:={};
*****                              ^ not supported yet
*****                                     ^ not supported yet
  408                            ELSE
  409                              Capa:=BITSET(UnChar(c));
*****                              ^ not supported yet
*****                                    ^ undeclared identifier
*****                                           ^ not supported yet
*****                                                   ^ not supported yet
  410                            END;
  411                            IF 0 IN Capa THEN
*****                                    ^ not supported yet
  412                              State:=capas2;
*****                              ^ not supported yet
*****                                     ^ not supported yet
  413                            ELSE
  414                              State:=windo;
*****                              ^ not supported yet
*****                                     ^ not supported yet
  415                            END;                                            |
  416              capas2      : IF c<32 THEN
*****              ^ not supported yet
  417                              temp:={};
*****                              ^ not supported yet
*****                                     ^ not supported yet
  418                            ELSE
  419                              temp:=BITSET(UnChar(c));
*****                              ^ not supported yet
*****                                    ^ undeclared identifier
*****                                           ^ not supported yet
*****                                                   ^ not supported yet
  420                            END;
  421                            IF NOT (0 IN Capa) THEN
*****                                         ^ not supported yet
  422                              State:=windo;
*****                              ^ not supported yet
*****                                     ^ not supported yet
  423                            END;                                            |
  424              windo       : IF c<32 THEN
*****              ^ not supported yet
  425                              WSiz:=0;
*****                              ^ not supported yet
*****                                    ^ incompatible assignment
  426                            ELSE
  427                              WSiz:=UnChar(c);
*****                              ^ not supported yet
*****                                    ^ not supported yet
*****                                            ^ not supported yet
  428                            END;
  429                            State:=maxlx1;                                  |
*****                            ^ not supported yet
*****                                   ^ not supported yet
  430              maxlx1      : IF c<32 THEN
*****              ^ not supported yet
  431                              XLen:=0;
*****                              ^ not supported yet
*****                                    ^ incompatible assignment
  432                            ELSE
  433                              XLen:=UnChar(c);
*****                              ^ not supported yet
*****                                    ^ not supported yet
*****                                            ^ not supported yet
  434                            END;
  435                            State:=maxlx2;                                  |
*****                            ^ not supported yet
*****                                   ^ not supported yet
  436              maxlx2      : IF c>31 THEN
*****              ^ not supported yet
  437                              XLen := XLen+(UnChar(c)<<6);
*****                              ^ not supported yet
*****                                      ^ not supported yet
*****                                            ^ not supported yet
*****                                                    ^ not supported yet
*****                                                       ^ arithmetic operand must be numeric
  438                            END;
  439                            State:=done;                                    |
*****                            ^ not supported yet
*****                                   ^ not supported yet
  440              done        : EXIT;                                           |
*****              ^ not supported yet
  441            END;
  442          END;
  443        END;
*****        ^ not supported yet
  444        RETURN rslt;
  445      END GetInitParams;
*****          ^ not supported yet
  446  
  447  (*...............................................*)
  448  
  449    PROCEDURE WriteData(Lnth:CARDINAL;VAR FBuff,Buff:ARRAY OF CHAR;WriteIt:BOOLEAN):CARDINAL;
*****                                                              ^ not supported yet
  450      (* Get data from an incoming packet into a file. *)
  451      VAR
  452        i,rep,c,BuffPtr   : CARDINAL;
  453        SetBit8           : BOOLEAN;
  454  
  455  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  456  
  457      PROCEDURE wPutChar(c:CARDINAL);
  458        BEGIN
  459          IF WriteIt AND (BuffPtr=MAXPACK) THEN
  460            INC(FTSupport.Transferred,MAXPACK);
*****            ^ undeclared identifier
*****                ^ not supported yet
*****                          ^ not supported yet
*****                                             ^ not supported yet
  461            FIO.WrBin(f,Buff,MAXPACK);
*****            ^ not supported yet
*****                ^ not supported yet
*****                      ^ not supported yet
*****                        ^ not supported yet
*****                                    ^ not supported yet
  462            BuffPtr := 0;
  463          END;
  464          Buff[BuffPtr] := CHR(c);
*****          ^ not supported yet
*****                      ^ not supported yet
*****                           ^ undeclared identifier
*****                                ^ not supported yet
  465          INC(BuffPtr);
*****          ^ undeclared identifier
*****                     ^ not supported yet
  466        END wPutChar;
*****            ^ not supported yet
  467  
  468  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  469  
  470      PROCEDURE Low(In:CARDINAL):CARDINAL;
  471        BEGIN
  472          RETURN CARDINAL(BITSET(In) - BITSET{7});
*****                          ^ undeclared identifier
*****                                   ^ not supported yet
*****                                       ^ undeclared identifier
  473        END Low;
  474  
  475  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  476  
  477      BEGIN (* WriteData *)
  478        BuffPtr:=0;
  479        i:=0;
  480        WITH Default DO
  481          WHILE i<Lnth DO
  482            rep := 1;
  483            c:=ORD(FBuff[i]);
  484            INC(i);     (* Get character *)
  485            IF c=Rept THEN
  486              rep := UnChar(ORD(FBuff[i]));
  487              c := ORD(FBuff[i+1]);
  488              INC(i,2);
  489            END;
  490            SetBit8:=FALSE;
  491            IF c=QBin THEN
  492              SetBit8 := TRUE;
  493              c:=ORD(FBuff[i]);
  494              INC(i);
  495            END;
  496            IF c=QCtl THEN                (* Control quote? *)
  497              c:=ORD(FBuff[i]);
  498              INC(i); (* Get the quoted character *)
  499              IF (Low(c) # QCtl) & (Low(c) # QBin) & (Low(c) # Rept) THEN
  500                c:=Ctrl(c);
  501              END;
  502            END;
  503            IF SetBit8 THEN
  504              c := CARDINAL(BITSET(c)+{7});
  505            END;
  506            WHILE rep>0 DO
  507              wPutChar(c);
  508              DEC(rep);     (* Put the char in the file *)
  509            END;
  510          END;
  511        END;
  512        IF (WriteIt) AND (BuffPtr>0) THEN
  513          FIO.WrBin(f,Buff,BuffPtr);
  514          INC(FTSupport.Transferred,LONGCARD(BuffPtr));
  515        END;
  516        IF WriteIt THEN
  517          FTSupport.UpdateStatus
  518        END;
  519        RETURN BuffPtr;
  520      END WriteData;
  521  
  522  (*...............................................*)
  523  
  524    PROCEDURE GetFileHeader():CARDINAL;
  525      VAR
  526        rslt,Seq,Lnth     : CARDINAL;
  527      BEGIN
  528        LOOP
  529          IF Tries=MAXTRIES THEN
  530            Error(TooMany);
  531            RETURN(ERROR);
  532          END;
  533          INC(Tries);
  534          rslt := ReadPacket(Seq,Lnth,FALSE);
  535          CASE rslt OF
  536            FILEHDR       : Lnth := WriteData(Lnth,FTSupport.FBuff,FTSupport.FileSpec,FALSE);
  537                            FTSupport.FileSpec[Lnth] := 0C;
  538                            FTSupport.CompleteFilename;
  539                            FTSupport.NewFilename;
  540                            f := FIO.Create(FTSupport.FileSpec);
  541                            IF FIO.IOresult() # 0 THEN
  542                              Error("File Create Error"); RETURN ERROR
  543                            END;
  544                            Msg(FileOpened); RETURN rslt;                   |
  545            TIMEOUT       : SendPacket(NAK,NxtPktNo(SeqNo),0);              |
  546            ERROR,
  547            SENDINIT,
  548            EOFILE,
  549            ENDSESS       : RETURN rslt;                                    |
  550          ELSE
  551            RETURN ERROR;
  552          END;
  553        END;
  554      END GetFileHeader;
  555  
  556  (*...............................................*)
  557  
  558    PROCEDURE GetFileAttributes(Lnth:CARDINAL);
  559      VAR
  560        attr              : CHAR;
  561        p,rslt,len        : CARDINAL;
  562      BEGIN
  563        (* Run along attribute data looking for "Size in Bytes" attribute. *)
  564        (* This is the only attribute we can actually use.                 *)
  565        p:=0;
  566        WHILE p<Lnth DO
  567          attr:=FTSupport.FBuff[p];
  568          INC(p);
  569          len:=UnChar(ORD(FTSupport.FBuff[p]));
  570          INC(p);
  571          IF attr='1' THEN (* found Size in bytes *)
  572            FTSupport.SizeInBytes := 0;
  573            WHILE len>0 DO
  574              FTSupport.SizeInBytes := FTSupport.SizeInBytes*10+LONGCARD(ORD(FTSupport.FBuff[p])-48);
  575              INC(p);
  576              DEC(len);
  577            END;
  578            FTSupport.UpdateStatus;
  579          ELSE
  580            INC(p,len);
  581          END;
  582        END;
  583      END GetFileAttributes;
  584  
  585  (*...............................................*)
  586  
  587    PROCEDURE GetFileData():CARDINAL;
  588      VAR
  589        i,p,rslt,Seq,Lnth,
  590        first,last        : CARDINAL;
  591        RcvTable          : ARRAY[0..MAXWINDO-1] OF TableEntry;
  592        WriteBuff         : Buffer;
  593  
  594  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  595  
  596      PROCEDURE NAKit(Seq:CARDINAL);
  597        BEGIN
  598          SendPacket(NAK,Seq,0);
  599        END NAKit;
  600  
  601  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  602  
  603      PROCEDURE InitReceiveTable(FirstSeqNo:CARDINAL);
  604        VAR
  605          i               : CARDINAL;
  606        BEGIN
  607          first:=0;
  608          last:=WindowSize-1;
  609          FOR i:=0 TO WindowSize-1 DO
  610            WITH RcvTable[i] DO
  611              PacketNo := CARDINAL(BITSET(FirstSeqNo+i+1)*BITSET(3FH));
  612              Acked := FALSE;
  613              Lenth := 0;
  614            END;
  615          END;
  616        END InitReceiveTable;
  617  
  618  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  619  
  620      PROCEDURE Duplicate(Seq:CARDINAL; VAR Index:CARDINAL):BOOLEAN;
  621        VAR
  622          i               : CARDINAL;
  623        BEGIN
  624          FOR i:=0 TO WindowSize-1 DO
  625            IF Seq=RcvTable[i].PacketNo THEN
  626              Index:=i;
  627              RETURN(TRUE)
  628            END;
  629          END;
  630          RETURN FALSE;
  631        END Duplicate;
  632  
  633  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  634  
  635      PROCEDURE MostWanted():CARDINAL;
  636        VAR
  637          i,p             : CARDINAL;
  638        BEGIN
  639          p:=first;
  640          FOR i:=0 TO WindowSize-1 DO
  641            IF NOT RcvTable[p].Acked THEN
  642              RETURN(p);
  643            END;
  644            p := (p+1) MOD WindowSize;
  645          END;
  646          RETURN NxtPktNo(RcvTable[last].PacketNo);
  647        END MostWanted;
  648  
  649  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  650  
  651      PROCEDURE RotateTable():CARDINAL;
  652        VAR
  653          i,NextPkt        :CARDINAL;
  654        BEGIN
  655          NextPkt := NxtPktNo(RcvTable[last].PacketNo);
  656          (* Ok, now rotate the window. Not physically, just adjust the    *)
  657          (* first and last pointers.                                      *)
  658          last:=first;
  659          first:=(first+1) MOD WindowSize;
  660          WITH RcvTable[last] DO (* write old contents then clear entry *)
  661            IF NOT Acked THEN
  662              RETURN(ERROR);
  663            END;
  664            IF Lenth>0 THEN
  665              i:=WriteData(Lenth,Data,WriteBuff,TRUE);
  666            END;
  667            Acked:=FALSE;
  668            PacketNo:=NextPkt;
  669            Lenth:=0;
  670          END;
  671          RETURN OK;
  672        END RotateTable;
  673  
  674  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  675  
  676      PROCEDURE StoreData(Index,Lnth:CARDINAL);
  677        BEGIN
  678          WITH RcvTable[Index] DO
  679            IF Acked THEN
  680              Msg("Duplicate Packet");
  681            END;
  682            Acked:=TRUE;
  683            Lenth:=Lnth;
  684            Lib.Move(ADR(FTSupport.FBuff),ADR(Data),Lenth);
  685          END;
  686        END StoreData;
  687  
  688  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  689  
  690      BEGIN (* GetFileData *)
  691        InitReceiveTable(SeqNo); (* initialise receive table *)
  692        LOOP
  693          IF FTSupport.AbortRequested() THEN
  694            Msg(UserAbort);
  695            RETURN ERROR;
  696          END;
  697          IF Tries=MAXTRIES THEN
  698            Msg(TooMany);
  699            RETURN(ERROR);
  700          END;
  701          INC(Tries);
  702          rslt := ReadPacket(Seq,Lnth,FALSE);
  703          CASE rslt OF
  704            DATA          : Tries := 0;
  705                            IF Duplicate(Seq,i) THEN
  706                              SendPacket(ACK,Seq,0);
  707                              StoreData(i,Lnth);
  708                            ELSE (* new packet *)
  709                              i:=0;
  710                              SendPacket(ACK,Seq,0);
  711                              REPEAT
  712                                INC(i);
  713                                IF RotateTable()=ERROR THEN
  714                                  Error("Out of Sequence!");
  715                                  RETURN ERROR;
  716                                END;
  717                              UNTIL Seq=RcvTable[last].PacketNo;
  718                              StoreData(last,Lnth);
  719                              IF i>1 THEN (* NAK any packets skipped *)
  720                                p:=first;
  721                                FOR i:=0 TO WindowSize-1 DO
  722                                  WITH RcvTable[p] DO
  723                                    IF NOT Acked THEN
  724                                      Error("NAK: Packets Skipped");
  725                                      NAKit(PacketNo);
  726                                    END;
  727                                  END;
  728                                  p := (p+1) MOD WindowSize;
  729                                END;
  730                              END;
  731                            END;                                            |
  732            ATTR          : Tries := 0;
  733                            SendPacket(ACK,Seq,0);
  734                            GetFileAttributes(Lnth);
  735                            InitReceiveTable(Seq);                          |
  736            TIMEOUT       : Error("NAK: Timeout");
  737                            NAKit(MostWanted());                            |
  738            ERROR         : RETURN rslt;                                    |
  739            FILEHDR       : RETURN rslt;                                    |
  740            EOFILE        : p:=first;
  741                            FOR i:=0 TO WindowSize-1 DO
  742                              WITH RcvTable[p] DO
  743                                IF Acked AND (Lenth>0) THEN
  744                                  Lnth := WriteData(Lenth,Data,WriteBuff,TRUE);
  745                                END;
  746                              END;
  747                              p := (p+1) MOD WindowSize;
  748                            END;
  749                            RETURN EOFILE;                                  |
  750          ELSE
  751            RETURN ERROR;
  752          END;
  753          SeqNo := Seq;
  754        END;
  755      END GetFileData;
  756  
  757  (*...............................................*)
  758  
  759    PROCEDURE RxStateMachine():CARDINAL;
  760      TYPE
  761        RxStates          = (rSendInit,rFHeader,rFData);
  762      VAR
  763        rslt              : CARDINAL;
  764        RxState           : RxStates;
  765      BEGIN
  766        RxState := rSendInit;
  767        SeqNo := 0;         (* Start Sequence Number *)
  768        Default.Time := 15; (* default timeout for Send-Init packet *)
  769        Default.Eoln := 13;
  770        Tries := 0;
  771        LOOP
  772          CASE RxState OF
  773            rSendInit     : rslt := GetInitParams();
  774                            IF rslt=ERROR THEN
  775                              RETURN ERROR
  776                            ELSIF rslt=SENDINIT THEN
  777                              SendInitParms(ACK);
  778                              Tries := 0;
  779                              RxState:=rFHeader;
  780                            ELSE (* timeout *)
  781                              SendPacket(NAK,SeqNo,0);
  782                            END;                                            |
  783            rFHeader      : InitVars;
  784                            rslt := GetFileHeader();
  785                            IF rslt=ERROR THEN
  786                              RETURN ERROR
  787                            ELSIF rslt=SENDINIT THEN
  788                              SendInitParms(ACK);
  789                            ELSIF rslt=EOFILE THEN
  790                              SendPacket(ACK,SeqNo,0);
  791                            ELSIF rslt=ENDSESS THEN
  792                              SeqNo := NxtPktNo(SeqNo);
  793                              SendPacket(ACK,SeqNo,0);
  794                              Msg(EndSession);
  795                              RETURN OK;
  796                            ELSIF rslt=FILEHDR THEN
  797                              SeqNo := NxtPktNo(SeqNo);
  798                              SendPacket(ACK,SeqNo,0);
  799                              Tries := 0;
  800                              RxState := rFData;
  801                            END;                                            |
  802            rFData        : rslt := GetFileData();
  803                            IF rslt=ERROR THEN
  804                              RETURN ERROR
  805                            ELSIF rslt=FILEHDR THEN
  806                              SendPacket(ACK,SeqNo,0);
  807                            ELSIF rslt=EOFILE THEN
  808                              SeqNo := NxtPktNo(SeqNo);
  809                              SendPacket(ACK,SeqNo,0);
  810                              Msg(FileClosed);
  811                              FIO.Close(f);
  812                              Tries := 0;
  813                              RxState := rFHeader;
  814                            END;                                            |
  815          END;
  816        END;
  817      END RxStateMachine;
  818  
  819  (*...............................................*)
  820  
  821    PROCEDURE KermitReceive():CARDINAL;
  822      VAR
  823        rslt:CARDINAL;
  824      BEGIN
  825        InitVars;
  826        FTSupport.OpenStatusWindow('SuperKermit Download');
  827        rslt := RxStateMachine();
  828        IF rslt=ERROR THEN
  829          SendPacket(ERROR,SeqNo,0);
  830        END;
  831        FIO.Close(f);
  832        FTSupport.CloseStatusWindow;
  833        RETURN rslt;
  834      END KermitReceive;
  835  
  836  (*...............................................*)
  837  
  838    PROCEDURE GetPath(Wild:ARRAY OF CHAR; VAR Path:ARRAY OF CHAR):BOOLEAN;
  839      VAR
  840        Drive,Ext         : ARRAY[0..4] OF CHAR;
  841        Name              : ARRAY[0..12] OF CHAR;
  842      BEGIN
  843        IF NOT Filenames.ParseFilename(Wild,Drive,Path,Name,Ext) THEN
  844          RETURN(FALSE);
  845        END;
  846        Name := '';
  847        Ext:='';
  848        Filenames.MakeFilename(Drive,Path,Name,Ext,Path);
  849        RETURN TRUE;
  850      END GetPath;
  851  
  852  (*...............................................*)
  853  
  854    PROCEDURE SendMyParams():CARDINAL;
  855      VAR
  856        rslt              : CARDINAL;
  857      BEGIN
  858        Msg(XParams);
  859        WITH Default DO
  860          WITH ComSetup.Setup.Kermit DO
  861            MaxL:=90;
  862            Time:=15;
  863            NPad:=NumPadChars;
  864            PadC:=ORD(PadChar);
  865            Eoln:=ORD(EolChar);
  866            QCtl:=ORD(CtlQuote);
  867            QBin:=ORD(EightBitQuote);
  868            Chkt:=1;
  869            Rept:=ORD(ReptPrefix);
  870            Capa:={WINDOWS,XLPKTS,ATTPKTS};
  871            WSiz:=MAXWINDO;
  872            XLen:=MAXPACK;
  873          END;
  874        END;
  875        Tries:=0;
  876        LOOP
  877          SendInitParms(SENDINIT);
  878          rslt := GetInitParams();
  879          CASE rslt OF
  880            ACK           : (* this is what I want*)
  881                            WITH Default DO
  882                              IF WINDOWS IN Capa THEN
  883                                WindowSize := Max(1,Min(WSiz,MAXWINDO));
  884                              ELSE
  885                                WindowSize := 1;
  886                              END;
  887                              IF (QBin=YES) OR (QBin=NO) THEN
  888                                QBin:=0;
  889                              END;
  890                              IF XLPKTS IN Capa THEN
  891                                SizeToSend := Min(MAXPACK,XLen-CHKLNTH)
  892                              ELSE
  893                                SizeToSend := MaxL-(CHKLNTH+2)
  894                              END;
  895                            END;
  896                            SeqNo := NxtPktNo(SeqNo);
  897                            RS232.FlushInBuf;
  898                            RETURN ACK;                                     |
  899            TIMEOUT       : (* loop again *)                                |
  900          ELSE
  901            RETURN ERROR;
  902          END;
  903        END;
  904      END SendMyParams;
  905  
  906  (*...............................................*)
  907  
  908    PROCEDURE SendMessage(tipe,DataLnth:CARDINAL):CARDINAL;
  909      VAR
  910        rslt,Seq,Lnth     : CARDINAL;
  911      BEGIN
  912        Tries := 0;
  913        LOOP
  914          SendPacket(tipe,SeqNo,DataLnth);
  915          rslt := ReadPacket(Seq,Lnth,FALSE);
  916          IF (rslt=ERROR) OR (rslt=ACK) THEN
  917            SeqNo := NxtPktNo(SeqNo);
  918            RETURN(rslt);
  919          END;
  920        END;
  921      END SendMessage;
  922  
  923  (*...............................................*)
  924  
  925    PROCEDURE SendFileHeader(VAR Path:ARRAY OF CHAR):CARDINAL;
  926      (* send file header and lnth attribute *)
  927      VAR
  928        rslt,Lnth         : CARDINAL;
  929      BEGIN
  930        Lnth:=Str.Length(FTSupport.FileSpec);
  931        Str.Copy(FTSupport.FBuff,FTSupport.FileSpec);
  932        rslt := SendMessage(FILEHDR,Lnth);
  933        IF rslt # ACK THEN
  934          RETURN(rslt);
  935        END;
  936        IF Path[0] # 0C THEN
  937          Str.Concat(FTSupport.FileSpec,Path,FTSupport.FileSpec);
  938        END;
  939        f := FIO.Open(FTSupport.FileSpec);
  940        IF FIO.IOresult() # 0 THEN
  941          RETURN(ERROR);
  942        END;
  943        IF NOT (ATTPKTS IN Default.Capa) THEN
  944          RETURN(ACK);
  945        END;
  946        FTSupport.SizeInBytes := FIO.Size(f);
  947        SPRINTF.SPrintF1("1$%u",FTSupport.SizeInBytes,FTSupport.FBuff);
  948        Lnth := Str.Length(FTSupport.FBuff);
  949        FTSupport.FBuff[1] := CHR(ToChar(Lnth-2));
  950        FTSupport.NewFilename;
  951        Msg(FileOpened);
  952        RETURN SendMessage(ATTR,Lnth);
  953      END SendFileHeader;
  954  
  955  (*...............................................*)
  956  
  957    PROCEDURE SendFileData():CARDINAL;
  958      TYPE
  959        SetOfChar         = SET OF CHAR;
  960      VAR
  961        rslt,rptr,
  962        bytesread,
  963        NextToSend,first,
  964        last,pbstack      : CARDINAL;
  965        Stack             : ARRAY[0..1] OF CARDINAL;
  966        CtrlChars         : SetOfChar;
  967        RxPos             : LONGCARD;
  968        SndTable          : ARRAY[0..MAXWINDO-1] OF TableEntry;
  969        ReadBuff          : Buffer;
  970  
  971  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  972  
  973      PROCEDURE PushBack(c:CARDINAL);
  974        BEGIN
  975          Stack[pbstack]:=c;
  976          INC(pbstack);
  977        END PushBack;
  978  
  979  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
  980  
  981      PROCEDURE GetChar(VAR c:CARDINAL):CARDINAL;
  982        BEGIN
  983          IF pbstack>0 THEN
  984            DEC(pbstack);
  985            c:=Stack[pbstack];
  986          ELSE
  987            WHILE rptr=bytesread DO
  988              IF bytesread<MAXPACK THEN
  989                c:=0FFFFH;
  990                RETURN(c);
  991              END;
  992              bytesread := FIO.RdBin(f,ReadBuff,MAXPACK);
  993              INC(RxPos,LONGCARD(bytesread));
  994              rptr := 0;
  995            END;
  996            c := ORD(ReadBuff[rptr]);
  997            INC(rptr);
  998          END;
  999          RETURN c;
 1000        END GetChar;
 1001  
 1002  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
 1003  
 1004      PROCEDURE FillBuffer(Index:CARDINAL);
 1005        VAR
 1006          wptr,c,c2,nextc,
 1007          rep,SafetyMargin: CARDINAL;
 1008        BEGIN
 1009          WITH SndTable[Index] DO
 1010            wptr:=0;
 1011            SafetyMargin:=SizeToSend-5;
 1012            IF Default.QBin=0 THEN
 1013              INC(SafetyMargin);
 1014            END;
 1015            WHILE (wptr<=SafetyMargin) AND (GetChar(c) # 0FFFFH) DO
 1016              rep:=1;
 1017              IF Default.Rept>0 THEN (* are we allowed repeated chars? *)
 1018                (* count repeated chars *)
 1019                WHILE (rep<94) AND (GetChar(nextc)=c) DO
 1020                  INC(rep);
 1021                END;
 1022                IF rep<94 THEN
 1023                  PushBack(nextc);
 1024                END;
 1025                IF rep>1 THEN
 1026                  IF rep=2 THEN (* not worth compressing *)
 1027                    PushBack(c);
 1028                  ELSE
 1029                    Data[wptr]:=CHR(Default.Rept);
 1030                    INC(wptr);
 1031                    Data[wptr]:=CHR(ToChar(rep));
 1032                    INC(wptr);
 1033                  END;
 1034                END;
 1035              END;
 1036              c2 := CARDINAL(BITSET(c)*BITSET(127));
 1037              IF (Default.QBin>0) AND (c>127) THEN
 1038                c:=c2;
 1039                Data[wptr]:=CHR(Default.QBin);
 1040                INC(wptr);
 1041              END;
 1042              IF CHR(c) IN CtrlChars THEN
 1043                Data[wptr]:=CHR(Default.QCtl);
 1044                INC(wptr);
 1045                IF (c2<32) OR (c2=127) THEN
 1046                  c:=Ctrl(c);
 1047                END;
 1048              END;
 1049              Data[wptr]:=CHR(c);
 1050              INC(wptr);
 1051            END;
 1052            Lenth := wptr;
 1053            FilePos := RxPos;
 1054          END;
 1055        END FillBuffer;
 1056  
 1057  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
 1058  
 1059      PROCEDURE InitSndTable;
 1060        VAR
 1061          i               : CARDINAL;
 1062        BEGIN
 1063          CtrlChars := SetOfChar{0C..CHR(31),CHR(127),CHR(128)..CHR(159),CHR(255)};
 1064          INCL(CtrlChars,CHR(Default.Rept));
 1065          INCL(CtrlChars,CHR(Default.QBin));
 1066          INCL(CtrlChars,CHR(Default.QCtl));
 1067          pbstack:=0;
 1068          rptr:=0FFFFH;
 1069          bytesread:=rptr;
 1070          first:=0;
 1071          last:=WindowSize-1;
 1072          RxPos := 0;
 1073          FOR i:=0 TO WindowSize-1 DO
 1074            WITH SndTable[i] DO
 1075              PacketNo:=(SeqNo+i) MOD 64;
 1076              Acked:=FALSE;
 1077              Sent := 0;
 1078            END;
 1079            FillBuffer(i);
 1080          END;
 1081        END InitSndTable;
 1082  
 1083  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
 1084  
 1085      PROCEDURE SendIt(Index:CARDINAL):CARDINAL;
 1086        BEGIN
 1087          WITH SndTable[Index] DO
 1088            IF Lenth=0 THEN
 1089              RETURN(OK);
 1090            END;
 1091            IF Sent=MAXTRIES THEN
 1092              RETURN(ERROR);
 1093            END;
 1094            INC(Sent);
 1095            Lib.Move(ADR(Data),ADR(FTSupport.FBuff),Lenth);
 1096            SendPacket(DATA,PacketNo,Lenth);
 1097          END;
 1098          RETURN OK;
 1099        END SendIt;
 1100  
 1101  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
 1102  
 1103      PROCEDURE WindowClosed():BOOLEAN;
 1104        (* Try and find the next packet to send by searching for the next  *)
 1105        (* packet which has not yet been sent and which has length>0. If   *)
 1106        (* one is found then the window has not yet closed, otherwise it   *)
 1107        (* is closed.                                                      *)
 1108        VAR
 1109          i,p             : CARDINAL;
 1110        BEGIN
 1111          p:=NextToSend;
 1112          FOR i:=0 TO WindowSize-1 DO
 1113            WITH SndTable[p] DO
 1114              IF (Sent=0) AND (Lenth>0) THEN
 1115                NextToSend:=p;
 1116                RETURN(FALSE);
 1117              END;
 1118            END;
 1119            p := (p+1) MOD WindowSize;
 1120          END;
 1121          RETURN TRUE;
 1122        END WindowClosed;
 1123  
 1124  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
 1125  
 1126      PROCEDURE Done():BOOLEAN;
 1127        VAR
 1128          i               : CARDINAL;
 1129        BEGIN
 1130          FOR i:=0 TO WindowSize-1 DO
 1131            IF SndTable[i].Lenth>0 THEN
 1132              RETURN(FALSE);
 1133            END;
 1134          END;
 1135          RETURN TRUE;
 1136        END Done;
 1137  
 1138  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
 1139  
 1140      PROCEDURE TestReply():CARDINAL;
 1141        VAR
 1142          next,rslt,Seq,
 1143          Lnth,i,ptr      : CARDINAL;
 1144          GotSOH          : BOOLEAN;
 1145          c               : CHAR;
 1146        BEGIN
 1147          LOOP
 1148            IF FTSupport.AbortRequested() THEN
 1149              Msg(UserAbort);
 1150              RETURN(ERROR);
 1151            END;
 1152            IF Done() THEN
 1153              RETURN(OK);
 1154            END;
 1155            Tries:=0;
 1156            GotSOH:=FALSE;
 1157            IF WindowClosed() THEN
 1158              (* force a wait for a reply *)
 1159              rslt := ReadPacket(Seq,Lnth,FALSE);
 1160            ELSE
 1161              (* Flush input buffer, looking out for a reply *)
 1162              IF RS232.SerialRead(c,0) THEN
 1163                REPEAT
 1164                UNTIL (ORD(c)=SOH) OR (NOT RS232.SerialRead(c,0));
 1165                GotSOH := (ORD(c)=SOH);
 1166              END;
 1167              IF GotSOH THEN
 1168                rslt := ReadPacket(Seq,Lnth,TRUE);
 1169              ELSE
 1170                RETURN OK;
 1171              END
 1172            END;
 1173            CASE rslt OF
 1174              ACK         : ptr:=first;
 1175                            FOR i:=0 TO WindowSize-1 DO
 1176                              WITH SndTable[ptr] DO
 1177                                IF PacketNo=Seq THEN
 1178                                  Acked:=TRUE;
 1179                                END;
 1180                              END;
 1181                              ptr := (ptr+1) MOD WindowSize;
 1182                            END;
 1183                            (* Rotate the table *)
 1184                            WHILE SndTable[first].Acked DO
 1185                              FTSupport.Transferred := SndTable[first].FilePos;
 1186                              FTSupport.UpdateStatus;
 1187                              next := NxtPktNo(SndTable[last].PacketNo);
 1188                              last:=first;
 1189                              first:=(first+1) MOD WindowSize;
 1190                              WITH SndTable[last] DO
 1191                                PacketNo:=next;
 1192                                Acked:=FALSE;
 1193                                Sent:=0;
 1194                              END;
 1195                              FillBuffer(last);
 1196                            END;
 1197                            IF WindowSize=1 THEN
 1198                              RETURN(OK);
 1199                            END;                                            |
 1200              NAK         : ptr:=first;
 1201                            FOR i:=0 TO WindowSize-1 DO
 1202                              WITH SndTable[ptr] DO
 1203                                IF PacketNo=Seq THEN
 1204                                  IF SendIt(ptr)=ERROR THEN
 1205                                    RETURN(ERROR);
 1206                                  END;
 1207                                END;
 1208                              END;
 1209                              ptr := (ptr+1) MOD WindowSize;
 1210                            END;                                            |
 1211              TIMEOUT     : (* resend the oldest UnAcked packet *)
 1212                            IF SendIt(first)=ERROR THEN
 1213                              RETURN(ERROR);
 1214                            END;                                            |
 1215            ELSE
 1216              RETURN ERROR;
 1217            END;
 1218          END;
 1219        END TestReply;
 1220  
 1221  (*. . . . . . . . . . . . . . . . . . . . . . . .*)
 1222  
 1223      BEGIN (* SendFileData *)
 1224        InitSndTable;
 1225        NextToSend:=0;
 1226        rslt:=OK;
 1227        LOOP
 1228          IF Done() THEN
 1229            EXIT;
 1230          END;
 1231          rslt := SendIt(NextToSend);
 1232          IF rslt=ERROR THEN
 1233            EXIT;
 1234          END;
 1235          NextToSend := (NextToSend+1) MOD WindowSize;
 1236          rslt := TestReply();
 1237          IF rslt=ERROR THEN
 1238            EXIT;
 1239          END;
 1240        END;
 1241        SeqNo := SndTable[first].PacketNo;
 1242        IF rslt # ERROR THEN
 1243          rslt:=OK;
 1244        END;
 1245        RETURN rslt;
 1246      END SendFileData;
 1247  
 1248  (*...............................................*)
 1249  
 1250    PROCEDURE TxStateMachine(VAR Wild:ARRAY OF CHAR):CARDINAL;
 1251      TYPE
 1252        TxStates          = (TxInit,TxSendInit,TxSendHdr,TxSendData,TxSendEOF,TxEndSess);
 1253      VAR
 1254        State             : TxStates;
 1255        GotFile           : BOOLEAN;
 1256        rslt              : CARDINAL;
 1257        Path              : ARRAY[0..80] OF CHAR;
 1258        Dir               : FIO.DirEntry;
 1259      BEGIN
 1260        State := TxInit;
 1261        SeqNo := 0;
 1262        LOOP
 1263          IF FTSupport.AbortRequested() THEN RETURN(ERROR) END;
 1264          CASE State OF
 1265            TxInit        : IF NOT GetPath(Wild,Path) THEN
 1266                              RETURN(ERROR);
 1267                            END;
 1268                            GotFile := FIO.ReadFirstEntry(Wild,FIO.FileAttr{},Dir);
 1269                            IF NOT GotFile THEN
 1270                              Error("No Matching Files");
 1271                              RETURN ERROR;
 1272                            END;
 1273                            Str.Copy(FTSupport.FileSpec,Dir.Name);
 1274                            State:=TxSendInit;                              |
 1275            TxSendInit    : IF SendMyParams() # ACK THEN
 1276                              RETURN(ERROR);
 1277                            END;
 1278                            State:=TxSendHdr;                               |
 1279            TxSendHdr     : FTSupport.Transferred:=0;
 1280                            IF SendFileHeader(Path) # ACK THEN
 1281                              RETURN(ERROR);
 1282                            END;
 1283                            State := TxSendData;                            |
 1284            TxSendData    : IF SendFileData()=ERROR THEN
 1285                              RETURN(ERROR);
 1286                            END;
 1287                            State := TxSendEOF;                             |
 1288            TxSendEOF     : IF SendMessage(EOFILE,0) # ACK THEN
 1289                              RETURN(ERROR);
 1290                            END;
 1291                            FIO.Close(f);
 1292                            Msg(FileClosed);
 1293                            GotFile := FIO.ReadNextEntry(Dir);
 1294                            IF GotFile THEN
 1295                              State:=TxSendHdr;
 1296                            ELSE
 1297                              State:=TxEndSess;
 1298                            END;
 1299                            Str.Copy(FTSupport.FileSpec,Dir.Name);          |
 1300            TxEndSess     : IF SendMessage(ENDSESS,0) # ACK THEN
 1301                              RETURN(ERROR);
 1302                            END;
 1303                            Msg(EndSession);
 1304                            RETURN OK;                                      |
 1305          END;
 1306        END;
 1307      END TxStateMachine;
 1308  
 1309  (*...............................................*)
 1310  
 1311    PROCEDURE KermitSend(wild:ARRAY OF CHAR):CARDINAL;
 1312      VAR
 1313        rslt              : CARDINAL;
 1314      BEGIN
 1315        InitVars;
 1316        FTSupport.OpenStatusWindow('SuperKermit Upload');
 1317        rslt := TxStateMachine(wild);
 1318        IF rslt=ERROR THEN
 1319          SendPacket(ERROR,SeqNo,0);
 1320        END;
 1321        FIO.Close(f);
 1322        FTSupport.CloseStatusWindow;
 1323        RETURN rslt;
 1324      END KermitSend;
 1325  
 1326  (*...............................................*)
 1327  
 1328  END Kermit.
 1329  

  467 errors