Programmer Power Tools/Programmer Power Tools.iso/modem/wxtermsr.arc/WXTMXFER.INC

Text File | 1988-02-12 | 40.4 KB | 1,043 lines

{$U-,C-,R-,K-}
  {   - originally written by:
Scott Murphy
77 So. Adams St. #301
Denver, CO 80209
Compuserve 70156,263
  }
  {   - modified to add CRC xmodem, wxmodem 7/86 - 10/86
Peter Boswell
ADI
Suite 650
350 N. Clark St.
Chicago, Il 60610
People/Link: Topper
Compuserve : 72247,3671
  }
CONST
     SOH = 1;                          {Start Of Header}
     EOT = 4;                          {End Of Transmission}
     ACK = 6;                          {ACKnowledge}
     DLE = $10;                        {Data Link Escape}
     XON = $11;                        {X-On}
     XOFF = $13;                       {X-Off}
     NAK = $15;                        {Negative AcKnowledge}
     SYN = $16;                        {Synchronize}
     CAN = $18;                        {CANcel}
     CHARC = $43;                      {C = CRC Xmodem}
     CHARW = $57;                      {W = WXmodem}
     MAXERRS = 10;                     {Maximum allowed errors}
     L = 0;
     H = 1;
     BufLen  = 128;                    {Disk I/O buffer length}
     Bufnum = 64;                      {Disk I/O buffer count}
     Maxwindow = 4;                    {Wxmodem window size}
                                       {CRC byte translation table}
     Crctab: ARRAY[0..255] OF INTEGER =
     (0, 4129, 8258, 12387, 16516, 20645, 24774, 28903,
      -32504,-28375,-24246,-20117,-15988,-11859,-7730,-3601,
      4657, 528, 12915, 8786, 21173, 17044, 29431, 25302,
      -27847,-31976,-19589,-23718,-11331,-15460,-3073,-7202,
      9314, 13379, 1056, 5121, 25830, 29895, 17572, 21637,
      -23190,-19125,-31448,-27383,-6674,-2609,-14932,-10867,
      13907, 9842, 5649, 1584, 30423, 26358, 22165, 18100,
      -18597,-22662,-26855,-30920,-2081,-6146,-10339,-14404,
      18628, 22757, 26758, 30887, 2112, 6241, 10242, 14371,
      -13876,-9747,-5746,-1617,-30392,-26263,-22262,-18133,
      23285, 19156, 31415, 27286, 6769, 2640, 14899, 10770,
      -9219,-13348,-1089,-5218,-25735,-29864,-17605,-21734,
      27814, 31879, 19684, 23749, 11298, 15363, 3168, 7233,
      -4690,-625,-12820,-8755,-21206,-17141,-29336,-25271,
      32407, 28342, 24277, 20212, 15891, 11826, 7761, 3696,
      -97,-4162,-8227,-12292,-16613,-20678,-24743,-28808,
      -28280,-32343,-20022,-24085,-12020,-16083,-3762,-7825,
      4224, 161, 12482, 8419, 20484, 16421, 28742, 24679,
      -31815,-27752,-23557,-19494,-15555,-11492,-7297,-3234,
      689, 4752, 8947, 13010, 16949, 21012, 25207, 29270,
      -18966,-23093,-27224,-31351,-2706,-6833,-10964,-15091,
      13538, 9411, 5280, 1153, 29798, 25671, 21540, 17413,
      -22565,-18438,-30823,-26696,-6305,-2178,-14563,-10436,
      9939, 14066, 1681, 5808, 26199, 30326, 17941, 22068,
      -9908,-13971,-1778,-5841,-26168,-30231,-18038,-22101,
      22596, 18533, 30726, 26663, 6336, 2273, 14466, 10403,
      -13443,-9380,-5313,-1250,-29703,-25640,-21573,-17510,
      19061, 23124, 27191, 31254, 2801, 6864, 10931, 14994,
      -722,-4849,-8852,-12979,-16982,-21109,-25112,-29239,
      31782, 27655, 23652, 19525, 15522, 11395, 7392, 3265,
      -4321,-194,-12451,-8324,-20581,-16454,-28711,-24584,
      28183, 32310, 20053, 24180, 11923, 16050, 3793, 7920);

{*** variables used as globals in this source segment
     (actually global to whole  source) ***}
VAR
   checksum     : INTEGER;
   fname        : bigstring;
   response     : STRING[1];
   crcval,db,sb : INTEGER;
   packetln     : INTEGER;            {128 + Checksum or 128 + CRC}
   p            : parity_set;
   dbuffer      : ARRAY[1..Bufnum,1..BufLen] OF Byte;
   dcount       : INTEGER;
   Wxmode       : BOOLEAN;
   Crcmode      : BOOLEAN;
   Openflag     : BOOLEAN;

