Columbia Kermit/kermit.zip/pub/rt11pascal/rtproc.pas

Pascal/Delphi Source File | 2020-01-01 | 26KB | 1,293 lines

{ Software Tools in PASCAL -- Procedures used by KERMIT }
{ Also Externals called by Send & Receive Switch }

{$E+}

 PROCEDURE stiphalt; { used by external procedures for halt }
 EXTERNAL;

 PROCEDURE FinishUp(t:boolean);
 EXTERNAL;

  PROCEDURE PutBin(c : character); { Output Binary }
   BEGIN
     IF (c = ENDFILE)
      THEN
     { flush buffer}
     { fill with NULLS -- will be written below }
     WHILE (bptr <= BLKSIZE) DO
      BEGIN
        binbuffer[bptr] := chr(NULLCHAR);
        bptr := bptr + 1;
      END;

      IF bptr > BLKSIZE
       THEN
    BEGIN
      bfile^ := binbuffer;
      put(bfile);
      bptr := 1;
      IF c <> ENDFILE THEN
          putbin(c);
    END
       ELSE
    BEGIN
      binbuffer[bptr] := chr(c);
      bptr := bptr + 1;
    END
   END;



  { close (omsi) -- close a file }
  PROCEDURE Sclose (fd : filedesc);
   BEGIN
     IF (fd >= STDERR) AND (fd <= MAXOPEN)
      THEN
       BEGIN
     WITH openlist[fd] DO
      BEGIN
        IF (mode <= -IOREAD)
         THEN
          BEGIN
        IF (mode = -IOWRITE)
         THEN
         putbin(ENDFILE);
         { flush buffer }
        close(bfile);
        mode := IOERROR;
          END
         ELSE
          BEGIN
        close(filevar);
        mode := IOAVAIL;
          END
      END;
       END
   END;


  PROCEDURE ResetLine; { Reset DL11 Line }
  EXTERNAL;


  PROCEDURE ConUP; { Console upper case only }
  EXTERNAL;

  { close all files on exit }
  PROCEDURE closeall;
  VAR
    fd : filedesc;
   BEGIN
     FOR fd := STDERR TO MAXOPEN DO
     Sclose(fd);
     ResetLine;
     ConUP;
   END;



  { Open file in Binary Mode }
  FUNCTION Obinary (VAR intname : string100; omode : integer) : filedesc;
  VAR
    len : integer;
   BEGIN
     IF (omode = -IOREAD)
      THEN
       BEGIN
     reset(bfile, intname,'',len);
     binbuffer  := bfile^;
     bptr := 1;
       END
      ELSE
       BEGIN
     rewrite(bfile, intname);
     bptr := 1;
       END;
     IF (omode = -IOREAD) AND (len <= 0)
      THEN
       BEGIN
     sclose(BINARYFILE);
     Obinary := IOERROR;
       END
      ELSE
       BEGIN
         Obinary := BINARYFILE;
     openlist[BINARYFILE].mode := omode;
       END;
   END;


  { open (RT-11) -- open a file for reading or writing }
  FUNCTION Sopen (VAR name : string; omode : integer) : filedesc;
  VAR
    i ,len: integer;
    intname : string100;
    found : boolean;
   BEGIN
     i := 1;
     WHILE (name[i] <> ENDSTR) AND (name[i] <> NEWLINE) DO
      BEGIN
    intname[i] := chr(name[i]);
    i := i + 1
      END;

     FOR i := i TO MAXSTR DO
     intname[i] := ' ';      { pad name with blanks }

     IF (omode < IOERROR)
      THEN
      Sopen := obinary(intname,omode)
      ELSE
       BEGIN

     { find a free slot in openlist }
     Sopen := IOERROR;
     found := false;
     i := 1;
     WHILE (i <= MAXOPEN) AND (NOT found) DO
      BEGIN
        IF (openlist[i].mode = IOAVAIL)
         THEN
         WITH openlist[i] DO
          BEGIN
        mode := omode;
        IF (mode = IOREAD)
         THEN
         reset(filevar, intname,'',len)
         ELSE
         IF (mode = IOWRITE)
          THEN
          rewrite(filevar, intname);

        IF (len <= 0) AND (mode=IOREAD)
         THEN
          BEGIN
            Sclose(i);
            Sopen := IOERROR
          END
         ELSE
         Sopen:=i;

        found := true
          END;
        i := i + 1
      END
       END
   END;

  { getcf (UCB) -- get one character from file }
  FUNCTION getcf (VAR c: character; fd : filedesc) : character;
  FORWARD;

  { getc (UCB) -- get one character from standard input }
  FUNCTION getc (VAR c : character) : character;
  VAR
    ch : char;
   BEGIN
     IF (redirect[STDIN] = STDIN )
      THEN
       BEGIN
     IF eof
      THEN
      c := ENDFILE
      ELSE
      IF eoln
       THEN
        BEGIN
          readln;
          c := NEWLINE
        END
       ELSE
        BEGIN
          read(ch);
          c := ord(ch)
        END;
     getc := c
       END
      ELSE
      getc := getcf(c,redirect[STDIN])
   END;


  PROCEDURE GETCL(VAR c : character;VAR t :integer);
   { Get Character from DL11 Line }
   { TimeLeft is also used }
  EXTERNAL;

  PROCEDURE GetBin(VAR c: character); { Get Binary character }
   BEGIN
     IF bptr > BLKSIZE
      THEN
       BEGIN
     get(bfile);
     binbuffer := bfile^;
     IF eof(bfile)
      THEN
      c := ENDFILE
      ELSE
       BEGIN
         bptr := 1;
         getbin(c);
       END;
       END
      ELSE
       BEGIN
     c := ord(binbuffer[bptr]);
     bptr := bptr + 1;
       END
   END;

  FUNCTION getcf; { Get Character from file }
  VAR
    ch : char;
   BEGIN
     IF (fd = STDIN)
      THEN
      getcf := getc(c)
      ELSE WITH openlist[fd] DO
      IF (mode = IOLINE)
       THEN
    BEGIN
      GETCL(c,TimeLeft);
      { strip parity }
      IF (parity <> oNONE) THEN
        c := c AND 177B;
    END
       ELSE
       IF (mode = -IOREAD)
    THEN
    GETBIN(c)
    ELSE
    IF eof(filevar)
     THEN
     c := ENDFILE
     ELSE
     IF eoln(filevar)
      THEN
       BEGIN
         readln(filevar);
         c := NEWLINE
       END
      ELSE
       BEGIN
         read(filevar, ch);
         c := ord(ch)
       END;
     getcf := c
   END;

  { getline (UCB) -- get a line from file }
  FUNCTION getline (VAR s : string; fd : filedesc;
            maxsize : integer) : boolean;
  VAR
    i : integer;
    c : character;
   BEGIN
     i := 1;
      REPEAT
       s[i] := getcf(c, fd);
       i := i + 1
      UNTIL (c = ENDFILE) OR (c = NEWLINE) OR (i >= maxsize);
     IF (c = ENDFILE)
      THEN   { went one too far }
      i := i - 1;
     s[i] := ENDSTR;
     getline := (c <> ENDFILE)
   END;

  { putcf (UCB) -- put a single character on file fd }
  PROCEDURE putcf (c : character; fd : filedesc);
  FORWARD;

  { putc (UCB) -- put one character on standard output }
  PROCEDURE putc (c : character);
   BEGIN
     IF (redirect[STDOUT] = STDOUT)
      THEN
      IF c = NEWLINE
       THEN
       writeln
       ELSE
       write(chr(c))
      ELSE
      putcf(c,redirect[STDOUT]);
   END;

  PROCEDURE PUTCL(VAR c : character); { Output character to DL11 Line }
  EXTERNAL;

  PROCEDURE putcf; { Put character to file }
   BEGIN
     IF (fd = STDOUT)
      THEN
      putc(c)
      ELSE WITH openlist[fd] DO
      IF (mode = IOLINE)
       THEN
       PUTCL(c)
       ELSE
       IF (mode = -IOWRITE)
    THEN
    PUTBIN(c)
    ELSE
    IF c = NEWLINE
     THEN
     writeln(filevar)
     ELSE
     write(filevar, chr(c))
   END;

  { putstr (UCB) -- put out string on file }
  PROCEDURE putstr (VAR s : string; f : filedesc);
  VAR
    i : integer;
   BEGIN
     i := 1;
     WHILE (s[i] <> ENDSTR) AND (i < MAXSTR) DO
      BEGIN
    putcf(s[i], f);
    i := i + 1
      END
   END;

  PROCEDURE Xbreak(VAR f : text);
    { As External since break is already defined }
  EXTERNAL;


  PROCEDURE Obreak(fd : filedesc);
   BEGIN
     IF (fd = STDOUT)
      THEN
      Xbreak(output)
      ELSE
      Xbreak(openlist[fd].filevar);
   END;

