{ 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;