PROCEDURE updcrc(a : Byte);
BEGIN
  {
     crcval := Crctab[hi(crcval) xor a] xor (lo(crcval) shl 8);
  }
     InLine(

        $A1/crcval/       {mov ax,crcval     AX <- crcval}
        $89/$C2/          {mov dx,ax         DX <- crcval}
        $88/$E0/          {mov al,ah         (AX) crcval >> 8}
        $B4/$00/          {mov ah,0 }
        $36/              {ss:}
        $8B/$8E/a/        {mov cx,[bp+a]     CX <- a}
        $31/$C8/          {xor ax,cx         AX <- (crcval >> 8) xor a}
        $D1/$E0/          {shl ax,1          AX <- AX * 2  (word index)}
        $BB/crctab/       {mov bx,offset crctab   BX <- addr(crctab)}
        $01/$C3/          {add bx,ax         BX <- addr(crctab)+((crcval>>8)xor a)*2 }
        $2E/              {cs:}
        $8B/07/           {mov ax,[bx]       AX <- contents of crctab}
        $88/$D6/          {mov dh,dl         (DX) crcval << 8}
        $B2/$00/          {mov dl,00}
        $31/$D0/          {xor ax,dx         AX <- contents of crctab xor crcval << 8}
        $A3/crcval        {mov crcval,ax     crcval <- AX}

          );
END;

{ Xmodem transmit window routine
  Peter Boswell, July 1986       }

PROCEDURE txwindow(opt : INTEGER; in_string : bigstring);

BEGIN
   CASE opt OF
       1  :     BEGIN                           {initialize}
                   OpenTemp(36,3,78,18,2);
                   ClrScr;
                   GotoXY(10,1);
                   WRITE('File - ',in_string);
                   GotoXY(10,2);
                   WRITE('Mode -');
                   GotoXY(4,3);
                   WRITE('Total time -');
                   GotoXY(2,4);
                   WRITE('Total Blocks -');
                   GotoXY(10,5);
                   WRITE('Sent -');
                   GotoXY(9,6);
                   WRITE('ACK''d -');
                   GotoXY(6,7);
                   WRITE('Last NAK -');
                   GotoXY(9,8);
                   WRITE('X-Off - No');
                   GotoXY(8,9);
                   WRITE('Window - 0');
                   GotoXY(4,11);
                   WRITE('Last Error -');
                   GotoXY(8,10);
                   WRITE('Errors -');
                END;
       2..11  : BEGIN
                   GotoXY(17,opt);
                   ClrEol;
                   WRITE(in_string);
                END;
       12     : BEGIN
                   GotoXY(3,12);
                   ClrEol;
                   WRITE(in_string);
                END;
       99     : CloseTemp;
   END;                                         {case}
END;
{ Xmodem receive window routine
  Peter Boswell, October 1986       }

PROCEDURE trwindow(opt : INTEGER; in_string : bigstring);

BEGIN
   CASE opt OF
       1  :     BEGIN                           {initialize}
                   OpenTemp(36,3,78,13,2);
                   ClrScr;
                   GotoXY(10,1);
                   WRITE('File - ',in_string);
                   GotoXY(10,2);
                   WRITE('Mode -');
                   GotoXY(6,3);
                   WRITE('Received -');
                   GotoXY(6,4);
                   WRITE('Last NAK -');
                   GotoXY(4,5);
                   WRITE('Last Error -');
                   GotoXY(8,6);
                   WRITE('Errors -');
                END;
       2..6   : BEGIN
                   GotoXY(17,opt);
                   ClrEol;
                   WRITE(in_string);
                END;
       8      : BEGIN
                   GotoXY(3,8);
                   ClrEol;
                   WRITE(in_string);
                END;
       99     : CloseTemp;
   END;                                         {case}
END;
{
  This routine deletes all DLE characters and XOR's the following character
  with 64.  If a SYN character is found then -2 is returned.
    }
FUNCTION dlecgetc(Tlimit : INTEGER) : INTEGER;
VAR
savecgetc : INTEGER;
BEGIN
     IF wxmode THEN
     BEGIN
          savecgetc := cgetc(Tlimit);
          IF savecgetc = SYN THEN
             savecgetc := -2
          ELSE
          IF savecgetc = DLE THEN
          BEGIN
               savecgetc := cgetc(Tlimit);
               IF savecgetc >= 0 THEN savecgetc := savecgetc XOr 64;
          END;
          dlecgetc := savecgetc;
     END
     ELSE
     dlecgetc := cgetc(Tlimit);
END;

PROCEDURE purge;
BEGIN
     WHILE dlecgetc(1) >= 0 DO
                     ;
END;