PROCEDURE GTLINE(var commandLine : string80);
BEGIN
  write('KERMIT-RT> ');
  Obreak(STDOUT);
  readln(commandLine);
END;


  { itoc - convert integer n to char string in s[i]... }
  FUNCTION itoc (n : integer; VAR s : string; i : integer) : integer;
     { returns end of s }
   BEGIN
     IF (n < 0)
      THEN
       BEGIN
     s[i] := ord('-');
     itoc := itoc(-n, s, i+1)
       END
      ELSE
       BEGIN
     IF (n >= 10)
      THEN
      i := itoc(n DIV 10, s, i);
     s[i] := n MOD 10 + ord('0');
     s[i+1] := ENDSTR;
     itoc := i + 1
       END
   END;

  { length -- compute length of string }
  FUNCTION length (VAR s : string) : integer;
  VAR
    n : integer;
   BEGIN
     n := 1;
     WHILE (s[n] <> ENDSTR) DO
     n := n + 1;
     length := n - 1
   END;

  { scopy -- copy string at src[i] to dest[j] }
  PROCEDURE scopy (VAR src : string; i : integer;
           VAR dest : string; j : integer);
   BEGIN
     WHILE (src[i] <> ENDSTR) DO
      BEGIN
    dest[j] := src[i];
    i := i + 1;
    j := j + 1
      END;
     dest[j] := ENDSTR
   END;

  { index -- find position of character c in string s }
  FUNCTION index (VAR s : string; c : character) : integer;
  VAR
    i : integer;
   BEGIN
     i := 1;
     WHILE (s[i] <> c) AND (s[i] <> ENDSTR) DO
     i := i + 1;
     IF (s[i] = ENDSTR)
      THEN
      index := 0
      ELSE
      index := i
   END;


  PROCEDURE CtoS({ Using } x:cstring; { Returning } VAR s:string);
    { convert constant to STIP string }
  VAR
    i : integer;
   BEGIN
     FOR i:=1 TO CONLENGTH DO
     s[i] := ord(x[i]);
     s[CONLENGTH+1] := ENDSTR;
   END;


  FUNCTION Exists({ Using }VAR s:string): { Returning } boolean;
    { returns true if file exists }
  VAR
    fd: filedesc;
    result: boolean;
   BEGIN
     fd  := Sopen(s,IOREAD);
     result := (fd <> IOERROR);
     Sclose(fd);
     Exists := result;
   END;



  FUNCTION nargs: integer; { returns number arguments }
    { for RT - 11 }
   BEGIN
     nargs := cmdargs
   END;


  FUNCTION getarg(n:integer;VAR s:string;maxsize:integer): BOOLEAN;
    { return the nth argument }
    { RT - 11 }
   BEGIN
     IF ((n<1) OR (cmdargs<n))
      THEN
      getarg := false
      ELSE
       BEGIN
     scopy(cmdlin,cmdidx[n],s,1);
     getarg := true
       END;
   END;


  PROCEDURE PutCon({ Using } x:cstring;
           { Using } fd:filedesc);
    { output literal }
  VAR
    s: string;
   BEGIN
     CtoS(x,s);
     putstr(s,fd);
     obreak(fd);
   END;

  PROCEDURE PutCln({ Using } x:cstring;
           { Using } fd:filedesc);
    { output literal followed by NEWLINE }
   BEGIN
     PutCon(x,fd);
     putcf(NEWLINE,fd);
     obreak(fd);
   END;

  PROCEDURE PutNum({ Using } n:integer;
           { Using } fd:filedesc);
    { Ouput number }
  VAR
    s: string;
    dummy: integer;
   BEGIN
     s[1] := BLANK;
     dummy := itoc(n,s,2);
     putstr(s,fd);
     obreak(fd);
   END;

  PROCEDURE PutCS({ Using } x:cstring;
          { Using } s : string;
          { Using } fd:filedesc);
    { output literal & string }
   BEGIN
     PutCon(x,fd);
     putstr(s,fd);
     putcf(NEWLINE,fd);
     obreak(fd);
   END;

  PROCEDURE PutCN({ Using } x:cstring;
          { Using } v : integer;
          { Using } fd:filedesc);
    { output literal & number }
   BEGIN
     PutCon(x,fd);
     PutNum(v,fd);
     putcf(NEWLINE,fd);
     obreak(fd);
   END;

  { For KERMIT }

  PROCEDURE AddTo({ Updating } VAR sum : Stats;
          { Using }  inc:integer);
   BEGIN
     sum := sum + inc;
   END;



  PROCEDURE PutPacket( p : Ppack); { Output Packet }
  VAR
    i : integer;
   BEGIN
     IF (Pad >0)
      THEN
      FOR i := 1 TO Pad DO
      putcf(PadChar,LineOut);
     WITH p^ DO
      BEGIN
    putcf(mark,LineOut);
    putcf(count,LineOut);
    putcf(seq,LineOut);
    putcf(ptype,LineOut);
    putstr(data,LineOut);
      END;
   END;

  FUNCTION GetIn { Returning } :character;  { get character }
    { Should return NULL  ) if no characters }
  VAR
    c :character;
   BEGIN
     c := getcf(c,LineIn);
     GetIn := c;

     IF (RunType = Receive) AND (c <> NULLCHAR)
      THEN
      AddTo(ChInPackRecv,1);

   END;


  PROCEDURE StartTimer;
   BEGIN
     TimeLeft := TheirTimeOut * 60; { in ticks }
   END;

  PROCEDURE StopTimer;
   BEGIN
     TimeLeft := MaxInt; { * 60 }
   END;

  FUNCTION MakeChar({ Using } c:character): { Returning } character;
    { convert integer to printable }
   BEGIN
     MakeChar := c + BLANK;
   END;

  FUNCTION UnChar({ Using } c:character): { Returning } character;
    { reverse of makechar }
   BEGIN
     UnChar := c - BLANK
   END;


  FUNCTION IsControl( c:character):  boolean;
    { true if control }
   BEGIN
     { assume -128 .. 127 for characters }
     IF (c >= NULLCHAR)
      THEN
      IsControl := (c=DEL ) OR (c < BLANK )
      ELSE
      IsControl := IsControl(c + 128);
   END;



  FUNCTION Ctl( c:character):  character;
    { c XOR 100 }
   BEGIN
     { assume -128 .. 127 for characters }
     IF (c >= NULLCHAR)
      THEN
      IF (c < 64)
       THEN
       c := c + 64
       ELSE
       c := c - 64
      ELSE
      c := Ctl(c + 128) - 128;
     Ctl := c;
   END;


  FUNCTION CheckFunction({ Using } c:integer): { Returning } character;
    { calculate checksum }
  VAR
    x: integer;
   BEGIN
     {   CheckFunction := (c + ( c AND 300 ) /100 ) AND 77; }
     x := (c MOD 256 ) DIV 64;
     x := x + c;
     CheckFunction := x MOD 64;
   END;

  PROCEDURE EnCodeParm({ Updating } VAR data:string);  { encode parameters }
  VAR
    i: integer;
   BEGIN
     FOR i:=1 TO NUMPARAM DO
     data[i] := BLANK;
     data[NUMPARAM+1] := ENDSTR;
     data[1] := MakeChar(SizeRecv);          { my biggest packet }
     data[2] := MakeChar(MyTimeOut);         { when I want timeout}
     data[3] := MakeChar(MyPad);             { how much padding }
     data[4] := Ctl(MyPadChar);              { my padding character }
     data[5] := MakeChar(myEOL);             { my EOL }
     data[6] := MyQuote;                     { my quote char }

    { Handle 8 Bit Quoting - for transmit use our default }

     IF RunType = Transmit
    THEN
      data[7] := Def8QuoteMode          { Default mode  }
    ELSE
    { For receive -- these may have to be changed }
      IF (QuoteForBinary = TYPEY) THEN
        IF (Def8QuoteMode <> TYPEY) THEN
            BEGIN
              BinaryMode := Quoted;
              data[7] := DEF8CHAR;
              QuoteForBinary := DEF8CHAR;
            END
        ELSE
            BEGIN
              BinaryMode := FullBinary;
              data[7] := TYPEY;
            END
      ELSE IF (QuoteForBinary = TYPEN) THEN
        data[7] := TYPEY
      ELSE IF (QuoteForBinary = BLANK) THEN
        data[7] := BLANK
      ELSE
        data[7] := TYPEY;

    { Make sure that Quote Character is OK }
    IF (RunType = Receive) AND (BinaryMode <> Quoted)
        THEN
          QuoteForBinary := ENDSTR;

  END;

  PROCEDURE DeCodeParm({ Using } VAR data:string); { decode parameters }
  VAR
    i,l : integer;
   BEGIN
     l := length(data);
     IF l < NUMPARAM
      THEN
    FOR i := l + 1 TO NUMPARAM DO
        data[i] := BLANK;
     data[NUMPARAM+1] := ENDSTR;
     SizeSend := UnChar(data[1]);    { Packet Size }
     TheirTimeOut := UnChar(data[2]);   { when I should time out }
     Pad := UnChar(data[3]);            { padding characters to send  }
     PadChar := Ctl(data[4]);           { padding character }
     IF data[5] = BLANK
    THEN SendEOL := CR
    ELSE SendEOL := UnChar(data[5]);{ EOL to send }
     IF data[6] = BLANK
    THEN SendQuote := SHARP
    ELSE SendQuote := data[6];      { quote to send }
     QuoteForBinary := data[7];        { 8 Bit Quote Character }

    { Change these if Full Binary not available }
    { Use NotSupported if 'N' received          }

     IF QuoteForBinary = TYPEY THEN
          BinaryMode := FullBinary
     ELSE IF QuoteForBinary = BLANK THEN
          BinaryMode := FullBinary
     ELSE IF QuoteForBinary = TYPEN THEN
          BinaryMode := NotSupported
     ELSE
          BinaryMode := Quoted;

    { Set it to quoted if we asked for it }
     IF (RunType = Transmit) AND (QuoteForBinary = TYPEY) AND
    (Def8QuoteMode <> TYPEY) THEN
    BEGIN
      BinaryMode := Quoted;
      QuoteForBinary := Def8QuoteMode;
    END;

    { Make sure that Quote Character is OK }
     IF (RunType = Transmit) AND (BinaryMode <> Quoted) THEN
          QuoteForBinary := ENDSTR;
  END;

  { Externals for RT-11 }

  PROCEDURE ICON; { set up console }
  EXTERNAL;

  PROCEDURE ITIME; { set up timer }
  EXTERNAL;

  PROCEDURE RCON;  { Reset console }
  EXTERNAL;

  PROCEDURE RTIME; { Reset Timer }
  EXTERNAL;

  PROCEDURE Virtual; { Virtual terminal }
  EXTERNAL;

  PROCEDURE SetLine; { Set up DL11 line }
  EXTERNAL;

  PROCEDURE SYSinit; { special initialization }
   BEGIN
   END;


  PROCEDURE SYSfinish; { System dependent }
   BEGIN
     RTIME;
     RCON;
   END;

  PROCEDURE StartRun; { initialization as necessary }
   BEGIN
     State := Init;              { send initiate is the start state }
     NumTry := 0;                { say no tries yet }
     RunTime := 0;

     NumSendPacks := 0;
     NumRecvPacks := 0;
     NumACK := 0;
     NumNAK := 0;
     NumACKrecv := 0;
     NumNAKrecv := 0;
     NumBADrecv := 0;
     ChInFileSend := 0.0;
     ChInPackSend := 0.0;
     ChInFileRecv := 0.0;
     ChInFileRecv := 0.0;

     ITIME;
     ICON;

   END;

  PROCEDURE OpenPort;
   BEGIN
     IF InvalidConnection
      THEN
       BEGIN
     InvalidConnection := false;
     LineIn := DL11LINE;
     LineOut := DL11LINE;
     SetLine;
       END;
   END;

  PROCEDURE BadVTerminalConnect;
   BEGIN;
     writeln('Bad Terminal Connection');
   END;


  PROCEDURE MakeConnection;
    { connect to remote }
   BEGIN
     writeln('[Connecting to remote host, Type CTRL-]C to return]');
     Virtual;
     writeln('[Connection closed, back at RT-11]');
   END;


  PROCEDURE DebugPacket({ Using }    mes : cstring;
            { Using }  VAR p : Ppack);
    { Print Debugging Info }
   BEGIN
     PutCon(mes,STDERR);
     WITH p^ DO
      BEGIN
    PutNum(Unchar(count),STDERR);
    PutNum(Unchar(seq),STDERR);
    putcf(BLANK,STDERR);
    putcf(ptype,STDERR);
    putcf(NEWLINE,STDERR);
    putstr(data,STDERR);
    putcf(NEWLINE,STDERR);
      END;
   END;


  PROCEDURE ReSendPacket;
    { re -sends previous packet }
   BEGIN
     NumSendPacks := NumSendPacks+1;
     AddTo(ChInPackSend,Pad + UnChar(LastPacket^.count) + 3);
     IF Debug
      THEN DebugPacket('Re-Sending ...      ',LastPacket);
     PutPacket(LastPacket);
   END;



  PROCEDURE SendPacket;
    { expects count as length of data portion }
    { and seq as number of packet }
    { builds & sends packet }
  VAR
    i,len,chksum : integer;
    temp : Ppack;
   BEGIN
     IF (NumTry <> 1) AND (RunType = Transmit )
      THEN
      ReSendPacket
      ELSE
       BEGIN
     WITH ThisPacket^ DO
      BEGIN
        mark :=SOH;               { mark }
        len := count;             { save length }
        count := MakeChar(len+3); { count = 3+length of data }
        seq := MakeChar(seq);     { seq number }
        chksum := count + seq + ptype;
        IF ( len > 0)
         THEN      { is there data ? }
         FOR i:= 1 TO len DO
         IF (data[i] >= 0)
          THEN
          chksum := chksum + data[i]
          ELSE
          chksum := chksum + data[i] + 256;
          { assume -128 .. 127 for characters }
        chksum := CheckFunction(chksum);  { calculate  checksum }
        data[len+1] := MakeChar(chksum);  { make printable & output }
        IF OneWayOnly THEN
        BEGIN
              data[len+2] := CR;          { Use CRLF }
              data[len+3] := NEWLINE;
              data[len+4] := ENDSTR;
        END
        ELSE
        BEGIN
              data[len+2] := SendEOL;          { EOL }
              data[len+3] := ENDSTR;
        END;
      END;


     NumSendPacks := NumSendPacks+1;
     IF Debug
      THEN DebugPacket('Sending ...         ',ThisPacket);

     PutPacket(ThisPacket);

     IF RunType = Transmit
      THEN
       BEGIN
         AddTo(ChInPackSend,Pad + len + 6);
         temp := LastPacket;
         LastPacket := ThisPacket;
         ThisPacket := temp;
       END;
       END
   END;



  PROCEDURE SendACK({ Using } n:integer); { send ACK packet }
   BEGIN
     WITH ThisPacket^ DO
      BEGIN
    count := 0;
    seq := n;
    ptype := TYPEY;
      END;
     SendPacket;
     NumACK := NumACK+1;
   END;

  PROCEDURE SendNAK({ Using } n:integer); { send NAK packet }
   BEGIN
     WITH ThisPacket^ DO
      BEGIN
    count := 0;
    seq := n;
    ptype := TYPEN;
      END;
     SendPacket;
     NumNAK := NumNAK+1;
   END;

  PROCEDURE ErrorPack({ Using } c:cstring);
    { output Error packet if necessary -- then exit }
   BEGIN
     IF Local
      THEN
      Putcln(c,STDERR);

      WITH ThisPacket^ DO
      BEGIN
        seq := n;
        ptype := TYPEE;
        CtoS(c,data);
        count := length(data);
      END;

     SendPacket;
     FinishUp(false);
     StipHalt;
   END;



  PROCEDURE Verbose({ Using } c:cstring);
    { Print message if verbosity }
   BEGIN
     IF Verbosity
      THEN
      Putcln(c,STDERR);
   END;


  PROCEDURE PutErr({ Using } c:cstring);
    { Print error_messages }
   BEGIN
     IF Local
      THEN
      Putcln(c,STDERR);
   END;

