{ PICS0E.INC Pascal Integrated Communications System Overlays }
  { 5/25/87 Ver 1.6 Copyright 1987 by Les Archambault }

  Overlay procedure RecvFile(var xfrname:filename;var xfrfile:untype_file;
                     var block:integer;mode:char;var Abort_batch:boolean);
    const
      maxerr=10;
      start_err=25;

    var
      CRCmode, timeout, EndOfFile, write_err,KMDmode,firstime: boolean;
      bt,blocknum,blockcpl,cancel: byte;
      ch: char;
      count:real;
      errcnt,recs,i,mv,vv: integer;
      file_buf:buf_ptr;

    Begin
      New(file_buf);
      SetSect(rcvdrv,rcvusr);
      OK := FALSE; firstime:=true;
      cancel:=0;
      EndOfFile := FALSE;
      CRCmode := TRUE;
      KMDmode:=false;
      errcnt := 0;
      recs:=1;
      if (mode='K') or (mode='B') then KMDmode:=true;
      repeat
        bt := (GetByte(4, timeout) and $7F);
        if timeout then
            begin
              errcnt := succ(errcnt);
              if (errcnt > 5) and (mode<>'B')
                then
                  begin
                    CRCmode := not CRCmode;
                    Writeln('Switching to Checksum');
                  end;
              if CRCmode then
                begin
                  PutByte(ord('C'));
                  if not KMDmode then PutByte(ord('K'));
                end
              else PutByte(ord(NAK))
            end
        else
          begin
            if bt=ord(CAN) then cancel:=succ(cancel)
            else if cancel>0 then cancel:=0;
            if cancel>=2 then errcnt:=start_err;
          end;
      { SOH and EOT must be solicited to be valid, but CAN may be sent anytime }
      until ((errcnt>0) and (bt in [ord(SOH), ord(EOT),ord(STX)])) or
            (errcnt >= start_err);
      cancel:=0;
      if errcnt >= start_err then errcnt:=maxerr
        else errcnt := 0;
      while (not EndOfFile) and (errcnt<maxerr) do
        begin
          case chr(bt) of
            SOH: begin
                   count:=lps;
                   if ch_carck then
                     while (not ch_inprdy) and (count>0) do count:=count-1.0;
                   blocknum := ch_inp;
                   count:=lps;
                   if ch_carck then
                     while (not ch_inprdy) and (count>0) do count:=count-1.0;
                   blockcpl := not ch_inp;
                   for i := 1 to 128 do
                     begin
                       count:=lps;
                       if ch_carck then
                         while (not ch_inprdy) and (count>0) do count:=count-1.0;
                       file_buf^[i] := ch_inp;
                     end;
                   count:=lps;
                   if ch_carck then
                     while (not ch_inprdy) and (count>0) do count:=count-1.0;
                   mv := ch_inp;
                   if CRCmode then
                     begin
                       count:=lps;
                       if ch_carck then
                          while (not ch_inprdy) and (count>0) do count:=count-1.0;
                        mv := swap(mv) or ch_inp;
                      end;
                   OK := (blocknum = blockcpl);
                   if cancel>0 then cancel:=0;
                   if OK then
                     begin
                       OK := (blocknum = lo(block));
                       if OK then
                         begin
                           vv := 0;
                           if CRCmode then
                              begin
                                for i := 1 to 128 do
                                updcrc(vv, file_buf^[i]);
                                updcrc(vv, 0);
                                updcrc(vv, 0)
                              end
                           else
                             begin
                               for i := 1 to 128 do
                                 vv := vv + file_buf^[i];
                               vv := lo(vv)
                             end;
                           OK := (mv = vv);
                           if OK then
                             begin
                               {$I-} blockwrite(XfrFile, file_buf^, 1) {$I+};
                               write_err:=(IOresult<>0);
                               if write_err then
                                 begin
                                   ok:=false;
                                   write('  ++ Disk or directory full');
                                 end;
                             end
                           else if CRCmode then write('  ++ CRC ')
                           else write('  ++ Checksum ')
                         end
                       else
                         begin
                           OK := (blocknum = lo(pred(block)));
                           if not OK then
                             write('  ++ Block number');
                         end
                     end
                   else write('  ++ Block complement mismatch');
                   ch := GetChar;           { Monitor local console }
                   if OK
                     then
                       begin
                         if (block = 1) and firstime then
                           begin
                             firstime:=false;
                             if CRCmode then writeln('CRC mode selected.')
                               else writeln('Checksum mode selected.');
                           end;
                         write(CR); clrEol;
                         write('Received Record: ', recs);
                         recs:=succ(recs);
                         block:=succ(block) mod 256;
                         errcnt := 0;
                         putbyte(ord(ACK));
                       end
                     else
                       begin
                         errcnt := succ(errcnt);
                         writeln(' - error ', errcnt, ' ++');
                         if write_err
                           then
                             begin
                               errcnt := maxerr;
                               putbyte(ord(CAN));
                               putbyte(ord(CAN));
                             end
                           else
                             begin
                               repeat bt:=GetByte(1,timeout)
                               until timeout;
                               putbyte(ord(NAK));
                             end;
                       end;
                 end;
            STX: begin
                   count:=lps;
                   if ch_carck then
                     while (not ch_inprdy) and (count>0) do count:=count-1.0;
                   blocknum := ch_inp;
                   count:=lps;
                   if ch_carck then
                     while (not ch_inprdy) and (count>0) do count:=count-1.0;
                   blockcpl := not ch_inp;
                   for i := 1 to 1024 do
                     begin
                       count:=lps;
                       if ch_carck then
                         while (not ch_inprdy) and (count>0) do count:=count-1.0;
                       file_buf^[i] := ch_inp;
                     end;
                   count:=lps;
                   if ch_carck then
                     while (not ch_inprdy) and (count>0) do count:=count-1.0;
                   mv := ch_inp;
                   if CRCmode then
                     begin
                       count:=lps;
                       if ch_carck then
                         while (not ch_inprdy) and (count>0) do count:=count-1.0;
                       mv := swap(mv) or ch_inp;
                     end;
                   if cancel>0 then cancel:=0;
                   OK := (blocknum = blockcpl);
                   if OK then
                     begin
                       OK := (blocknum = lo(block));
                       if OK then
                         begin
                           vv := 0;
                           if CRCmode then
                              begin
                                for i := 1 to 1024 do
                                updcrc(vv, file_buf^[i]);
                                updcrc(vv, 0);
                                updcrc(vv, 0)
                              end
                           else
                             begin
                               for i := 1 to 1024 do
                                 vv := vv + file_buf^[i];
                               vv := lo(vv)
                             end;
                           OK := (mv = vv);
                           if OK then
                             begin
                               {$I-} blockwrite(XfrFile, file_buf^, 8) {$I+};
                               write_err := (IOresult<>0);
                               if write_err then
                                 begin
                                   OK:=false;
                                   write('  ++ Disk or directory full');
                                 end;
                             end
                           else if CRCmode then write('  ++ CRC ')
                           else write('  ++ Checksum ')
                         end
                       else
                         begin
                           OK := (blocknum = lo(pred(block)));
                           if not OK then
                             write('  ++ Block number');
                         end
                     end
                   else write('  ++ Block complement mismatch');
                   ch := GetChar;           { Monitor local console }
                   if OK
                     then
                       begin
                         if (block = 1) and firstime then
                           begin
                             firstime:=false;
                             if CRCmode then writeln('CRC mode selected.')
                               else writeln('Checksum mode selected.');
                           end;
                         write(CR); clrEol;
                         write('Received Records: ',recs,'-',recs+7);
                         recs:=recs+8;
                         block:=succ(block) mod 256;
                         errcnt := 0;
                         putbyte(ord(ACK));
                       end
                     else
                       begin
                         errcnt := succ(errcnt);
                         writeln(' - error ', errcnt, ' ++');
                         if write_err
                           then
                             begin
                               errcnt := maxerr;
                               putbyte(ord(CAN));
                               putbyte(ord(CAN));
                             end
                           else
                             begin
                               repeat bt:=GetByte(1,timeout) until timeout;
                               putbyte(ord(NAK));
                             end;
                       end;
                 end;

            EOT: begin
                   EndOfFile := TRUE;
                   putbyte(ord(ACK));
                 end;
            CAN: begin
                   cancel:=succ(cancel);
                   if cancel>=2 then
                     begin
                       OK := FALSE;
                       errcnt := maxerr;
                       writeln('Sender Cancelled');
                     end;
                 end;
            else begin
                   OK := FALSE;
                   if cancel>0 then cancel:=0;
                   if timeout then write('  ++ Timeout')
                     else  write('  ++ Received ', bt, ', not SOH');
                   errcnt := succ(errcnt);
                   writeln(' - error ', errcnt, ' ++');
                   repeat
                     bt:=getbyte(1,timeout);
                   until timeout;
                   putbyte(ord(NAK));
                 end;
          end;  {case}
          if (not endoffile) and (errcnt<maxerr) then
            bt:=(getbyte(10,timeout) and $7F);  {get next SOH etc}
        end;   {while}
      if (mode='B') and (errcnt>=maxerr) then abort_batch:=true;
      if (errcnt>=maxerr) and (not ok) then
        begin
          repeat
            bt:=getbyte(1,timeout);
          until timeout;
          putbyte(ord(CAN));
          putbyte(ord(CAN));
        end;
      dispose(file_buf);
    end;

{end of PICS0E.inc }