PROCEDURE SaveCommStatus;
BEGIN
      p := parity;
      db := dbits;
      sb := stop_bits;
      dbits        := 8;
      parity       := none;
      stop_bits    := 1;
      update_uart
END;

PROCEDURE recv_wcp;
{receive a file using Ward Christensen's checksum protocol}
LABEL
     99;
VAR
   j, firstchar, sectnum, sectcurr, prevchar, lignore, blkcnt,
   toterr, errors, sectcomp, bufcurr, bresult : INTEGER;
   Xtrace, EotFlag, ErrorFlag, Extend : BOOLEAN;
   UserKey : Byte;
   blkfile : FILE;
   statstr : bigstring;
   trfile                     : TEXT;
BEGIN
     status(2, 'RECV XMODEM');
     ErrorFlag := TRUE;
     EotFlag   := FALSE;
     Xtrace    := FALSE;
     Openflag  := FALSE;
     Bufcurr   := 1;
     SaveCommStatus;
     WHILE ErrorFlag DO
     BEGIN
          OpenTemp(1,3,80,8,2);
          REPEAT
                WRITE('Enter a filename for download file (<cr> to abort): ');
                READLN(fname);
                supcase(fname);
                IF LENGTH(fname) > 0 THEN
                   IF exists(fname) THEN
                   BEGIN
                     WRITE(fname, ' Exists. OK to overwrite it (Y/N)? ');
                     READLN(response);
                     IF UpCase(response) = 'Y' THEN
                        ErrorFlag := FALSE;
                   END
                   ELSE ErrorFlag := FALSE
          UNTIL (NOT ErrorFlag) OR (LENGTH(fname) = 0);
          CloseTemp;
          IF LENGTH(fname) > 0 THEN
          BEGIN
               Assign(blkfile,fname);
               {$I-} REWRITE(blkfile); {$I+}
               ErrorFlag := (IOResult <> 0);
               IF ErrorFlag THEN
               BEGIN
                  WRITELN(#13,#10,'WXTERM --- cannot open file');
                  GOTO 99;
               END
               ELSE
                  openflag := TRUE;
          END;
          IF LENGTH(fname) = 0 THEN
          BEGIN
               WRITELN(#13,#10,'WXTERM --- user aborted receive.');
               GOTO 99;
          END;
     END;                                       {while}
     trwindow(1, fname);
     blkcnt := 0;
     sectnum := 0;
     errors := 0;
     toterr := 0;
{    assign(trfile,'trace');}
{    rewrite(trfile);}
     Crcmode  := TRUE;                          {Assume CRC versus Checksum}
     Packetln := 130;                           {128 byte data + 2 byte CRC}
     Wxmode   := TRUE;                          {Assume Wxmodem}
     Lignore  := 0;                             {ignore packets after error}
     i:=0;                                      {Try for Wxmodem 3 times}
     purge;
     trwindow(8,'Trying Wxmodem');
     REPEAT
          send(ORD('W'));
          firstchar := cgetc(12);               {12 seconds each}
          IF scan(Extend, UserKey) THEN
               IF UserKey = CAN THEN GOTO 99;
          i := i + 1;
     UNTIL (firstchar=SYN) OR (firstchar=CAN) OR (i=3);
     IF firstchar=CAN THEN GOTO 99;
     IF firstchar <> SYN THEN
     BEGIN
          Wxmode := FALSE;
          i:=0;                                 {Try CRC xmodem 3 times}
          trwindow(8,'Trying CRC Xmodem');
          REPEAT
               send(ORD('C'));
               firstchar := cgetc(4);           {4 seconds each}
               IF scan(Extend,UserKey) THEN
                    IF UserKey = CAN THEN GOTO 99;
               i := i + 1;
          UNTIL (firstchar=SOH) OR (firstchar=CAN) OR (i=3);
          IF firstchar = CAN THEN GOTO 99;
          IF firstchar <> SOH THEN
          BEGIN
               Crcmode  := FALSE;
               Packetln := 129;                 {128 bytes + 1 byte Checksum}
               i:=0;                            {Try Checksum xmodem 4 times}
               trwindow(5,'Trying Checksum Xmodem');
               REPEAT
                    send(NAK);
                    firstchar := cgetc(10);     {10 seconds each}
                    IF scan(Extend,UserKey) THEN
                         IF UserKey = CAN THEN GOTO 99;
                    i := i + 1;
               UNTIL (firstchar=SOH) OR (firstchar=CAN) OR (i=4);
          END;                                  {Checksum}
     END;                                       {CRC}
     IF wxmode THEN
     BEGIN
         trwindow(2,'WXmodem');
     END;
     IF NOT wxmode AND crcmode THEN
     BEGIN
         trwindow(2,'CRC Xmodem');
     END;
     IF NOT wxmode AND NOT crcmode THEN
     BEGIN
         trwindow(2,'Checksum Xmodem');
     END;
     trwindow(8,'Press ^X to quit');
        { firstchar contains the first character and Wxmode and Crcmode
          indicate the type of Xmodem }

     prevchar := firstchar;                     {save the firstchar}
     WHILE (EotFlag = FALSE) AND (Errors < MAXERRS) DO
     BEGIN                                      {locate start of packet}
       IF (firstchar=SOH) AND
          ((Wxmode AND (prevchar=SYN)) OR (NOT Wxmode)) THEN
       BEGIN                                    {process packet}
          prevchar := -1;
          firstchar := -1;
          sectcurr := dlecgetc(15);
{         writeln(trfile,'sectcurr=',sectcurr:4);}
          sectcomp := dlecgetc(15);
          IF sectcurr = (sectcomp XOr 255) THEN
          BEGIN                                 {sequence versus compl good}
               IF sectcurr = ((sectnum + 1) AND 255) THEN
               BEGIN                            {in sequence}
                    crcval   := 0;
                    checksum := 0;
                    j        := 1;
                    REPEAT
                         firstchar := dlecgetc(15);
                         IF firstchar >= 0 THEN
                         BEGIN
                              IF j < 129 THEN
                                 dbuffer[bufcurr,j] := firstchar;
                              IF Crcmode THEN updcrc(firstchar)
                              ELSE checksum := (checksum AND 255) + firstchar;
                              j := j + 1;
                         END;
                    UNTIL (j > Packetln) OR (firstchar < 0);
                    IF j > Packetln THEN        {good packet length}
                    BEGIN
                         IF (Crcmode AND (crcval=0) OR
                         (NOT Crcmode AND ((checksum ShR 1) = firstchar)))
                         THEN
                         BEGIN                  {good crc/checksum}
                              firstchar := -1;  {make sure this byte not used
                                                 for start of packet }                errors  := 0;
                              sectnum := sectcurr;
                              blkcnt  := blkcnt + 1;
                              send(ACK);
                              IF Wxmode THEN send(sectcurr AND 3);
{                             write(trfile,' ACK ');}
{                             if Wxmode then write(trfile,(sectcurr and 3):1);}
                              STR(blkcnt:4,statstr);
                              trwindow(3,statstr);
                              IF errors <> 0 THEN
                              BEGIN
                                 errors := 0;
                                 trwindow(6,'0');
                                 trwindow(5,' ');
                              END;
                              bufcurr := bufcurr + 1;
                              IF bufcurr > bufnum THEN
                              BEGIN             {Disk write routine}
                                   bufcurr := 1;
                                   IF wxmode AND pcjrmode THEN
                                   BEGIN               {if unable to overlap
                                                        disk i/o and comm i/o.}
                                        send(XOFF);    {stop transmitter}
                                        Delay(250);    {give it a chance}
                                   END;
                                   BLOCKWRITE(blkfile,dbuffer,bufnum,bresult);
                                   IF wxmode AND pcjrmode THEN
                                   BEGIN
                                        Flush(blkfile); {complete all i/o}
                                        send(XON);      {restart transmitter}
                                   END;
                                   IF bresult <> bufnum THEN
                                   BEGIN
                                        trwindow(8,'Disk write error');
                                        GOTO 99;
                                   END;
                              END;              {End of disk write routine}
                         END                    {good crc/checksum}
                         ELSE
                         BEGIN                  {bad crc/checksum}
                              trwindow(5,'CRC/Checksum error');
                              STR((blkcnt+1):6,statstr);
                              trwindow(4,statstr);
                              errors := errors + 1;
                              STR(errors:3,statstr);
                              trwindow(6,statstr);
                              toterr := toterr + 1;
                              purge;  {clear any garbage coming in}
                              send(NAK);
                              IF wxmode THEN
                              BEGIN
                                   send(sectcurr AND 3);
                                   lignore := maxwindow;
                              END;
{                             write(trfile,' NAK CRC ',(sectcurr and 3):1);}
                         END;                   {bad crc/checsum}
                    END                         {good packet length}
                    ELSE
                    BEGIN                       {bad packet length}
                         trwindow(5,'Short block error');
                         STR((blkcnt+1):6,statstr);
                         trwindow(4,statstr);
                         errors := errors + 1;
                         STR(errors:3,statstr);
                         trwindow(6,statstr);
                         toterr := toterr + 1;
                         purge;   {clear any garbage}
                         send(NAK);
                         IF wxmode THEN
                         BEGIN
                              send(sectcurr AND 3);
                              lignore := maxwindow;
                         END;
                         purge;   {clear any garbage}
{                        write(trfile,' NAK SHORT ',(sectcurr and 3):1);}
                    END;                        {bad packet length}
               END                              {good block sequence number}
               ELSE
               BEGIN                            {invalid sequence number}
                    IF lignore <= 0 THEN        {are we ignoring packets?}
                    BEGIN
                         trwindow(5,'Out of sequence');
                         STR((blkcnt+1):6,statstr);
                         trwindow(4,statstr);
                         errors := errors + 1;
                         STR(errors:3,statstr);
                         trwindow(6,statstr);
                         toterr := toterr + 1;
                         purge;   {clear any garbage coming in}
                         send(NAK);
                         IF wxmode THEN
                         BEGIN
                              send((sectnum+1) AND 3);
                              lignore := Maxwindow;
                         END;
                         purge;   {clear any garbage coming in}
{                        write(trfile,' NAK SEQ ',((sectnum+1) and 3):1);}
                    END
                    ELSE lignore := lignore -1
               END;                             {invalid sequence number}
          END                                   {valid complement}
          ELSE
          BEGIN                                 {invalid complement}
               trwindow(5,'Sequence complement error');
               STR((blkcnt+1):6,statstr);
               trwindow(4,statstr);
               errors := errors + 1;
               STR(errors:3,statstr);
               trwindow(6,statstr);
               toterr := toterr + 1;
               purge;    {clear any garbage comming in}
               send(NAK);
               IF wxmode THEN
               BEGIN
                    send((sectnum+1) AND 3);
                    lignore := Maxwindow;
               END;
               purge;    {clear any garbage comming in}
{              write(trfile,' NAK CMP ',((sectnum + 1) and 3):1);}
          END;                                  {invalid complement}
       END                                      {process packet}
       ELSE                                     {not start of packet}
       BEGIN
            CASE prevchar OF
              EOT:   BEGIN
                          IF firstchar=EOT THEN
                          BEGIN
                               EotFlag := TRUE;
                               send(ACK);
                          END;
                     END;
              CAN:   BEGIN
                          IF firstchar=CAN THEN
                          GOTO 99;
                     END;
            END;                                {Of case}
            IF NOT EotFlag THEN
            BEGIN
                 IF firstchar=EOT THEN
                 BEGIN
                      send(NAK);  {first EOT received}
                      trwindow(5,' First EOT received');
                 END;
                 prevchar := firstchar;
                 firstchar := cgetc(15);        {start of packet!!!!}
                 IF firstchar=-1 THEN
                 BEGIN
                      IF (prevchar=CAN) OR (prevchar=EOT) THEN
                         firstchar := prevchar  {assume two have been received}
                      ELSE
                      BEGIN
                           trwindow(5,'Timeout on start of packet');
                           STR((blkcnt+1):6,statstr);
                           trwindow(4,statstr);
                           errors := errors + 1;
                           STR(errors:3,statstr);
                           trwindow(6,statstr);
                           send(XON);
                           toterr := toterr + 1;
                           send(NAK);
                           IF wxmode THEN
                           BEGIN
                                send((sectnum+1) AND 3);
                                lignore := Maxwindow;
                           END;
{                          write(trfile,' NAK TIM ',((sectnum+1) and 3):1);}
                      END;
                 END;                           {Timeout at start of packet}
                 IF scan(Extend,UserKey) THEN
                      IF UserKey = CAN THEN GOTO 99;
            END;                                {end of not EotFlag}
         END;                                   {not start of packet}
     END;                                       {xmodem loop}
           {If there are any xmodem packets left in dbuffer, we had best
            write them out}

     IF EotFlag AND (bufcurr>1) THEN
     BEGIN
          bufcurr := bufcurr - 1;
          trwindow(8,'Writing final blocks');
          IF wxmode AND pcjrmode THEN
          BEGIN               {if unable to overlap
                               disk i/o and comm i/o.}
               send(XOFF);    {stop transmitter}
               Delay(250);    {give it a chance}
          END;
          BLOCKWRITE(Blkfile,dbuffer,bufcurr,bresult);
          IF wxmode AND pcjrmode THEN
          BEGIN
               Flush(blkfile); {complete all i/o}
               send(XON);      {restart transmitter}
          END;
          IF bufcurr <> bresult THEN
          BEGIN
               trwindow(8,'Disk write error at end of receive');
               EotFlag := FALSE;                {no longer a 'real' eot}
          END;
     END;

  99:
     IF NOT Eotflag THEN
     BEGIN
          IF errors >= Maxerrs THEN
               trwindow(8,'Maximum errors exceeded')
          ELSE
          IF UserKey = CAN THEN
          BEGIN
               trwindow(5,'^X entered');
               send(CAN); send(CAN); send(CAN);
          END;
          IF firstchar = CAN THEN
               trwindow(5,'Cancel received');
          IF openflag THEN
          BEGIN
               {$I-} CLOSE(blkfile) {$I+};
               i := IOResult;                     {clear ioresult}
               {$I-} Erase(blkfile); {$I+}
               i := IOResult;                     {clear ioresult}
          END;
     END;
     trwindow(8,'Press any key to continue');
     REPEAT
     UNTIL (KeyPressed);
     IF scan(Extend,UserKey) THEN;
     trwindow(99,'  ');
     status(2,'On-Line/Ready');
     status(3,' ');
     status(0,' ');
     dbits        := db;
     parity       := p;
     stop_bits    := sb;
{    close(trfile);}
     update_uart;
END;

PROCEDURE send_wcp;
LABEL
  tran,99;
VAR
   UserKey                    : Byte;
   c, i, j, sectnum, errors   : INTEGER;
   tblks, sblks, ackblks, rblks : INTEGER;        {total, sent, ack'd blocks}
   twindow, awindow           : INTEGER;          {transmission window}
   bresult, nblks, prevchar   : INTEGER;
   bflag, canflag, xpause     : BOOLEAN;
   extend                     : BOOLEAN;
   blkfile                    : FILE;
   statstr                    : bigstring;
   xblk, ackseq               : INTEGER;
   trfile                     : TEXT;

PROCEDURE checkack(tlimit : INTEGER);

VAR
inchar  :   INTEGER;

BEGIN
   REPEAT                                      {until no more data & timelimit}
      inchar := cgetc(0);
      IF inchar <> -1 THEN
      BEGIN                                     {got a character}
         IF wxmode THEN                         {wxmodem}
         BEGIN
{           write(trfile,inchar:4);}
            CASE inchar OF
               XOFF : BEGIN
                         xpause := TRUE;
                         txwindow(8,'Received - waiting');
                      END;
               XON  : BEGIN
                         xpause := FALSE;
                         txwindow(8,'No');
                      END;
               ACK, NAK, CAN :
                      prevchar := inchar;       {save ACK/NAK/CAN}
               0..3 : BEGIN                     {valid ACK/NAK sequence number}
                         CASE prevchar OF
                            ACK : BEGIN
                                     ackseq := inchar - (ackblks AND twindow);
                                     IF ackseq <= 0 THEN
                                        ackseq := ackseq + maxwindow;
                                     nblks := ackblks + ackseq;
                                     IF nblks <= sblks THEN
                                     BEGIN
                                        ackblks := nblks;
                                        STR(ackblks:4,statstr);
                                        txwindow(6,statstr);
                                        IF errors <> 0 THEN
                                        BEGIN
                                           errors := 0;
                                           txwindow(10,'0');
                                        END;
                                     END;
{                                    writeln(trfile,' ACK ',inchar:2,ackblks:5);}
                                     prevchar := -1;
                                  END;                 {case ACK}
                            NAK : BEGIN
                                     ackseq := inchar - (ackblks AND twindow);
                                     IF ackseq <= 0 THEN
                                        ackseq := ackseq + maxwindow;
                                     nblks := ackblks + ackseq;
                                     IF nblks <= sblks THEN
                                     BEGIN
                                        sblks := nblks - 1;
                                        IF (sblks - ackblks) <= 2 THEN
                                           ackblks := sblks;
                                        STR(nblks:4,statstr);
                                        txwindow(7,statstr);
                                        STR(sblks:4,statstr);
                                        txwindow(5,statstr);
                                        errors := errors + 1;
                                        STR(errors:3,statstr);
                                        txwindow(10,statstr);
                                     END
                                     ELSE
                                     BEGIN
                                       GotoXY(3,12);
                                       ClrEol;
                                       WRITELN('Invalid NAK seq ',nblks:4,ackseq:4,inchar:3);
                                     END;
{                                    writeln(0tile,' NAK ',inchar:2,ackblks:5,sblks:5);}
                                     prevchar := -1;
                                  END;                 {case NAK}
                            CAN : BEGIN
                                     IF inchar = CAN THEN
                                        canflag := TRUE;
                                  END;
                         END;                          {of case prevchar}
                      END;                             {case 0..3}
               ELSE                                    {of case inchar}
                  prevchar := -1;       {inchar not XON/XOFF/ACK/NAK/CAN/0/1/2/3}
            END;                                {of case inchar}
         END                                    {wxmodem mode}
         ELSE
         BEGIN                                  {regular xmodem}
            CASE inchar OF
               ACK : BEGIN
                        ackblks := ackblks + 1;
                        errors  := 0;
                     END;
               NAK : BEGIN
                        sblks   := sblks - 1;
                        errors  := errors + 1;
                     END;
               CAN : BEGIN
                        IF prevchar = CAN THEN
                           canflag := TRUE;
                        prevchar   := CAN;
                     END;
            ELSE     prevchar := inchar;
            END;                                {end of case inchar}
         END;                                   {regular xmodem}
      END                                       {end of got a character}
      ELSE                                      {no incoming data, inchar=-1}
      BEGIN
         IF tlimit > 0 THEN
         BEGIN
            Delay(1);
            tlimit := tlimit - 1;
         END;
      END;                                      {end no incoming data}
      IF scan(Extend,UserKey) THEN
      BEGIN
         IF UserKey = CAN THEN
         BEGIN
            canflag := TRUE;
            tlimit  := 0;                       {force end of repeat}
            inchar  := -1;                      { "    "   "  "     }
            xpause  := FALSE;
            purge;
         END;
      END;                                      {end of keypressed}
   UNTIL (tlimit <= 0) AND (inchar = -1);       {repeat until nothing left}
END;                                            {of procedure checkack}

PROCEDURE dlesend(c:INTEGER);
VAR
  j : INTEGER;
BEGIN
   IF wxmode THEN
   BEGIN
      IF buf_start <> buf_end THEN              {if there is any incoming data}
         checkack(0);
      WHILE xpause DO                           {X-Off received .. better wait}
         BEGIN
            j := 0;
            REPEAT
               checkack(0);
               j := j + 1;
               Delay(1);
            UNTIL ((xpause = FALSE) OR (j = 10000));
            IF xpause THEN                      {but not forever}
            BEGIN
               txwindow(8,'No - Timed Out');
               xpause := FALSE;
            END;
         END;
      CASE c OF
         SYN, XON, XOFF, DLE :  BEGIN
                                   send(DLE);
                                   send(c XOr 64);
                                END;
                            ELSE   send(c);
      END;
   END
   ELSE send(c);                                {regular xmodem}
END;


BEGIN
     status(2, 'SEND XMODEM');
     SaveCommStatus;
     openflag := FALSE;
{    assign(trfile,'trace');}
{    rewrite(trfile);}
     OpenTemp(1,3,80,8,2);
     REPEAT
       WRITE('Enter a filename for upload file (<cr> to abort): ');
       READLN(fname);
       supcase(fname);
       IF LENGTH(fname) > 0 THEN
       BEGIN
         bflag := exists(fname);
         IF NOT bflag THEN
         BEGIN
           WRITELN('Could not open file ',fname);
           WRITELN('(Spelling or drive designation wrong?)');
           WRITELN
         END
       END
    UNTIL bflag OR (LENGTH(fname) = 0);
    CloseTemp;
    IF LENGTH(fname) = 0 THEN
      GOTO 99;
    Assign(Blkfile,fname);
    {I-} RESET(Blkfile); {I+}
    IF IOResult <> 0 THEN
       GOTO 99;
    openflag := TRUE;
    txwindow(1,fname);
    tblks := TRUNC(LongFileSize(Blkfile));
    STR((tblks)*22.3333333/speed:6:2,statstr);
    txwindow(3,statstr);
    STR(tblks:4,statstr);
    txwindow(4,statstr);
    txwindow(12,'Press ^X to abort transfer');
    prevchar := -1;
    sblks   := 0;                               {sent blks}
    ackblks := 0;                               {ack'd blocks}
    rblks   := 0;                               {highest read block}
    errors  := 0;
    canflag := FALSE;                           {not cancelled yet}
    xpause  := FALSE;
    UserKey := 0;

                      {Xmodem transmit protocol initialization}

    i := 0;
    REPEAT
      c := cgetc(1);
      IF c <> -1 THEN
      BEGIN                                     {we got a character!}
           i := i + 1;                          {one of our 10 characters}
           CASE c OF
             NAK   :  BEGIN                     {Checksum Xmodem}
                           crcmode := FALSE;
                           wxmode  := FALSE;
                           twindow := 0;
                           txwindow(2,'Checksum Xmodem Send');
                           GOTO tran;
                      END;
             CHARC :  BEGIN                     {CRC Xmodem}
                           crcmode := TRUE;
                           wxmode  := FALSE;
                           twindow := 0;
                           txwindow(2,'CRC Xmodem Send');
                           GOTO tran;
                      END;
             CHARW :  BEGIN                     {WXmodem}
                           crcmode := TRUE;
                           wxmode  := TRUE;
                           twindow := Maxwindow - 1;
                           txwindow(2,'WXmodem Send');
                           STR(Maxwindow:1,statstr);
                           txwindow(9,statstr);
                           GOTO tran;
                      END;
             CAN   :  BEGIN                     {Cancel request received}
                           IF canflag THEN GOTO 99
                           ELSE canflag := TRUE;
                      END;
           END;                                 {of case c}
       END;                                     {got a character}

       IF scan(Extend, UserKey) THEN ;
    UNTIL (i > 10) OR (UserKey = CAN);
    IF UserKey = CAN THEN GOTO 99;
    UserKey := 0;
    txwindow(10,'Could not start: cancelled');
    purge;
    GOTO 99;

tran:                                           {let's send the file!}
    awindow := twindow;
    errors  := 0;
              {Xmodem packet level loop}

    WHILE (ackblks < tblks) AND (errors <= MAXERRS) DO
    BEGIN
       i := 0;
       WHILE (sblks - ackblks) > awindow DO     {is the ack window open?}
       BEGIN                                    {no, so wait for ack/nak}
          i := i + 1;
          IF i <= 1 THEN
          BEGIN
             STR((awindow+1):1,statstr);
             txwindow(9,CONCAT(statstr,' Closed'));
          END;
          checkack(50);                         {50*2400 = 120 seconds +}
          IF canflag THEN
             GOTO 99;
          IF scan(Extend,UserKey) THEN
             IF UserKey = CAN THEN
                GOTO 99;
          IF i > 2400 THEN
          BEGIN
             txwindow(11,'Timeout for ack');
             sblks := ackblks + 1;
             IF sblks > tblks THEN
                GOTO 99;
          END;
          IF (sblks - ackblks) <= awindow THEN
          BEGIN
             STR((awindow+1):1,statstr);
             txwindow(9,statstr);
          END;
       END;                                     {window closed}

       IF sblks < tblks THEN                    {is there anything left?}
       BEGIN
          awindow := twindow;                   {ack window is transmit window}
                           {disk read routine}
          sblks := sblks + 1;
          xblk  := sblks;
          WHILE (xblk > rblks) OR (xblk <= (rblks - bufnum)) DO
          BEGIN
             IF xblk < (rblks - bufnum) THEN    {if we got nak'd back}
             BEGIN
                Seek(blkfile,(xblk-1));
             END;
             BLOCKREAD(blkfile,dbuffer,bufnum,bresult);
             rblks := xblk + bufnum - 1;        {note rblks must go past eof}
          END;                                  {end of disk read routine}

          j := bufnum - rblks + xblk;           {index of next packet}

          crcval := 0;
          checksum := 0;
          STR(xblk:4,statstr);
          txwindow(5,statstr);
          IF wxmode THEN
          BEGIN
             WHILE xpause DO
                BEGIN
                  checkack(15);
                  xpause := FALSE;
                  txwindow(8,'No');
                END;
             send(SYN);
          END;
          dlesend(SOH);
          dlesend(xblk AND 255);                {block sequence}
          dlesend((xblk AND 255) XOr 255);      {complement sequence}
          FOR i := 1 TO 128 DO
          BEGIN
             c := dbuffer[j,i];
             IF crcmode THEN updcrc(c)
             ELSE checksum := (checksum + c) AND 255;
             dlesend(c);
          END;
          IF crcmode THEN
          BEGIN
             dlesend(Hi(crcval));
             dlesend(Lo(crcval));
          END
          ELSE
             send(checksum);
          IF canflag THEN
             GOTO 99;
{         writeln(trfile,'SENT ',sblks:5,xblk:5);}
       END                                      {something to send}
       ELSE
       BEGIN                                    {nothing else to send}
          IF wxmode THEN
          BEGIN
             awindow := sblks - ackblks - 1;    {wait for final acks}
             STR(awindow:1,statstr);
             txwindow(9,CONCAT(statstr,' -- Closing'));
          END;
       END;
    END;                                        {xmodem send routine}

    REPEAT                                      {end of transmission}
      send(EOT);
      UserKey := 0;
      REPEAT
        c := cgetc(15);
        IF scan(Extend,UserKey) THEN ;
      UNTIL (c <> -1) OR (UserKey = CAN);

      IF UserKey = CAN THEN GOTO 99;
      IF c = NAK THEN
      BEGIN
         errors := errors + 1;
         Delay(250);
      END;
    UNTIL (c = ACK) OR (errors = MAXERRS);
    IF errors = MAXERRS THEN
       txwindow(11,'ACK not received at EOT');
    99:
{   close(trfile);}
    IF openflag THEN
    BEGIN
       {$I-} CLOSE(blkfile) {$I+} ;
       i := IOResult;                           {clear ioresult}
    END;
    IF ((UserKey = CAN) OR canflag) AND (LENGTH(fname) > 0) THEN
    BEGIN
      txwindow(11,'Cancel-at your request');
      REPEAT
        send(CAN);
        send(CAN);
        purge
      UNTIL cgetc(1) = -1
    END;
    txwindow(12,'Press any key to continue');
    REPEAT
    UNTIL (KeyPressed);
    IF scan(Extend,UserKey) THEN;
    txwindow(99,'  ');
    status(2,'On-Line/Ready');
    status(3,' ');
    dbits        := db;
    parity       := p;
    stop_bits    := sb;
    update_uart
END;