{$E-}
{ Turn off Externals here }

  PROCEDURE Field1; { Count }
  VAR
    test: boolean;
   BEGIN
     WITH NextPacket^ DO
      BEGIN
    count := UnChar(t);
    test := (count >= 3) OR (count <= SizeRecv-2);
    InputPacket^.count := t;
    IF NOT test
     THEN
     Verbose('Bad count           ');
    isgood := isgood AND test;
      END;
   END;

  PROCEDURE Field2; { Packet Number }
  VAR
    test : boolean;
   BEGIN
     WITH NextPacket^ DO
      BEGIN
    seq := UnChar(t);
    test := (seq >= 0) OR (seq <= 63);
    InputPacket^.seq := t;
    IF NOT test
     THEN
     Verbose('Bad seq number      ');
    isgood := isgood AND test;
      END;
   END;

  PROCEDURE Field3; { Packet Type }
  VAR
    test : boolean;
   BEGIN
     WITH NextPacket^ DO
      BEGIN
    ptype := t;
    test := (t =TYPEB) OR (t=TYPED) OR (t=TYPEE) OR (t=TYPEF)
    OR (t=TYPEN) OR (t=TYPES) OR (t=TYPEY) OR (t=TYPEZ);
    InputPacket^.ptype := t;
    IF NOT test
     THEN
     Verbose('Bad Packet Type     ');
    isgood := isgood AND test;
      END;
   END;

  PROCEDURE ProcessQuoted; { for Data }
   BEGIN
     WITH NextPacket^ DO
      BEGIN
    IF (t=MyQuote) OR (t=QuoteForBinary)
     THEN    { character is quote }
      BEGIN
        IF control
         THEN        { quote ,quote  }
          BEGIN
        data[dataptr] := t + ishigh;
        dataptr := dataptr+1;
        control := false;
        ishigh := 0;
          END
         ELSE IF (t=MyQuote) THEN  { set control on }
            control := true
      END
     ELSE                 { not quote }
     IF control
      THEN      { convert to control }
       BEGIN
         data[dataptr] := ctl(t) + ishigh;
         dataptr := dataptr+1;
         control := false;
         ishigh := 0;
       END
      ELSE      { regular data }
       BEGIN
         data[dataptr] := t + ishigh;
         dataptr := dataptr+1;
         ishigh := 0;
       END;
      END;
   END;

  PROCEDURE Field4; { Data }
   BEGIN
     PacketPtr := PacketPtr+1;
     InputPacket^.data[PacketPtr] := t;
     WITH NextPacket^ DO
      BEGIN
    IF ((ptype = TYPES) or (ptype = TYPEY))
     THEN
       BEGIN
         data[dataptr] := t;
         dataptr := dataptr+1;
       END
    ELSE
       BEGIN
         IF (BinaryMode = Quoted) THEN
        BEGIN { has it been quited ?}
          IF (NOT control) AND (t = QuoteForBinary)
            THEN ishigh := 128
          ELSE
            ProcessQuoted;
        END
         ELSE
           ProcessQuoted;  { do regular quoting }
       END;
      END;
   END;

  PROCEDURE Field5; { Check Sum }
  VAR
    test : boolean;
   BEGIN
     WITH InputPacket^ DO
      BEGIN
    PacketPtr := PacketPtr +1;
    data[PacketPtr] := t;
    PacketPtr := PacketPtr +1;
    data[PacketPtr] := ENDSTR;
      END;
     { end of input string }
     check := CheckFunction(check);
     check := MakeChar(check);
     test := (t=check);
     isgood := isgood AND test;
     NextPacket^.data[dataptr] := ENDSTR;
     { end of data string }
     finished := true;  { set finished }
   END;

  PROCEDURE BuildPacket;
    { receive packet & validate checksum }
  VAR
    temp : Ppack;
   BEGIN
     WITH NextPacket^ DO
      BEGIN
    IF restart
     THEN
      BEGIN
        { read until get SOH marker }
        IF  (t = SOH)
         THEN
          BEGIN
        finished := false;    { set varibles }
        control := false;
        ishigh := 0;          { no shift }
        isgood := true;
        seq := -1;       { set return values to bad packet }
        ptype := QUESTION;
        data[1] := ENDSTR;
        data[MAXSTR] := ENDSTR;

        restart := false;
        fld := 0;
        dataptr := 1;
        PacketPtr := 0;
        check := 0;
          END;
      END
     ELSE                          { have started packet }
      BEGIN
        IF (t=SOH)          { check for restart or EOL }
         THEN
         restart := true
         ELSE
         IF (t=myEOL)
          THEN
           BEGIN
         finished := true;
         isgood := false;
           END
          ELSE
           BEGIN
         CASE fld OF
           { increment field number }
           0:   fld := 1;
           1:   fld := 2;
           2:   fld := 3;
           3:
           IF (count=3)  { no data }
            THEN
            fld := 5
            ELSE
            fld := 4;
           4:
           IF (PacketPtr>=count-3) { end of data }
            THEN
            fld := 5;
          END { case };

         IF (fld<>5)
          THEN
          check := check+t; { add into checksum }

         CASE fld OF
           1:      Field1;
           2:      Field2;
           3:      Field3;
           4:      Field4;
           5:      Field5;
          END;
         { case }
           END;
      END;

    IF finished
     THEN
      BEGIN
        IF (ptype=TYPEE)  AND isgood
         THEN   { error_packets }
          BEGIN
        IF Local
         THEN
         putstr(data,STDERR);
        putcf(NEWLINE,STDERR);
        FinishUp(false);
        StipHalt;
          END;

        NumRecvPacks := NumRecvPacks+1;
        IF Debug
         THEN
          BEGIN
        DebugPacket('Received ...        ',InputPacket);
        IF isgood
         THEN
         PutCln('Is Good             ',STDERR);
          END;

        temp := CurrentPacket;
        CurrentPacket := NextPacket;
        NextPacket := temp;
      END;
      END;
   END;

{$E+}
{ Turn on Externals here }

  FUNCTION RecvPacket: boolean;
   BEGIN
     StartTimer;
     finished := false;
     restart := true;
     FromConsole := nothing;  { No Interupt }
      REPEAT
       t := GetIn;
       IF Local   { check Interupt }
    THEN
    CASE FromConsole OF
      abortnow:
       BEGIN
         ErrorPack('Aborting Transfer   ');
       END;
      nothing:        { nothing };
      CRin:
       BEGIN
         t := MyEOL;
         FromConsole := nothing;
       END;
     END;
    { case }
       IF (t <> NULLCHAR)
    THEN
    BuildPacket;
      UNTIL finished  OR (TimeLeft <= 0);
     IF (TimeLeft <= 0)
      THEN
       BEGIN
     CurrentPacket^.ptype := TYPET;
     restart := true;
     isgood := true;
     Verbose('Timed Out           ')
       END;
     StopTimer;
     RecvPacket := isgood;
   END;

  FUNCTION RecvACK : { Returning } boolean;
    { receive ACK with correct number }
  VAR
    Ok: boolean;
   BEGIN
     IF (NOT OneWayOnly )
      THEN
      Ok := RecvPacket;
     WITH CurrentPacket^ DO
      BEGIN
    IF (ptype=TYPEY)
     THEN
     NumACKrecv := NumACKrecv+1
     ELSE
     IF (ptype=TYPEN)
      THEN
      NumNAKrecv := NumNAKrecv+1
      ELSE
      IF NOT OneWayOnly
       THEN
       NumBadrecv := NumBadrecv +1;
       { got right one ? }
    RecvACK := ( Ok AND (ptype=TYPEY) AND (n=seq))
                 OR  ( OneWayOnly)
      END;
   END;